+;;; while we are at it, let us write something which helps us sanity
+;;; check our own code; it is too easy to write #+ when meaning #!+,
+;;; and such mistakes can go undetected for a while.
+;;;
+;;; ideally we wouldn't use *SHEBANG-FEATURES* but
+;;; *ALL-POSSIBLE-SHEBANG-FEATURES*, but maintaining that variable
+;;; will not be easy.
+(defun checked-feature-in-features-list-p (feature list)
+ (etypecase feature
+ (symbol (unless (member feature '(:ansi-cl :common-lisp :ieee-floating-point))
+ (when (member feature *shebang-features* :test #'eq)
+ (error "probable XC bug in host read-time conditional")))
+ (member feature list :test #'eq))
+ (cons (flet ((subfeature-in-list-p (subfeature)
+ (checked-feature-in-features-list-p subfeature list)))
+ (ecase (first feature)
+ (:or (some #'subfeature-in-list-p (rest feature)))
+ (:and (every #'subfeature-in-list-p (rest feature)))
+ (:not (let ((rest (cdr feature)))
+ (if (or (null (car rest)) (cdr rest))
+ (error "wrong number of terms in compound feature ~S"
+ feature)
+ (not (subfeature-in-list-p (second feature)))))))))))
+(compile 'checked-feature-in-features-list-p)
+
+(defun she-reader (stream sub-character infix-parameter)
+ (when infix-parameter
+ (error "illegal read syntax: #~D~C" infix-parameter sub-character))
+ (when (let* ((*package* (find-package "KEYWORD"))
+ (*read-suppress* nil)
+ (notp (eql sub-character #\-))
+ (feature (read stream)))
+ (if (checked-feature-in-features-list-p feature *features*)
+ notp
+ (not notp)))
+ (let ((*read-suppress* t))
+ (read stream t nil t)))
+ (values))
+(compile 'she-reader)
+\f
+;;;; variables like *SHEBANG-FEATURES* but different
+
+;;; This variable is declared here (like *SHEBANG-FEATURES*) so that
+;;; things like chill.lisp work (because the variable has properties
+;;; similar to *SHEBANG-FEATURES*, and chill.lisp was set up to work
+;;; for that). For an explanation of what it really does, look
+;;; elsewhere.
+(export '*shebang-backend-subfeatures*)
+(declaim (type list *shebang-backend-subfeatures*))
+(defvar *shebang-backend-subfeatures*)
+\f
+;;;; string checker, for catching non-portability early
+(defun make-quote-reader (standard-quote-reader)
+ (lambda (stream char)
+ (let ((result (funcall standard-quote-reader stream char)))
+ (unless (every (lambda (x) (typep x 'standard-char)) result)
+ (warn "Found non-STANDARD-CHAR in ~S" result))
+ result)))
+(compile 'make-quote-reader)
+
+(set-macro-character #\" (make-quote-reader (get-macro-character #\" nil)))