Optimizer support for logtest and logbit?

[bpt/guile.git] / module / language / cps / types.scm

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 0bd2812..87cfe17 100644 (file)
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1012,6 +1012,37 @@ minimum, and maximum."
            (- -1 (&max a))
            (- -1 (&min a))))
 
+(define-simple-type-checker (logtest &exact-integer &exact-integer))
+(define-type-inferrer (logtest a b result)
+  (define (logand-min a b)
+    (if (< a b 0)
+        (min a b)
+        0))
+  (define (logand-max a b)
+    (if (< a b 0)
+        0
+        (max a b)))
+  (restrict! a &exact-integer -inf.0 +inf.0)
+  (restrict! b &exact-integer -inf.0 +inf.0)
+  (let ((min (logand-min (&min a) (&min b)))
+        (max (logand-max (&max a) (&max b))))
+    (if (and (= min max) (not (inf? min)))
+        (let ((res (if (zero? min) 0 1)))
+          (define! result &boolean res res))
+        (define! result &exact-integer 0 1))))
+
+(define-simple-type-checker (logbit? (&exact-integer 0 +inf.0) &exact-integer))
+(define-type-inferrer (logbit? a b result)
+  (let ((a-min (&min a))
+        (a-max (&max a))
+        (b-min (&min b))
+        (b-max (&max b)))
+    (if (and (eqv? a-min a-max) (>= a-min 0) (not (inf? a-min))
+             (eqv? b-min b-max) (>= b-min 0) (not (inf? b-min)))
+        (let ((res (if (logbit? a-min b-min) 1 0)))
+          (define! result &boolean res res))
+        (define! result &boolean 0 1))))
+
 ;; Flonums.
 (define-simple-type-checker (sqrt &number))
 (define-type-inferrer (sqrt x result)