X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=0cf927964da2f799d10e0f7b8dc470346afc2385;hb=7aef55b130d95c384b63422807f1848faa9aba5a;hp=75b11b96065ecb4d732f54960bbf540b6c54a6ca;hpb=425dd2dc04e5069689af53adfbef2671b7c1ca48;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 75b11b9..0cf9279 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 @@ -174,9 +178,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)))) @@ -337,8 +346,9 @@ ;;; can pick them apart in the DEFTRANSFORMS, and transform '(3) style ;;; dimensions to integer args directly. (define-source-transform make-array (dimensions &rest keyargs &environment env) - (if (and (fun-lexically-notinline-p 'list) - (fun-lexically-notinline-p 'vector)) + (if (or (and (fun-lexically-notinline-p 'list) + (fun-lexically-notinline-p 'vector)) + (oddp (length keyargs))) (values nil t) (multiple-value-bind (new-dimensions rank) (flet ((constant-dims (dimensions) @@ -1090,7 +1100,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