wow, looks like all tests pass...

.hgignore

@@ -12,7 +12,6 @@ junk*
 *.tar.bz2
 *.log
 *.err
-*.res
 *.out
 gc
 gc6.8

eval.c

@@ -103,17 +103,19 @@ static sexp sexp_flatten_dot (sexp ls) {
   return sexp_nreverse(sexp_reverse_flatten_dot(ls));
 }
 
-static int sexp_param_index (sexp params, sexp name) {
-  int i=0;
-  while (sexp_pairp(params)) {
-    if (sexp_car(params) == name)
+static int sexp_param_index (sexp lambda, sexp name) {
+  sexp ls = sexp_lambda_params(lambda);
+  int i = 0;
+  for (i=0; sexp_pairp(ls); ls=sexp_cdr(ls), i++)
+    if (sexp_car(ls) == name)
       return i;
-    params = sexp_cdr(params);
-    i++;
-  }
-  if (params == name)
+  if (ls == name)
     return i;
-  return -1;
+  ls = sexp_lambda_locals(lambda);
+  for (i=-1; sexp_pairp(ls); ls=sexp_cdr(ls), i--)
+    if (sexp_car(ls) == name)
+      return i;
+  return -10000;
 }
 
 /************************* bytecode utilities ***************************/
@@ -150,8 +152,10 @@ static void emit(char c, sexp context)  {
 }
 
 static void emit_word(sexp_uint_t val, sexp context)  {
+  unsigned char *data;
   expand_bcode(context, sizeof(sexp));
-  *((sexp_uint_t*)(&(sexp_bytecode_data(sexp_context_bc(context))[sexp_context_pos(context)]))) = val;
+  data = sexp_bytecode_data(sexp_context_bc(context));
+  *((sexp_uint_t*)(&(data[sexp_context_pos(context)]))) = val;
   sexp_context_pos(context) += sizeof(sexp);
 }
 
@@ -324,6 +328,7 @@ static sexp analyze_lambda (sexp x, sexp context) {
   sexp_lambda_params(res) = sexp_cadr(x);
   sexp_lambda_fv(res) = SEXP_NULL;
   sexp_lambda_sv(res) = SEXP_NULL;
+  sexp_lambda_locals(res) = SEXP_NULL;
   context = sexp_child_context(context, res);
   sexp_context_env(context)
     = extend_env(sexp_context_env(context),
@@ -514,12 +519,10 @@ static void generate_non_global_ref (sexp name, sexp cell, sexp lambda,
                                      sexp fv, sexp context, int unboxp) {
   sexp_uint_t i;
   sexp loc = sexp_cdr(cell);
-  sexp_debug("cell: ", cell);
   if (loc == lambda && sexp_lambdap(lambda)) {
     /* local ref */
-    sexp_debug("params: ", sexp_lambda_params(lambda));
     emit(OP_LOCAL_REF, context);
-    emit_word(sexp_param_index(sexp_lambda_params(lambda), name), context);
+    emit_word(sexp_param_index(lambda, name), context);
   } else {
     /* closure ref */
     for (i=0; sexp_pairp(fv); fv=sexp_cdr(fv), i++)
@@ -642,9 +645,12 @@ static void generate_lambda (sexp lambda, sexp context) {
   fv = sexp_lambda_fv(lambda);
   ctx = sexp_new_context(sexp_context_stack(context));
   sexp_context_lambda(ctx) = lambda;
+  /* allocate space for local vars */
+  for (ls=sexp_lambda_locals(lambda); sexp_pairp(ls); ls=sexp_cdr(ls))
+    emit_push(SEXP_UNDEF, ctx);
   /* box mutable vars */
   for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) {
-    k = sexp_param_index(sexp_lambda_params(lambda), sexp_car(ls));
+    k = sexp_param_index(lambda, sexp_car(ls));
     if (k >= 0) {
       emit(OP_LOCAL_REF, ctx);
       emit_word(k, ctx);
@@ -710,7 +716,7 @@ static sexp diff_free_vars (sexp fv, sexp params) {
 /*   sexp_debug("diff-free-vars: ", fv); */
 /*   sexp_debug("params: ", params); */
   for ( ; sexp_pairp(fv); fv=sexp_cdr(fv))
-    if (sexp_param_index(params, sexp_ref_name(sexp_car(fv))) < 0)
+    if (sexp_memq(sexp_ref_name(sexp_car(fv)), params) == SEXP_FALSE)
       sexp_push(res, sexp_car(fv));
 /*   sexp_debug(" => ", res); */
   return res;
@@ -720,7 +726,7 @@ static sexp free_vars (sexp x, sexp fv) {
   sexp fv1, fv2;
   if (sexp_lambdap(x)) {
     fv1 = free_vars(sexp_lambda_body(x), SEXP_NULL);
-    fv2 = diff_free_vars(fv1, sexp_lambda_params(x));
+    fv2 = diff_free_vars(fv1, sexp_flatten_dot(sexp_lambda_params(x)));
     sexp_lambda_fv(x) = fv2;
     fv = union_free_vars(fv2, fv);
   } else if (sexp_pairp(x)) {
@@ -763,6 +769,7 @@ static sexp make_opcode_procedure (sexp op, sexp_uint_t i, sexp env,
   sexp_lambda_params(lambda) = params;
   sexp_lambda_fv(lambda) = SEXP_NULL;
   sexp_lambda_sv(lambda) = SEXP_NULL;
+  sexp_lambda_locals(lambda) = SEXP_NULL;
   sexp_context_lambda(context) = lambda;
   sexp_context_top(context) = top;
   env = extend_env(env, params, lambda);
@@ -1396,6 +1403,10 @@ sexp compile (sexp x, sexp context) {
 
 sexp eval_in_context (sexp obj, sexp context) {
   sexp thunk = compile(obj, context);
+  if (sexp_exceptionp(thunk)) {
+    sexp_print_exception(obj, cur_error_port);
+    return SEXP_UNDEF;
+  }
   return apply(thunk, SEXP_NULL, context);
 }
 
@@ -1431,10 +1442,14 @@ void repl (sexp context) {
     obj = sexp_read(cur_input_port);
     if (obj == SEXP_EOF)
       break;
-    res = eval_in_context(obj, context);
-    if (res != SEXP_UNDEF) {
-      sexp_write(res, cur_output_port);
-      sexp_write_char('\n', cur_output_port);
+    if (sexp_exceptionp(obj)) {
+      sexp_print_exception(obj, cur_error_port);
+    } else {
+      res = eval_in_context(obj, context);
+      if (res != SEXP_UNDEF) {
+        sexp_write(res, cur_output_port);
+        sexp_write_char('\n', cur_output_port);
+      }
     }
   }
 }

sexp.c

@@ -36,7 +36,9 @@ static char sexp_separators[] = {
   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, /* x5_ */
 };
 
-#define digit_value(c) (((c)<='9') ? ((c) - '0') : ((toupper(c) - 'A') + 10))
+static int digit_value (c) {
+  return (((c)<='9') ? ((c) - '0') : ((toupper(c) - 'A') + 10));
+}
 
 static int is_separator(int c) {
   /* return (!((c-9)&(~3))) | (~(c^4)); */
@@ -133,9 +135,12 @@ sexp sexp_print_exception(sexp exn, sexp out) {
 }
 
 static sexp sexp_read_error(char *message, sexp irritants, sexp port) {
-  return sexp_make_exception(the_read_error_symbol, sexp_make_string(message),
+  sexp name = (sexp_port_name(port)
+               ? sexp_make_string(sexp_port_name(port)) : SEXP_FALSE);
+  return sexp_make_exception(the_read_error_symbol,
+                             sexp_make_string(message),
                              irritants,
-                             sexp_make_string(sexp_port_name(port)),
+                             name,
                              sexp_make_integer(sexp_port_line(port)));
 }
 
@@ -382,6 +387,7 @@ sexp sexp_get_output_string(sexp port) {
 sexp sexp_make_input_port(FILE* in) {
   sexp p = sexp_alloc_type(port, SEXP_IPORT);
   sexp_port_stream(p) = in;
+  sexp_port_name(p) = NULL;
   sexp_port_line(p) = 0;
   return p;
 }
@@ -389,6 +395,7 @@ sexp sexp_make_input_port(FILE* in) {
 sexp sexp_make_output_port(FILE* out) {
   sexp p = sexp_alloc_type(port, SEXP_OPORT);
   sexp_port_stream(p) = out;
+  sexp_port_name(p) = NULL;
   sexp_port_line(p) = 0;
   return p;
 }
@@ -480,7 +487,12 @@ void sexp_write (sexp obj, sexp out) {
   } else if (sexp_integerp(obj)) {
     sexp_printf(out, "%ld", sexp_unbox_integer(obj));
   } else if (sexp_charp(obj)) {
-    if ((33 <= sexp_unbox_character(obj)) && (sexp_unbox_character(obj) < 127))
+    if (obj == sexp_make_character(' '))
+      sexp_write_string("#\\space", out);
+    else if (obj == sexp_make_character('\n'))
+      sexp_write_string("#\\newline", out);
+    else if ((33 <= sexp_unbox_character(obj))
+             && (sexp_unbox_character(obj) < 127))
       sexp_printf(out, "#\\%c", sexp_unbox_character(obj));
     else
       sexp_printf(out, "#\\x%02d", sexp_unbox_character(obj));
@@ -700,49 +712,59 @@ sexp sexp_read_raw (sexp in) {
       res = sexp_read_number(in, 10); break;
     case 'x':
       res = sexp_read_number(in, 16); break;
-/*     case 'e': */
-/*     case 'i': */
+    case 'e':
+      res = sexp_read(in);
+      if (sexp_flonump(res))
+        res = sexp_make_integer((sexp_sint_t)sexp_flonum_value(res));
+      break;
+    case 'i':
+      res = sexp_read(in);
+      if (sexp_integerp(res))
+        res = sexp_make_flonum(sexp_unbox_integer(res));
+      break;
     case 'f':
     case 't':
       c2 = sexp_read_char(in);
       if (c2 == EOF || is_separator(c2)) {
         res = (c1 == 't' ? SEXP_TRUE : SEXP_FALSE);
+        sexp_push_char(c2, in);
       } else {
-        return sexp_read_error("invalid syntax #%c%c",
-                               sexp_list2(sexp_make_character(c1),
-                                          sexp_make_character(c2)),
-                               in);
+        res = sexp_read_error("invalid syntax #%c%c",
+                              sexp_list2(sexp_make_character(c1),
+                                         sexp_make_character(c2)),
+                              in);
       }
-      sexp_push_char(c2, in);
       break;
     case ';':
       sexp_read_raw(in);
       goto scan_loop;
     case '\\':
       c1 = sexp_read_char(in);
-      c2 = sexp_read_char(in);
-      if (c2 == EOF || is_separator(c2)) {
-        sexp_push_char(c2, in);
+      str = sexp_read_symbol(in, c1);
+      if (str[0] == '\0')
+        res =
+          sexp_read_error("unexpected end of character literal", SEXP_NULL, in);
+      if (str[1] == '\0') {
         res = sexp_make_character(c1);
-      } else if ((c1 == 'x' || c1 == 'X') && isxdigit(c2)) {
-        c1 = sexp_read_char(in);
-        res = sexp_make_character(16 * digit_value(c2) + digit_value(c1));
+      } else if ((c1 == 'x' || c1 == 'X') &&
+                 isxdigit(str[0]) && isxdigit(str[1]) && str[2] == '\0') {
+        res = sexp_make_character(16 * digit_value(c1) + digit_value(str[1]));
       } else {
-        str = sexp_read_symbol(in, c1);
         if (strcasecmp(str, "space") == 0)
           res = sexp_make_character(' ');
         else if (strcasecmp(str, "newline") == 0)
-          res = sexp_make_character('\r');
+          res = sexp_make_character('\n');
         else if (strcasecmp(str, "return") == 0)
           res = sexp_make_character('\r');
         else if (strcasecmp(str, "tab") == 0)
           res = sexp_make_character('\t');
         else {
-          return sexp_read_error("unknown character name",
-                                 sexp_list1(sexp_make_string(str)),
-                                 in);
+          res = sexp_read_error("unknown character name",
+                                sexp_list1(sexp_make_string(str)),
+                                in);
         }
       }
+      sexp_free(str);
       break;
     case '(':
       sexp_push_char(c1, in);
@@ -750,17 +772,17 @@ sexp sexp_read_raw (sexp in) {
       if (! sexp_listp(res)) {
         if (! sexp_exceptionp(res)) {
           sexp_deep_free(res);
-          return sexp_read_error("dotted list not allowed in vector syntax",
-                                 SEXP_NULL,
-                                 in);
+          res = sexp_read_error("dotted list not allowed in vector syntax",
+                                SEXP_NULL,
+                                in);
         }
       } else {
         res = sexp_list_to_vector(res);
       }
       break;
     default:
-      return sexp_read_error("invalid # syntax",
-                             sexp_list1(sexp_make_character(c1)), in);
+      res = sexp_read_error("invalid # syntax",
+                            sexp_list1(sexp_make_character(c1)), in);
     }
     break;
   case '.':

tests/test03-nested-closure.scm

@@ -0,0 +1,8 @@
+
+((lambda (a b)
+   ((lambda (c d e)
+      (write (+ e (* c 1000) (* a 100) (* b 10) d))
+      (newline))
+    (- a 2) (+ b 2) 10000))
+ 3 5)
+

tests/test05-internal-define.res

@@ -0,0 +1 @@
+1000 1003

tests/test05-internal-define.scm

@@ -0,0 +1,8 @@
+
+(let ((a 1000))
+  (define b (+ a 3))
+  (write a)
+  (display " ")
+  (write b)
+  (newline))
+

tests/test07-mutation.res

@@ -0,0 +1 @@
+11357