diff src/lread.c @ 140:585fb297b004 r20-2b4

Import from CVS: tag r20-2b4
author cvs
date Mon, 13 Aug 2007 09:32:43 +0200
parents 7d55a9ba150c
children 1856695b1fa9
line wrap: on
line diff
--- a/src/lread.c	Mon Aug 13 09:31:48 2007 +0200
+++ b/src/lread.c	Mon Aug 13 09:32:43 2007 +0200
@@ -73,6 +73,13 @@
 
 int puke_on_fsf_keys;
 
+/* This symbol is also used in fns.c */
+#define FEATUREP_SYNTAX
+
+#ifdef FEATUREP_SYNTAX
+static Lisp_Object Qfeaturep;
+#endif
+
 /* non-zero if inside `load' */
 int load_in_progress;
 
@@ -2369,7 +2376,26 @@
 	      return Fsignal (Qinvalid_read_syntax,
 		    list1 (build_string ("Cannot read unreadable object")));
 	    }
-
+#ifdef FEATUREP_SYNTAX
+	  case '+':
+	  case '-':
+	    {
+	      Lisp_Object fexp, obj, tem;
+	      struct gcpro gcpro1, gcpro2;
+
+	      fexp = read0(readcharfun);
+	      obj = read0(readcharfun);
+
+	      /* the call to `featurep' may GC. */
+	      GCPRO2(fexp, obj);
+	      tem = call1(Qfeaturep, fexp);
+	      UNGCPRO;
+
+	      if (c == '+' && NILP(tem)) goto retry;
+	      if (c == '-' && !NILP(tem)) goto retry;
+	      return obj;
+	    }
+#endif
 	  default:
 	    {
 	      unreadchar (readcharfun, c);
@@ -2583,10 +2609,12 @@
 	return (state);
       else
 	unreadchar (readcharfun, ch);
+#ifdef FEATUREP_SYNTAX
       if (ch == ']')
 	syntax_error ("\"]\" in a list");
       else if (ch == ')')
 	syntax_error ("\")\" in a vector");
+#endif
       state = ((conser) (readcharfun, state, len));
     }
 }
@@ -2618,6 +2646,18 @@
       free_cons (XCONS (tem));
       tem = Qnil;
       ch = XCHAR (elt);
+#ifdef FEATUREP_SYNTAX
+      if (ch == s->terminator) /* deal with #+, #- reader macros */
+	{
+	  unreadchar (readcharfun, s->terminator);
+	  goto done;
+	}
+      else if (ch == ']')
+	syntax_error ("']' in a list");
+      else if (ch == ')')
+	syntax_error ("')' in a vector");
+      else
+#endif
       if (ch != '.')
 	signal_simple_error ("BUG! Internal reader error", elt);
       else if (!s->allow_dotted_lists)
@@ -3130,6 +3170,12 @@
   /* So that early-early stuff will work */
   Ffset (Qload, intern ("load-internal"));
 
+#ifdef FEATUREP_SYNTAX
+  Qfeaturep = intern("featurep");
+  staticpro(&Qfeaturep);
+  Fprovide(intern("xemacs"));
+#endif
+
 #ifdef LISP_BACKQUOTES
   old_backquote_flag = new_backquote_flag = 0;
 #endif