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*
! Reduction
[ 1 ] [ [ 4 <reversed> [ 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
\ 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 [
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 ;
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 -- )
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 + <bit-array> dup set-bits (nsieve-bits) ;
+ [ 0 2 ] dip 1 + <bit-array> 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 ;
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 <array> (nsieve) ;
+ [ 0 2 ] dip 1 + t <array> (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 ;