[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Add some comments and indent code neatly.
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Thu Mar 16 17:26:53 UTC 2023
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>
More information about the cmucl-cvs
mailing list