:complex-arg1 :complex-subtypep-arg1))))
;;; Just parse the type specifiers and call CSUBTYPE.
-(defun sb!xc:subtypep (type1 type2)
+(defun sb!xc:subtypep (type1 type2 &optional environment)
#!+sb-doc
"Return two values indicating the relationship between type1 and type2.
If values are T and T, type1 definitely is a subtype of type2.
If values are NIL and T, type1 definitely is not a subtype of type2.
If values are NIL and NIL, it couldn't be determined."
+ (declare (ignore environment))
(csubtypep (specifier-type type1) (specifier-type type2)))
;;; If two types are definitely equivalent, return true. The second
(defun accumulate1-compound-type (type types %compound-type-p simplify2)
(declare (type ctype type))
(declare (type (vector ctype) types))
- (declare (type function simplify2))
+ (declare (type function %compound-type-p simplify2))
;; Any input object satisfying %COMPOUND-TYPE-P should've been
;; broken into components before it reached us.
(aver (not (funcall %compound-type-p type)))
(declare (ignore type1 type2))
(values nil nil))
-(!define-type-method (hairy :simple-intersection2 :complex-intersection2)
+(!define-type-method (hairy :simple-intersection2)
(type1 type2)
(if (type= type1 type2)
type1
nil))
+(!define-type-method (hairy :complex-intersection2)
+ (type1 type2)
+ (aver (hairy-type-p type2))
+ (let ((hairy-type-spec (type-specifier type2)))
+ (if (and (consp hairy-type-spec)
+ (eq (car hairy-type-spec) 'not))
+ (if (csubtypep type1 (specifier-type (cadr hairy-type-spec)))
+ *empty-type*
+ nil)
+ nil)))
+
(!define-type-method (hairy :simple-=) (type1 type2)
(if (equal (hairy-type-specifier type1)
(hairy-type-specifier type2))
(!define-type-class cons)
(!def-type-translator cons (&optional (car-type-spec '*) (cdr-type-spec '*))
- (make-cons-type (specifier-type car-type-spec)
- (specifier-type cdr-type-spec)))
+ (let ((car-type (specifier-type car-type-spec))
+ (cdr-type (specifier-type cdr-type-spec)))
+ (if (or (eq car-type *empty-type*)
+ (eq cdr-type *empty-type*))
+ *empty-type*
+ (make-cons-type car-type cdr-type))))
(!define-type-method (cons :unparse) (type)
(let ((car-eltype (type-specifier (cons-type-car-type type)))