Extend reader with placeholders for immutable values and structures.

This means that such values can once again contain references (#=nnn).

Makefile

@@ -11,7 +11,7 @@ LDFLAGS  := -lrt -lm -g
 CFLAGS += $(shell echo $(MODS:%=-DHAVE_MOD_%) | tr 'a-z' 'A-Z')
 
 OBJS := rosella.o gc.o builtin.o interp.o reader.o $(MODS:%=mods/mod_%.o)
-DEPS := $(OBJS:%.o=%.d)
+DEPS := $(OBJS:%.o=.%.d)
 GCNO := $(OBJS:%.o=%.gcno)
 GCDA := $(OBJS:%.o=%.gcda)
 
@@ -55,7 +55,7 @@ install: rosella
 uninstall:
 	$(RM) $(PREFIX)/bin/rosella
 
-%.d: %.c
+.%.d: %.c
 	$(CC) $(CPPFLAGS) -MM $< -MF $@ -MT $(<:%.c=%.o) -MT $@
 
 rosella: $(OBJS)

reader.c

@@ -23,17 +23,46 @@ typedef struct reader_state
   int ch;
   int line;
   int column;
-  gc_root_t ref_alist;
   gc_root_t weak_list;
   gc_root_t ref_list;
 } reader_state_t;
 
+#define REFERENCE_SLOT_IDENT    0
+#define REFERENCE_SLOT_VALUE    1
+#define REFERENCE_SLOT_PATCHED  2
+#define REFERENCE_SLOTS         3
+
+#define REF_IDENT(ref)          _SLOT_VALUE(REFERENCE, (ref), IDENT)
+#define REF_VALUE(ref)          _SLOT_VALUE(REFERENCE, (ref), VALUE)
+#define REF_PATCHED(ref)        _SLOT_VALUE(REFERENCE, (ref), PATCHED)
+
+/* Wraps values which should be made immutable after substitution */
+#define IMMUTABLE_PH_SLOT_VALUE  0
+#define IMMUTABLE_PH_SLOTS       1
+
+#define IMMUTABLE_PH_VALUE(ph)   _SLOT_VALUE(IMMUTABLE_PH, (ph), VALUE)
+
+/* Wraps structure instances, where the type is always immutable */
+#define STRUCT_PH_SLOT_TYPE    0
+#define STRUCT_PH_SLOT_VALUES  1
+#define STRUCT_PH_SLOT_RESULT  2
+#define STRUCT_PH_SLOTS        3
+
+#define STRUCT_PH_TYPE(ph)     _SLOT_VALUE(STRUCT_PH, (ph), TYPE)
+#define STRUCT_PH_VALUES(ph)   _SLOT_VALUE(STRUCT_PH, (ph), VALUES)
+#define STRUCT_PH_RESULT(ph)   _SLOT_VALUE(STRUCT_PH, (ph), RESULT)
+
+static gc_root_t reference_root;
+static gc_root_t struct_ph_root;
+static gc_root_t immutable_ph_root;
+
 static value_t read_one_value(reader_state_t *state);
 static value_t read_special(reader_state_t *state);
 static value_t read_list(reader_state_t *state);
 static value_t read_fixnum(reader_state_t *state, int radix);
 static value_t read_number(reader_state_t *state);
 static value_t read_string(reader_state_t *state);
+static value_t read_immutable(reader_state_t *state);
 
 static value_t read_box(reader_state_t *state);
 static value_t read_vector(reader_state_t *state);
@@ -41,7 +70,7 @@ static value_t read_struct(reader_state_t *state);
 static value_t read_weak_box(reader_state_t *state);
 
 static value_t read_definition(reader_state_t *state);
-static value_t read_placeholder(reader_state_t *state);
+static value_t read_reference(reader_state_t *state);
 
 static value_t read_indirect(value_t path);
 
@@ -50,13 +79,11 @@ static value_t freeze(value_t val);
 static void next_char(reader_state_t *state);
 static void skip_whitespace(reader_state_t *state);
 
-static bool    is_placeholder(reader_state_t *state, value_t value);
+static bool    is_reference(reader_state_t *state, value_t value);
-static value_t get_placeholder(reader_state_t *state, fixnum_t ref);
+static value_t get_reference(reader_state_t *state, fixnum_t ref);
-static void    set_placeholder(reader_state_t *state, value_t place, value_t value);
+static void    set_reference(reader_state_t *state, value_t place, value_t value);
-static void    finalize_placeholders(reader_state_t *state);
+static void    finalize_references(reader_state_t *state);
-static value_t patch_placeholders(reader_state_t *state, value_t v);
+static value_t patch_placeholders(reader_state_t *state, value_t in);
-
-static void tree_replace(value_t *in, value_t oldval, value_t newval);
 
 static inline void next_char(reader_state_t *state)
 {
@@ -76,12 +103,18 @@ static inline void next_char(reader_state_t *state)
   }
 }
 
+void reader_init(void)
+{
+  register_gc_root(&reference_root,    make_struct_type(NIL, REFERENCE_SLOTS,    FALSE_VALUE));
+  register_gc_root(&struct_ph_root,    make_struct_type(NIL, STRUCT_PH_SLOTS,    FALSE_VALUE));
+  register_gc_root(&immutable_ph_root, make_struct_type(NIL, IMMUTABLE_PH_SLOTS, FALSE_VALUE));
+}
+
 value_t read_value_from_file(FILE *f)
 {
   reader_state_t state;
   value_t result;
 
-  register_gc_root(&state.ref_alist, NIL);
   register_gc_root(&state.weak_list, NIL);
   register_gc_root(&state.ref_list, NIL);
 
@@ -94,9 +127,8 @@ value_t read_value_from_file(FILE *f)
 
   result = patch_placeholders(&state, result);
 
-  unregister_gc_root(&state.ref_list);
   unregister_gc_root(&state.weak_list);
-  unregister_gc_root(&state.ref_alist);
+  unregister_gc_root(&state.ref_list);
 
   return result;
 }
@@ -217,14 +249,14 @@ static value_t read_special(reader_state_t *state)
   case '0' ... '9':
     return read_definition(state);
   case '=':
-    return read_placeholder(state);
+    return read_reference(state);
   case 'I':
   case 'i':
     next_char(state);
     return read_indirect(read_string(state));
   case '@':
     next_char(state);
-    return freeze(read_one_value(state));
+    return read_immutable(state);
   default:
     release_assert(NOTREACHED("Invalid character in special value."));
     return UNDEFINED;
@@ -638,6 +670,21 @@ static value_t read_string(reader_state_t *state)
   return value;
 }
 
+static value_t read_immutable(reader_state_t *state)
+{
+  gc_root_t ph_root;
+  value_t val;
+
+  register_gc_root(&ph_root, make_struct(immutable_ph_root.value));
+
+  val = read_one_value(state);
+  IMMUTABLE_PH_VALUE(ph_root.value) = val;
+  WRITE_BARRIER(ph_root.value);
+
+  unregister_gc_root(&ph_root);
+  return ph_root.value;
+}
+
 static value_t read_box(reader_state_t *state)
 {
   next_char(state);
@@ -673,25 +720,19 @@ static value_t read_vector(reader_state_t *state)
 
 static value_t read_struct(reader_state_t *state)
 {
-  gc_root_t list_root;
+  gc_root_t ph_root;
-  value_t value;
+  value_t values;
-  value_t item;
 
-  register_gc_root(&list_root, read_list(state));
+  register_gc_root(&ph_root, make_struct(struct_ph_root.value));
 
-  value = make_struct(CAR(list_root.value));
+  values = read_list(state);
+  STRUCT_PH_TYPE(ph_root.value)   = CAR(values);
+  STRUCT_PH_VALUES(ph_root.value) = CDR(values);
+  STRUCT_PH_RESULT(ph_root.value) = FALSE_VALUE;
+  WRITE_BARRIER(ph_root.value);
 
-  item = _CDR(list_root.value);
+  unregister_gc_root(&ph_root);
-  for (size_t i = 0; i < _get_struct(value)->nslots; ++i)
+  return ph_root.value;
-  {
-    _get_struct(value)->slots[i] = CAR(item);
-    /* No write barrier needed here; structure is still in Gen-0. */
-    item = _CDR(item);
-  }
-
-  unregister_gc_root(&list_root);
-
-  return value;
 }
 
 static value_t read_weak_box(reader_state_t *state)
@@ -713,15 +754,15 @@ static value_t read_definition(reader_state_t *state)
   release_assert(state->ch == '=');
   next_char(state);
 
-  register_gc_root(&place_root, get_placeholder(state, ref));
+  register_gc_root(&place_root, get_reference(state, ref));
   v = read_one_value(state);
-  set_placeholder(state, place_root.value, v);
+  set_reference(state, place_root.value, v);
   unregister_gc_root(&place_root);
 
   return v;
 }
 
