Add #n=object, #n#, and #:symbol constructs to reader.

(readevalloop, read, Fread_from_string): Empty list of read objects before
read0 call.
(read1): New variable `uninterned_symbol', which controls how to make
symbols.  Support #:, #n=object and #n#.
(make_symbol): New function, used in read1 to make uninterned symbols
(Fintern): Set `obarray' field of interned symbols.
(init_obarray): Explicit set `obarray' field of symbol `nil'.
(syms_of_lread): staticpro read_objects, the list of read objects.

1 files changed, 70 insertions, 2 deletions

diff --git a/src/lread.c b/src/lread.c
index 21f32863f98..2272b81149e 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -98,6 +98,12 @@ Lisp_Object Vload_file_name;
 /* Function to use for reading, in `load' and friends.  */
 Lisp_Object Vload_read_function;
 
+/* The association list of objects read with the #n=object form.
+   Each member of the list has the form (n . object), and is used to
+   look up the object for the corresponding #n# construct.
+   It must be set to nil before all top-level calls to read0.  */
+Lisp_Object read_objects;
+
 /* Nonzero means load should forcibly load all dynamic doc strings.  */
 static int load_force_doc_strings;
 
@@ -802,6 +808,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag)
       else
         {
           UNREAD (c);
+          read_objects = Qnil;
           if (NILP (Vload_read_function))
             val = read0 (readcharfun);
           else
@@ -949,6 +956,7 @@ STREAM or the value of `standard-input' may be:\n\
     stream = Qread_char;
 
   new_backquote_flag = 0;
+  read_objects = Qnil;
 
 #ifndef standalone
   if (EQ (stream, Qread_char))
@@ -996,6 +1004,7 @@ START and END optionally delimit a substring of STRING from which to read;\n\
   read_from_string_limit = endval;
 
   new_backquote_flag = 0;
+  read_objects = Qnil;
 
   tem = read0 (string);
   return Fcons (tem, make_number (read_from_string_index));
@@ -1191,6 +1200,8 @@ read1 (readcharfun, pch, first_in_list)
      int first_in_list;
 {
   register int c;
+  int uninterned_symbol = 0;
+
   *pch = 0;
 
  retry:
@@ -1353,7 +1364,43 @@ read1 (readcharfun, pch, first_in_list)
         return Vload_file_name;
       if (c == '\'')
         return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
+      /* #:foo is the uninterned symbol named foo.  */
+      if (c == ':')
+        {
+          uninterned_symbol = 1;
+          c = READCHAR;
+          goto default_label;
+        }
+      /* Reader forms that can reuse previously read objects.  */
+      if (c >= '0' && c <= '9')
+        {
+          int n = 0;
+          Lisp_Object tem;
 
+          /* Read a non-negative integer.  */
+          while (c >= '0' && c <= '9')
+            {
+              n *= 10;
+              n += c - '0';
+              c = READCHAR;
+            }
+          /* #n=object returns object, but associates it with n for #n#.  */
+          if (c == '=')
+            {
+              tem = read0 (readcharfun);
+              read_objects = Fcons (Fcons (make_number (n), tem), read_objects);
+              return tem;
+            }
+          /* #n# returns a previously read object.  */
+          if (c == '#')
+            {
+              tem = Fassq (make_number (n), read_objects);
+              if (CONSP (tem))
+                return XCDR (tem);
+              /* Fall through to error message.  */
+            }
+          /* Fall through to error message.  */
+        }
 
       UNREAD (c);
       Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
@@ -1545,7 +1592,7 @@ read1 (readcharfun, pch, first_in_list)
             UNREAD (c);
         }
 
-        if (!quoted)
+        if (!quoted && !uninterned_symbol)
           {
             register char *p1;
             register Lisp_Object val;
@@ -1581,7 +1628,10 @@ read1 (readcharfun, pch, first_in_list)
 #endif
           }
 
-        return intern (read_buffer);
+        if (uninterned_symbol)
+          return make_symbol (read_buffer);
+        else
+          return intern (read_buffer);
       }
     }
 }
@@ -1865,6 +1915,19 @@ intern (str)
                    : make_string (str, len)),
                   obarray);
 }
+
+/* Create an uninterned symbol with name STR.  */
+
+Lisp_Object
+make_symbol (str)
+     char *str;
+{
+  int len = strlen (str);
+
+  return Fmake_symbol ((!NILP (Vpurify_flag)
+                        ? make_pure_string (str, len)
+                        : make_string (str, len)));
+}
 
 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
   "Return the canonical symbol whose name is STRING.\n\
@@ -1888,6 +1951,7 @@ it defaults to the value of `obarray'.")
   if (!NILP (Vpurify_flag))
     string = Fpurecopy (string);
   sym = Fmake_symbol (string);
+  XSYMBOL (sym)->obarray = obarray;
 
   ptr = &XVECTOR (obarray)->contents[XINT (tem)];
   if (SYMBOLP (*ptr))
@@ -2103,6 +2167,7 @@ init_obarray ()
   initial_obarray = Vobarray;
   staticpro (&initial_obarray);
   /* Intern nil in the obarray */
+  XSYMBOL (Qnil)->obarray = Vobarray;
   /* These locals are to kludge around a pyramid compiler bug. */
   hash = hash_string ("nil", 3);
   /* Separate statement here to avoid VAXC bug. */
@@ -2505,4 +2570,7 @@ You cannot count on them to still be there!");
   staticpro (&Qload_file_name);
 
   staticpro (&dump_path);
+
+  staticpro (&read_objects);
+  read_objects = Qnil;
 }