X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsharpm.lisp;h=273a6a6004ca2081a52e2fa7f96a604b69167e12;hb=2010727926b091b23a246f6f659be61e27e19667;hp=1a9112a2060b3de626bd2c770d7df4673b1f3ec8;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index 1a9112a..273a6a6 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -8,16 +8,13 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 
 (declaim (special *read-suppress* *standard-readtable* *bq-vector-flag*))
 
 ;;; FIXME: Is it standard to ignore numeric args instead of raising errors?
 (defun ignore-numarg (sub-char numarg)
   (when numarg
-    (warn "A numeric argument was ignored in #~D~A." numarg sub-char)))
+    (warn "A numeric argument was ignored in #~W~A." numarg sub-char)))
 
 ;;;; reading arrays and vectors: the #(, #*, and #A readmacros
 
@@ -95,16 +92,17 @@
 		     (make-array (dims) :initial-contents contents))
 	(unless (typep seq 'sequence)
 	  (%reader-error stream
-			 "#~DA axis ~D is not a sequence:~%  ~S"
+			 "#~WA axis ~W is not a sequence:~%  ~S"
 			 dimensions axis seq))
 	(let ((len (length seq)))
 	  (dims len)
-	  (unless (= axis (1- dimensions))
-	    (when (zerop len)
-	      (%reader-error stream
-			     "#~DA axis ~D is empty, but is not ~
-			      the last dimension."
-			     dimensions axis))
+	  (unless (or (= axis (1- dimensions))
+		      ;; ANSI: "If some dimension of the array whose
+		      ;; representation is being parsed is found to be
+		      ;; 0, all dimensions to the right (i.e., the
+		      ;; higher numbered dimensions) are also
+		      ;; considered to be 0."
+		      (= len 0))
 	    (setq seq (elt seq 0))))))))
 
 ;;;; reading structure instances: the #S readmacro
@@ -160,13 +158,13 @@
 	((not radix)
 	 (%reader-error stream "radix missing in #R"))
 	((not (<= 2 radix 36))
-	 (%reader-error stream "illegal radix for #R: ~D" radix))
+	 (%reader-error stream "illegal radix for #R: ~D." radix))
 	(t
 	 (let ((res (let ((*read-base* radix))
 		      (read stream t nil t))))
 	   (unless (typep res 'rational)
 	     (%reader-error stream
-			    "#~A (base ~D) value is not a rational: ~S."
+			    "#~A (base ~D.) value is not a rational: ~S."
 			    sub-char
 			    radix
 			    res))
@@ -218,19 +216,21 @@
 	 tree)
 	(t tree)))
 
-;;; Sharp-equal works as follows. When a label is assigned (ie when #= is
-;;; called) we GENSYM a symbol is which is used as an unforgeable tag.
-;;; *SHARP-SHARP-ALIST* maps the integer tag to this gensym.
+;;; Sharp-equal works as follows. When a label is assigned (i.e. when
+;;; #= is called) we GENSYM a symbol is which is used as an
+;;; unforgeable tag. *SHARP-SHARP-ALIST* maps the integer tag to this
+;;; gensym.
 ;;;
-;;; When SHARP-SHARP encounters a reference to a label, it returns the symbol
-;;; assoc'd with the label. Resolution of the reference is deferred until the
-;;; read done by #= finishes. Any already resolved tags (in
-;;; *SHARP-EQUAL-ALIST*) are simply returned.
+;;; When SHARP-SHARP encounters a reference to a label, it returns the
+;;; symbol assoc'd with the label. Resolution of the reference is
+;;; deferred until the read done by #= finishes. Any already resolved
+;;; tags (in *SHARP-EQUAL-ALIST*) are simply returned.
 ;;;
 ;;; After reading of the #= form is completed, we add an entry to
-;;; *SHARP-EQUAL-ALIST* that maps the gensym tag to the resolved object. Then
-;;; for each entry in the *SHARP-SHARP-ALIST, the current object is searched
-;;; and any uses of the gensysm token are replaced with the actual value.
+;;; *SHARP-EQUAL-ALIST* that maps the gensym tag to the resolved
+;;; object. Then for each entry in the *SHARP-SHARP-ALIST, the current
+;;; object is searched and any uses of the gensysm token are replaced
+;;; with the actual value.
 (defvar *sharp-sharp-alist* ())
 
 (defun sharp-equal (stream ignore label)
@@ -301,23 +301,20 @@
 
 (defun sharp-backslash (stream backslash numarg)
   (ignore-numarg backslash numarg)
-  (unread-char backslash stream)
-  (let* ((*readtable* *standard-readtable*)
-	 (charstring (read-extended-token stream)))
+  (let ((charstring (read-extended-token-escaped stream)))
     (declare (simple-string charstring))
     (cond (*read-suppress* nil)
 	  ((= (the fixnum (length charstring)) 1)
 	   (char charstring 0))
 	  ((name-char charstring))
 	  (t
-	   (%reader-error stream
-			  "unrecognized character name: ~S"
+	   (%reader-error stream "unrecognized character name: ~S"
 			  charstring)))))
 
 (defun sharp-vertical-bar (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
   (let ((stream (in-synonym-of stream)))
-    (if (lisp-stream-p stream)
+    (if (ansi-stream-p stream)
 	(prepare-for-fast-read-char stream
 	  (do ((level 1)
 	       (prev (fast-read-char) char)
@@ -412,9 +409,9 @@
   (set-dispatch-macro-character #\# #\| #'sharp-vertical-bar)
   (set-dispatch-macro-character #\# #\p #'sharp-p)
   (set-dispatch-macro-character #\# #\P #'sharp-p)
-  (set-dispatch-macro-character #\# #\  #'sharp-illegal)
   (set-dispatch-macro-character #\# #\) #'sharp-illegal)
   (set-dispatch-macro-character #\# #\< #'sharp-illegal)
-  ;; FIXME: Should linefeed/newline go in this list too?
-  (dolist (cc '#.(list tab-char-code form-feed-char-code return-char-code))
+  (set-dispatch-macro-character #\# #\Space #'sharp-illegal)
+  (dolist (cc '#.(list tab-char-code form-feed-char-code return-char-code
+                       line-feed-char-code backspace-char-code))
     (set-dispatch-macro-character #\# (code-char cc) #'sharp-illegal)))