X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=a595e63a63ff176d324a79556563d66b12fa2dfa;hb=0892423b9a4f2f8f9ca0096964deb4680e8441de;hp=82b3bdb83e8ddc30d8bb4873aac03dd3c2c68659;hpb=a5b1b81acd785b8864ec8ef48c17ac2b48bc1d06;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 82b3bdb..a595e63 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -98,6 +98,10 @@ (values element-type (when (eq *wild-type* element-type) (apply #'type-union element-supertypes))))) + (member-type + ;; Convert member-type to an union-type. + (array-type-upgraded-element-type + (apply #'type-union (mapcar #'ctype-of (member-type-members type))))) (t ;; KLUDGE: there is no good answer here, but at least ;; *wild-type* won't cause HAIRY-DATA-VECTOR-{REF,SET} to be @@ -165,6 +169,11 @@ (block nil (let ((dimensions (array-type-dimensions-or-give-up (lvar-conservative-type array)))) + ;; Might be *. (Note: currently this is never true, because the type + ;; derivation infers the rank from the call to ARRAY-IN-BOUNDS-P, but + ;; let's keep this future proof.) + (when (eq '* dimensions) + (give-up-ir1-transform "array bounds unknown")) ;; shortcut for zero dimensions (when (some (lambda (dim) (and (bound-known-p dim) (zerop dim))) @@ -174,9 +183,14 @@ ;; we can already decide on the result of the optimization without ;; even taking a look at the dimensions. (flet ((subscript-bounds (subscript) - (let* ((type (lvar-type subscript)) - (low (numeric-type-low type)) - (high (numeric-type-high type))) + (let* ((type1 (lvar-type subscript)) + (type2 (if (csubtypep type1 (specifier-type 'integer)) + (weaken-integer-type type1 :range-only t) + (give-up))) + (low (if (integer-type-p type2) + (numeric-type-low type2) + (give-up))) + (high (numeric-type-high type2))) (cond ((and (or (not (bound-known-p low)) (minusp low)) (or (not (bound-known-p high)) (not (minusp high)))) @@ -358,7 +372,8 @@ (values dimensions nil)))) (let ((initial-contents (getf keyargs :initial-contents))) (when (and initial-contents rank) - (setf (getf keyargs :initial-contents) + (setf keyargs (copy-list keyargs) + (getf keyargs :initial-contents) (rewrite-initial-contents rank initial-contents env)))) `(locally (declare (notinline list vector)) (make-array ,new-dimensions ,@keyargs))))) @@ -594,7 +609,12 @@ (unless (constant-lvar-p dims) (give-up-ir1-transform "The dimension list is not constant; cannot open code array creation.")) - (let ((dims (lvar-value dims))) + (let ((dims (lvar-value dims)) + (element-type-ctype (and (constant-lvar-p element-type) + (ir1-transform-specifier-type + (lvar-value element-type))))) + (when (unknown-type-p element-type-ctype) + (give-up-ir1-transform)) (unless (every #'integerp dims) (give-up-ir1-transform "The dimension list contains something other than an integer: ~S" @@ -611,9 +631,7 @@ (rank (length dims)) (spec `(simple-array ,(cond ((null element-type) t) - ((and (constant-lvar-p element-type) - (ir1-transform-specifier-type - (lvar-value element-type))) + (element-type-ctype (sb!xc:upgraded-array-element-type (lvar-value element-type))) (t '*)) @@ -991,10 +1009,44 @@ `(aref (the ,',type ,a) ,i)) (define-source-transform ,setter (a i v) `(%aset (the ,',type ,a) ,i ,v))))) - (define-frob svref %svset simple-vector) (define-frob schar %scharset simple-string) (define-frob char %charset string)) +;;; We transform SVREF and %SVSET directly into DATA-VECTOR-REF/SET: this is +;;; around 100 times faster than going through the general-purpose AREF +;;; transform which ends up doing a lot of work -- and introducing many +;;; intermediate lambdas, each meaning a new trip through the compiler -- to +;;; get the same result. +;;; +;;; FIXME: [S]CHAR, and [S]BIT above would almost certainly benefit from a similar +;;; treatment. +(define-source-transform svref (vector index) + (let ((elt-type (or (when (symbolp vector) + (let ((var (lexenv-find vector vars))) + (when var + (type-specifier + (array-type-declared-element-type (lambda-var-type var)))))) + t))) + (with-unique-names (n-vector) + `(let ((,n-vector ,vector)) + (the ,elt-type (data-vector-ref + (the simple-vector ,n-vector) + (%check-bound ,n-vector (length ,n-vector) ,index))))))) + +(define-source-transform %svset (vector index value) + (let ((elt-type (or (when (symbolp vector) + (let ((var (lexenv-find vector vars))) + (when var + (type-specifier + (array-type-declared-element-type (lambda-var-type var)))))) + t))) + (with-unique-names (n-vector) + `(let ((,n-vector ,vector)) + (truly-the ,elt-type (data-vector-set + (the simple-vector ,n-vector) + (%check-bound ,n-vector (length ,n-vector) ,index) + (the ,elt-type ,value))))))) + (macrolet (;; This is a handy macro for computing the row-major index ;; given a set of indices. We wrap each index with a call ;; to %CHECK-BOUND to ensure that everything works out @@ -1091,7 +1143,8 @@ `(deftransform ,name ((array index ,@extra)) (let* ((type (lvar-type array)) (element-type (array-type-upgraded-element-type type)) - (declared-type (array-type-declared-element-type type))) + (declared-type (type-specifier + (array-type-declared-element-type type)))) ;; If an element type has been declared, we want to ;; use that information it for type checking (even ;; if the access can't be optimized due to the array