(!define-type-method (hairy :unparse) (x)
(hairy-type-specifier x))
-(defun maybe-specifier-for-reparse (type)
- (when (unknown-type-p type)
- (let* ((spec (unknown-type-specifier type))
- (name (if (consp spec)
- (car spec)
- spec)))
- (when (info :type :kind name)
- spec))))
-
-;;; Evil macro.
-(defmacro maybe-reparse-specifier! (type)
- (assert (symbolp type))
- (with-unique-names (spec)
- `(let ((,spec (maybe-specifier-for-reparse ,type)))
- (when ,spec
- (setf ,type (specifier-type ,spec))
- t))))
-
(!define-type-method (hairy :simple-subtypep) (type1 type2)
(let ((hairy-spec1 (hairy-type-specifier type1))
(hairy-spec2 (hairy-type-specifier type2)))
(cond ((equal-but-no-car-recursion hairy-spec1 hairy-spec2)
(values t t))
((maybe-reparse-specifier! type1)
- (if (unknown-type-p type1)
- (values nil nil)
- (csubtypep type1 type2)))
+ (csubtypep type1 type2))
((maybe-reparse-specifier! type2)
- (if (unknown-type-p type2)
- (values nil nil)
- (csubtypep type1 type2)))
+ (csubtypep type1 type2))
(t
(values nil nil)))))
(!define-type-method (hairy :complex-subtypep-arg2) (type1 type2)
(if (maybe-reparse-specifier! type2)
- (if (unknown-type-p type2)
- (values nil nil)
- (csubtypep type1 type2))
+ (csubtypep type1 type2)
(let ((specifier (hairy-type-specifier type2)))
(cond ((and (consp specifier) (eql (car specifier) 'satisfies))
(case (cadr specifier)
(!define-type-method (hairy :complex-subtypep-arg1) (type1 type2)
(if (maybe-reparse-specifier! type1)
- (if (unknown-type-p type1)
- (values nil nil)
- (csubtypep type1 type2))
+ (csubtypep type1 type2)
(values nil nil)))
(!define-type-method (hairy :complex-=) (type1 type2)
(if (maybe-reparse-specifier! type2)
- (if (unknown-type-p type2)
- (values nil nil)
- (type= type1 type2))
+ (type= type1 type2)
(values nil nil)))
(!define-type-method (hairy :simple-intersection2 :complex-intersection2)