((logior . _) &type-check)
((logxor . _) &type-check)
((lognot . _) &type-check)
+ ((logtest a b) &type-check)
+ ((logbit? a b) &type-check)
((sqrt _) &type-check)
((abs _) &type-check))
(- -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)
($ <lexical-ref> _ _ sym) ($ <lexical-ref> _ _ sym))
(for-tail (make-const #f #t)))
+ (('= ($ <primcall> src2 'logand (a b)) ($ <const> _ 0))
+ (let ((src (or src src2)))
+ (make-primcall src 'not
+ (list (make-primcall src 'logtest (list a b))))))
+
+ (('logbit? ($ <const> src2
+ (? (lambda (bit)
+ (and (exact-integer? bit) (not (negative? bit))))
+ bit))
+ val)
+ (fold-constants src 'logtest
+ (list (make-const (or src2 src) (ash 1 bit)) val)
+ ctx))
+
(((? effect-free-primitive?) . args)
(fold-constants src name args ctx))
memq memv
= < > <= >= zero? positive? negative?
+ * - / 1- 1+ quotient remainder modulo
- ash logand logior logxor lognot
+ ash logand logior logxor lognot logtest logbit?
sqrt abs
not
pair? null? list? symbol? vector? string? struct? number? char? nil?
`(values
eq? eqv? equal?
= < > <= >= zero? positive? negative?
- ash logand logior logxor lognot
+ ash logand logior logxor lognot logtest logbit?
+ * - / 1- 1+ sqrt abs quotient remainder modulo
not
pair? null? nil? list?