0.7.13.pcl-class.1

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

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index 233a35a..6615bb9 100644 (file)
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -96,12 +96,13 @@
                         dimensions axis seq))
        (let ((len (length seq)))
          (dims len)
-         (unless (= axis (1- dimensions))
-           (when (zerop len)
-             (%reader-error stream
-                            "#~WA axis ~W 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))))))))
 \f
 ;;;; reading structure instances: the #S readmacro
@@ -118,13 +119,13 @@
       (%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)
+    (let ((classoid (find-classoid (car body) nil)))
+      (unless (typep classoid 'structure-classoid)
        (%reader-error stream "~S is not a defined structure type."
                       (car body)))
       (let ((def-con (dd-default-constructor
                      (layout-info
-                      (class-layout class)))))
+                      (classoid-layout classoid)))))
        (unless def-con
          (%reader-error
           stream "The ~S structure does not have a default constructor."
@@ -183,12 +184,12 @@
 ;; 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)))
+  (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*))
         (setf (gethash tree *sharp-equal-circle-table*) t)
-        (cond ((typep tree 'structure-object)
+        (cond ((typep tree '(or structure-object standard-object))
                (do ((i 1 (1+ i))
                     (end (%instance-length tree)))
                    ((= i end))