[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Add some comments and indent code neatly.

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl


Commits:
07cc6791 by Raymond Toy at 2023-03-16T10:26:24-07:00
Add some comments and indent code neatly.

- - - - -


1 changed file:

- src/compiler/srctran.lisp


Changes:

=====================================
src/compiler/srctran.lisp
=====================================
@@ -3537,6 +3537,11 @@
 (deftransform > ((x y) (real real) * :when :both)
   (ir1-transform-< y x x y '<))
 
+;;; Ir1-transform->=-helper -- Internal
+;;;
+;;; Derives the result type of the comparison X >= Y returning two
+;;; values: the first true if X >= Y, and the second true if X < Y.
+;;; This is the equivalent of ir1-transform-<-helper, but for >=.
 #+(and x86)
 (defun ir1-transform->=-helper (x y)
   (flet ((maybe-convert (type)
@@ -3558,34 +3563,33 @@
 				      (interval-< x-arg y-arg)))))
       (values definitely-true definitely-false))))
 
+;;; IR1-TRANSFORM->= -- Internal
+;;;
+;;;   Like IR1-TRANSFORM-< but for >=.  This is needed so that the
+;;; compiler can statically determine (>= X Y) using type information.
 #+(and x86)
 (defun ir1-transform->= (x y first second inverse)
-    (if (same-leaf-ref-p x y)
-	't
-	(multiple-value-bind (definitely-true definitely-false)
-	    (ir1-transform->=-helper x y)
-	  (cond (definitely-true
-		    t)
-		(definitely-false
-		    nil)
-		((and (constant-continuation-p first)
-                      (not (constant-continuation-p second)))
-		 #+nil
-		 (format t "swapping ~A~%" inverse)
-		 `(,inverse y x))
-		(t
-		 (give-up))))))
+  ;; If the leaves are the same, the (>= X Y) is true.
+  (if (same-leaf-ref-p x y)
+      't
+      (multiple-value-bind (definitely-true definitely-false)
+	  (ir1-transform->=-helper x y)
+	(cond (definitely-true
+		  t)
+	      (definitely-false
+		  nil)
+	      ((and (constant-continuation-p first)
+                    (not (constant-continuation-p second)))
+	       `(,inverse y x))
+	      (t
+	       (give-up))))))
 
 #+(and x86)
 (deftransform <= ((x y) (real real) * :when :both)
-  #+nli
-  (format t "transform <=~%")
   (ir1-transform->= y x x y '>=))
 
 #+(and  x86)
 (deftransform >= ((x y) (real real) * :when :both)
-  #+nil
-  (format t "transform >=~%")
   (ir1-transform->= x y x y '<=))
 
 
@@ -3605,7 +3609,6 @@
     ;; (<= x y) is the same as (not (> x y))
     `(not (> x y)))
 
-  
   (deftransform >= ((x y) (integer integer) * :when :both)
     ;; (>= x y) is the same as (not (< x y))
     `(not (< x y))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/07cc6791a1b285aca7d733f296d560d7ee070f3d

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/07cc6791a1b285aca7d733f296d560d7ee070f3d
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230316/f9c871dd/attachment-0001.html>