Misc. reader improvements, plus ability to run *.rla directly.

Fix tree_replace() to handle recursive data structures.
Fix some other minor bugs in the reader and interpreter.
Implement comment-escapes in the string parser, for more readable input.
Allow input program files (*.rla) to be invoked directly, with arguments.
Add a simple string->number converter as a builtin function.

builtin.c

@@ -5,6 +5,7 @@
 
 #include "gc.h"
 #include "builtin.h"
+#include "interp.h"
 
 static gc_root_t builtin_list;
 
@@ -12,6 +13,8 @@ static void register_structure(gc_root_t *ms_root);
 static void register_template(gc_root_t *ms_root);
 static void register_lambda(gc_root_t *ms_root);
 
+static void bi_string_to_number(interp_state_t *state);
+
 void builtin_init(void)
 {
   gc_root_t ms_root;
@@ -20,6 +23,7 @@ void builtin_init(void)
   register_gc_root(&ms_root, UNDEFINED);
 
   register_builtin(BI_UNDEFINED, UNDEFINED);
+  register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number));
 
   register_structure(&ms_root);
   register_template(&ms_root);
@@ -167,4 +171,26 @@ static void register_lambda(gc_root_t *ms_root)
 
 #undef SS
 
+static void bi_string_to_number(interp_state_t *state)
+{
+  char *str;
+  char *end;
+  fixnum_t num;
+  value_t rval;
+
+  str = value_to_string(CAR(state->argv.value));
+  num = strtol(str, &end, 0);
+  free(str);
+
+  if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num))
+    rval = cons(fixnum_value(num), NIL);
+  else
+    rval = cons(FALSE_VALUE, NIL);
+
+  state->lambda.value = state->k.value;
+  state->argv.value   = rval;
+  state->k.value      = FALSE_VALUE;
+  state->ctx.value    = FALSE_VALUE;
+}
+
 /* vim:set sw=2 expandtab: */

builtin.h

@@ -13,6 +13,9 @@
 #define BI_TEMPLATE  "template"
 #define BI_LAMBDA    "lambda"
 
+/* Name of builtin function */
+#define BI_STRING_TO_NUMBER "string->number"
+
 #define STRUCTURE_SLOT_NAME     0
 #define STRUCTURE_SLOT_SUPER    1
 #define STRUCTURE_SLOT_SLOTS    2

gc.h

@@ -51,7 +51,7 @@ typedef void (builtin_fn_t)(struct interp_state *state);
 
 /* Special values (0 <= n < 1024) */
 /* These correspond to objects within the first page of memory */
-#define SPECIAL_VALUE(n)  ((value_t)(4*(n)+2))
+#define SPECIAL_VALUE(n)  ((value_t)(4*(n)+4))
 #define TYPE_TAG(n)       SPECIAL_VALUE(768+(n))
 #define MAX_SPECIAL       SPECIAL_VALUE(1023)
 

interp.c

@@ -208,16 +208,21 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
   struct_t *ts;
   vector_t *l_inst;
   byte_string_t *t_inst;
+  value_t temp;
+
+  if (struct_is_a(templ, lambda_type_root.value))
+    return templ;
+
+  release_assert(struct_is_a(templ, template_type_root.value));
   
   register_gc_root(&templ_root, templ);
   register_gc_root(&lambda_root, make_struct(lambda_type_root.value, LAMBDA_SLOTS));
   
   /* Need to do this first, since it can call the garbage collector. */
