From 9fbccc50ded825be82f758400012fce552913c14 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Thu, 12 Apr 2001 19:45:57 +0000 Subject: [PATCH] From Ray Toy: Here is the patch that makes the propagate-float-type, propagate-fun-type, and constrain-float-type features the default. All old code is removed. If you recompile, you should probably remove these features, just to be sure (caught a few mistakes that way). --- compiler/constraint.lisp | 3 +- compiler/float-tran.lisp | 53 +----- compiler/fndb.lisp | 28 +-- compiler/srctran.lisp | 378 +-------------------------------------- 4 files changed, 15 insertions(+), 447 deletions(-) diff --git a/compiler/constraint.lisp b/compiler/constraint.lisp index 82bd1e600..be49147bc 100644 --- a/compiler/constraint.lisp +++ b/compiler/constraint.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/constraint.lisp,v 1.22 2001/03/04 20:12:13 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.23 2001/04/12 19:45:56 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -409,7 +409,6 @@ (let ((greater (if not-p (not greater) greater))) (setq res (constrain-integer-type res y greater not-p))))) - #+constrain-float-type ((and (float-type-p res) (float-type-p y)) (let ((greater (eq kind '>))) (let ((greater (if not-p (not greater) greater))) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index e4535df26..3e6ad0991 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.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/float-tran.lisp,v 1.82 2000/07/06 04:38:39 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.83 2001/04/12 19:45:56 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -118,9 +118,9 @@ #+new-random (deftransform random ((num &optional state) ((integer 1 - #+(and propagate-float-type x86) #xffffffff - #+(and propagate-float-type (not x86)) #x7fffffff - #-propagate-float-type #.most-positive-fixnum) + #+x86 #xffffffff + #-x86 #x7fffffff + ) &optional *)) #+x86 "use inline (unsigned-byte 32) operations" #-x86 "use inline (signed-byte 32) operations" @@ -282,9 +282,6 @@ ;;; Optimizers for scale-float. If the float has bounds, new bounds ;;; are computed for the result, if possible. -#+propagate-float-type -(progn - (defun scale-float-derive-type-aux (f ex same-arg) (declare (ignore same-arg)) (flet ((scale-bound (x n) @@ -347,7 +344,6 @@ (one-arg-derive-type num #',aux-name #',fun)))))) (frob %single-float single-float) (frob %double-float double-float)) -) ; end progn ;;;; Float contagion: @@ -395,36 +391,6 @@ (frob >) (frob =)) - -;;;; Irrational derive-type methods: - -;;; Derive the result to be float for argument types in the appropriate domain. -;;; -#-propagate-fun-type -(dolist (stuff '((asin (real -1.0 1.0)) - (acos (real -1.0 1.0)) - (acosh (real 1.0)) - (atanh (real -1.0 1.0)) - (sqrt (real 0.0)))) - (destructuring-bind (name type) stuff - (let ((type (specifier-type type))) - (setf (function-info-derive-type (function-info-or-lose name)) - #'(lambda (call) - (declare (type combination call)) - (when (csubtypep (continuation-type - (first (combination-args call))) - type) - (specifier-type 'float))))))) - -#-propagate-fun-type -(defoptimizer (log derive-type) ((x &optional y)) - (when (and (csubtypep (continuation-type x) - (specifier-type '(real 0.0))) - (or (null y) - (csubtypep (continuation-type y) - (specifier-type '(real 0.0))))) - (specifier-type 'float))) - ;;;; Irrational transforms: @@ -580,9 +546,6 @@ (float pi x) (float 0 x))) -#+(or propagate-float-type propagate-fun-type) -(progn - ;;; The number is of type REAL. (declaim (inline numeric-type-real-p)) (defun numeric-type-real-p (type) @@ -597,10 +560,6 @@ (list (coerce (car bound) type)) (coerce bound type)))) -) ; end progn - -#+propagate-fun-type -(progn ;;;; Optimizers for elementary functions ;;;; @@ -1118,7 +1077,6 @@ (defoptimizer (phase derive-type) ((num)) (one-arg-derive-type num #'phase-derive-type-aux #'phase)) -) ;end progn for propagate-fun-type (deftransform realpart ((x) ((complex rational)) *) '(kernel:%realpart x)) @@ -1321,8 +1279,6 @@ ;;; reduction correctly but still provides useful results when the ;;; inputs are union types. -#+propagate-fun-type -(progn (defun trig-derive-type-aux (arg domain fcn &optional def-lo def-hi (increasingp t)) (etypecase arg @@ -1404,4 +1360,3 @@ (specifier-type `(complex ,(or (numeric-type-format arg) 'float)))) #'cis)) -) ; end progn diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index 8fc4ae433..9df662408 100644 --- a/compiler/fndb.lisp +++ b/compiler/fndb.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/fndb.lisp,v 1.92 2001/04/10 22:34:02 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.93 2001/04/12 19:45:57 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -242,12 +242,6 @@ (defknown lcm (&rest integer) unsigned-byte (movable foldable flushable explicit-check)) -#-propagate-fun-type -(defknown exp (number) irrational - (movable foldable flushable explicit-check recursive) - :derive-type #'result-type-float-contagion) - -#+propagate-fun-type (defknown exp (number) irrational (movable foldable flushable explicit-check recursive)) @@ -266,25 +260,6 @@ (defknown cis (real) (complex float) (movable foldable flushable explicit-check)) -#-propagate-fun-type -(progn -(defknown (sin cos) (number) - (or (float -1.0 1.0) (complex float)) - (movable foldable flushable explicit-check recursive) - :derive-type #'result-type-float-contagion) - -(defknown atan - (number &optional real) irrational - (movable foldable flushable explicit-check recursive) - :derive-type #'result-type-float-contagion) - -(defknown (tan sinh cosh tanh asinh) - (number) irrational (movable foldable flushable explicit-check recursive) - :derive-type #'result-type-float-contagion) -) ; end progn - -#+propagate-fun-type -(progn (defknown (sin cos) (number) (or (float -1.0 1.0) (complex float)) (movable foldable flushable explicit-check recursive)) @@ -295,7 +270,6 @@ (defknown (tan sinh cosh tanh asinh) (number) irrational (movable foldable flushable explicit-check recursive)) -) ; end progn (defknown (asin acos acosh atanh) (number) irrational diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 83dfc2b4b..a64db6907 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.105 2001/03/04 20:12:26 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.106 2001/04/12 19:45:57 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -184,9 +184,7 @@ `(,',fun ,x 1))))) (frob truncate) (frob round) - #+propagate-float-type (frob floor) - #+propagate-float-type (frob ceiling)) (def-source-transform lognand (x y) `(lognot (logand ,x ,y))) @@ -243,9 +241,6 @@ ;;;; everything we want to know. Reason 2 wins for now. -#+propagate-float-type -(progn - ;;; The basic interval type. It can handle open and closed intervals. A ;;; bound is open if it is a list containing a number, just like Lisp says. ;;; NIL means unbounded. @@ -849,7 +844,7 @@ (declare (type interval x)) (interval-func #'(lambda (x) (* x x)) (interval-abs x))) -) ; end progn + @@ -877,9 +872,6 @@ :low low :high high)) (numeric-contagion x y)))) -#+(or propagate-float-type propagate-fun-type) -(progn - ;; Simple utility to flatten a list (defun flatten-list (x) (labels ((flatten-helper (x r);; 'r' is the stuff to the 'right'. @@ -1292,63 +1284,8 @@ (make-canonical-union-type results) (first results))))))) -) ; end progn -#-propagate-float-type -(progn -(defoptimizer (+ derive-type) ((x y)) - (derive-integer-type - x y - #'(lambda (x y) - (flet ((frob (x y) - (if (and x y) - (+ x y) - nil))) - (values (frob (numeric-type-low x) (numeric-type-low y)) - (frob (numeric-type-high x) (numeric-type-high y))))))) - -(defoptimizer (- derive-type) ((x y)) - (derive-integer-type - x y - #'(lambda (x y) - (flet ((frob (x y) - (if (and x y) - (- x y) - nil))) - (values (frob (numeric-type-low x) (numeric-type-high y)) - (frob (numeric-type-high x) (numeric-type-low y))))))) - - -(defoptimizer (* derive-type) ((x y)) - (derive-integer-type - x y - #'(lambda (x y) - (let ((x-low (numeric-type-low x)) - (x-high (numeric-type-high x)) - (y-low (numeric-type-low y)) - (y-high (numeric-type-high y))) - (cond ((not (and x-low y-low)) - (values nil nil)) - ((or (minusp x-low) (minusp y-low)) - (if (and x-high y-high) - (let ((max (* (max (abs x-low) (abs x-high)) - (max (abs y-low) (abs y-high))))) - (values (- max) max)) - (values nil nil))) - (t - (values (* x-low y-low) - (if (and x-high y-high) - (* x-high y-high) - nil)))))))) - -(defoptimizer (/ derive-type) ((x y)) - (numeric-contagion (continuation-type x) (continuation-type y))) - -) ; end progn - -#+propagate-float-type -(progn (defun +-derive-type-aux (x y same-arg) (if (and (numeric-type-real-p x) (numeric-type-real-p y)) @@ -1481,7 +1418,7 @@ (defoptimizer (/ derive-type) ((x y)) (two-arg-derive-type x y #'/-derive-type-aux #'/)) -) ;end progn + ;;; 'ash derive type optimizer. @@ -1498,43 +1435,7 @@ ;;; ash-inner: performs the shift when within range, limited to a maximum of ;;; 64, otherwise returns the inner limit. ;;; -#-propagate-fun-type -(defoptimizer (ash derive-type) ((n shift)) - (flet ((ash-outer (n s) - (when (and (fixnump s) - (<= s 64) - (> s most-negative-fixnum)) - (ash n s))) - (ash-inner (n s) - (if (and (fixnump s) - (> s most-negative-fixnum)) - (ash n (min s 64)) - (if (minusp n) -1 0)))) - (or (let ((n-type (continuation-type n))) - (when (numeric-type-p n-type) - (let ((n-low (numeric-type-low n-type)) - (n-high (numeric-type-high n-type))) - (if (constant-continuation-p shift) - (let ((shift (continuation-value shift))) - (make-numeric-type :class 'integer :complexp :real - :low (when n-low (ash n-low shift)) - :high (when n-high (ash n-high shift)))) - (let ((s-type (continuation-type shift))) - (when (numeric-type-p s-type) - (let ((s-low (numeric-type-low s-type)) - (s-high (numeric-type-high s-type))) - (make-numeric-type :class 'integer :complexp :real - :low (when n-low - (if (minusp n-low) - (ash-outer n-low s-high) - (ash-inner n-low s-low))) - :high (when n-high - (if (minusp n-high) - (ash-inner n-high s-low) - (ash-outer n-high s-high))))))))))) - *universal-type*))) -;;; -#+propagate-fun-type + (defun ash-derive-type-aux (n-type shift same-arg) (declare (ignore same-arg)) (flet ((ash-outer (n s) @@ -1564,26 +1465,10 @@ (ash-outer n-high s-high)))))) *universal-type*))) ;;; -#+propagate-fun-type (defoptimizer (ash derive-type) ((n shift)) (two-arg-derive-type n shift #'ash-derive-type-aux #'ash)) -#-propagate-float-type -(macrolet ((frob (fun) - `#'(lambda (type type2) - (declare (ignore type2)) - (let ((lo (numeric-type-low type)) - (hi (numeric-type-high type))) - (values (if hi (,fun hi) nil) (if lo (,fun lo) nil)))))) - - (defoptimizer (%negate derive-type) ((num)) - (derive-integer-type num num (frob -))) - - (defoptimizer (lognot derive-type) ((int)) - (derive-integer-type int int (frob lognot)))) - -#+propagate-float-type (defoptimizer (lognot derive-type) ((int)) (derive-integer-type int int #'(lambda (type type2) @@ -1595,7 +1480,6 @@ (numeric-type-class type) (numeric-type-format type)))))) -#+propagate-float-type (defoptimizer (%negate derive-type) ((num)) (flet ((negate-bound (b) (set-bound (- (bound-value b)) (consp b)))) @@ -1611,27 +1495,6 @@ result)) #'-))) -#-propagate-float-type -(defoptimizer (abs derive-type) ((num)) - (let ((type (continuation-type num))) - (if (and (numeric-type-p type) - (eq (numeric-type-class type) 'integer) - (eq (numeric-type-complexp type) :real)) - (let ((lo (numeric-type-low type)) - (hi (numeric-type-high type))) - (make-numeric-type :class 'integer :complexp :real - :low (cond ((and hi (minusp hi)) - (abs hi)) - (lo - (max 0 lo)) - (t - 0)) - :high (if (and hi lo) - (max (abs hi) (abs lo)) - nil))) - (numeric-contagion type type)))) - -#+propagate-float-type (defun abs-derive-type-aux (type) (cond ((eq (numeric-type-complexp type) :complex) ;; The absolute value of a complex number is always a @@ -1660,33 +1523,9 @@ :high (coerce-numeric-bound (interval-high abs-bnd) bound-type)))))) -#+propagate-float-type (defoptimizer (abs derive-type) ((num)) (one-arg-derive-type num #'abs-derive-type-aux #'abs)) -#-propagate-float-type -(defoptimizer (truncate derive-type) ((number divisor)) - (let ((number-type (continuation-type number)) - (divisor-type (continuation-type divisor)) - (integer-type (specifier-type 'integer))) - (if (and (numeric-type-p number-type) - (csubtypep number-type integer-type) - (numeric-type-p divisor-type) - (csubtypep divisor-type integer-type)) - (let ((number-low (numeric-type-low number-type)) - (number-high (numeric-type-high number-type)) - (divisor-low (numeric-type-low divisor-type)) - (divisor-high (numeric-type-high divisor-type))) - (values-specifier-type - `(values ,(integer-truncate-derive-type number-low number-high - divisor-low divisor-high) - ,(integer-rem-derive-type number-low number-high - divisor-low divisor-high)))) - *universal-type*))) - -#+propagate-float-type -(progn - (defun rem-result-type (number-type divisor-type) ;; Figure out what the remainder type is. The remainder is an ;; integer if both args are integers; a rational if both args are @@ -2196,7 +2035,7 @@ (interval-split 0 num t t) (interval-merge-pair (truncate-rem-bound neg div) (truncate-rem-bound pos div)))))) -) + @@ -2283,54 +2122,6 @@ `integer))))) -#-propagate-float-type -(defun integer-rem-derive-type - (number-low number-high divisor-low divisor-high) - (if (and divisor-low divisor-high) - ;; We know the range of the divisor, and the remainder must be smaller - ;; than the divisor. We can tell the sign of the remainer if we know - ;; the sign of the number. - (let ((divisor-max (1- (max (abs divisor-low) (abs divisor-high))))) - `(integer ,(if (or (null number-low) - (minusp number-low)) - (- divisor-max) - 0) - ,(if (or (null number-high) - (plusp number-high)) - divisor-max - 0))) - ;; The divisor is potentially either very positive or very negative. - ;; Therefore, the remainer is unbounded, but we might be able to tell - ;; something about the sign from the number. - `(integer ,(if (and number-low (not (minusp number-low))) - ;; The number we are dividing is positive. Therefore, - ;; the remainder must be positive. - 0 - '*) - ,(if (and number-high (not (plusp number-high))) - ;; The number we are dividing is negative. Therefore, - ;; the remainder must be negative. - 0 - '*)))) - -#-propagate-float-type -(defoptimizer (random derive-type) ((bound &optional state)) - (let ((type (continuation-type bound))) - (when (numeric-type-p type) - (let ((class (numeric-type-class type)) - (high (numeric-type-high type)) - (format (numeric-type-format type))) - (make-numeric-type - :class class - :format format - :low (coerce 0 (or format class 'real)) - :high (cond ((not high) nil) - ((eq class 'integer) (max (1- high) 0)) - ((or (consp high) (zerop high)) high) - (t `(,high)))))))) - - -#+propagate-float-type (defun random-derive-type-aux (type) (let ((class (numeric-type-class type)) (high (numeric-type-high type)) @@ -2344,7 +2135,6 @@ ((or (consp high) (zerop high)) high) (t `(,high)))))) -#+propagate-float-type (defoptimizer (random derive-type) ((bound &optional state)) (one-arg-derive-type bound #'random-derive-type-aux nil)) @@ -2368,127 +2158,7 @@ (or (null min) (minusp min)))) (values nil t t))) -#-propagate-fun-type -(progn -(defoptimizer (logand derive-type) ((x y)) - (multiple-value-bind - (x-len x-pos x-neg) - (integer-type-length (continuation-type x)) - (declare (ignore x-pos)) - (multiple-value-bind - (y-len y-pos y-neg) - (integer-type-length (continuation-type y)) - (declare (ignore y-pos)) - (if (not x-neg) - ;; X must be positive. - (if (not y-neg) - ;; The must both be positive. - (cond ((or (null x-len) (null y-len)) - (specifier-type 'unsigned-byte)) - ((or (zerop x-len) (zerop y-len)) - (specifier-type '(integer 0 0))) - (t - (specifier-type `(unsigned-byte ,(min x-len y-len))))) - ;; X is positive, but Y might be negative. - (cond ((null x-len) - (specifier-type 'unsigned-byte)) - ((zerop x-len) - (specifier-type '(integer 0 0))) - (t - (specifier-type `(unsigned-byte ,x-len))))) - ;; X might be negative. - (if (not y-neg) - ;; Y must be positive. - (cond ((null y-len) - (specifier-type 'unsigned-byte)) - ((zerop y-len) - (specifier-type '(integer 0 0))) - (t - (specifier-type - `(unsigned-byte ,y-len)))) - ;; Either might be negative. - (if (and x-len y-len) - ;; The result is bounded. - (specifier-type `(signed-byte ,(1+ (max x-len y-len)))) - ;; We can't tell squat about the result. - (specifier-type 'integer))))))) -(defoptimizer (logior derive-type) ((x y)) - (multiple-value-bind - (x-len x-pos x-neg) - (integer-type-length (continuation-type x)) - (multiple-value-bind - (y-len y-pos y-neg) - (integer-type-length (continuation-type y)) - (cond - ((and (not x-neg) (not y-neg)) - ;; Both are positive. - (specifier-type `(unsigned-byte ,(if (and x-len y-len) - (max x-len y-len) - '*)))) - ((not x-pos) - ;; X must be negative. - (if (not y-pos) - ;; Both are negative. The result is going to be negative and be - ;; the same length or shorter than the smaller. - (if (and x-len y-len) - ;; It's bounded. - (specifier-type `(integer ,(ash -1 (min x-len y-len)) -1)) - ;; It's unbounded. - (specifier-type '(integer * -1))) - ;; X is negative, but we don't know about Y. The result will be - ;; negative, but no more negative than X. - (specifier-type - `(integer ,(or (numeric-type-low (continuation-type x)) '*) - -1)))) - (t - ;; X might be either positive or negative. - (if (not y-pos) - ;; But Y is negative. The result will be negative. - (specifier-type - `(integer ,(or (numeric-type-low (continuation-type y)) '*) - -1)) - ;; We don't know squat about either. It won't get any bigger. - (if (and x-len y-len) - ;; Bounded. - (specifier-type `(signed-byte ,(1+ (max x-len y-len)))) - ;; Unbounded. - (specifier-type 'integer)))))))) - -(defoptimizer (logxor derive-type) ((x y)) - (multiple-value-bind - (x-len x-pos x-neg) - (integer-type-length (continuation-type x)) - (multiple-value-bind - (y-len y-pos y-neg) - (integer-type-length (continuation-type y)) - (cond - ((or (and (not x-neg) (not y-neg)) - (and (not x-pos) (not y-pos))) - ;; Either both are negative or both are positive. The result will be - ;; positive, and as long as the longer. - (specifier-type `(unsigned-byte ,(if (and x-len y-len) - (max x-len y-len) - '*)))) - ((or (and (not x-pos) (not y-neg)) - (and (not y-neg) (not y-pos))) - ;; Either X is negative and Y is positive of vice-verca. The result - ;; will be negative. - (specifier-type `(integer ,(if (and x-len y-len) - (ash -1 (max x-len y-len)) - '*) - -1))) - ;; We can't tell what the sign of the result is going to be. All we - ;; know is that we don't create new bits. - ((and x-len y-len) - (specifier-type `(signed-byte ,(1+ (max x-len y-len))))) - (t - (specifier-type 'integer)))))) - -) ; end progn - -#+propagate-fun-type -(progn (defun logand-derive-type-aux (x y &optional same-leaf) (declare (ignore same-leaf)) (multiple-value-bind @@ -2644,7 +2314,7 @@ :low 0 :high nil)))))) #'integer-length)) -) ; end progn + ;;;; Miscellaneous derive-type methods: @@ -3331,33 +3001,6 @@ res)) -;;; IR1-TRANSFORM-< -- Internal -;;; -;;; See if we can statically determine (< X Y) using type information. If -;;; X's high bound is < Y's low, then X < Y. Similarly, if X's low is >= to -;;; Y's high, then X >= Y (so return NIL). If not, at least make sure any -;;; constant arg is second. -;;; -#-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)) - (x-lo (numeric-type-low x-type)) - (x-hi (numeric-type-high x-type)) - (y-type (numeric-type-or-lose y)) - (y-lo (numeric-type-low y-type)) - (y-hi (numeric-type-high y-type))) - (cond ((and x-hi y-lo (< x-hi y-lo)) - 't) - ((and y-hi x-lo (>= x-lo y-hi)) - 'nil) - ((and (constant-continuation-p first) - (not (constant-continuation-p second))) - `(,inverse y x)) - (t - (give-up)))))) - ;;; Ir1-transform-<-helper -- Internal ;;; ;;; Derive the result type of the comparision X < Y returning two values: the @@ -3366,7 +3009,7 @@ ;;; X are less than all types of Y, then X < Y. Similarly, if all types of X ;;; are >= all types of Y, then X >= Y. ;;; -#+propagate-float-type + (defun ir1-transform-<-helper (x y) (flet ((maybe-convert (type) (numeric-type->interval (if (member-type-p type) @@ -3393,7 +3036,6 @@ ;;; Y's high, then X >= Y (so return NIL). If not, at least make sure any ;;; constant arg is second. ;;; -#+propagate-float-type (defun ir1-transform-< (x y first second inverse) (if (same-leaf-ref-p x y) 'nil @@ -3409,13 +3051,11 @@ (t (give-up)))))) -(deftransform < ((x y) #-propagate-float-type (integer integer) - #+propagate-float-type (real real) +(deftransform < ((x y) (real real) * :when :both) (ir1-transform-< x y x y '>)) -(deftransform > ((x y) #-propagate-float-type (integer integer) - #+propagate-float-type (real real) +(deftransform > ((x y) (real real) * :when :both) (ir1-transform-< y x x y '<)) -- GitLab