#f)) ((<= imin min max imax) (values #t #t)) (else (values #f #f)))) (else (values #f #f)))))) (define-nullish-predicate-folder null? &null &nil) (define-nullish-predicate-folder false? &nil &false) (define-nullish-predicate-folder nil? &null &false) ;; &nil in middle (define-syntax-rule (define-unary-type-predicate-folder op &type) (define-unary-branch-folder (op type min max) (let ((type* (logand type &type))) (cond ((zero? type*) (values #t #f)) ((eqv? type type*) (values #t #t)) (else (values #f #f)))))) (define-unary-branch-folder (heap-object? type min max) (define &immediate-types (logior &fixnum &char &special-immediate)) (cond ((zero? (logand type &immediate-types)) (values #t #t)) ((type<=? type &immediate-types) (values #t #f)) (else (values #f #f)))) ;; All the cases that are in compile-bytecode. (define-unary-type-predicate-folder bignum? &bignum) (define-unary-type-predicate-folder bitvector? &bitvector) (define-unary-type-predicate-folder bytevector? &bytevector) (define-unary-type-predicate-folder char? &char) (define-unary-type-predicate-folder compnum? &complex) (define-unary-type-predicate-folder fixnum? &fixnum) (define-unary-type-predicate-folder flonum? &flonum) (define-unary-type-predicate-folder fluid? &fluid) (define-unary-type-predicate-folder fracnum? &fraction) (define-unary-type-predicate-folder immutable-vector? &immutable-vector) (define-unary-type-predicate-folder keyword? &keyword) (define-unary-type-predicate-folder mutable-vector? &mutable-vector) (define-unary-type-predicate-folder pair? &pair) (define-unary-type-predicate-folder pointer? &pointer) (define-unary-type-predicate-folder program? &procedure) (define-unary-type-predicate-folder string? &string) (define-unary-type-predicate-folder struct? &struct) (define-unary-type-predicate-folder symbol? &symbol) (define-unary-type-predicate-folder syntax? &syntax) (define-unary-type-predicate-folder variable? &box) (define-unary-branch-folder (vector? type min max) (cond ((zero? (logand type &vector)) (values #t #f)) ((type<=? type &vector) (values #t #t)) (else (values #f #f)))) (define-unary-branch-folder (procedure? type min max) (define applicable-types (logior &procedure &struct &other-heap-object)) (cond ((zero? (logand type applicable-types)) (values #t #f)) ((= type &procedure) (values #t #t)) (else (values #f #f)))) (let ((&heap-number (logior &bignum &flonum &fraction &complex))) (define-unary-type-predicate-folder heap-number? &heap-number)) (define-unary-type-predicate-folder number? &number) (define-unary-type-predicate-folder complex? &number) (define-unary-type-predicate-folder real? &real) (define-unary-type-predicate-folder exact-integer? &exact-integer) (define-unary-type-predicate-folder exact? &exact-number) (let ((&inexact (logior &flonum &complex))) (define-unary-type-predicate-folder inexact? &inexact)) (define-unary-branch-folder (rational? type min max) (cond ((zero? (logand type &number)) (values #t #f)) ((eqv? type (logand type &exact-number)) (values #t #t)) (else (values #f #f)))) (define-unary-branch-folder (integer? type min max) (cond ((zero? (logand type &number)) (values #t #f)) ((eqv? type (logand type &exact-integer)) (values #t #t)) (else (values #f #f)))) (define-binary-branch-folder (eq? type0 min0 max0 type1 min1 max1) (cond ((or (zero? (logand type0 type1)) (< max0 min1) (< max1 min0)) (values #t #f)) ((and (eqv? type0 type1) (eqv? min0 min1 max0 max1) (zero? (logand type0 (1- type0))) (not (zero? (logand type0 &scalar-types)))) (values #t #t)) (else (values #f #f)))) (define-branch-folder-alias heap-numbers-equal? eq?) (define (compare-exact-ranges min0 max0 min1 max1) (and (cond ((< max0 min1) '<) ((> min0 max1) '>) ((= min0 max0 min1 max1) '=) ((<= max0 min1) '<=) ((>= min0 max1) '>=) (else #f)))) (define-binary-branch-folder (< type0 min0 max0 type1 min1 max1) (if (type<=? (logior type0 type1) &exact-number) (case (compare-exact-ranges min0 max0 min1 max1) ((<) (values #t #t)) ((= >= >) (values #t #f)) (else (values #f #f))) (values #f #f))) (define-binary-branch-folder (u64-< type0 min0 max0 type1 min1 max1) (case (compare-exact-ranges min0 max0 min1 max1) ((<) (values #t #t)) ((= >= >) (values #t #f)) (else (values #f #f)))) (define-branch-folder-alias s64-< u64-<) ;; We currently cannot define branch folders for floating point ;; comparison ops like the commented one below because we can't prove ;; there are no nans involved. ;; ;; (define-branch-folder-alias f64-< <) (define-binary-branch-folder (<= type0 min0 max0 type1 min1 max1) (if (type<=? (logior type0 type1) &exact-number) (case (compare-exact-ranges min0 max0 min1 max1) ((< <= =) (values #t #t)) ((>) (values #t #f)) (else (values #f #f))) (values #f #f))) (define-unary-branch-folder* (u64-imm-= c type min max) (cond ((= c min max) (values #t #t)) ((<= min c max) (values #f #f)) (else (values #t #f)))) (define-branch-folder-alias s64-imm-= u64-imm-=) (define-unary-branch-folder* (u64-imm-< c type min max) (cond ((< max c) (values #t #t)) ((>= min c) (values #t #f)) (else (values #f #f)))) (define-branch-folder-alias s64-imm-< u64-imm-<) (define-unary-branch-folder* (imm-u64-< c type min max) (cond ((< c min) (values #t #t)) ((>= c max) (values #t #f)) (else (values #f #f)))) (define-branch-folder-alias imm-s64-< imm-u64-<) (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1) (cond ((not (type<=? (logior type0 type1) &exact-number)) (values #f #f)) ((zero? (logand type0 type1)) ;; If both values are exact but of different types, they are not ;; equal. (values #t #f)) (else (case (compare-exact-ranges min0 max0 min1 max1) ((=) (values #t #t)) ((< >) (values #t #f)) (else (values #f #f)))))) (define-binary-branch-folder (u64-= type0 min0 max0 type1 min1 max1) (case (compare-exact-ranges min0 max0 min1 max1) ((=) (values #t #t)) ((< >) (values #t #f)) (else (values #f #f)))) (define-branch-folder-alias s64-= u64-=)