Adding compiler transforms in propagation

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index ff68fb2400a97a345afb744373d61bc06b39da4c..b0605bfb356bfa0660d85410f0a104bc8a10ca86 100644 (file)
--- 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 eb94597160c68026ab6b7e8ae204715ecea16b39..e87d3a6a0db33f68954f8ce8af7db75226991f60 100644 (file)
--- 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 ;