diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index ff68fb2400..b0605bfb35 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -300,3 +300,12 @@ CONSTANT: lookup-table-at-max 256 tester '[ _ filter ] ; \ intersect [ intersect-quot ] 1 define-partial-eval + +: fixnum-bits ( -- n ) + cell-bits tag-bits get - ; + +: bit-quot ( #call -- quot/f ) + in-d>> second value-info interval>> 0 fixnum-bits [a,b] interval-subset? + [ [ >fixnum ] dip fixnum-bit? ] f ? ; + +\ bit? [ bit-quot ] "custom-inlining" set-word-prop diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index eb94597160..e87d3a6a0d 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -55,7 +55,10 @@ M: fixnum shift >fixnum fixnum-shift ; inline M: fixnum bitnot fixnum-bitnot ; inline -M: fixnum bit? neg shift 1 bitand 0 > ; inline +: fixnum-bit? ( n m -- b ) + neg shift 1 bitand 0 > ; + +M: fixnum bit? fixnum-bit? ; inline : fixnum-log2 ( x -- n ) 0 swap [ dup 1 eq? ] [ [ 1 + ] [ 2/ ] bi* ] until drop ;