;;;; 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
(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))
(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 "~@<repeated keyword ~S in lambda list: ~2I~_~S~:>"
+ kwd lambda-list))
(key-info (make-key-info :name kwd
:type (specifier-type (second key))))))
(setf (args-type-keywords result) (key-info)))
;;;; 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)
(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*)
(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*)
(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.
(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
;;; 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)
: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)))
((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
(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
: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).
(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)
(!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))
\f
;;;; numeric types
(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
(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)
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
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)
(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)))
(!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)
(make-member-type :members (remove-duplicates members))
*empty-type*))
\f
+;;;; 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)))))))
+\f
;;;; 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)
(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))
(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))))))
\f
;;;; CONS types
(cond ((null (res)) *empty-type*)
((null (rest (res))) (first (res)))
(t
- (make-union-type (res)))))))
+ (make-union-type-or-something (res)))))))
\f
(!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)
projects / sbcl.git / blobdiff