[Sbcl-commits] CVS: sbcl/src/cold shebang.lisp,1.8,1.9

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/cold
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21640/src/cold

Modified Files:
	shebang.lisp 
Log Message:
1.0.20.2: Fewer XC/reader-conditional confusions
	Inspired by Josh Elasser (sbcl-devel 2008-08-29), write code
	that tries to be clever about reader conditionals in the 
	cross-compiler, in order to point out when a mistake is likely.
	... and fix the extra buglet that this reveals.


Index: shebang.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/cold/shebang.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- shebang.lisp	11 Apr 2007 20:57:13 -0000	1.8
+++ shebang.lisp	4 Sep 2008 13:04:48 -0000	1.9
@@ -61,6 +61,45 @@
 (compile 'shebang-reader)
 
 (set-dispatch-macro-character #\# #\! #'shebang-reader)
+;;; 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)
 
 ;;;; variables like *SHEBANG-FEATURES* but different