-static value_t read_placeholder(reader_state_t *state)
+static value_t read_reference(reader_state_t *state)
 {
   next_char(state);
   skip_whitespace(state);
@@ -744,7 +785,7 @@ static value_t read_placeholder(reader_state_t *state)
   }
   else
   {
-    return get_placeholder(state, get_fixnum(read_fixnum(state, 0)));
+    return get_reference(state, get_fixnum(read_fixnum(state, 0)));
   }
 }
 
@@ -779,41 +820,41 @@ static value_t freeze(value_t val)
   return val;
 }
 
-static bool is_placeholder(reader_state_t *state, value_t value)
+static bool is_reference(reader_state_t *state, value_t value)
 {
-  for (value_t item = state->ref_alist.value; !is_nil(item); item = _CDDR(item))
+  return struct_is_a(value, reference_root.value);
-  {
-    if (value == item)
-      return true;
-  }
-  return false;
 }
 
-static value_t get_placeholder(reader_state_t *state, fixnum_t ref)
+static value_t get_reference(reader_state_t *state, fixnum_t refid)
 {
-  value_t refval = fixnum_value(ref);
+  value_t refidval = fixnum_value(refid);
 
-  for (value_t item = state->ref_alist.value; !is_nil(item); item = _CDDR(item))
+  for (value_t item = state->ref_list.value; !is_nil(item); item = _CDR(item))
   {
-    if (_CAR(item) == refval)
+    if (REF_IDENT(_CAR(item)) == refidval)
-      return item;
+      return _CAR(item);
   }
 
-  /* No existing placeholder with that number; create a new one. */
+  /* No existing reference with that number; create a new one. */
-  state->ref_alist.value = cons(UNDEFINED, state->ref_alist.value);
+  {
-  state->ref_alist.value = cons(refval,    state->ref_alist.value);
+    value_t ref = make_struct(reference_root.value);
-  return state->ref_alist.value;
+    REF_IDENT(ref)   = refidval;
+    REF_VALUE(ref)   = UNDEFINED;
+    REF_PATCHED(ref) = FALSE_VALUE;
+    state->ref_list.value = cons(ref, state->ref_list.value);
+  }
+  return _CAR(state->ref_list.value);
 }
 
-static void set_placeholder(reader_state_t *state, value_t place, value_t value)
+static void set_reference(reader_state_t *state, value_t ref, value_t value)
 {
-  assert(is_placeholder(state, place));
+  assert(is_reference(state, ref));
-  release_assert(is_undefined(_CADR(place)));
+  release_assert(is_undefined(REF_VALUE(ref)));
-  _CADR(place) = value;
+  REF_VALUE(ref) = value;
-  WRITE_BARRIER(_CDR(place));
+  WRITE_BARRIER(ref);
 }
 
-static void finalize_placeholders(reader_state_t *state)
+static void finalize_references(reader_state_t *state)
 {
   bool changed = true;
 
@@ -822,103 +863,144 @@ static void finalize_placeholders(reader_state_t *state)
   {
     changed = false;
 
-    /* Resolve one level of placeholder-to-placeholder links.
+    /* Resolve one level of placeholder-to-placeholder links. */
-    * Self-links indicate cycles and are replaced with UNDEFINED. */
+    for (value_t item = state->ref_list.value; !is_nil(item); item = _CDR(item))
-    for (value_t item = state->ref_alist.value; !is_nil(item); item = _CDDR(item))
     {
-      if (_CADR(item) == item)
+      value_t ref = _CAR(item);
+      if (REF_VALUE(ref) == ref)
       {
-        _CADR(item) = UNDEFINED;
+        /* Self-links indicate cycles. */
+        REF_VALUE(ref) = UNDEFINED;
         changed = true;
       }
-      else if (is_placeholder(state, _CADR(item)))
+      else if (is_reference(state, REF_VALUE(ref)))
       {
-        _CADR(item) = _CADR(_CADR(item));
+        REF_VALUE(ref) = REF_VALUE(REF_VALUE(ref));
-        WRITE_BARRIER(_CDR(item));
+        WRITE_BARRIER(ref);
         changed = true;
       }
     }
   }
 }
 
-static value_t patch_placeholders(reader_state_t *state, value_t v)
+static value_t _patch_placeholders(reader_state_t *state, value_t in, void *seen)
 {
-  finalize_placeholders(state);
+  gc_root_t in_root;
-
+  struct seen_value
-  for (value_t item = state->ref_alist.value; !is_nil(item); item = _CDDR(item))
   {
-    assert(!is_placeholder(state, _CADR(item)));
+    gc_root_t *root;
-    tree_replace(&v, item, _CADR(item));
-  }
-
-  return v;
-}
-
-typedef struct seen_value
-{
-  value_t value;
     struct seen_value *prev;
-} seen_value_t;
+  } this_seen = { &in_root, (struct seen_value*)seen };
 
-static bool _tree_replace(value_t *in, value_t oldval, value_t newval,
+  if (struct_is_a(in, reference_root.value))
-                          seen_value_t *seen)
-{
-  seen_value_t this_seen = { *in, seen };
-  bool updated = false;
-
-  for (seen_value_t *item = seen; item; item = item->prev)
   {
-    if (*in == item->value)
+    if (!_get_boolean(REF_PATCHED(in)))
-      return false;
+    {
+      value_t val;
+
+      REF_PATCHED(in) = TRUE_VALUE;
+
+      register_gc_root(&in_root, in);
+      val = _patch_placeholders(state, REF_VALUE(in_root.value), &this_seen);
+      in = in_root.value;
+      unregister_gc_root(&in_root);
+
+      REF_VALUE(in) = val;
+      WRITE_BARRIER(in);
     }
 
-  if (*in == oldval)
+    return REF_VALUE(in);
-  {
-    *in = newval;
-    return true;
-  }
-  else if (is_box(*in))
-  {
-    updated = _tree_replace(&_get_box(*in)->value, oldval, newval, &this_seen);
-  }
-  else if (is_pair(*in))
-  {
-    updated = _tree_replace(&_get_pair(*in)->car, oldval, newval, &this_seen);
-
-    if (_tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen))
-      updated = true;
-  }
-  else if (is_vector(*in))
-  {
-    for (size_t i = 0; i < _get_vector(*in)->size; ++i)
-    {
-      if (_tree_replace(&_get_vector(*in)->elements[i], oldval, newval, &this_seen))
-        updated = true;
-    }
-  }
-  else if (is_struct(*in))
-  {
-    /* make_struct() won't allow type field to be a placeholder. */
-    for (size_t i = 0; i < _get_struct(*in)->nslots; ++i)
-    {
-      if (_tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen))
-        updated = true;
-    }
-  }
-  else if (is_weak_box(*in))
-  {
-    updated = _tree_replace(&_get_weak_box(*in)->value, oldval, newval, &this_seen);
   }
 
-  if (updated)
+  for (struct seen_value *item = this_seen.prev; item; item = item->prev)
-    WRITE_BARRIER(*in);
+  {
+    if (in == item->root->value)
+      return in;
+  }
 
-  return false;
+  register_gc_root(&in_root, in);
+
+  if (struct_is_a(in_root.value, immutable_ph_root.value))
+  {
+    value_t val = _patch_placeholders(state, IMMUTABLE_PH_VALUE(in_root.value), &this_seen);
+    in_root.value = freeze(val);
+  }
+  else if (struct_is_a(in_root.value, struct_ph_root.value))
+  {
+    if (_get_boolean(STRUCT_PH_RESULT(in_root.value)))
+    {
+      in_root.value = STRUCT_PH_RESULT(in_root.value);
+    }
+    else
+    {
+      value_t sval;
+      value_t values;
+
+      STRUCT_PH_RESULT(in_root.value) = UNDEFINED;
+      sval = make_struct(_patch_placeholders(state, STRUCT_PH_TYPE(in_root.value), &this_seen));
+      STRUCT_PH_RESULT(in_root.value) = sval;
+      values = STRUCT_PH_VALUES(in_root.value);
+      in_root.value = sval;
+
+      for (int i = 0; i < _get_struct(in_root.value)->nslots; ++i)
+      {
+        if (is_nil(values)) break;
+        _get_struct(in_root.value)->slots[i] = CAR(values);
+        values = _CDR(values);
+      }
+      WRITE_BARRIER(in_root.value);
+
+      for (int i = 0; i < _get_struct(in_root.value)->nslots; ++i)
+      {
+        _get_struct(in_root.value)->slots[i] =
+          _patch_placeholders(state, _get_struct(in_root.value)->slots[i], &this_seen);
+        WRITE_BARRIER(in_root.value);
+      }
+    }
+  }
+  else if (is_box(in_root.value))
+  {
+    value_t val = _patch_placeholders(state, _get_box(in_root.value)->value, &this_seen);
+    _get_box(in_root.value)->value = val;
+  }
+  else if (is_weak_box(in_root.value))
+  {
+    value_t val = _patch_placeholders(state, _get_weak_box(in_root.value)->value, &this_seen);
+    _get_weak_box(in_root.value)->value = val;
+  }
+  else if (is_pair(in_root.value))
+  {
+    value_t val;
+    val = _patch_placeholders(state, _CAR(in_root.value), &this_seen);
+    _CAR(in_root.value) = val;
+    val = _patch_placeholders(state, _CDR(in_root.value), &this_seen);
+    _CDR(in_root.value) = val;
+  }
+  else if (is_vector(in_root.value))
+  {
+    size_t nelem = _get_vector(in_root.value)->size;
+    for (size_t i = 0; i < nelem; ++i)
+    {
+      value_t val = _patch_placeholders(state, _get_vector(in_root.value)->elements[i], &this_seen);
+      _get_vector(in_root.value)->elements[i] = val;
+    }
+  }
+
+  unregister_gc_root(&in_root);
+  return in_root.value;
 }
 
-static void tree_replace(value_t *in, value_t oldval, value_t newval)
+static value_t patch_placeholders(reader_state_t *state, value_t in)
 {
-  (void)_tree_replace(in, oldval, newval, NULL);
+  gc_root_t root;
+  register_gc_root(&root, in);
+
+  finalize_references(state);
+
+  root.value = _patch_placeholders(state, root.value, NULL);
+
+  unregister_gc_root(&root);
+  return root.value;
 }
 
 static void skip_whitespace(reader_state_t *state)

reader.h

@@ -5,6 +5,7 @@
 
 #include "gc.h"
 
+void reader_init(void);
 value_t read_value_from_file(FILE *f);
 value_t read_value_from_path(const char *path);
 

rosella.c

@@ -50,10 +50,10 @@ int main(int argc, char **argv)
   gc_init(1024*1024, 1024*1024, 4*1024*1024);
   builtin_init();
   interpreter_init();
-
 #ifdef HAVE_MOD_IO
   mod_io_init();
 #endif
+  reader_init();
 
   if (argc < 2 || (strcmp(argv[1], "-t") == 0) || (strcmp(argv[1], "--test") == 0))
   {