Common Lisp like feature expressions (was: How and when to use GCPRO?)

[Leo <sdl.web@gmail.com>]

On 2010-12-27 16:00 +0000, Stefan Monnier wrote:
>         Stefan "wondering why eval_feature_expression would need to be
>                 written in C rather than in Elisp"

I hadn't thought of that :(

I put together a small patch for anyone who would like to try it:

diff --git a/lisp/subr.el b/lisp/subr.el
index 03f7e04..92f3b0a 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1719,6 +1719,31 @@ FILE should be the name of a library, with no directory name."
   (eval-after-load file (read)))
 (make-obsolete 'eval-next-after-load `eval-after-load "23.2")
 \f
+(defun eval-feature-expression (form)
+  (cond
+   ((atom form) (featurep form nil))
+   ;; ensure form is a proper list
+   ((condition-case nil
+        (and (length form) nil)
+      (error (error "Invalid feature expression: %s" form))))
+   ((eq (car form) 'not)
+    (if (= (length form) 2)
+        (not (eval-feature-expression (cadr form)))
+      (error "Invalid feature expression: %s" form)))
+   ((= (length form) 2)
+    (eval-feature-expression (cadr form)))
+   ((eq (car form) 'and)
+    (if (= (length form) 1)
+        t
+      (and (eval-feature-expression (cadr form))
+           (eval-feature-expression (cons 'and (cddr form))))))
+   ((eq (car form) 'or)
+    (if (= (length form) 1)
+        nil
+      (or (eval-feature-expression (cadr form))
+          (eval-feature-expression (cons 'or (cddr form))))))
+   (t (error "Invalid feature expression: %s" form))))
+\f
 ;;;; Process stuff.
 
 (defun process-lines (program &rest args)
diff --git a/src/lread.c b/src/lread.c
index 72c01ed..32c36ee 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -96,6 +96,9 @@ Lisp_Object Qinhibit_file_name_operation;
 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
+/* Used in feature expression */
+Lisp_Object Qobarray, Qeval_feature_expression;
+
 /* Used instead of Qget_file_char while loading *.elc files compiled
    by Emacs 21 or older.  */
 static Lisp_Object Qget_emacs_mule_file_char;
@@ -2426,6 +2429,24 @@ read1 (readcharfun, pch, first_in_list)
 	  UNREAD (c);
 	  invalid_syntax ("#", 1);
 	}
+      /* feature expressions as in Common Lisp */
+      if (c == '+' || c == '-')
+        {
+          Lisp_Object fexp = read0(readcharfun);
+          fexp = call1 (Qeval_feature_expression, fexp);
+          if (c == '-')
+            fexp = NILP (fexp) ? Qt : Qnil;
+          if (NILP (fexp))
+            {
+              int count = SPECPDL_INDEX ();
+              Lisp_Object tem = Fmake_vector (make_number(17),make_number(0));
+              /* use a temporary obarray */
+              specbind (Qobarray, tem);
+              read0 (readcharfun);
+              unbind_to (count, Qnil);
+            }
+          goto retry;
+        }
       if (c == '^')
 	{
 	  c = READCHAR;
@@ -4536,6 +4557,11 @@ to load.  See also `load-dangerous-libraries'.  */);
   Qcomma_dot = intern_c_string (",.");
   staticpro (&Qcomma_dot);
 
+  Qeval_feature_expression = intern_c_string ("eval-feature-expression");
+  staticpro (&Qeval_feature_expression);
+  Qobarray = intern_c_string ("obarray");
+  staticpro(&Qobarray);
+  
   Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
   staticpro (&Qinhibit_file_name_operation);