mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 22:12:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

Revert "si::type=: do not assume all complex number types to be equivalent"

Browse source 
This reverts commit 177ad215ea.

See #493. the issue with typecase must be resolved outside the
subtypep because these numbers indeed have the same internal
representation (see clhs entry for subtypep and typep).
This commit is contained in:
Daniel Kochmański 2019-04-19 13:16:03 +02:00
parent ab35ce71a2
commit 2ec7688554
1 changed files with 13 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/lsp/predlib.lsp
View file

@ -1172,31 +1172,21 @@ if not possible."
;; bring the type to canonical form, which is a union of all specialized
;; complex types that can store an element of the corresponding type.
;;
;; Don't be tempted to do "better" than that. CANONICAL-COMPLEX-TYPE
;; yields results for use of SUBTYPEP which has clearly specified to
;; return true when: T1 is a subtype of T2 or when the upgraded type
;; specifiers refer to the same sets of objects. TYPEP has a different
;; specification and TYPECASE should use it. -- jd 2019-04-19
(defun canonical-complex-type (real-type)
(declare (si::c-local))
(case real-type
((#+short-float SHORT-FLOAT
SINGLE-FLOAT
DOUBLE-FLOAT
INTEGER
RATIO
#+long-float LONG-FLOAT)
(let ((tag (new-type-tag)))
(push-type `(COMPLEX ,real-type) tag)))
((RATIONAL) (canonical-type '(OR (COMPLEX INTEGER) (COMPLEX RATIO))))
((FLOAT) (canonical-type '(OR
#+short-float (COMPLEX SHORT-FLOAT)
(COMPLEX SINGLE-FLOAT)
(COMPLEX DOUBLE-FLOAT)
#+long-float (COMPLEX LONG-FLOAT))))
((* NIL REAL) (canonical-type
'(OR (COMPLEX INTEGER) (COMPLEX RATIO)
#+short-float (COMPLEX SHORT-FLOAT)
(COMPLEX SINGLE-FLOAT)
(COMPLEX DOUBLE-FLOAT)
#+long-float (COMPLEX LONG-FLOAT)
)))
(otherwise (canonical-complex-type (upgraded-complex-part-type real-type)))))
;; UPGRADE-COMPLEX-PART-TYPE signals condition when REAL-TYPE is not
;; a subtype of REAL.
(let ((type (if (eq real-type '*)
`(complex real)
`(complex ,(upgraded-complex-part-type real-type)))))
(or (find-registered-tag type)
(let ((tag (new-type-tag)))
(push-type type tag)))))
;;----------------------------------------------------------------------
;; CONS types. Only (CONS T T) and variants, as well as (CONS NIL *), etc