From aa1651032d0545f86889ed523d40a745da6911ed Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 20 Jan 2010 00:10:49 -0600 Subject: [PATCH] Adding compiler transforms in propagation --- .../tree/propagation/transforms/transforms.factor | 9 +++++++++ core/math/integers/integers.factor | 5 ++++- 2 files changed, 13 insertions(+), 1 deletion(-) 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 ;