comparison src/lread.c @ 11683:355d0b23a080

(read1): New arg FIRST_IN_LIST; all callers changed. Special handling for backquote and comma. (Qbackquote, Qcomma, Qcomma_at, Qcomma_dot): New variables. (syms_of_lread): Initialize and staticpro them. (Fread, Fread_from_string): Initialize new_backquote_flag.

11682:7eda6c1f3d5e

extern int errno;

Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
Lisp_Object Qascii_character, Qload, Qload_file_name;

extern Lisp_Object Qevent_symbol_element_mask;

/* non-zero if inside `load' */
int load_in_progress;

static int read_pure;

/* For use within read-from-string (this reader is non-reentrant!!) */
static int read_from_string_index;
static int read_from_string_limit;

/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again. */

  if (NILP (readcharfun))
    readcharfun = Vstandard_input;
  if (EQ (readcharfun, Qt))
    readcharfun = Qread_char;

#ifndef standalone
  if (EQ (readcharfun, Qread_char))
    return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
#endif

    }

  read_from_string_index = startval;
  read_from_string_limit = endval;

  tem = read0 (string);
  return Fcons (tem, make_number (read_from_string_index));
}

/* Use this for recursive reads, in contexts where internal tokens

     Lisp_Object readcharfun;
{
  register Lisp_Object val;
  char c;

  val = read1 (readcharfun, &c);
  if (c)
    Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil));

  return val;
}

    }
}

/* If the next token is ')' or ']' or '.', we store that character
   in *PCH and the return value is not interesting.  Else, we store
   zero in *PCH and we read and return one lisp object.  */
static Lisp_Object
read1 (readcharfun, pch)
     register Lisp_Object readcharfun;
     char *pch;
{
  register int c;
  *pch = 0;

 retry:

	  Lisp_Object tmp;
	  struct gcpro gcpro1;
	  char ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch);
	  if (ch != 0 || !STRINGP (tmp))
	    Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      beg = read1 (readcharfun, &ch);
	      if (ch == ')')
		break;
	      if (ch == 0)
		end = read1 (readcharfun, &ch);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch);
	      if (ch)
		Fsignal (Qinvalid_read_syntax,
			 Fcons (build_string ("invalid string property list"),
				Qnil));
	      Fset_text_properties (beg, end, plist, tmp);

    case '\'':
      {
	return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
      }

    case '?':
      {
	register Lisp_Object val;

	/* Otherwise, we fall through!  Note that the atom-reading loop
	   below will now loop at least once, assuring that we will not
	   try to UNREAD two characters in a row.  */
      }
    default:
      if (c <= 040) goto retry;
      {
	register char *p = read_buffer;
	int quoted = 0;

  Lisp_Object val, tail;
  register Lisp_Object elt, tem;
  struct gcpro gcpro1, gcpro2;
  int cancel = 0;

  val = Qnil;
  tail = Qnil;

  while (1)
    {
      char ch;
      GCPRO2 (val, tail);
      elt = read1 (readcharfun, &ch);
      UNGCPRO;

	/* If purifying, and the list starts with #$,
	   return 0 instead.  This is a doc string reference
	   and it will be replaced anyway by Snarf-documentation,
	   so don't waste pure space with it.  */

	      GCPRO2 (val, tail);
	      if (!NILP (tail))
		XCONS (tail)->cdr = read0 (readcharfun);
	      else
		val = read0 (readcharfun);
	      read1 (readcharfun, &ch);
	      UNGCPRO;
	      if (ch == ')')
		return (cancel ? make_number (0) : val);
	      return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
	    }

  staticpro (&Qread_char);

  Qget_file_char = intern ("get-file-char");
  staticpro (&Qget_file_char);

  Qascii_character = intern ("ascii-character");
  staticpro (&Qascii_character);

  Qload = intern ("load");
  staticpro (&Qload);

11683:355d0b23a080

extern int errno;

Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
Lisp_Object Qascii_character, Qload, Qload_file_name;
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot;

extern Lisp_Object Qevent_symbol_element_mask;

/* non-zero if inside `load' */
int load_in_progress;

static int read_pure;

/* For use within read-from-string (this reader is non-reentrant!!) */
static int read_from_string_index;
static int read_from_string_limit;

/* Nonzero means inside a new-style backquote
   with no surrounding parentheses.
   Fread initializes this to zero, so we need not specbind it
   or worry about what happens to it when there is an error.  */
static int new_backquote_flag;

/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again. */

  if (NILP (readcharfun))
    readcharfun = Vstandard_input;
  if (EQ (readcharfun, Qt))
    readcharfun = Qread_char;

  new_backquote_flag = 0;

#ifndef standalone
  if (EQ (readcharfun, Qread_char))
    return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
#endif

    }

  read_from_string_index = startval;
  read_from_string_limit = endval;

  new_backquote_flag = 0;

  tem = read0 (string);
  return Fcons (tem, make_number (read_from_string_index));
}

