mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-01 20:06:00 +00:00
Code Issues Releases Activity

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

Browse Source 
(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.
This commit is contained in:
Erik Naggum 1996-09-09 02:30:05 +00:00
parent 081e0581b6
commit 4ad679f96d
1 changed files with 70 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
src/lread.c
View File

@ -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;
}