-  _LAMBDA_SLOT(lambda_root.value, INSTANCE_VARS) =
+  temp = make_vector(get_byte_string(get_struct(templ_root.value)
-    make_vector(get_vector(get_struct(templ_root.value)
+                                       ->slots[TEMPLATE_SLOT_INSTANCE_VARS])->size,
-                             ->slots[TEMPLATE_SLOT_INSTANCE_VARS])
-                  ->size,
                      UNDEFINED);
+  _LAMBDA_SLOT(lambda_root.value, INSTANCE_VARS) = temp;
 
   ls = _get_struct(lambda_root.value);
   ts = _get_struct(templ_root.value);

reader.c

@@ -10,7 +10,9 @@
 typedef struct reader_state
 {
   FILE *file;
-  char ch;
+  int ch;
+  int line;
+  int column;
   gc_root_t ref_alist;
   gc_root_t weak_list;
   gc_root_t ref_list;
@@ -31,6 +33,7 @@ static value_t read_definition(reader_state_t *state);
 static value_t read_backref(reader_state_t *state);
 
 static void next_char(reader_state_t *state);
+static void skip_whitespace(reader_state_t *state);
 
 static value_t make_placeholder(reader_state_t *state, fixnum_t ref);
 static value_t get_placeholder(reader_state_t *state, fixnum_t ref);
@@ -48,6 +51,7 @@ value_t read_value(FILE *f)
   register_gc_root(&state.ref_list, NIL);
 
   state.file = f;
+  state.line = state.column = 1;
   next_char(&state);
   result = read_one_value(&state);
   ungetc(state.ch, f);
@@ -63,9 +67,7 @@ value_t read_value(FILE *f)
 
 static value_t read_one_value(reader_state_t *state)
 {
-  while (isspace(state->ch))
+  skip_whitespace(state);
-    next_char(state);
-
   release_assert(state->ch != EOF);
 
   switch (state->ch)
@@ -80,6 +82,8 @@ static value_t read_one_value(reader_state_t *state)
   case '\"':
     return read_string(state);
   default:
+    fprintf(stderr, "Unexpected character '%c' in input on line %d, column %d.\n",
+        state->ch, state->line, state->column);
     release_assert(NOTREACHED("Unexpected character in input."));
     return UNDEFINED;
   }
@@ -170,9 +174,7 @@ static value_t read_list(reader_state_t *state)
 
   while (!done)
   {
-    while (isspace(state->ch))
+    skip_whitespace(state);
-      next_char(state);
-
     release_assert(state->ch != EOF);
 
     switch (state->ch)
@@ -184,9 +186,7 @@ static value_t read_list(reader_state_t *state)
         value_t temp = read_one_value(state);
         reverse_list(&list_root.value, temp);
 
-        while (isspace(state->ch))
+        skip_whitespace(state);
-          next_char(state);
-
         release_assert(state->ch == ')');
         next_char(state);
 
@@ -202,17 +202,14 @@ static value_t read_list(reader_state_t *state)
       break;
     default:
       {
-        value_t temp;
+        value_t temp = read_one_value(state);
-        list_root.value = cons(UNDEFINED, list_root.value);
+        list_root.value = cons(temp, list_root.value);
-        temp = read_one_value(state);
-        _CAR(list_root.value) = temp;
       }
       break;
     }
   }
 
   unregister_gc_root(&list_root);
-
   return list_root.value;
 }
 
@@ -225,8 +222,13 @@ static value_t read_number(reader_state_t *state)
   {
     negative = true;
     next_char(state);
-    release_assert(isdigit(state->ch));
   }
+  else if (state->ch == '+')
+  {
+    next_char(state);
+  }
+
+  release_assert(isdigit(state->ch));
 
   while (isdigit(state->ch))
   {
@@ -256,10 +258,10 @@ static value_t read_string(reader_state_t *state)
 
   while (state->ch != '"')
   {
-    bool skip_whitespace = false;
+    bool skip_ws = false;
     char ch;
 
-    if ((buffer_size - length) < 2)
+    if ((buffer_size - length) < 1)
     {
       release_assert(buffer_size <= INT32_MAX / 3);
       buffer_size = (3 * buffer_size) / 2;
@@ -315,7 +317,14 @@ static value_t read_string(reader_state_t *state)
       case '\t':
       case '\v':
       case '\n':
-        skip_whitespace = true;
+        skip_ws = true;
+        break;
+      case ';':
+        /* Treats everything that follows on the same line as a comment,
+         * and additionally skips leading whitespace on the next line. */
+        while (state->ch != '\n')
+          next_char(state);
+        skip_ws = true;
         break;
       case '\\': ch = '\\'; next_char(state); break;
       case '\'': ch = '\''; next_char(state); break;
@@ -335,8 +344,10 @@ static value_t read_string(reader_state_t *state)
       }
     }
 
-    if (skip_whitespace)
+    if (skip_ws)
     {
+      /* Slightly different from the normal skip_whitespace();
+       * Assumes first char is space, and bounded by '\n' afterward. */
       do {
         next_char(state);
       } while (isspace(state->ch) && (state->ch != '\n'));
@@ -349,7 +360,6 @@ static value_t read_string(reader_state_t *state)
 
   next_char(state);
 
-  buffer[length] = '\0';
   value = make_byte_string(length, '\0');
   memcpy(_get_byte_string(value)->bytes, buffer, length);
   free(buffer);
@@ -359,86 +369,70 @@ static value_t read_string(reader_state_t *state)
 
 static value_t read_box(reader_state_t *state)
 {
-  gc_root_t root;
-  value_t v;
-
   next_char(state);
-
+  return make_box(read_one_value(state));
-  register_gc_root(&root, make_box(UNDEFINED));
-
-  v = read_one_value(state);
-  _get_box(root.value)->value = v;
-
-  unregister_gc_root(&root);
-
-  return root.value;
 }
 
 static value_t read_vector(reader_state_t *state)
 {
   gc_root_t list_root;
-  gc_root_t vec_root;
   size_t length = 0;
-  value_t v;
+  value_t value;
+  value_t item;
 
   register_gc_root(&list_root, read_list(state));
 
-  for (value_t v = list_root.value; !is_nil(v); v = CDR(v))
+  for (value_t item = list_root.value; !is_nil(item); item = CDR(item))
     ++length;
 
-  register_gc_root(&vec_root, make_vector(length, UNDEFINED));
+  value = make_vector(length, UNDEFINED);
 
-  v = list_root.value;
+  item = list_root.value;
-  for (size_t i = 0; i < length; ++i, v = _CDR(v))
+  for (size_t i = 0; i < length; ++i)
-    _get_vector(vec_root.value)->elements[i] = _CAR(v);
+  {
+    _get_vector(value)->elements[i] = _CAR(item);
+    item = _CDR(item);
+  }
 
   unregister_gc_root(&list_root);
-  unregister_gc_root(&vec_root);
 
-  return vec_root.value;
+  return value;
 }
 
 static value_t read_struct(reader_state_t *state)
 {
   gc_root_t list_root;
-  gc_root_t struct_root;
   size_t slots = 0;
-  value_t v;
+  value_t value;
+  value_t item;
 
   register_gc_root(&list_root, read_list(state));
 
-  for (value_t v = CDR(list_root.value); !is_nil(v); v = CDR(v))
+  for (item = CDR(list_root.value); !is_nil(item); item = CDR(item))
     ++slots;
 
-  register_gc_root(&struct_root, make_struct(_CAR(list_root.value), slots));
+  value = make_struct(_CAR(list_root.value), slots);
 
-  v = _CDR(list_root.value);
+  item = _CDR(list_root.value);
-  for (size_t i = 0; i < slots; ++i, v = _CDR(v))
+  for (size_t i = 0; i < slots; ++i)
-    _get_struct(struct_root.value)->slots[i] = _CAR(v);
+  {
+    _get_struct(value)->slots[i] = _CAR(item);
+    item = _CDR(item);
+  }
 
   unregister_gc_root(&list_root);
-  unregister_gc_root(&struct_root);
 
-  return struct_root.value;
+  return value;
 }
 
 static value_t read_weak_box(reader_state_t *state)
 {
-  gc_root_t box_root;
+  value_t value;
-  gc_root_t value_root;
 
   next_char(state);
-
+  value = read_one_value(state);
-  register_gc_root(&box_root, make_weak_box(UNDEFINED));
+  state->weak_list.value = cons(value, state->weak_list.value);
-  register_gc_root(&value_root, read_one_value(state));
+  return make_weak_box(value);
-
-  _get_weak_box(box_root.value)->value = value_root.value;
-  state->weak_list.value = cons(value_root.value, state->weak_list.value);
-
-  unregister_gc_root(&box_root);
-  unregister_gc_root(&value_root);
-
-  return box_root.value;
 }
 
 static value_t read_definition(reader_state_t *state)
@@ -461,6 +455,7 @@ static value_t read_definition(reader_state_t *state)
 static value_t read_backref(reader_state_t *state)
 {
   next_char(state);
+  skip_whitespace(state);
   release_assert(state->ch != EOF);
 
   if (state->ch == '"')
@@ -518,44 +513,94 @@ static void set_placeholder(value_t place, value_t value)
   CAR(CDR(place)) = value;
 }
 
-static void tree_replace(value_t *in, value_t oldval, value_t newval)
+typedef struct seen_value
 {
+  value_t value;
+  struct seen_value *prev;
+} seen_value_t;
+
+static void _tree_replace(value_t *in, value_t oldval, value_t newval,
+                          seen_value_t *seen)
+{
+  seen_value_t this_seen = { *in, seen };
+
+  for (seen_value_t *item = seen; item; item = item->prev)
+  {
+    if (*in == item->value)
+      return;
+  }
+
   if (*in == oldval)
   {
     *in = newval;
   }
   else if (is_box(*in))
   {
-    tree_replace(&_get_box(*in)->value, oldval, newval);
+    _tree_replace(&_get_box(*in)->value, oldval, newval, &this_seen);
   }
   else if (is_pair(*in))
   {
-    tree_replace(&_get_pair(*in)->car, oldval, newval);
+    _tree_replace(&_get_pair(*in)->car, oldval, newval, &this_seen);
-    tree_replace(&_get_pair(*in)->cdr, oldval, newval);
+    _tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen);
   }
   else if (is_vector(*in))
   {
     for (size_t i = 0; i < _get_vector(*in)->size; ++i)
     {
-      tree_replace(&_get_vector(*in)->elements[i], oldval, newval);
+      _tree_replace(&_get_vector(*in)->elements[i], oldval, newval, &this_seen);
     }
   }
   else if (is_struct(*in))
   {
-    tree_replace(&_get_struct(*in)->type, oldval, newval);
+    _tree_replace(&_get_struct(*in)->type, oldval, newval, &this_seen);
 
     for (size_t i = 0; i < _get_struct(*in)->nslots; ++i)
-      tree_replace(&_get_struct(*in)->slots[i], oldval, newval);
+      _tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen);
   }
   else if (is_weak_box(*in))
   {
-    tree_replace(&_get_weak_box(*in)->value, oldval, newval);
+    _tree_replace(&_get_weak_box(*in)->value, oldval, newval, &this_seen);
   }
 }
 
