diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index ad17ccc1c9..e2bfe58788 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays system sorting math.libm math.floats.private math.integers.private -math.intervals quotations effects alien alien.data ; +math.intervals quotations effects alien alien.data sets ; FROM: math => float ; SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: void* @@ -952,3 +952,13 @@ M: tuple-with-read-only-slot clone ! Reduction [ 1 ] [ [ 4 [ nth-unsafe ] [ ] unless ] final-info length ] unit-test + +! Optimization on bit? +[ t ] [ [ 3 bit? ] { bit? fixnum-bit? } inlined? ] unit-test +[ f ] [ [ 500 bit? ] { bit? fixnum-bit? } inlined? ] unit-test + +[ t ] [ [ { 1 } intersect ] { intersect } inlined? ] unit-test +[ f ] [ [ { 1 } swap intersect ] { intersect } inlined? ] unit-test ! We could do this + +[ t ] [ [ { 1 } diff ] { diff } inlined? ] unit-test +[ f ] [ [ { 1 } swap diff ] { diff } inlined? ] unit-test ! We could do this diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index e95c6c4a49..da3bd58f74 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -284,6 +284,15 @@ CONSTANT: lookup-table-at-max 256 \ 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 + ! Speeds up sum-file, sort and reverse-complement benchmarks by ! compiling decoder-readln better \ push [ diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index e95c6d832b..5f461e22a3 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -58,7 +58,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 > ; inline + +M: fixnum bit? fixnum-bit? ; inline : fixnum-log2 ( x -- n ) 0 swap [ dup 1 eq? ] [ [ 1 + ] [ 2/ ] bi* ] until drop ; diff --git a/extra/benchmark/nsieve-bits/nsieve-bits.factor b/extra/benchmark/nsieve-bits/nsieve-bits.factor index 9ccc2d8616..8d56bd935b 100644 --- a/extra/benchmark/nsieve-bits/nsieve-bits.factor +++ b/extra/benchmark/nsieve-bits/nsieve-bits.factor @@ -1,5 +1,5 @@ USING: math math.parser sequences sequences.private kernel -bit-arrays make io ; +bit-arrays make io math.ranges multiline fry locals ; IN: benchmark.nsieve-bits : clear-flags ( step i seq -- ) @@ -13,23 +13,24 @@ IN: benchmark.nsieve-bits 2dup length < [ 2dup nth-unsafe [ over dup 2 * pick clear-flags - rot 1 + -rot ! increment count + [ 1 + ] 2dip ! increment count ] when [ 1 + ] dip (nsieve-bits) ] [ 2drop ] if ; inline recursive : nsieve-bits ( m -- count ) - 0 2 rot 1 + dup set-bits (nsieve-bits) ; + [ 0 2 ] dip 1 + dup set-bits (nsieve-bits) ; : nsieve-bits. ( m -- ) [ "Primes up to " % dup # " " % nsieve-bits # ] "" make - print ; + print ; inline : nsieve-bits-main ( n -- ) - dup 2^ 10000 * nsieve-bits. - dup 1 - 2^ 10000 * nsieve-bits. - 2 - 2^ 10000 * nsieve-bits. ; + [ 2^ 10000 * nsieve-bits. ] + [ 1 - 2^ 10000 * nsieve-bits. ] + [ 2 - 2^ 10000 * nsieve-bits. ] + tri ; : nsieve-bits-main* ( -- ) 11 nsieve-bits-main ; diff --git a/extra/benchmark/nsieve/nsieve.factor b/extra/benchmark/nsieve/nsieve.factor index 646c98f3a4..7c4a655e59 100644 --- a/extra/benchmark/nsieve/nsieve.factor +++ b/extra/benchmark/nsieve/nsieve.factor @@ -13,22 +13,23 @@ IN: benchmark.nsieve 2dup length < [ 2dup nth-unsafe [ over dup 2 * pick clear-flags - rot 1 + -rot ! increment count + [ 1 + ] 2dip ! increment count ] when [ 1 + ] dip (nsieve) ] [ 2drop ] if ; inline recursive : nsieve ( m -- count ) - 0 2 rot 1 + t (nsieve) ; + [ 0 2 ] dip 1 + t (nsieve) ; : nsieve. ( m -- ) [ "Primes up to " % dup # " " % nsieve # ] "" make print ; : nsieve-main ( n -- ) - dup 2^ 10000 * nsieve. - dup 1 - 2^ 10000 * nsieve. - 2 - 2^ 10000 * nsieve. ; + [ 2^ 10000 * nsieve. ] + [ 1 - 2^ 10000 * nsieve. ] + [ 2 - 2^ 10000 * nsieve. ] + tri ; : nsieve-main* ( -- ) 9 nsieve-main ;