X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsharpm.lisp;h=39c8e66ce1be9b66a5500bca95a19bbe0f60214a;hb=54da325f13fb41669869aea688ae195426c0e231;hp=f0a11683135a80a2f59e1f305a31aacf3bb513f2;hpb=8eb6f7d3da3960c827b704e23b5a47008274be7d;p=sbcl.git

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index f0a1168..39c8e66 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -14,95 +14,111 @@
 ;;; 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
 
 (defun sharp-left-paren (stream ignore length)
   (declare (ignore ignore) (special *backquote-count*))
   (let* ((list (read-list stream nil))
-	 (listlength (length list)))
+         (list-length (handler-case (length list)
+                        (type-error ()
+                          (simple-reader-error stream
+                                               "Improper list in #(): ~S."
+                                               list)))))
     (declare (list list)
-	     (fixnum listlength))
+             (fixnum list-length))
     (cond (*read-suppress* nil)
-	  ((zerop *backquote-count*)
-	   (if length
-	       (cond ((> listlength (the fixnum length))
-		      (%reader-error
-		       stream
-		       "vector longer than specified length: #~S~S"
-		       length list))
-		     (t
-		      (fill (the simple-vector
-				 (replace (the simple-vector
-					       (make-array length))
-					  list))
-			    (car (last list))
-			    :start listlength)))
-	       (coerce list 'vector)))
-	  (t (cons *bq-vector-flag* list)))))
+          ((and length (> list-length length))
+           (simple-reader-error
+            stream
+            "Vector longer than the specified length: #~S~S."
+            length list))
+          ((zerop *backquote-count*)
+           (if length
+               (fill (replace (make-array length) list)
+                     (car (last list))
+                     :start list-length)
+               (coerce list 'vector)))
+          (t
+           (cons *bq-vector-flag*
+                 (if length
+                     (append list
+                             (make-list (- length list-length)
+                                        :initial-element (car (last list))))
+                     list))))))
 
 (defun sharp-star (stream ignore numarg)
   (declare (ignore ignore))
   (multiple-value-bind (bstring escape-appearedp) (read-extended-token stream)
     (declare (simple-string bstring))
     (cond (*read-suppress* nil)
-	  (escape-appearedp
-	   (%reader-error stream "An escape character appeared after #*"))
-	  ((and numarg (zerop (length bstring)) (not (zerop numarg)))
-	   (%reader-error
-	    stream
-	    "You have to give a little bit for non-zero #* bit-vectors."))
-	  ((or (null numarg) (>= (the fixnum numarg) (length bstring)))
-	   (let* ((len1 (length bstring))
-		  (last1 (1- len1))
-		  (len2 (or numarg len1))
-		  (bvec (make-array len2 :element-type 'bit
-				    :initial-element 0)))
-	     (declare (fixnum len1 last1 len2))
-	     (do ((i 0 (1+ i))
-		  (char ()))
-		 ((= i len2))
-	       (declare (fixnum i))
-	       (setq char (elt bstring (if (< i len1) i last1)))
-	       (setf (elt bvec i)
-		     (cond ((char= char #\0) 0)
-			   ((char= char #\1) 1)
-			   (t
-			    (%reader-error
-			     stream
-			     "illegal element given for bit-vector: ~S"
-			     char)))))
-	     bvec))
-	  (t
-	   (%reader-error stream
-			 "Bit vector is longer than specified length #~A*~A"
-			 numarg bstring)))))
+          (escape-appearedp
+           (simple-reader-error stream
+                                "An escape character appeared after #*."))
+          ((and numarg (zerop (length bstring)) (not (zerop numarg)))
+           (simple-reader-error
+            stream
+            "You have to give a little bit for non-zero #* bit-vectors."))
+          ((or (null numarg) (>= (the fixnum numarg) (length bstring)))
+           (let* ((len1 (length bstring))
+                  (last1 (1- len1))
+                  (len2 (or numarg len1))
+                  (bvec (make-array len2 :element-type 'bit
+                                    :initial-element 0)))
+             (declare (fixnum len1 last1 len2))
+             (do ((i 0 (1+ i))
+                  (char ()))
+                 ((= i len2))
+               (declare (fixnum i))
+               (setq char (elt bstring (if (< i len1) i last1)))
+               (setf (elt bvec i)
+                     (cond ((char= char #\0) 0)
+                           ((char= char #\1) 1)
+                           (t
+                            (simple-reader-error
+                             stream
+                             "illegal element given for bit-vector: ~S"
+                             char)))))
+             bvec))
+          (t
+           (simple-reader-error
+            stream
+            "Bit vector is longer than specified length #~A*~A"
+            numarg
+            bstring)))))
 
 (defun sharp-A (stream ignore dimensions)
   (declare (ignore ignore))
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-A nil))
-  (unless dimensions (%reader-error stream "no dimensions argument to #A"))
+  (unless dimensions
+    (simple-reader-error stream "No dimensions argument to #A."))
   (collect ((dims))
-    (let* ((contents (read stream t nil t))
-	   (seq contents))
+    (let* ((*bq-error*
+            (if (zerop *backquote-count*)
+                *bq-error*
+                "Comma inside a backquoted array (not a list or general vector.)"))
+           (*backquote-count* 0)
+           (contents (read stream t nil t))
+           (seq contents))
       (dotimes (axis dimensions
-		     (make-array (dims) :initial-contents contents))
-	(unless (typep seq 'sequence)
-	  (%reader-error stream
-			 "#~DA axis ~D 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))
-	    (setq seq (elt seq 0))))))))
+                     (make-array (dims) :initial-contents contents))
+        (unless (typep seq 'sequence)
+          (simple-reader-error stream
+                               "#~WA axis ~W is not a sequence:~%  ~S"
+                               dimensions axis seq))
+        (let ((len (length seq)))
+          (dims len)
+          (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
 
@@ -111,67 +127,113 @@
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-S nil))
-  (let ((body (if (char= (read-char stream t) #\( )
-		  (read-list stream nil)
-		  (%reader-error stream "non-list following #S"))))
+  (let* ((*bq-error*
+          (if (zerop *backquote-count*)
+              *bq-error*
+              "Comma inside backquoted structure (not a list or general vector.)"))
+         (*backquote-count* 0)
+         (body (if (char= (read-char stream t) #\( )
+                  (let ((*backquote-count* 0))
+                    (read-list stream nil))
+                  (simple-reader-error stream "non-list following #S"))))
     (unless (listp body)
-      (%reader-error stream "non-list following #S: ~S" body))
+      (simple-reader-error stream "non-list following #S: ~S" body))
     (unless (symbolp (car body))
-      (%reader-error stream "Structure type is not a symbol: ~S" (car body)))
-    (let ((class (sb!xc:find-class (car body) nil)))
-      (unless (typep class 'sb!xc:structure-class)
-	(%reader-error stream "~S is not a defined structure type."
-		       (car body)))
-      (let ((def-con (dd-default-constructor
-		      (layout-info
-		       (class-layout class)))))
-	(unless def-con
-	  (%reader-error
-	   stream "The ~S structure does not have a default constructor."
-	   (car body)))
-	(apply (fdefinition def-con) (rest body))))))
+      (simple-reader-error stream
+                           "Structure type is not a symbol: ~S"
+                           (car body)))
+    (let ((classoid (find-classoid (car body) nil)))
+      (unless (typep classoid 'structure-classoid)
+        (simple-reader-error stream
+                             "~S is not a defined structure type."
+                             (car body)))
+      (let ((default-constructor (dd-default-constructor
+                                  (layout-info (classoid-layout classoid)))))
+        (unless default-constructor
+          (simple-reader-error
+           stream
+           "The ~S structure does not have a default constructor."
+           (car body)))
+        (when (and (atom (rest body))
+                   (not (null (rest body))))
+          (simple-reader-error stream "improper list for #S: ~S." body))
+        (apply (fdefinition default-constructor)
+               (loop for tail on (rest body) by #'cddr
+                     with slot-name = (and (consp tail) (car tail))
+                     do (progn
+                          (when (null (cdr tail))
+                            (simple-reader-error
+                             stream
+                             "the arglist for the ~S constructor in #S ~
+                              has an odd length: ~S."
+                             (car body) (rest body)))
+                          (when (or (atom (cdr tail))
+                                    (and (atom (cddr tail))
+                                         (not (null (cddr tail)))))
+                            (simple-reader-error
+                             stream
+                             "the arglist for the ~S constructor in #S ~
+                              is improper: ~S."
+                             (car body) (rest body)))
+                          (when (not (typep (car tail) 'string-designator))
+                            (simple-reader-error
+                             stream
+                             "a slot name in #S is not a string ~
+                              designator: ~S."
+                             slot-name))
+                          (when (not (keywordp slot-name))
+                            (warn 'structure-initarg-not-keyword
+                                  :format-control
+                                  "in #S ~S, the use of non-keywords ~
+                                   as slot specifiers is deprecated: ~S."
+                                  :format-arguments
+                                  (list (car body) slot-name))))
+                     collect (intern (string (car tail)) *keyword-package*)
+                     collect (cadr tail)))))))
 
 ;;;; reading numbers: the #B, #C, #O, #R, and #X readmacros
 
 (defun sharp-B (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
-  (sharp-r stream sub-char 2))
+  (sharp-R stream sub-char 2))
 
 (defun sharp-C (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
   ;; The next thing had better be a list of two numbers.
   (let ((cnum (read stream t nil t)))
-    (when *read-suppress* (return-from sharp-c nil))
+    (when *read-suppress* (return-from sharp-C nil))
     (if (and (listp cnum) (= (length cnum) 2))
-	(complex (car cnum) (cadr cnum))
-	(%reader-error stream "illegal complex number format: #C~S" cnum))))
+        (complex (car cnum) (cadr cnum))
+        (simple-reader-error stream
+                             "illegal complex number format: #C~S"
+                             cnum))))
 
 (defun sharp-O (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
-  (sharp-r stream sub-char 8))
+  (sharp-R stream sub-char 8))
 
 (defun sharp-R (stream sub-char radix)
   (cond (*read-suppress*
-	 (read-extended-token stream)
-	 nil)
-	((not radix)
-	 (%reader-error stream "radix missing in #R"))
-	((not (<= 2 radix 36))
-	 (%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."
-			    sub-char
-			    radix
-			    res))
-	   res))))
+         (read-extended-token stream)
+         nil)
+        ((not radix)
+         (simple-reader-error stream "radix missing in #R"))
+        ((not (<= 2 radix 36))
+         (simple-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)
+             (simple-reader-error stream
+                                  "#~A (base ~D.) value is not a rational: ~S."
+                                  sub-char
+                                  radix
+                                  res))
+           res))))
 
 (defun sharp-X (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
-  (sharp-r stream sub-char 16))
+  (sharp-R stream sub-char 16))
 
 ;;;; reading circular data: the #= and ## readmacros
 