+static void tree_replace(value_t *in, value_t oldval, value_t newval)
+{
+  _tree_replace(in, oldval, newval, NULL);
+}
+
 static void next_char(reader_state_t *state)
 {
   state->ch = fgetc(state->file);
+
+  if (state->ch == '\n')
+  {
+    ++state->line;
+    state->column = 1;
+  }
+  else
+  {
+    ++state->column;
+  }
+}
+
+static void skip_whitespace(reader_state_t *state)
+{
+  while (isspace(state->ch))
+    next_char(state);
+
+  /* Comments count as whitespace */
+  if (state->ch == ';')
+  {
+    do {
+      next_char(state);
+
+      if (state->ch == '\n')
+      {
+        next_char(state);
+        break;
+      }
+    } while (state->ch != EOF);
+  }
 }
 
 /* vim:set sw=2 expandtab: */

rosella.c

@@ -32,15 +32,38 @@ int main(int argc, char **argv)
   srand((unsigned int)time(NULL));
 
   gc_init(1024, 256*1024*1024);
-
   builtin_init();
   interpreter_init();
 
+  if (argc < 2 || (strcmp(argv[1], "-k") == 0))
+  {
     test_builtins();
     test_weak_boxes_and_wills();
     if (argc > 1)
       test_reader();
     test_garbage_collection(argc > 1);
+  }
+  else
+  {
+    gc_root_t argv_root;
+    FILE *f = fopen(argv[1], "r");
+    value_t program;
+
+    register_gc_root(&argv_root, NIL);
+
+    /* Construct list backward, so that we don't have to reverse it. */
+    for (int i = argc - 1; i >= 2; --i)
+    {
+      value_t temp = string_to_value(argv[i]);
+      argv_root.value = cons(temp, argv_root.value);
+    }
+    
+    program = read_value(f);
+    print_value(run_interpreter(program, argv_root.value));
+    nl();
+    fclose(f);
+    unregister_gc_root(&argv_root);
+  }
 
   return 0;
 }
@@ -159,7 +182,15 @@ static void test_reader(void)
 
   do {
     v = read_value(stdin);
-    print_value(v); nl(); nl();
+    if (is_struct(v) && _get_struct(v)->type == lookup_builtin(BI_LAMBDA))
+    {
+      print_value(run_interpreter(v, NIL));
+    }
+    else
+    {
+      print_value(v);
+    }
+    nl(); nl();
   } while (v != NIL);
 }