[Openmcl-cvs-notifications] r8524 - /trunk/source/level-1/l1-typesys.lisp

[gz at clozure.com]

Author: gz
Date: Wed Feb 20 20:57:59 2008
New Revision: 8524

Log:
Fix ticket#245

Modified:
    trunk/source/level-1/l1-typesys.lisp

Modified: trunk/source/level-1/l1-typesys.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-typesys.lisp (original)
+++ trunk/source/level-1/l1-typesys.lisp Wed Feb 20 20:57:59 2008
@@ -3632,29 +3632,29 @@
            ((t) (not (simple-array-p object)))
            ((nil) (simple-array-p object))
            ((* :maybe) t))
-         (let* ((ctype-dimensions (array-ctype-dimensions type))
-                (header-p (=3D typecode target::subtag-arrayH)))
-           (or (eq (array-ctype-dimensions type) '*)
-               (and (null (cdr ctype-dimensions)) (not header-p))
-               (and header-p
-                    (let* ((rank (%svref object target::arrayH.rank-cell)))
-                      (declare (fixnum rank))
-                      (and (=3D rank (length ctype-dimensions))
-                           (do* ((i 0 (1+ i))
-                                 (dim target::arrayH.dim0-cell (1+ dim))
-                                 (want (array-ctype-dimensions type) (cdr =
want))
-                                 (got (%svref object dim) (%svref object d=
im)))
-                                ((=3D i rank) t)
-                             (unless (or (eq (car want) '*)
-                                         (=3D (car want) got))
-                               (return nil)))))))
-           (or (eq (array-ctype-element-type type) *wild-type*)
-               (eql (array-ctype-typecode type)
-                    (if (> typecode target::subtag-vectorH)
+         (let* ((ctype-dimensions (array-ctype-dimensions type)))
+           (or (eq ctype-dimensions '*)
+	       (if (eql typecode target::subtag-arrayH)
+		   (let* ((rank (%svref object target::arrayH.rank-cell)))
+		     (declare (fixnum rank))
+		     (and (eql rank (length ctype-dimensions))
+			  (do* ((i 0 (1+ i))
+				(dim target::arrayH.dim0-cell (1+ dim))
+				(want (array-ctype-dimensions type) (cdr want))
+				(got (%svref object dim) (%svref object dim)))
+			       ((eql i rank) t)
+			    (unless (or (eq (car want) '*)
+					(eql (car want) (the fixnum got)))
+			      (return nil)))))
+		   (and (null (cdr ctype-dimensions))
+			(eql (car ctype-dimensions) (array-total-size object))))))
+	 (or (eq (array-ctype-element-type type) *wild-type*)
+	     (eql (array-ctype-typecode type)
+		  (if (> typecode target::subtag-vectorH)
                       typecode
                       (ldb target::arrayH.flags-cell-subtag-byte (the fixn=
um (%svref object target::arrayH.flags-cell)))))
-               (type=3D (array-ctype-specialized-element-type type)
-                      (specifier-type (array-element-type object))))))))
+	     (type=3D (array-ctype-specialized-element-type type)
+		    (specifier-type (array-element-type object)))))))
 =

 =

 (defun member-%%typep (object type)