From: Christophe R. <cr...@us...> - 2003-06-27 10:18:46
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1:/tmp/cvs-serv20038/src/compiler Modified Files: array-tran.lisp debug-dump.lisp fndb.lisp Log Message: 0.8.1.9: Implement slightly DWIMish behaviour for (TYPE (ARRAY FOO ..) ..) declarations, as discussed on the CLHS "Declaration TYPE" page, and on sbcl-help circa 2003-05-08 and with Fufie on #lisp around 2003-06-24 ... We need the target's UPGRADED-ARRAY-ELEMENT-TYPE, so move the definition and define it in SB!XC ... use it (carefully) in MAKE-ARRAY optimizers and transforms, because the declaration behaviour we're implementing doesn't extend to (MAKE-ARRAY .. :ELEMENT-TYPE 'FOO) ... insert appropriate THEs in HAIRY-DATA-VECTOR-{REF,SET} if the declared array element type isn't the same as the declared upgraded element type Index: array-tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/array-tran.lisp,v retrieving revision 1.53 retrieving revision 1.54 diff -u -d -r1.53 -r1.54 --- array-tran.lisp 26 Jun 2003 09:54:54 -0000 1.53 +++ array-tran.lisp 27 Jun 2003 10:07:44 -0000 1.54 @@ -41,6 +41,12 @@ ;; 2002-08-21 *wild-type*))) +(defun extract-declared-element-type (array) + (let ((type (continuation-type array))) + (if (array-type-p type) + (array-type-element-type type) + *wild-type*))) + ;;; The ``new-value'' for array setters must fit in the array, and the ;;; return type is going to be the same as the new-value for SETF ;;; functions. @@ -136,7 +142,12 @@ `(,(if simple 'simple-array 'array) ,(cond ((not element-type) t) ((constant-continuation-p element-type) - (continuation-value element-type)) + (let ((ctype (careful-specifier-type + (continuation-value element-type)))) + (cond + ((or (null ctype) (unknown-type-p ctype)) '*) + (t (sb!xc:upgraded-array-element-type + (continuation-value element-type)))))) (t '*)) ,(cond ((constant-continuation-p dims) @@ -338,8 +349,14 @@ (len (if (constant-continuation-p length) (continuation-value length) '*)) - (result-type-spec `(simple-array ,eltype (,len))) (eltype-type (ir1-transform-specifier-type eltype)) + (result-type-spec + `(simple-array + ,(if (unknown-type-p eltype-type) + (give-up-ir1-transform + "ELEMENT-TYPE is an unknown type: ~S" eltype) + (sb!xc:upgraded-array-element-type eltype)) + (,len))) (saetp (find-if (lambda (saetp) (csubtypep eltype-type (saetp-ctype saetp))) *specialized-array-element-type-properties*))) @@ -415,8 +432,11 @@ (rank (length dims)) (spec `(simple-array ,(cond ((null element-type) t) - ((constant-continuation-p element-type) - (continuation-value element-type)) + ((and (constant-continuation-p element-type) + (ir1-transform-specifier-type + (continuation-value element-type))) + (sb!xc:upgraded-array-element-type + (continuation-value element-type))) (t '*)) ,(make-list rank :initial-element '*)))) `(let ((header (make-array-header sb!vm:simple-array-widetag ,rank))) Index: debug-dump.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/debug-dump.lisp,v retrieving revision 1.29 retrieving revision 1.30 diff -u -d -r1.29 -r1.30 --- debug-dump.lisp 12 Jun 2002 10:02:01 -0000 1.29 +++ debug-dump.lisp 27 Jun 2003 10:07:45 -0000 1.30 @@ -303,6 +303,8 @@ ;; SIGNED-BYTE arrays, so better make it break now if it ever ;; will: #+sb-xc-host + ;; not SB!XC:UPGRADED-ARRAY-ELEMENT-TYPE, because we are + ;; worried about whether the host's implementation of arrays. (aver (subtypep (upgraded-array-element-type specializer) 'unsigned-byte)) (coerce seq `(simple-array ,specializer (*))))))) Index: fndb.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v retrieving revision 1.70 retrieving revision 1.71 diff -u -d -r1.70 -r1.71 --- fndb.lisp 8 Jun 2003 06:12:31 -0000 1.70 +++ fndb.lisp 27 Jun 2003 10:07:45 -0000 1.71 @@ -44,7 +44,7 @@ (defknown type-of (t) t (foldable flushable)) ;;; These can be affected by type definitions, so they're not FOLDABLE. -(defknown (upgraded-complex-part-type upgraded-array-element-type) +(defknown (upgraded-complex-part-type sb!xc:upgraded-array-element-type) (type-specifier &optional lexenv-designator) type-specifier (unsafely-flushable)) |