From aa1651032d0545f86889ed523d40a745da6911ed Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 20 Jan 2010 00:10:49 -0600 Subject: [PATCH 1/3] 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 ; From 52f2ac2bb9459162ed76281259b4e5db09903353 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 25 Jan 2010 20:15:17 -0600 Subject: [PATCH 2/3] Tests for propagation additions; making fixnum-bit? inline --- .../tree/propagation/propagation-tests.factor | 12 +++++++++++- core/math/integers/integers.factor | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) 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/core/math/integers/integers.factor b/core/math/integers/integers.factor index 9f7543ca13..5f461e22a3 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -59,7 +59,7 @@ M: fixnum shift >fixnum fixnum-shift ; inline M: fixnum bitnot fixnum-bitnot ; inline : fixnum-bit? ( n m -- b ) - neg shift 1 bitand 0 > ; + neg shift 1 bitand 0 > ; inline M: fixnum bit? fixnum-bit? ; inline From 93282bcc94e7916ca5d70276681bd06f2c5a3e23 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Jan 2010 15:11:12 -0600 Subject: [PATCH 3/3] Removing rot/-rot in nsieve and nsieve-bits --- extra/benchmark/nsieve-bits/nsieve-bits.factor | 15 ++++++++------- extra/benchmark/nsieve/nsieve.factor | 11 ++++++----- 2 files changed, 14 insertions(+), 12 deletions(-) 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 ;