From f8aa8cda09b14fda04a4cca593436c8dec6577c8 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Mon, 8 Sep 1997 02:26:35 +0000 Subject: [PATCH] Add an interval->= function, and exploit this in ir1-transform-<. --- compiler/srctran.lisp | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index f7c4b339b..c12a2f9db 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.55 1997/09/05 17:28:37 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.56 1997/09/08 02:26:35 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -709,6 +709,18 @@ ;; Don't overlap if one or the other are open. (or (consp left) (consp right))))))) +;;; INVTERVAL->= +;;; +;;; Return T if X >= Y. That is, every number in the interval X is +;;; always greater than any number in the interval Y. +;;; +(defun interval->= (x y) + (declare (type interval x y)) + ;; X >= Y if lower bound of X >= upper bound of Y + (when (and (interval-bounded-p x 'below) + (interval-bounded-p y 'above)) + (>= (bound-value (interval-low x)) (bound-value (interval-high y))))) + ;;; INTERVAL-ABS ;;; ;;; Return an interval that is the absolute value of X. Thus, if X = @@ -2692,7 +2704,8 @@ ;;; Y's high, the X >= Y (so return NIL). If not, at least make sure any ;;; constant arg is second. ;;; -(defun ir1-transform-integer-< (x y first second inverse) +#-propagate-float-type +(defun ir1-transform-< (x y first second inverse) (if (same-leaf-ref-p x y) 'nil (let* ((x-type (numeric-type-or-lose x)) @@ -2712,15 +2725,15 @@ (give-up)))))) #+propagate-float-type -(defun ir1-transform-float-< (x y first second inverse) +(defun ir1-transform-< (x y first second inverse) (if (same-leaf-ref-p x y) 'nil (let ((xi (numeric-type->interval (numeric-type-or-lose x))) (yi (numeric-type->interval (numeric-type-or-lose y)))) (cond ((interval-< xi yi) - t) - ((interval-< yi xi) - nil) + 't) + ((interval->= xi yi) + 'nil) ((and (constant-continuation-p first) (not (constant-continuation-p second))) `(,inverse y x)) @@ -2728,18 +2741,18 @@ (give-up)))))) (deftransform < ((x y) (integer integer) * :when :both) - (ir1-transform-integer-< x y x y '>)) + (ir1-transform-< x y x y '>)) (deftransform > ((x y) (integer integer) * :when :both) - (ir1-transform-integer-< y x x y '<)) + (ir1-transform-< y x x y '<)) #+propagate-float-type (deftransform < ((x y) (float float) * :when :both) - (ir1-transform-float-< x y x y '>)) + (ir1-transform-< x y x y '>)) #+propagate-float-type (deftransform > ((x y) (float float) * :when :both) - (ir1-transform-float-< y x x y '<)) + (ir1-transform-< y x x y '<)) -- GitLab