[Sbcl-commits] CVS: sbcl/src/compiler ir1opt.lisp,1.79,1.80 srctran.lisp,1.93,1.94

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv30599/src/compiler

Modified Files:
	ir1opt.lisp srctran.lisp 
Log Message:
0.8.3.86:
        * Fix transformers for </>/<=/>=:
        ... when swap arguments, change function name "<" <-> ">";
        ... do not check whether an interval is a constant LVAR;
        * add type declaration in CONSTANT-LVAR-P.


Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- ir1opt.lisp	21 Sep 2003 09:58:07 -0000	1.79
+++ ir1opt.lisp	22 Sep 2003 14:12:04 -0000	1.80
@@ -21,6 +21,7 @@
 ;;; Return true for an LVAR whose sole use is a reference to a
 ;;; constant leaf.
 (defun constant-lvar-p (thing)
+  (declare (type (or lvar null) thing))
   (and (lvar-p thing)
        (let ((use (principal-lvar-use thing)))
          (and (ref-p use) (constant-p (ref-leaf use))))))

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -d -r1.93 -r1.94
--- srctran.lisp	21 Sep 2003 09:58:08 -0000	1.93
+++ srctran.lisp	22 Sep 2003 14:12:05 -0000	1.94
@@ -2981,27 +2981,27 @@
 ;;; information. If X's high bound is < Y's low, then X < Y.
 ;;; Similarly, if X's low is >= to Y's high, the X >= Y (so return
 ;;; NIL). If not, at least make sure any constant arg is second.
-(macrolet ((def (name reflexive-p surely-true surely-false)
+(macrolet ((def (name inverse reflexive-p surely-true surely-false)
              `(deftransform ,name ((x y))
                 (if (same-leaf-ref-p x y)
                     ,reflexive-p
-                    (let ((x (or (type-approximate-interval (lvar-type x))
-                                 (give-up-ir1-transform)))
-                          (y (or (type-approximate-interval (lvar-type y))
-                                 (give-up-ir1-transform))))
+                    (let ((ix (or (type-approximate-interval (lvar-type x))
+                                  (give-up-ir1-transform)))
+                          (iy (or (type-approximate-interval (lvar-type y))
+                                  (give-up-ir1-transform))))
                       (cond (,surely-true
                              t)
                             (,surely-false
                              nil)
                             ((and (constant-lvar-p x)
                                   (not (constant-lvar-p y)))
-                             `(,',name y x))
+                             `(,',inverse y x))
                             (t
                              (give-up-ir1-transform))))))))
-  (def < nil (interval-< x y) (interval->= x y))
-  (def > nil (interval-< y x) (interval->= y x))
-  (def <= t (interval->= y x) (interval-< y x))
-  (def >= t (interval->= x y) (interval-< x y)))
+  (def < > nil (interval-< ix iy) (interval->= ix iy))
+  (def > < nil (interval-< iy ix) (interval->= iy ix))
+  (def <= >= t (interval->= iy ix) (interval-< iy ix))
+  (def >= <= t (interval->= ix iy) (interval-< ix iy)))
 
 (defun ir1-transform-char< (x y first second inverse)
   (cond