Skip to content
Snippets Groups Projects
Commit 7917d824 authored by dtc's avatar dtc
Browse files

Fix for two-arg-derive-type when given two integer member types.

parent b6137f53
No related branches found
No related tags found
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/srctran.lisp,v 1.76 1998/01/11 07:15:41 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.77 1998/02/02 18:01:35 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -873,10 +873,9 @@ ...@@ -873,10 +873,9 @@
;; Not real float. ;; Not real float.
type)) type))
;;; Convert from the standard type convention for which -0.0 and 0.0 ;;; Convert back from the intermediate convention for which -0.0 and
;;; and equal to an intermediate convention for which they are ;;; 0.0 are considered different to the standard type convention for
;;; considered different which is more natural for some of the ;;; which and equal.
;;; optimisers.
;;; ;;;
#-negative-zero-is-not-zero #-negative-zero-is-not-zero
(defun convert-back-numeric-type (type) (defun convert-back-numeric-type (type)
...@@ -929,7 +928,7 @@ ...@@ -929,7 +928,7 @@
(t (t
;; (float +0.0 x) => (or (member 0.0) (float (0.0) x)) ;; (float +0.0 x) => (or (member 0.0) (float (0.0) x))
;; (float (-0.0) x) => (or (member 0.0) (float (0.0) x)) ;; (float (-0.0) x) => (or (member 0.0) (float (0.0) x))
(list (specifier-type `(member ,(float 0.0 lo-val))) (list (make-member-type :members (list (float 0.0 lo-val)))
(make-numeric-type :class (numeric-type-class type) (make-numeric-type :class (numeric-type-class type)
:format (numeric-type-format type) :format (numeric-type-format type)
:complexp :real :complexp :real
...@@ -954,7 +953,7 @@ ...@@ -954,7 +953,7 @@
(t (t
;; (float x (+0.0)) => (or (member -0.0) (float x (0.0))) ;; (float x (+0.0)) => (or (member -0.0) (float x (0.0)))
;; (float x -0.0) => (or (member -0.0) (float x (0.0))) ;; (float x -0.0) => (or (member -0.0) (float x (0.0)))
(list (specifier-type `(member ,(float -0.0 hi-val))) (list (make-member-type :members (list (float -0.0 hi-val)))
(make-numeric-type :class (numeric-type-class type) (make-numeric-type :class (numeric-type-class type)
:format (numeric-type-format type) :format (numeric-type-format type)
:complexp :real :complexp :real
...@@ -1052,9 +1051,9 @@ ...@@ -1052,9 +1051,9 @@
(member-type (member-type
(with-float-traps-masked (with-float-traps-masked
(:underflow :overflow :divide-by-zero) (:underflow :overflow :divide-by-zero)
(specifier-type (make-member-type
`(member :members (list (funcall
,(funcall fcn (first (member-type-members x))))))) fcn (first (member-type-members x)))))))
(numeric-type (numeric-type
#-negative-zero-is-not-zero #-negative-zero-is-not-zero
(if convert-type (if convert-type
...@@ -1106,13 +1105,13 @@ ...@@ -1106,13 +1105,13 @@
:invalid) :invalid)
(funcall fcn x y)))) (funcall fcn x y))))
(cond ((null result)) (cond ((null result))
((float-nan-p result) ((and (floatp result) (float-nan-p result))
(make-numeric-type (make-numeric-type
:class 'float :class 'float
:format (type-of result) :format (type-of result)
:complexp :real)) :complexp :real))
(t (t
(specifier-type `(member ,result)))))) (make-member-type :members (list result))))))
((and (member-type-p x) (numeric-type-p y)) ((and (member-type-p x) (numeric-type-p y))
(let* ((x (convert-member-type x)) (let* ((x (convert-member-type x))
(y (if convert-type (convert-numeric-type y) y)) (y (if convert-type (convert-numeric-type y) y))
...@@ -1145,7 +1144,7 @@ ...@@ -1145,7 +1144,7 @@
(:underflow :overflow :divide-by-zero) (:underflow :overflow :divide-by-zero)
(funcall fcn x y)))) (funcall fcn x y))))
(if result (if result
(specifier-type `(member ,result))))) (make-member-type :members (list result)))))
((and (member-type-p x) (numeric-type-p y)) ((and (member-type-p x) (numeric-type-p y))
(let ((x (convert-member-type x))) (let ((x (convert-member-type x)))
(funcall derive-fcn x y same-arg))) (funcall derive-fcn x y same-arg)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment