2007-09-20 18:09:08 -04:00
|
|
|
IN: benchmark.nsieve-bits
|
|
|
|
USING: math math.parser sequences sequences.private kernel
|
2008-09-10 23:11:40 -04:00
|
|
|
bit-arrays make io ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: clear-flags ( step i seq -- )
|
|
|
|
2dup length >= [
|
|
|
|
3drop
|
|
|
|
] [
|
2008-12-17 20:28:07 -05:00
|
|
|
f 2over set-nth-unsafe [ over + ] dip clear-flags
|
2008-08-24 04:59:22 -04:00
|
|
|
] if ; inline recursive
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: (nsieve-bits) ( count i seq -- count )
|
2008-01-12 21:38:22 -05:00
|
|
|
2dup length < [
|
2007-09-20 18:09:08 -04:00
|
|
|
2dup nth-unsafe [
|
|
|
|
over dup 2 * pick clear-flags
|
|
|
|
rot 1+ -rot ! increment count
|
2008-12-17 20:28:07 -05:00
|
|
|
] when [ 1+ ] dip (nsieve-bits)
|
2007-09-20 18:09:08 -04:00
|
|
|
] [
|
|
|
|
2drop
|
2008-08-24 04:59:22 -04:00
|
|
|
] if ; inline recursive
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: nsieve-bits ( m -- count )
|
|
|
|
0 2 rot 1+ <bit-array> dup set-bits (nsieve-bits) ;
|
|
|
|
|
|
|
|
: nsieve-bits. ( m -- )
|
|
|
|
[ "Primes up to " % dup # " " % nsieve-bits # ] "" make
|
|
|
|
print ;
|
|
|
|
|
|
|
|
: nsieve-bits-main ( n -- )
|
|
|
|
dup 2^ 10000 * nsieve-bits.
|
2008-01-13 13:29:04 -05:00
|
|
|
dup 1- 2^ 10000 * nsieve-bits.
|
2007-09-20 18:09:08 -04:00
|
|
|
2 - 2^ 10000 * nsieve-bits. ;
|
|
|
|
|
2008-06-09 03:14:14 -04:00
|
|
|
: nsieve-bits-main* ( -- ) 11 nsieve-bits-main ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
MAIN: nsieve-bits-main*
|