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/07cc6791a1b285aca7d733f2... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/07cc6791a1b285aca7d733f2... You're receiving this email because of your account on gitlab.common-lisp.net.