[Improved feature readers
pix@kepibu.org**20090720011410
 It turns out #+/#- also need to do their thing under *read-suppress*, rather
 than simply skipping two forms.
 
 E.g.,
   '(#+(or) #+(not a b) a b c) => '(c)
   '(#+(or) #+(and) a b c)     => '(b c)
 
 (Not that such constructions are practically portable anyway, but meh.)
 
 Regardless, this fixes that as best I can.  Unfortunately, it also forces
 the normal package problems within feature expressions:
   #+(or) #+(notapackage:foo) 'a  => PACKAGE-ERROR
   #+(or) #+(cl:notexported)  'a  => PACKAGE-ERROR
 
 This is, so far as I can tell, portably unavoidable.  However, some (all?)
 implementations /already/ have this problem, so at least it's nothing new.
] {
hunk ./reader.lisp 3
+(define-condition suppressed-error (warning)
+  ((original-error     :initarg :error)
+   (feature-expression :initarg :feature))
+  (:report (lambda (c s)
+             (format s "Suppressed an error while testing feature expansion ~S: ~A"
+                     (slot-value c 'feature-expression)
+                     (slot-value c 'original-error)))))
+
hunk ./reader.lisp 12
-(defun feature-reader (stream subchar arg)
+(defun feature-reader (stream fn arg)
hunk ./reader.lisp 14
-  (declare (ignore arg))
+  (when (and arg (not *read-suppress*))
+    (error 'simple-error
+           :format-control "Numeric arg (~D) specified on reader conditional where none allowed."
+           :format-arguments (list arg)))
hunk ./reader.lisp 19
-           (ecase subchar
-             (#\+ (featurep form))
-             (#\- (not (featurep form)))))
+           ;; from CLHS *read-suppress* <http://www.lispworks.com/documentation/HyperSpec/Body/v_rd_sup.htm>:
+           ;; Any standardized reader macro that is defined to read a following
+           ;; object or token will do so, but not signal an error if the object
+           ;; read is not of an appropriate type or syntax.
+           ;;
+           ;; I take that to mean errors thrown during the course of #'featurep
+           ;; should be suppressed.  Some implementations differ.
+           (handler-bind
+               ((error (lambda (c)
+                         (when *read-suppress*
+                           (warn 'suppressed-error :feature form :error c)
+                           (return-from feature-truth nil)))))
+             (funcall fn form)))
hunk ./reader.lisp 35
-      (*read-suppress*
-       (read-form stream)
-       (read-form stream)
-       (values))
hunk ./reader.lisp 36
-        (let ((*package* (find-package :keyword)))
+        (let ((*package* (find-package :keyword))
+              ;; Incorrectly interns symbols, but we need more than just cl:nil :/
+              (*read-suppress* nil))
hunk ./reader.lisp 45
+(defun |#+-reader| (stream subchar arg)
+  (declare (ignore subchar))
+  (feature-reader stream #'featurep arg))
+
+(defun |#--reader| (stream subchar arg)
+  (declare (ignore subchar))
+  (feature-reader stream (complement #'featurep) arg))
+
hunk ./reader.lisp 54
-  (set-dispatch-macro-character #\# #\+ #'feature-reader)
-  (set-dispatch-macro-character #\# #\- #'feature-reader))
+  (set-dispatch-macro-character #\# #\+ #'|#+-reader|)
+  (set-dispatch-macro-character #\# #\- #'|#--reader|))
}