X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Flate-type.lisp;h=edd81f76be856acdc78d881b8593a962ed5fef12;hb=467a8e5dba8bfa2598ca8e22c1204dc173ce556f;hp=68ba00d9d848eb237ec1d725f32b7fd78be2e8c9;hpb=77360ee4a1f94c41b807be7ad0e8687199fceef1;p=sbcl.git diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 68ba00d..edd81f7 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -128,7 +128,8 @@ ;;;; also be annotated with function or values types. ;;; the description of a keyword argument -(defstruct (key-info #-sb-xc-host (:pure t)) +(defstruct (key-info #-sb-xc-host (:pure t) + (:copier nil)) ;; the keyword (name (required-argument) :type keyword) ;; the type of the argument value @@ -242,7 +243,7 @@ (multiple-value-bind (required optional restp rest keyp keys allowp aux) (parse-lambda-list lambda-list) (when aux - (error "&Aux in a FUNCTION or VALUES type: ~S." lambda-list)) + (error "&AUX in a FUNCTION or VALUES type: ~S." lambda-list)) (setf (args-type-required result) (mapcar #'specifier-type required)) (setf (args-type-optional result) (mapcar #'specifier-type optional)) (setf (args-type-rest result) (if restp (specifier-type rest) nil)) @@ -253,7 +254,8 @@ (error "Keyword type description is not a two-list: ~S." key)) (let ((kwd (first key))) (when (find kwd (key-info) :key #'key-info-name) - (error "Repeated keyword ~S in lambda list: ~S." kwd lambda-list)) + (error "~@" + kwd lambda-list)) (key-info (make-key-info :name kwd :type (specifier-type (second key)))))) (setf (args-type-keywords result) (key-info))) @@ -307,10 +309,8 @@ ;;;; We provide a few special operations that can be meaningfully used ;;;; on VALUES types (as well as on any other type). -;;; Return the type of the first value indicated by Type. This is used -;;; by people who don't want to have to deal with values types. - -;;; MNA: fix-instance-typep-call patch +;;; Return the type of the first value indicated by TYPE. This is used +;;; by people who don't want to have to deal with VALUES types. #!-sb-fluid (declaim (freeze-type values-type)) ; (inline single-value-type)) (defun single-value-type (type) @@ -318,7 +318,8 @@ (cond ((values-type-p type) (or (car (args-type-required type)) (if (args-type-optional type) - (type-union (car (args-type-optional type)) (specifier-type 'null))) + (type-union (car (args-type-optional type)) + (specifier-type 'null))) (args-type-rest type) (specifier-type 'null))) ((eq type *wild-type*) @@ -340,10 +341,10 @@ (values fixed (+ fixed (length (args-type-optional type)))))) (values nil nil))) -;;; Determine if Type corresponds to a definite number of values. The -;;; first value is a list of the types for each value, and the second -;;; value is the number of values. If the number of values is not -;;; fixed, then return NIL and :Unknown. +;;; Determine whether TYPE corresponds to a definite number of values. +;;; The first value is a list of the types for each value, and the +;;; second value is the number of values. If the number of values is +;;; not fixed, then return NIL and :UNKNOWN. (defun values-types (type) (declare (type ctype type)) (cond ((eq type *wild-type*) @@ -360,7 +361,6 @@ (values (mapcar #'single-value-type req) (length req)))))) ;;; Return two values: -;;; MNA: fix-instance-typep-call patch ;;; 1. A list of all the positional (fixed and optional) types. ;;; 2. The &REST type (if any). If keywords allowed, *UNIVERSAL-TYPE*. ;;; If no keywords or &REST, then the DEFAULT-TYPE. @@ -371,8 +371,7 @@ (cond ((args-type-keyp type) *universal-type*) ((args-type-rest type)) (t - ;; MNA: fix-instance-typep-call patch - default-type)))) + default-type)))) ;;; Return a list of OPERATION applied to the types in TYPES1 and ;;; TYPES2, padding with REST2 as needed. TYPES1 must not be shorter @@ -424,19 +423,15 @@ ;;; OPERATION returned true as its second value each time we called ;;; it. Since we approximate the intersection of VALUES types, the ;;; second value being true doesn't mean the result is exact. -;;; MNA: fix-instance-typep-call patch (defun args-type-op (type1 type2 operation nreq default-type) - ;;; MNA: fix-instance-typep-call patch (declare (type ctype type1 type2 default-type) (type function operation nreq)) (if (or (values-type-p type1) (values-type-p type2)) (let ((type1 (coerce-to-values type1)) (type2 (coerce-to-values type2))) (multiple-value-bind (types1 rest1) - ;;; MNA: fix-instance-typep-call patch (values-type-types type1 default-type) (multiple-value-bind (types2 rest2) - ;;; MNA: fix-instance-typep-call patch (values-type-types type2 default-type) (multiple-value-bind (rest rest-exact) (funcall operation rest1 rest2) @@ -458,7 +453,6 @@ :optional (if opt-last (subseq opt 0 (1+ opt-last)) ()) - ;; MNA fix-instance-typep-call patch :rest (if (eq rest default-type) nil rest)) (and rest-exact res-exact))))))))) (funcall operation type1 type2))) @@ -480,9 +474,7 @@ ((eq type1 *empty-type*) type2) ((eq type2 *empty-type*) type1) (t - ;;; MNA: fix-instance-typep-call patch (values (args-type-op type1 type2 #'type-union #'min *empty-type*))))) -;;; (defun-cached (values-type-intersection :hash-function type-cache-hash :hash-bits 8 :values 2 @@ -493,7 +485,10 @@ (cond ((eq type1 *wild-type*) (values type2 t)) ((eq type2 *wild-type*) (values type1 t)) (t - (args-type-op type1 type2 #'type-intersection #'max (specifier-type 'null))))) + (args-type-op type1 type2 + #'type-intersection + #'max + (specifier-type 'null))))) ;;; This is like TYPES-INTERSECT, except that it sort of works on ;;; VALUES types. Note that due to the semantics of @@ -625,13 +620,13 @@ :default :vanilla))) (cond ((eq res :vanilla) (or (vanilla-union type1 type2) - (make-union-type (list type1 type2)))) + (make-union-type-or-something (list type1 type2)))) (res) (t - (make-union-type (list type1 type2))))))) + (make-union-type-or-something (list type1 type2))))))) ;;; Return as restrictive a type as we can discover that is no more -;;; restrictive than the intersection of Type1 and Type2. The second +;;; restrictive than the intersection of TYPE1 and TYPE2. The second ;;; value is true if the result is exact. At worst, we randomly return ;;; one of the arguments as the first value (trying not to return a ;;; hairy type). @@ -768,7 +763,7 @@ (values type1 nil)) (!define-type-method (hairy :complex-union) (type1 type2) - (make-union-type (list type1 type2))) + (make-union-type-or-something (list type1 type2))) (!define-type-method (hairy :simple-=) (type1 type2) (if (equal (hairy-type-specifier type1) @@ -778,10 +773,24 @@ (!def-type-translator not (&whole whole type) (declare (ignore type)) + ;; Check legality of arguments. + (destructuring-bind (not typespec) whole + (declare (ignore not)) + (specifier-type typespec)) ; must be legal typespec + ;; Create object. (make-hairy-type :specifier whole)) (!def-type-translator satisfies (&whole whole fun) (declare (ignore fun)) + ;; Check legality of arguments of arguments. + (destructuring-bind (satisfies predicate-name) whole + (declare (ignore satisfies)) + (unless (symbolp predicate-name) + (error 'simple-type-error + :datum predicate-name + :expected-type symbol + :format-control "~S is not a symbol." + :format-arguments (list predicate-name)))) (make-hairy-type :specifier whole)) ;;;; numeric types @@ -1387,8 +1396,8 @@ (let ((dims1 (array-type-dimensions type1)) (dims2 (array-type-dimensions type2)) (complexp2 (array-type-complexp type2))) - ;; See whether dimensions are compatible. - (cond ((not (or (eq dims2 '*) + (cond (;; not subtypep unless dimensions are compatible + (not (or (eq dims2 '*) (and (not (eq dims1 '*)) ;; (sbcl-0.6.4 has trouble figuring out that ;; DIMS1 and DIMS2 must be lists at this @@ -1401,18 +1410,27 @@ (the list dims1) (the list dims2))))) (values nil t)) - ;; See whether complexpness is compatible. + ;; not subtypep unless complexness is compatible ((not (or (eq complexp2 :maybe) (eq (array-type-complexp type1) complexp2))) (values nil t)) - ;; If the TYPE2 eltype is wild, we win. Otherwise, the types - ;; must be identical. - ((or (eq (array-type-element-type type2) *wild-type*) - (type= (specialized-element-type-maybe type1) - (specialized-element-type-maybe type2))) + ;; Since we didn't fail any of the tests above, we win + ;; if the TYPE2 element type is wild. + ((eq (array-type-element-type type2) *wild-type*) (values t t)) - (t - (values nil t))))) + (;; Since we didn't match any of the special cases above, we + ;; can't give a good answer unless both the element types + ;; have been defined. + (or (unknown-type-p (array-type-element-type type1)) + (unknown-type-p (array-type-element-type type2))) + (values nil nil)) + (;; Otherwise, the subtype relationship holds iff the + ;; types are equal, and they're equal iff the specialized + ;; element types are identical. + t + (values (type= (specialized-element-type-maybe type1) + (specialized-element-type-maybe type2)) + t))))) (!define-superclasses array ((string string) @@ -1510,10 +1528,9 @@ t)) (!define-type-method (member :complex-subtypep-arg1) (type1 type2) - (block PUNT - (values (every-type-op ctypep type2 (member-type-members type1) - :list-first t) - t))) + (every/type (swapped-args-fun #'ctypep) + type2 + (member-type-members type1))) ;;; We punt if the odd type is enumerable and intersects with the ;;; MEMBER type. If not enumerable, then it is definitely not a @@ -1537,13 +1554,13 @@ t))) (!define-type-method (member :complex-intersection) (type1 type2) - (block PUNT + (block punt (collect ((members)) (let ((mem2 (member-type-members type2))) - (dolist (member mem2) + (dolist (member mem2) (multiple-value-bind (val win) (ctypep member type1) (unless win - (return-from PUNT (values type2 nil))) + (return-from punt (values type2 nil))) (when val (members member)))) (values (cond ((subsetp mem2 (members)) type2) @@ -1552,9 +1569,9 @@ (make-member-type :members (members)))) t))))) -;;; We don't need a :COMPLEX-UNION, since the only interesting case is a union -;;; type, and the member/union interaction is handled by the union type -;;; method. +;;; We don't need a :COMPLEX-UNION, since the only interesting case is +;;; a union type, and the member/union interaction is handled by the +;;; union type method. (!define-type-method (member :simple-union) (type1 type2) (let ((mem1 (member-type-members type1)) (mem2 (member-type-members type2))) @@ -1566,7 +1583,8 @@ (!define-type-method (member :simple-=) (type1 type2) (let ((mem1 (member-type-members type1)) (mem2 (member-type-members type2))) - (values (and (subsetp mem1 mem2) (subsetp mem2 mem1)) + (values (and (subsetp mem1 mem2) + (subsetp mem2 mem1)) t))) (!define-type-method (member :complex-=) (type1 type2) @@ -1582,64 +1600,242 @@ (make-member-type :members (remove-duplicates members)) *empty-type*)) +;;;; intersection types +;;;; +;;;; Until version 0.6.10.6, SBCL followed the original CMU CL approach +;;;; of punting on all AND types, not just the unreasonably complicated +;;;; ones. The change was motivated by trying to get the KEYWORD type +;;;; to behave sensibly: +;;;; ;; reasonable definition +;;;; (DEFTYPE KEYWORD () '(AND SYMBOL (SATISFIES KEYWORDP))) +;;;; ;; reasonable behavior +;;;; (ASSERT (SUBTYPEP 'KEYWORD 'SYMBOL)) +;;;; Without understanding a little about the semantics of AND, we'd +;;;; get (SUBTYPEP 'KEYWORD 'SYMBOL)=>NIL,NIL and, for entirely +;;;; parallel reasons, (SUBTYPEP 'RATIO 'NUMBER)=>NIL,NIL. That's +;;;; not so good..) +;;;; +;;;; We still follow the example of CMU CL to some extent, by punting +;;;; (to the opaque HAIRY-TYPE) on sufficiently complicated types +;;;; involving AND. + +;;; In general, make an INTERSECTION-TYPE object from the specifier +;;; types. But in various special cases, dodge instead, representing +;;; the intersection type in some other way. +(defun make-intersection-type-or-something (types) + (declare (list types)) + (/show0 "entering MAKE-INTERSECTION-TYPE-OR-SOMETHING") + (cond ((null types) + *universal-type*) + ((null (cdr types)) + (first types)) + (;; if potentially too hairy + (some (lambda (type) + ;; Allowing irreducible union types into intersection + ;; types leads to issues of canonicalization. Those might + ;; be soluble but it would be nicer just to avoid them + ;; entirely by punting to HAIRY-TYPE. -- WHN 2001-03-02 + (union-type-p type)) + types) + ;; (CMU CL punted to HAIRY-TYPE like this for all AND-based + ;; types. We don't want to do that for simple intersection + ;; types like the definition of KEYWORD, hence the guard + ;; clause above. But we do want to punt for any really + ;; unreasonable cases which might have motivated them to punt + ;; in all cases, hence the punt-to-HAIRY-TYPE code below.) + (make-hairy-type :specifier `(and ,@(mapcar #'type-specifier types)))) + (t + (%make-intersection-type (some #'type-enumerable types) types)))) + +(!define-type-class intersection) + +;;; A few intersection types have special names. The others just get +;;; mechanically unparsed. +(!define-type-method (intersection :unparse) (type) + (declare (type ctype type)) + (/show0 "entering INTERSECTION :UNPARSE") + (or (find type '(ratio bignum keyword) :key #'specifier-type :test #'type=) + `(and ,@(mapcar #'type-specifier (intersection-type-types type))))) + +;;; shared machinery for type equality: true if every type in the set +;;; TYPES1 matches a type in the set TYPES2 and vice versa +(defun type=-set (types1 types2) + (/show0 "entering TYPE=-SET") + (flet (;; true if every type in the set X matches a type in the set Y + (type<=-set (x y) + (declare (type list x y)) + (every (lambda (xelement) + (position xelement y :test #'type=)) + x))) + (values (and (type<=-set types1 types2) + (type<=-set types2 types1)) + t))) + +;;; Two intersection types are equal if their subtypes are equal sets. +;;; +;;; FIXME: Might it be better to use +;;; (AND (SUBTYPEP X Y) (SUBTYPEP Y X)) +;;; instead, since SUBTYPEP is the usual relationship that we care +;;; most about, so it would be good to leverage any ingenuity there +;;; in this more obscure method? +(!define-type-method (intersection :simple-=) (type1 type2) + (/show0 "entering INTERSECTION :SIMPLE-=") + (type=-set (intersection-type-types type1) + (intersection-type-types type2))) + +(!define-type-method (intersection :simple-subtypep) (type1 type2) + (/show0 "entering INTERSECTION :SIMPLE-SUBTYPEP") + (let ((certain? t)) + (dolist (t1 (intersection-type-types type1) (values nil certain?)) + (multiple-value-bind (subtypep validp) + (intersection-complex-subtypep-arg2 t1 type2) + (cond ((not validp) + (setf certain? nil)) + (subtypep + (return (values t t)))))))) + +(!define-type-method (intersection :complex-subtypep-arg1) (type1 type2) + (/show0 "entering INTERSECTION :COMPLEX-SUBTYPEP-ARG1") + (any/type (swapped-args-fun #'csubtypep) + type2 + (intersection-type-types type1))) + +(defun intersection-complex-subtypep-arg2 (type1 type2) + (every/type #'csubtypep type1 (intersection-type-types type2))) +(!define-type-method (intersection :complex-subtypep-arg2) (type1 type2) + (/show0 "entering INTERSECTION :COMPLEX-SUBTYPEP-ARG2") + (intersection-complex-subtypep-arg2 type1 type2)) + +;;; shared logic for unions and intersections: Return a new type list +;;; where pairs of types which can be simplified by SIMPLIFY2-FUN have +;;; been replaced by their simplified forms. +(defun simplify-types (types simplify2-fun) + (declare (type function simplify2-fun)) + (let (;; our result, accumulated as a vector + (a (make-array (length types) :fill-pointer 0))) + (dolist (%type types (coerce a 'list)) + ;; Merge TYPE into RESULT. + (named-let again ((type %type)) + (dotimes (i (length a) (vector-push-extend type a)) + (let ((ai (aref a i))) + (multiple-value-bind (simplified win?) + (funcall simplify2-fun type ai) + (when win? + (setf (aref a i) (vector-pop a)) + ;; Give the new SIMPLIFIED its own chance to be + ;; pairwise simplified w.r.t. elements of A. + (return (again simplified)))))))))) + +;;; FIXME: See FIXME note for DEFUN SIMPLIFY2-UNION. +(defun simplify2-intersection (x y) + (let ((intersection (type-intersection x y))) + (if (and (or (intersection-type-p intersection) + (hairy-type-p intersection)) + (not (intersection-type-p x)) + (not (intersection-type-p y))) + (values nil nil) + (values intersection t)))) + +(!define-type-method (intersection :simple-intersection :complex-intersection) + (type1 type2) + (/show0 "entering INTERSECTION :SIMPLE-INTERSECTION :COMPLEX-INTERSECTION") + (flet ((type-components (type) + (typecase type + (intersection-type (intersection-type-types type)) + (t (list type))))) + (make-intersection-type-or-something + ;; FIXME: Here and in MAKE-UNION-TYPE and perhaps elsewhere we + ;; should be looking for simplifications and putting things into + ;; canonical form. + (append (type-components type1) + (type-components type2))))) + +(!def-type-translator and (&whole whole &rest type-specifiers) + ;; Note: Between the behavior of SIMPLIFY-INTERSECTION-TYPE (which + ;; will reduce to a 1-element list any list of types which CMU CL + ;; could've represented) and MAKE-INTERSECTION-TYPE-OR-SOMETHING + ;; (which knows to treat a 1-element intersection as the element + ;; itself) we should recover CMU CL's behavior for anything which it + ;; could handle usefully (i.e. could without punting to HAIRY-TYPE). + (/show0 "entering type translator for AND") + (if *xtype?* + (make-intersection-type-or-something + (mapcar #'specifier-type type-specifiers)) + (let ((res *wild-type*)) + (dolist (type-specifier type-specifiers res) + (let ((ctype (specifier-type type-specifier))) + (multiple-value-bind (int win) (type-intersection res ctype) + (unless win + (return (make-hairy-type :specifier whole))) + (setq res int))))))) + ;;;; union types ;;; Make a union type from the specifier types, setting ENUMERABLE in -;;; the result if all are enumerable. -(defun make-union-type (types) +;;; the result if all are enumerable; or take the easy way out if we +;;; recognize a special case which can be represented more simply. +(defun make-union-type-or-something (types) (declare (list types)) - (%make-union-type (every #'type-enumerable types) types)) + (/show0 "entering MAKE-UNION-TYPE-OR-SOMETHING") + (cond ((null types) + *empty-type*) + ((null (cdr types)) + (first types)) + (t + (%make-union-type (every #'type-enumerable types) types)))) (!define-type-class union) -;;; If LIST, then return that, otherwise the OR of the component types. +;;; The LIST type has a special name. Other union types +;;; just get mechanically unparsed. (!define-type-method (union :unparse) (type) (declare (type ctype type)) (if (type= type (specifier-type 'list)) 'list `(or ,@(mapcar #'type-specifier (union-type-types type))))) -;;; Two union types are equal if every type in one is equal to some -;;; type in the other. +;;; Two union types are equal if their subtypes are equal sets. (!define-type-method (union :simple-=) (type1 type2) - (block PUNT - (let ((types1 (union-type-types type1)) - (types2 (union-type-types type2))) - (values (and (dolist (type1 types1 t) - (unless (any-type-op type= type1 types2) - (return nil))) - (dolist (type2 types2 t) - (unless (any-type-op type= type2 types1) - (return nil)))) - t)))) + (type=-set (union-type-types type1) + (union-type-types type2))) ;;; Similarly, a union type is a subtype of another if every element ;;; of TYPE1 is a subtype of some element of TYPE2. +;;; +;;; KLUDGE: This definition seems redundant, here in UNION-TYPE and +;;; similarly in INTERSECTION-TYPE, with the logic in the +;;; corresponding :COMPLEX-SUBTYPEP-ARG1 and :COMPLEX-SUBTYPEP-ARG2 +;;; methods. Ideally there's probably some way to make the +;;; :SIMPLE-SUBTYPEP method default to the :COMPLEX-SUBTYPEP-FOO +;;; methods in such a way that this definition could go away, but I +;;; don't grok the system well enough to tell whether it's simple to +;;; arrange this. -- WHN 2000-02-03 (!define-type-method (union :simple-subtypep) (type1 type2) - (block PUNT - (let ((types2 (union-type-types type2))) - (values (dolist (type1 (union-type-types type1) t) - (unless (any-type-op csubtypep type1 types2) - (return nil))) - t)))) + (dolist (t1 (union-type-types type1) (values t t)) + (multiple-value-bind (subtypep validp) + (union-complex-subtypep-arg2 t1 type2) + (cond ((not validp) + (return (values nil nil))) + ((not subtypep) + (return (values nil t))))))) (!define-type-method (union :complex-subtypep-arg1) (type1 type2) - (block PUNT - (values (every-type-op csubtypep type2 (union-type-types type1) - :list-first t) - t))) + (every/type (swapped-args-fun #'csubtypep) + type2 + (union-type-types type1))) +(defun union-complex-subtypep-arg2 (type1 type2) + (any/type #'csubtypep type1 (union-type-types type2))) (!define-type-method (union :complex-subtypep-arg2) (type1 type2) - (block PUNT - (values (any-type-op csubtypep type1 (union-type-types type2)) t))) + (union-complex-subtypep-arg2 type1 type2)) (!define-type-method (union :complex-union) (type1 type2) - (let* ((class1 (type-class-info type1))) + (let ((class1 (type-class-info type1))) (collect ((res)) (let ((this-type type1)) (dolist (type (union-type-types type2) (if (res) - (make-union-type (cons this-type (res))) + (make-union-type-or-something (cons this-type (res))) this-type)) (cond ((eq (type-class-info type) class1) (let ((union (funcall (type-class-simple-union class1) @@ -1660,7 +1856,7 @@ (setq res (type-union res t2))))) (!define-type-method (union :simple-intersection :complex-intersection) - (type1 type2) + (type1 type2) (let ((res *empty-type*) (win t)) (dolist (type (union-type-types type2) (values res win)) @@ -1668,23 +1864,33 @@ (setq res (type-union res int)) (unless w (setq win nil)))))) -(!def-type-translator or (&rest types) +;;; FIXME: Obviously, this could be implemented more efficiently if it +;;; were a primitive. (Making it construct the entire result before +;;; discarding it because it turns out to be insufficiently simple is +;;; less than optimum.) A little less obviously, if it were a +;;; primitive, we could use it a lot more -- basically everywhere we +;;; do MAKE-UNION-TYPE-OR-SOMETHING. So perhaps this should become +;;; a primitive; and SIMPLIFY2-INTERSECTION, too, for the same reason. +(defun simplify2-union (x y) + (let ((union (type-union x y))) + (if (and (or (union-type-p union) + (hairy-type-p union)) + (not (union-type-p x)) + (not (union-type-p y))) + (values nil nil) + (values union t)))) + +(!def-type-translator or (&rest type-specifiers) + ;; FIXME: new code -- doesn't work? + #| + (make-union-type-or-something + (simplify-types (mapcar #'specifier-type type-specifiers) + #'simplify2-union)) + |# + ;; old code (reduce #'type-union - (mapcar #'specifier-type types) + (mapcar #'specifier-type type-specifiers) :initial-value *empty-type*)) - -;;; We don't actually have intersection types, since the result of -;;; reasonable type intersections is always describable as a union of -;;; simple types. If something is too hairy to fit this mold, then we -;;; make a hairy type. -(!def-type-translator and (&whole spec &rest types) - (let ((res *wild-type*)) - (dolist (type types res) - (let ((ctype (specifier-type type))) - (multiple-value-bind (int win) (type-intersection res ctype) - (unless win - (return (make-hairy-type :specifier spec))) - (setq res int)))))) ;;;; CONS types @@ -1794,16 +2000,16 @@ (cond ((null (res)) *empty-type*) ((null (rest (res))) (first (res))) (t - (make-union-type (res))))))) + (make-union-type-or-something (res))))))) (!def-type-translator array (&optional (element-type '*) - (dimensions '*)) + (dimensions '*)) (specialize-array-type (make-array-type :dimensions (canonical-array-dimensions dimensions) :element-type (specifier-type element-type)))) (!def-type-translator simple-array (&optional (element-type '*) - (dimensions '*)) + (dimensions '*)) (specialize-array-type (make-array-type :dimensions (canonical-array-dimensions dimensions) :element-type (specifier-type element-type)