0.9.0.6:

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

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index 6bae634..049145d 100644 (file)
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -159,9 +159,12 @@
                               designator: ~S."
                             slot-name))
                          (when (not (keywordp slot-name))
-                           (style-warn "in #S ~S, the use of non-keywords ~
-                                         as slot specifiers is deprecated: ~S."
-                                       (car body) 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)))))))
 \f
@@ -169,20 +172,20 @@
 
 (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))))
 
 (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*
@@ -205,7 +208,7 @@
 
 (defun sharp-X (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
-  (sharp-r stream sub-char 16))
+  (sharp-R stream sub-char 16))
 \f
 ;;;; reading circular data: the #= and ## readmacros
 
@@ -217,7 +220,8 @@
 ;; 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 standard-object)))
+  (cond ((not (typep tree
+                    '(or cons (array t) structure-object standard-object)))
         (let ((entry (find tree old-new-alist :key #'second)))
           (if entry (third entry) tree)))
        ((null (gethash tree *sharp-equal-circle-table*))
@@ -346,35 +350,41 @@
 
 (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
+  (handler-bind
+      ((character-decoding-error
+       #'(lambda (decoding-error)
+           (declare (ignorable decoding-error))
+           (style-warn "Character decoding error in a #|-comment at position ~A reading source file ~A, resyncing." (file-position 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 (fast-read-char) char)
-              (char (fast-read-char) (fast-read-char)))
+              (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)
-                    (done-with-fast-read-char)
                     (return (values)))
-                  (setq char (fast-read-char)))
+                  (setq char (read-char stream t)))
                  ((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))))))))
+                  (setq char (read-char stream t))
+                  (setq level (1+ level)))))))))
 \f
 ;;;; a grab bag of other sharp readmacros: #', #:, and #.
 
@@ -440,8 +450,8 @@
   (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 #\# #\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 #\# #\Space #'sharp-illegal)