0.7.3.4:

[sbcl.git] / src / code / reader.lisp

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 69d1a6f..bc7c7b1 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -178,7 +178,7 @@
   FROM-TABLE defaults to the standard Lisp readtable when NIL."
   (let ((really-from-readtable (or from-readtable *standard-readtable*)))
     ;; Copy FROM-CHAR entries to TO-CHAR entries, but make sure that if
-    ;; from char is a constituent you don't copy non-movable secondary
+    ;; FROM-CHAR is a constituent you don't copy non-movable secondary
     ;; attributes (constituent types), and that said attributes magically
     ;; appear if you transform a non-constituent to a constituent.
     (let ((att (get-cat-entry from-char really-from-readtable)))
@@ -203,7 +203,7 @@
         (set-cat-entry char (get-secondary-attribute char) rt)
         (set-cat-entry char +char-attr-terminating-macro+ rt))
     (set-cmt-entry char function rt)
-    T))
+    t))
 
 (defun get-macro-character (char &optional (rt *readtable*))
   #!+sb-doc
@@ -1172,7 +1172,7 @@
                ((not dig)
                 (setq exponent (if negative-exponent (- exponent) exponent)))
             (setq exponent (+ (* exponent 10) dig)))
-          ;; Generate and return the float, depending on float-char:
+          ;; Generate and return the float, depending on FLOAT-CHAR:
           (let* ((float-format (case (char-upcase float-char)
                                  (#\E *read-default-float-format*)
                                  (#\S 'short-float)
@@ -1307,15 +1307,20 @@
   #!+sb-doc
   "Return the macro character function for SUB-CHAR under DISP-CHAR
    or NIL if there is no associated function."
-  (unless (digit-char-p sub-char)
-    (let* ((sub-char (char-upcase sub-char))
-          (rt (or rt *standard-readtable*))
-          (dpair (find disp-char (dispatch-tables rt)
-                       :test #'char= :key #'car)))
-      (if dpair
-         (elt (the simple-vector (cdr dpair))
-              (char-code sub-char))
-         (error "~S is not a dispatch char." disp-char)))))
+  (let* ((sub-char (char-upcase sub-char))
+         (rt (or rt *standard-readtable*))
+         (dpair (find disp-char (dispatch-tables rt)
+                      :test #'char= :key #'car)))
+    (if dpair
+        (let ((dispatch-fun (elt (the simple-vector (cdr dpair))
+                                 (char-code sub-char))))
+         ;; Digits are also initialized in a dispatch table to
+         ;; #'dispatch-char-error; READ-DISPATCH-CHAR handles them
+         ;; separately. - CSR, 2002-04-12
+          (if (eq dispatch-fun #'dispatch-char-error)
+              nil
+              dispatch-fun))
+        (error "~S is not a dispatch char." disp-char))))
 
 (defun read-dispatch-char (stream char)
   ;; Read some digits.