;;;; 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
(!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
(first types))
(;; if potentially too hairy
(some (lambda (type)
- (or (union-type-p type)
- (hairy-type-p 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
(intersection-type-types type2)))
(!define-type-method (intersection :simple-subtypep) (type1 type2)
- (declare (type list type1 type2))
(/show0 "entering INTERSECTION :SIMPLE-SUBTYPEP")
(let ((certain? t))
(dolist (t1 (intersection-type-types type1) (values nil certain?))
(!define-type-method (intersection :simple-intersection :complex-intersection)
(type1 type2)
(/show0 "entering INTERSECTION :SIMPLE-INTERSECTION :COMPLEX-INTERSECTION")
- (let ((type1types (intersection-type-types type1))
- (type2types (if (intersection-type-p type2)
- (intersection-type-types type2)
- (list type2))))
+ (flet ((type-components (type)
+ (typecase type
+ (intersection-type (intersection-type-types type))
+ (t (list type)))))
(make-intersection-type-or-something
- (simplify-intersection-type-types
- (append type1types type2types)))))
+ ;; 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 (&rest type-specifiers)
+(!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
;; 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")
- (make-intersection-type-or-something
- (simplify-types (mapcar #'specifier-type type-specifiers)
- #'simplify2-intersection)))
-|#
-;;; (REMOVEME once INTERSECTION-TYPE works.)
-(!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))))))
+ (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-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)