Skip to content
Snippets Groups Projects
Commit 15ca185f authored by dtc's avatar dtc
Browse files

Updates from Raymond Toy:

Elfun-derive-type-union didn't properly handle the case of
elfun-derive-type-1 returning a union type like (or float (complex
float)) - it does now.

Elfun-derive-type-1 is slightly enhanced so that if the input is a
complex type, the result is a complex type of the same.  Before, we
just returned default-type.  Also, it's a bit smarter now so that if
the result is supposed to be (or float (complex float)), we try to
refine float to single-float or double-float if possible.
parent b3d03d27
Branches
Tags
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.36 1997/09/08 20:26:26 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.37 1997/09/20 11:51:08 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -557,28 +557,36 @@ ...@@ -557,28 +557,36 @@
(float-infinity-p hi-lim)) (float-infinity-p hi-lim))
nil nil
hi-lim))))) hi-lim)))))
((eq (numeric-type-complexp num) :complex)
(copy-numeric-type num))
(default-type
default-type)
(t (t
default-type))) (let ((f-type (or (numeric-type-format num) 'float)))
(specifier-type `(or ,f-type (complex ,f-type)))))))
;;; Same as ELFUN-DERIVE-TYPE-1 except we can handle simple ;;; Same as ELFUN-DERIVE-TYPE-1 except we can handle simple
;;; NUMERIC-TYPEs and UNION-TYPEs. ;;; NUMERIC-TYPEs and UNION-TYPEs.
(defun elfun-derive-type-union (defun elfun-derive-type-union
(type cond limit-fun (type cond limit-fun
&optional (default-type &optional default-type)
(specifier-type '(or float (complex float)))))
(cond ((union-type-p type) (cond ((union-type-p type)
;; For a UNION-TYPE, run down the list of unions and derive ;; For a UNION-TYPE, run down the list of unions and derive
;; the resulting type of each union and make a UNION-TYPE of ;; the resulting type of each union and make a UNION-TYPE of
;; the results. ;; the results.
(let ((result '())) (let ((result '()))
(dolist (interval (union-type-types type)) (dolist (interval (union-type-types type))
(push (elfun-derive-type-1 interval cond limit-fun default-type) (let ((derived-type (elfun-derive-type-1 interval cond limit-fun default-type)))
result)) (if (union-type-p derived-type)
;; Insert union types in to the result
(dolist (item (union-type-types derived-type))
(push item result))
(push derived-type result))))
(make-union-type (derive-merged-union-types result)))) (make-union-type (derive-merged-union-types result))))
((numeric-type-p type) ((numeric-type-p type)
(elfun-derive-type-1 type cond limit-fun default-type)) (elfun-derive-type-1 type cond limit-fun default-type))
(t (t
default-type))) (specifier-type 'number))))
) ; end progn ) ; end progn
#+propagate-fun-type #+propagate-fun-type
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment