Improved feature readers
Mon Jul 20 01:14:10 UTC 2009 pix@kepibu.org
* Improved feature readers
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|))
}