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.

--- old-portaCL/reader.lisp 2013-06-15 07:47:04.000000000 +0000

+++ new-portaCL/reader.lisp 2013-06-15 07:47:04.000000000 +0000

@@ -1,28 +1,55 @@

(in-package #:portaCL)

+(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)))))

+

;; see CLHS 2.4.8.17 <http://www.lispworks.com/documentation/HyperSpec/Body/02_dhq.htm>

-(defun feature-reader (stream subchar arg)

+(defun feature-reader (stream fn arg)

"Reader for enhanced #+/#- feature conditionals."

- (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)))

(flet ((feature-truth (form)

- (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)))

(read-form (stream)

(read stream t nil t)))

(cond

- (*read-suppress*

- (read-form stream)

- (read-form stream)

- (values))

((feature-truth

- (let ((*package* (find-package :keyword)))

+ (let ((*package* (find-package :keyword))

+ ;; Incorrectly interns symbols, but we need more than just cl:nil :/

+ (*read-suppress* nil))

(read-form stream)))

(values (read-form stream)))

(t

(let ((*read-suppress* t)) (read-form stream))

(values)))))

+(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))

+

(defun install-feature-readers (&optional (*readtable* *readtable*))

- (set-dispatch-macro-character #\# #\+ #'feature-reader)

- (set-dispatch-macro-character #\# #\- #'feature-reader))

+ (set-dispatch-macro-character #\# #\+ #'|#+-reader|)

+ (set-dispatch-macro-character #\# #\- #'|#--reader|))