/* Use this for recursive reads, in contexts where internal tokens

     Lisp_Object readcharfun;
{
  register Lisp_Object val;
  char c;

  val = read1 (readcharfun, &c, 0);
  if (c)
    Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil));

  return val;
}

    }
}

/* If the next token is ')' or ']' or '.', we store that character
   in *PCH and the return value is not interesting.  Else, we store
   zero in *PCH and we read and return one lisp object.

   FIRST_IN_LIST is nonzero if this is the first element of a list.  */

static Lisp_Object
read1 (readcharfun, pch, first_in_list)
     register Lisp_Object readcharfun;
     char *pch;
     int first_in_list;
{
  register int c;
  *pch = 0;

 retry:

	  Lisp_Object tmp;
	  struct gcpro gcpro1;
	  char ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch, 0);
	  if (ch != 0 || !STRINGP (tmp))
	    Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      beg = read1 (readcharfun, &ch, 0);
	      if (ch == ')')
		break;
	      if (ch == 0)
		end = read1 (readcharfun, &ch, 0);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch, 0);
	      if (ch)
		Fsignal (Qinvalid_read_syntax,
			 Fcons (build_string ("invalid string property list"),
				Qnil));
	      Fset_text_properties (beg, end, plist, tmp);

    case '\'':
      {
	return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
      }

    case '`':
      if (first_in_list)
	goto default_label;
      else
	{
	  Lisp_Object value;

	  new_backquote_flag = 1;
	  value = read0 (readcharfun);
	  new_backquote_flag = 0;

	  return Fcons (Qbackquote, Fcons (value, Qnil));
	}

    case ',':
      if (new_backquote_flag)
	{
	  Lisp_Object comma_type = Qnil;
	  Lisp_Object value;
	  int ch = READCHAR;

	  if (ch == '@')
	    comma_type = Qcomma_at;
	  else if (ch == '.')
	    comma_type = Qcomma_dot;
	  else
	    {
	      if (ch >= 0) UNREAD (ch);
	      comma_type = Qcomma;
	    }

	  new_backquote_flag = 0;
	  value = read0 (readcharfun);
	  new_backquote_flag = 1;
	  return Fcons (comma_type, Fcons (value, Qnil));
	}
      else
	goto default_label;

    case '?':
      {
	register Lisp_Object val;

	/* Otherwise, we fall through!  Note that the atom-reading loop
	   below will now loop at least once, assuring that we will not
	   try to UNREAD two characters in a row.  */
      }
    default:
    default_label:
      if (c <= 040) goto retry;
      {
	register char *p = read_buffer;
	int quoted = 0;

  Lisp_Object val, tail;
  register Lisp_Object elt, tem;
  struct gcpro gcpro1, gcpro2;
  int cancel = 0;

  /* Initialize this to 1 if we are reading a list.  */
  int first_in_list = flag <= 0;

  val = Qnil;
  tail = Qnil;

  while (1)
    {
      char ch;
      GCPRO2 (val, tail);
      elt = read1 (readcharfun, &ch, first_in_list);
      UNGCPRO;

      first_in_list = 0;

	/* If purifying, and the list starts with #$,
	   return 0 instead.  This is a doc string reference
	   and it will be replaced anyway by Snarf-documentation,
	   so don't waste pure space with it.  */

	      GCPRO2 (val, tail);
	      if (!NILP (tail))
		XCONS (tail)->cdr = read0 (readcharfun);
	      else
		val = read0 (readcharfun);
	      read1 (readcharfun, &ch, 0);
	      UNGCPRO;
	      if (ch == ')')
		return (cancel ? make_number (0) : val);
	      return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
	    }

  staticpro (&Qread_char);

  Qget_file_char = intern ("get-file-char");
  staticpro (&Qget_file_char);

  Qbackquote = intern ("`");
  staticpro (&Qbackquote);
  Qcomma = intern (",");
  staticpro (&Qcomma);
  Qcomma_at = intern (",@");
  staticpro (&Qcomma_at);
  Qcomma_dot = intern (",.");
  staticpro (&Qcomma_dot);

  Qascii_character = intern ("ascii-character");
  staticpro (&Qascii_character);

  Qload = intern ("load");
  staticpro (&Qload);