@@ -183,37 +245,54 @@
 ;; substitutes in arrays and structures as well as lists. The first arg is an
 ;; alist of the things to be replaced assoc'd with the things to replace them.
 (defun circle-subst (old-new-alist tree)
-  (cond ((not (typep tree '(or cons (array t) structure-object)))
-	 (let ((entry (find tree old-new-alist :key #'second)))
-	   (if entry (third entry) tree)))
-	((null (gethash tree *sharp-equal-circle-table*))
-	 (setf (gethash tree *sharp-equal-circle-table*) t)
-	 (cond ((typep tree 'structure-object)
-		(do ((i 1 (1+ i))
-		     (end (%instance-length tree)))
-		    ((= i end))
-		  (let* ((old (%instance-ref tree i))
-			 (new (circle-subst old-new-alist old)))
-		    (unless (eq old new)
-		      (setf (%instance-ref tree i) new)))))
-	       ((arrayp tree)
-		(with-array-data ((data tree) (start) (end))
-		  (declare (fixnum start end))
-		  (do ((i start (1+ i)))
-		      ((>= i end))
-		    (let* ((old (aref data i))
-			   (new (circle-subst old-new-alist old)))
-		      (unless (eq old new)
-			(setf (aref data i) new))))))
-	       (t
-		(let ((a (circle-subst old-new-alist (car tree)))
-		      (d (circle-subst old-new-alist (cdr tree))))
-		  (unless (eq a (car tree))
-		    (rplaca tree a))
-		  (unless (eq d (cdr tree))
-		    (rplacd tree d)))))
-	 tree)
-	(t tree)))
+  (cond ((not (typep tree '(or cons (array t) instance funcallable-instance)))
+         (let ((entry (find tree old-new-alist :key #'second)))
+           (if entry (third entry) tree)))
+        ((null (gethash tree *sharp-equal-circle-table*))
+         (setf (gethash tree *sharp-equal-circle-table*) t)
+         (cond ((consp tree)
+                (let ((a (circle-subst old-new-alist (car tree)))
+                      (d (circle-subst old-new-alist (cdr tree))))
+                  (unless (eq a (car tree))
+                    (rplaca tree a))
+                  (unless (eq d (cdr tree))
+                    (rplacd tree d))))
+               ((arrayp tree)
+                (with-array-data ((data tree) (start) (end))
+                  (declare (fixnum start end))
+                  (do ((i start (1+ i)))
+                      ((>= i end))
+                    (let* ((old (aref data i))
+                           (new (circle-subst old-new-alist old)))
+                      (unless (eq old new)
+                        (setf (aref data i) new))))))
+               ((typep tree 'instance)
+                (let* ((n-untagged (layout-n-untagged-slots (%instance-layout tree)))
+                       (n-tagged (- (%instance-length tree) n-untagged)))
+                  ;; N-TAGGED includes the layout as well (at index 0), which
+                  ;; we don't grovel.
+                  (do ((i 1 (1+ i)))
+                      ((= i n-tagged))
+                    (let* ((old (%instance-ref tree i))
+                           (new (circle-subst old-new-alist old)))
+                      (unless (eq old new)
+                        (setf (%instance-ref tree i) new))))
+                  (do ((i 0 (1+ i)))
+                      ((= i n-untagged))
+                    (let* ((old (%raw-instance-ref/word tree i))
+                           (new (circle-subst old-new-alist old)))
+                      (unless (= old new)
+                        (setf (%raw-instance-ref/word tree i) new))))))
+               ((typep tree 'funcallable-instance)
+                (do ((i 1 (1+ i))
+                     (end (- (1+ (get-closure-length tree)) sb!vm:funcallable-instance-info-offset)))
+                    ((= i end))
+                  (let* ((old (%funcallable-instance-info tree i))
+                         (new (circle-subst old-new-alist old)))
+                    (unless (eq old new)
+                      (setf (%funcallable-instance-info tree i) new))))))
+         tree)
+        (t tree)))
 
 ;;; 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
@@ -236,17 +315,17 @@
   (declare (ignore ignore))
   (when *read-suppress* (return-from sharp-equal (values)))
   (unless label
-    (%reader-error stream "missing label for #=" label))
+    (simple-reader-error stream "missing label for #=" label))
   (when (or (assoc label *sharp-sharp-alist*)
-	    (assoc label *sharp-equal-alist*))
-    (%reader-error stream "multiply defined label: #~D=" label))
+            (assoc label *sharp-equal-alist*))
+    (simple-reader-error stream "multiply defined label: #~D=" label))
   (let* ((tag (gensym))
-	 (*sharp-sharp-alist* (acons label tag *sharp-sharp-alist*))
-	 (obj (read stream t nil t)))
+         (*sharp-sharp-alist* (acons label tag *sharp-sharp-alist*))
+         (obj (read stream t nil t)))
     (when (eq obj tag)
-      (%reader-error stream
-		     "must tag something more than just #~D#"
-		     label))
+      (simple-reader-error stream
+                     "must tag something more than just #~D#"
+                     label))
     (push (list label tag obj) *sharp-equal-alist*)
     (let ((*sharp-equal-circle-table* (make-hash-table :test 'eq :size 20)))
       (circle-subst *sharp-equal-alist* obj))))
@@ -255,32 +334,34 @@
   (declare (ignore ignore))
   (when *read-suppress* (return-from sharp-sharp nil))
   (unless label
-    (%reader-error stream "missing label for ##" label))
+    (simple-reader-error stream "missing label for ##" label))
 
   (let ((entry (assoc label *sharp-equal-alist*)))
     (if entry
-	(third entry)
-	(let ((pair (assoc label *sharp-sharp-alist*)))
-	  (unless pair
-	    (%reader-error stream "object is not labelled #~S#" label))
-	  (cdr pair)))))
+        (third entry)
+        (let (;; Has this label been defined previously? (Don't read
+              ;; ANSI "2.4.8.15 Sharpsign Equal-Sign" and worry that
+              ;; it requires you to implement forward references,
+              ;; because forward references are disallowed in
+              ;; "2.4.8.16 Sharpsign Sharpsign".)
+              (pair (assoc label *sharp-sharp-alist*)))
+          (unless pair
+            (simple-reader-error stream
+                                 "reference to undefined label #~D#"
+                                 label))
+          (cdr pair)))))
 
 ;;;; conditional compilation: the #+ and #- readmacros
 
 (flet ((guts (stream not-p)
-	 (unless (if (handler-case
-			 (let ((*package* *keyword-package*)
-			       (*read-suppress* nil))
-			   (featurep (read stream t nil t)))
-		       (reader-package-error
-			(condition)
-			(declare (ignore condition))
-			nil))
-		     (not not-p)
-		     not-p)
-	   (let ((*read-suppress* t))
-	     (read stream t nil t)))
-	 (values)))
+         (unless (if (let ((*package* *keyword-package*)
+                           (*read-suppress* nil))
+                       (featurep (read stream t nil t)))
+                     (not not-p)
+                     not-p)
+           (let ((*read-suppress* t))
+             (read stream t nil t)))
+         (values)))
 
   (defun sharp-plus (stream sub-char numarg)
     (ignore-numarg sub-char numarg)
@@ -303,44 +384,53 @@
   (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"
-			  charstring)))))
+          ((= (the fixnum (length charstring)) 1)
+           (char charstring 0))
+          ((name-char charstring))
+          (t
+           (simple-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 (ansi-stream-p stream)
-	(prepare-for-fast-read-char stream
-	  (do ((level 1)
-	       (prev (fast-read-char) char)
-	       (char (fast-read-char) (fast-read-char)))
-	      (())
-	    (cond ((and (char= prev #\|) (char= char #\#))
-		   (setq level (1- level))
-		   (when (zerop level)
-		     (done-with-fast-read-char)
-		     (return (values)))
-		   (setq char (fast-read-char)))
-		  ((and (char= prev #\#) (char= char #\|))
-		   (setq char (fast-read-char))
-		   (setq level (1+ level))))))
-	;; fundamental-stream
-	(do ((level 1)
-	     (prev (read-char stream t) char)
-	     (char (read-char stream t) (read-char stream t)))
-	    (())
-	  (cond ((and (char= prev #\|) (char= char #\#))
-		 (setq level (1- level))
-		 (when (zerop level)
-		   (return (values)))
-		 (setq char (read-char stream t)))
-		((and (char= prev #\#) (char= char #\|))
-		 (setq char (read-char stream t))
-		 (setq level (1+ level))))))))
+  (handler-bind
+      ((character-decoding-error
+        #'(lambda (decoding-error)
+            (declare (ignorable decoding-error))
+            (style-warn
+             'sb!kernel::character-decoding-error-in-dispatch-macro-char-comment
+             :sub-char sub-char :position (file-position stream) :stream stream)
+            (invoke-restart 'attempt-resync))))
+    (let ((stream (in-synonym-of stream)))
+      (if (ansi-stream-p stream)
+          (prepare-for-fast-read-char stream
+            (do ((level 1)
+                 (prev (fast-read-char) char)
+                 (char (fast-read-char) (fast-read-char)))
+                (())
+              (cond ((and (char= prev #\|) (char= char #\#))
+                     (setq level (1- level))
+                     (when (zerop level)
+                       (done-with-fast-read-char)
+                       (return (values)))
+                     (setq char (fast-read-char)))
+                    ((and (char= prev #\#) (char= char #\|))
+                     (setq char (fast-read-char))
+                     (setq level (1+ level))))))
+          ;; fundamental-stream
+          (do ((level 1)
+               (prev (read-char stream t) char)
+               (char (read-char stream t) (read-char stream t)))
+              (())
+            (cond ((and (char= prev #\|) (char= char #\#))
+                   (setq level (1- level))
+                   (when (zerop level)
+                     (return (values)))
+                   (setq char (read-char stream t)))
+                  ((and (char= prev #\#) (char= char #\|))
+                   (setq char (read-char stream t))
+                   (setq level (1+ level)))))))))
 
 ;;;; a grab bag of other sharp readmacros: #', #:, and #.
 
@@ -356,9 +446,8 @@
     (cond
      (*read-suppress* nil)
      (colon
-      (%reader-error stream
-		     "The symbol following #: contains a package marker: ~S"
-		     token))
+      (simple-reader-error
+       stream "The symbol following #: contains a package marker: ~S" token))
      (t
       (make-symbol token)))))
 
@@ -371,12 +460,12 @@
   (let ((token (read stream t nil t)))
     (unless *read-suppress*
       (unless *read-eval*
-	(%reader-error stream "can't read #. while *READ-EVAL* is NIL"))
+        (simple-reader-error stream "can't read #. while *READ-EVAL* is NIL"))
       (eval token))))
 
 (defun sharp-illegal (stream sub-char ignore)
   (declare (ignore ignore))
-  (%reader-error stream "illegal sharp macro character: ~S" sub-char))
+  (simple-reader-error stream "illegal sharp macro character: ~S" sub-char))
 
 ;;; for cold init: Install SHARPM stuff in the current *READTABLE*.
 (defun !sharpm-cold-init ()
@@ -406,11 +495,11 @@
   (set-dispatch-macro-character #\# #\C #'sharp-C)
   (set-dispatch-macro-character #\# #\c #'sharp-C)
   (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 #\# #\p #'sharp-P)
+  (set-dispatch-macro-character #\# #\P #'sharp-P)
   (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)))