From: Christophe R. <cr...@us...> - 2003-06-27 10:15:11
|
Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8-pr-cvs1:/tmp/cvs-serv20038/src/compiler/generic Modified Files: vm-tran.lisp vm-type.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: vm-tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- vm-tran.lisp 10 Jun 2003 11:08:13 -0000 1.27 +++ vm-tran.lisp 27 Jun 2003 10:07:45 -0000 1.28 @@ -43,7 +43,8 @@ (deftransform hairy-data-vector-ref ((array index) (array t) * :important t) "avoid runtime dispatch on array element type" - (let ((element-ctype (extract-upgraded-element-type array))) + (let ((element-ctype (extract-upgraded-element-type array)) + (declared-element-ctype (extract-declared-element-type array))) (declare (type ctype element-ctype)) (when (eq *wild-type* element-ctype) (give-up-ir1-transform @@ -56,7 +57,11 @@ `(multiple-value-bind (array index) (%data-vector-and-index array index) (declare (type (simple-array ,element-type-specifier 1) array)) - (data-vector-ref array index))))) + ,(let ((bare-form '(data-vector-ref array index))) + (if (type= element-ctype declared-element-ctype) + bare-form + `(the ,(type-specifier declared-element-ctype) + ,bare-form))))))) (deftransform data-vector-ref ((array index) (simple-array t)) @@ -80,7 +85,8 @@ * :important t) "avoid runtime dispatch on array element type" - (let ((element-ctype (extract-upgraded-element-type array))) + (let ((element-ctype (extract-upgraded-element-type array)) + (declared-element-ctype (extract-declared-element-type array))) (declare (type ctype element-ctype)) (when (eq *wild-type* element-ctype) (give-up-ir1-transform @@ -90,9 +96,12 @@ (%data-vector-and-index array index) (declare (type (simple-array ,element-type-specifier 1) array) (type ,element-type-specifier new-value)) - (data-vector-set array - index - new-value))))) + ,(if (type= element-ctype declared-element-ctype) + '(data-vector-set array index new-value) + `(truly-the ,(type-specifier declared-element-ctype) + (data-vector-set array index + (the ,(type-specifier declared-element-ctype) + new-value)))))))) (deftransform data-vector-set ((array index new-value) (simple-array t t)) Index: vm-type.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-type.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- vm-type.lisp 24 Mar 2003 18:39:06 -0000 1.14 +++ vm-type.lisp 27 Jun 2003 10:07:45 -0000 1.15 @@ -150,6 +150,16 @@ (return stype)))))) type)) +(defun sb!xc:upgraded-array-element-type (spec &optional environment) + #!+sb-doc + "Return the element type that will actually be used to implement an array + with the specifier :ELEMENT-TYPE Spec." + (declare (ignore environment)) + (if (unknown-type-p (specifier-type spec)) + (error "undefined type: ~S" spec) + (type-specifier (array-type-specialized-element-type + (specifier-type `(array ,spec)))))) + ;;; Return the most specific integer type that can be quickly checked that ;;; includes the given type. (defun containing-integer-type (subtype) |