From: Christophe R. <cr...@us...> - 2002-12-05 10:44:47
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1:/tmp/cvs-serv26868/src/code Modified Files: describe.lisp Log Message: 0.7.10.11: A couple of array fixes ... make DESCRIBE work on rank-0 arrays (Lutz Euler sbcl-devel 2002-12-03) ... make DEFTRANSFORM MAKE-ARRAY warn (or style-warn) in the various appropriate cases: * default :INITIAL-ELEMENT not compatible with :ELEMENT-TYPE * provided :INITIAL-ELEMENT not compatible with :ELEMENT-TYPE * provided :INITIAL-ELEMENT not compatible with (UPGRADED-ARRAY-ELEMENT-TYPE ELEMENT-TYPE) Index: describe.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/describe.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- describe.lisp 12 Oct 2002 15:51:35 -0000 1.33 +++ describe.lisp 5 Dec 2002 10:44:44 -0000 1.34 @@ -43,18 +43,18 @@ (defmethod describe-object ((x array) s) (let ((rank (array-rank x))) - (cond ((> rank 1) - (format s "~S ~_is " x) - (write-string (if (%array-displaced-p x) "a displaced" "an") s) - (format s " array of rank ~S." rank) - (format s "~@:_Its dimensions are ~S." (array-dimensions x))) - (t + (cond ((= rank 1) (format s "~@:_~S is a ~:[~;displaced ~]vector of length ~S." x (and (array-header-p x) (%array-displaced-p x)) (length x)) (when (array-has-fill-pointer-p x) (format s "~@:_It has a fill pointer, currently ~S." - (fill-pointer x)))))) + (fill-pointer x)))) + (t + (format s "~S ~_is " x) + (write-string (if (%array-displaced-p x) "a displaced" "an") s) + (format s " array of rank ~S." rank) + (format s "~@:_Its dimensions are ~S." (array-dimensions x))))) (let ((array-element-type (array-element-type x))) (unless (eq array-element-type t) (format s |