From: Nikodemus S. <de...@us...> - 2009-05-04 20:43:12
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv21203/src/compiler Modified Files: typetran.lisp Log Message: 1.0.28.10: faster array dimension typechecking code * Put in an explicit ARRAY-HEADER-P, and short-circuit on its result when possible, otherwise use the known presence or lack of header to get dimensions more efficiently: using either %ARRAY-DIMENSION or VECTOR-LENGTH. Index: typetran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v retrieving revision 1.58 retrieving revision 1.59 diff -u -d -r1.58 -r1.59 --- typetran.lisp 14 Mar 2008 19:03:06 -0000 1.58 +++ typetran.lisp 4 May 2009 20:43:04 -0000 1.59 @@ -340,16 +340,27 @@ (dims (array-type-dimensions type))) (unless (or (eq dims '*) (equal dims (array-type-dimensions stype))) - (collect ((res)) - (when (eq (array-type-dimensions stype) '*) - (res `(= (array-rank ,obj) ,(length dims)))) - (do ((i 0 (1+ i)) - (dim dims (cdr dim))) - ((null dim)) - (let ((dim (car dim))) - (unless (eq dim '*) - (res `(= (array-dimension ,obj ,i) ,dim))))) - (res))))) + (cond ((cdr dims) + `((array-header-p ,obj) + ,@(when (eq (array-type-dimensions stype) '*) + `((= (%array-rank ,obj) ,(length dims)))) + ,@(loop for d in dims + for i from 0 + unless (eq '* d) + collect `(= (%array-dimension ,obj ,i) ,d)))) + ((and dims (csubtypep stype (specifier-type 'simple-array))) + `((not (array-header-p ,obj)) + ,@(unless (eq '* (car dims)) + `((= (vector-length ,obj) ,@dims))))) + ((and dims (csubtypep stype (specifier-type '(and array (not simple-array))))) + `((array-header-p ,obj) + ,@(unless (eq '* (car dims)) + `((= (%array-dimension ,obj 0) ,@dims))))) + (dims + (unless (eq '* (car dims)) + `((if (array-header-p ,obj) + (= (%array-dimension ,obj 0) ,@dims) + (= (vector-length ,obj) ,@dims))))))))) ;;; Return forms to test that OBJ has the element-type specified by ;;; type specified by TYPE, where STYPE is the type we have checked |