Skip to content
Snippets Groups Projects
Commit 8a4671aa authored by dtc's avatar dtc
Browse files

Hack patch to not-more-contagious, was allowing erroneous transforms

which this patch should close but some acceptable transforms are being
missed.
parent 42fe84df
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.51 1997/06/05 00:33:16 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.52 1997/06/16 18:51:33 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -2253,13 +2253,37 @@ turned off" ...@@ -2253,13 +2253,37 @@ turned off"
;;; result type is not affected by the type of X. That is, Y is at least as ;;; result type is not affected by the type of X. That is, Y is at least as
;;; contagious as X. ;;; contagious as X.
;;; ;;;
#+nil
(defun not-more-contagious (x y) (defun not-more-contagious (x y)
(declare (type continuation x y)) (declare (type continuation x y))
(let ((x (continuation-type x)) (let ((x (continuation-type x))
(y (continuation-type y))) (y (continuation-type y)))
(values (type= (numeric-contagion x y) (values (type= (numeric-contagion x y)
(numeric-contagion y y))))) (numeric-contagion y y)))))
;;;
;;; Patched version by Raymond Toy. dtc: Should be safer although it
;;; needs more work as valid transforms are missed; some cases are
;;; specific to particular transform functions so the use of this
;;; function may need a re-think.
;;;
(defun not-more-contagious (x y)
(declare (type continuation x y))
(flet ((simple-numeric-type (num)
;; Return non-NIL if NUM is integer, rational, or a float
;; of some type (but not FLOAT)
(case (numeric-type-class num)
((integer rational)
t)
(float
(numeric-type-format num))
(t
nil))))
(let ((x (continuation-type x))
(y (continuation-type y)))
(if (and (simple-numeric-type x)
(simple-numeric-type y))
(values (type= (numeric-contagion x y)
(numeric-contagion y y)))))))
;;; Fold (OP x 0). ;;; Fold (OP x 0).
;;; ;;;
......
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