changeset 25165:8b9110694bfa

(read1): Added circular reading code to #N=. (SUBSTITUTE): New macro. (seen_list): New variable. (substitute_object_in_subtree): New function. (substitute_object_recurse): New function. (substitute_in_interval): New function.

--- a/src/lread.c	Tue Aug 03 15:59:18 1999 +0000
+++ b/src/lread.c	Tue Aug 03 17:27:46 1999 +0000
@@ -408,6 +408,9 @@
 
 static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
 static int read_multibyte ();
+static Lisp_Object substitute_object_recurse ();
+static void        substitute_object_in_subtree (), substitute_in_interval ();
+
 
 /* Get a character from the tty.  */
 
@@ -1806,8 +1809,23 @@
 	  /* #n=object returns object, but associates it with n for #n#.  */
 	  if (c == '=')
 	    {
+	      /* Make a placeholder for #n# to use temporarily */
+	      Lisp_Object placeholder;
+	      Lisp_Object cell;
+
+	      placeholder = Fcons(Qnil, Qnil);
+	      cell = Fcons (make_number (n), placeholder);
+	      read_objects = Fcons (cell, read_objects);
+
+	      /* Read the object itself. */
 	      tem = read0 (readcharfun);
-	      read_objects = Fcons (Fcons (make_number (n), tem), read_objects);
+
+	      /* Now put it everywhere the placeholder was... */
+	      substitute_object_in_subtree (tem, placeholder);
+
+	      /* ...and #n# will use the real value from now on.  */
+	      Fsetcdr (cell, tem);
+	      
 	      return tem;
 	    }
 	  /* #n# returns a previously read object.  */
@@ -2163,6 +2181,129 @@
     }
 }
 
+
+/* List of nodes we've seen during substitute_object_in_subtree. */
+static Lisp_Object seen_list;
+
+static void
+substitute_object_in_subtree (object, placeholder)
+     Lisp_Object object;
+     Lisp_Object placeholder;
+{
+  Lisp_Object check_object;
+
+  /* We haven't seen any objects when we start. */
+  seen_list = Qnil;
+
+  /* Make all the substitutions. */
+  check_object
+    = substitute_object_recurse (object, placeholder, object);
+  
+  /* Clear seen_list because we're done with it. */
+  seen_list = Qnil;
+
+  /* The returned object here is expected to always eq the
+     original. */
+  if (!EQ (check_object, object))
+    error ("Unexpected mutation error in reader");
+}
+
+/*  Feval doesn't get called from here, so no gc protection is needed. */
+#define SUBSTITUTE(get_val, set_val)                 \
+{                                                    \
+  Lisp_Object old_value = get_val;                   \
+  Lisp_Object true_value                             \
+    = substitute_object_recurse (object, placeholder,\
+			       old_value);           \
+                                                     \
+  if (!EQ (old_value, true_value))                   \
+    {                                                \
+       set_val;                                      \
+    }                                                \
+}
+
+static Lisp_Object
+substitute_object_recurse (object, placeholder, subtree)
+     Lisp_Object object;
+     Lisp_Object placeholder;
+     Lisp_Object subtree;
+{
+  /* If we find the placeholder, return the target object. */
+  if (EQ (placeholder, subtree))
+    return object;
+
+  /* If we've been to this node before, don't explore it again. */
+  if (!EQ (Qnil, Fmemq (subtree, seen_list)))
+    return subtree;
+
+  /* If this node can be the entry point to a cycle, remember that
+     we've seen it.  It can only be such an entry point if it was made
+     by #n=, which means that we can find it as a value in
+     read_objects.  */
+  if (!EQ (Qnil, Frassq (subtree, read_objects)))
+    seen_list = Fcons (subtree, seen_list);
+      
+  /* Recurse according to subtree's type.
+     Every branch must return a Lisp_Object.  */
+  switch (XTYPE (subtree))
+    {
+    case Lisp_Vectorlike:
+      {
+	int i;
+	int length = Flength(subtree);
+	for (i = 0; i < length; i++)
+	  {
+	    Lisp_Object idx = make_number (i);
+	    SUBSTITUTE (Faref (subtree, idx),
+			Faset (subtree, idx, true_value)); 
+	  }
+	return subtree;
+      }
+
+    case Lisp_Cons:
+      {
+	SUBSTITUTE (Fcar_safe (subtree),
+		    Fsetcar (subtree, true_value)); 
+	SUBSTITUTE (Fcdr_safe (subtree),
+		    Fsetcdr (subtree, true_value)); 
+	return subtree;
+      }
+
+#ifdef USE_TEXT_PROPERTIES
+    case Lisp_String:
+      {
+	/* Check for text properties in each interval.
+	   substitute_in_interval contains part of the logic. */ 
+
+	INTERVAL    root_interval = XSTRING (subtree)->intervals;
+	Lisp_Object arg           = Fcons (object, placeholder);
+	   
+	traverse_intervals (root_interval, 1, 0,
+			    &substitute_in_interval, arg); 
+
+	return subtree;
+      }
+#endif /* defined USE_TEXT_PROPERTIES */
+
+      /* Other types don't recurse any further. */
+    default:
+      return subtree;
+    }
+}
+
+/*  Helper function for substitute_object_recurse.  */
+static void
+substitute_in_interval (interval, arg)
+     INTERVAL    interval;
+     Lisp_Object arg;
+{
+  Lisp_Object object      = Fcar (arg);
+  Lisp_Object placeholder = Fcdr (arg);
+
+  SUBSTITUTE(interval->plist, interval->plist = true_value);
+}
+
+
 #ifdef LISP_FLOAT_TYPE
 
 #define LEAD_INT 1
@@ -3306,4 +3447,6 @@
 
   staticpro (&read_objects);
   read_objects = Qnil;
+  staticpro (&seen_list);
+  
 }