[Sbcl-commits] CVS: sbcl/src/code pprint.lisp,1.20,1.21 print.lisp,1.37,1.38 sharpm.lisp,1.7,1.8

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv22380/src/code

Modified Files:
	pprint.lisp print.lisp sharpm.lisp 
Log Message:
0.7.11.6:
	Fix bugs identified by Paul Dietz (cmucl-imp 2003-01-03) for
		printing and reading arrays
	... inspired by but slightly different from Gerd Moellmann fixes
		cmucl-imp 2003-01-04


Index: pprint.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/pprint.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- pprint.lisp	29 Sep 2002 18:48:53 -0000	1.20
+++ pprint.lisp	8 Jan 2003 10:59:11 -0000	1.21
@@ -974,7 +974,8 @@
 	     (stringp array)
 	     (bit-vector-p array))
 	 (output-ugly-object array stream))
-	((and *print-readably* (not (eq (array-element-type array) t)))
+	((and *print-readably*
+	      (not (array-readably-printable-p array)))
 	 (let ((*print-readably* nil))
 	   (error 'print-not-readable :object array)))
 	((vectorp array)

Index: print.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/print.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- print.lisp	14 Dec 2002 22:10:08 -0000	1.37
+++ print.lisp	8 Jan 2003 10:59:11 -0000	1.38
@@ -973,7 +973,7 @@
 	   (write-char (if (zerop bit) #\0 #\1) stream)))
 	(t
 	 (when (and *print-readably*
-		    (not (eq (array-element-type vector) t)))
+		    (not (array-readably-printable-p array)))
 	   (error 'print-not-readable :object vector))
 	 (descend-into (stream)
 		       (write-string "#(" stream)
@@ -1000,6 +1000,14 @@
 	  (when (needs-slash-p char) (write-char #\\ stream))
 	  (write-char char stream))))))
 
+(defun array-readably-printable-p (array)
+  (and (eq (array-element-type array) t)
+       (let ((zero (position 0 (array-dimensions array)))
+	     (number (position 0 (array-dimensions array)
+			       :test (complement #'eql)
+			       :from-end t)))
+	 (or (null zero) (null number) (> zero number)))))
+
 ;;; Output the printed representation of any array in either the #< or #A
 ;;; form.
 (defun output-array (array stream)
@@ -1016,7 +1024,7 @@
 ;;; Output the readable #A form of an array.
 (defun output-array-guts (array stream)
   (when (and *print-readably*
-	     (not (eq (array-element-type array) t)))
+	     (not (array-readably-printable-p array)))
     (error 'print-not-readable :object array))
   (write-char #\# stream)
   (let ((*print-base* 10))

Index: sharpm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sharpm.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- sharpm.lisp	12 Apr 2002 12:15:56 -0000	1.7
+++ sharpm.lisp	8 Jan 2003 10:59:11 -0000	1.8
@@ -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))))))))
 
 ;;;; reading structure instances: the #S readmacro