Commit d7c351c7 authored by Daniel Kochmański's avatar Daniel Kochmański

predlib: type= doesn't yield T for complex types

TYPE= is only used from cmpopt's typep compiler macro which optimizes
atomic complex types by other means. Compound complex types are
handled differently for subtypep and typep (the first relies on
upgraded type and the second relies on the actual types), so we can't
rely in this case on SAFE-CANONICAL-TYPE.
parent 2ec76885
......@@ -79,7 +79,7 @@
when (si::type= type a-type)
do (return `(,function-name ,object))))
;;
;; Complex types defined with DEFTYPE.
;; Derived types defined with DEFTYPE.
((and (atom type)
(setq function (si:get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(expand-typep form object `',(funcall function nil) env))
......@@ -90,7 +90,7 @@
;;
;; CONS types. They must be checked _before_ sequence types. We
;; do not produce optimized forms because they can be recursive.
((and (consp type) (eq first 'CONS))
((and (consp type) (eq (first type) 'CONS))
form)
;;
;; The type denotes a known class and we can check it
......@@ -141,13 +141,19 @@
(setf ,var2 (truly-the ,first ,var1))
(AND ,@(expand-in-interval-p var2 rest)))))))
;;
;; Compound COMPLEX types.
((and (eq first 'COMPLEX)
(= (list-length type) 2))
`(and (typep (realpart ,object) ',(second type))
(typep (imagpart ,object) ',(second type))))
;;
;; (SATISFIES predicate)
((and (eq first 'SATISFIES)
(= (list-length type) 2)
(symbolp (setf function (second type))))
`(,function ,object))
;;
;; Complex types with arguments.
;; Derived compound types.
((setf function (si:get-sysprop first 'SI::DEFTYPE-DEFINITION))
(expand-typep form object `',(funcall function rest) env))
(t
......
......@@ -568,9 +568,10 @@ Returns T if X belongs to TYPE; NIL otherwise."
(COMPLEX
(and (complexp object)
(or (null i)
;; type specifier may be i.e (complex integer) so we
;; should check both real and imag part (disregarding
;; the fact that both have the same upgraded type).
(and (typep (realpart object) (car i))
;;wfs--should only have to check one.
;;Illegal to mix real and imaginary types!
(typep (imagpart object) (car i))))
))
(SEQUENCE (or (listp object) (vectorp object)))
......@@ -1514,9 +1515,17 @@ if not possible."
(declare (si::c-local))
(when (eq t1 t2)
(return-from fast-type= (values t t)))
(let* ((tag1 (safe-canonical-type t1))
(tag2 (safe-canonical-type t2)))
(cond ((and (numberp tag1) (numberp tag2))
(let ((tag1 (safe-canonical-type t1))
(tag2 (safe-canonical-type t2))
(tag3 (safe-canonical-type 'complex)))
;; FAST-TYPE= can't rely on the CANONICAL-TYPE in case of complex
;; numbers which have an exceptional behavior define for TYPEP not
;; being consistent with SUBTYPEP. -- jd 2019-04-19
(cond ((and (numberp tag1)
(numberp tag2)
(/= tag2 tag3))
;; We must call safe-canonical-type again because one of
;; the calls above could have called UPDATE-TYPES.
(values (= (safe-canonical-type t1) (safe-canonical-type t2))
t))
#+nil
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment