Add some benchmarks
Slava Pestov
parent
7359873b60
commit
8a8d3b50b9
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math sequences kernel base64 ;
|
||||
IN: benchmark.base64
|
||||
|
||||
: base64-benchmark ( -- )
|
||||
65535 [ 255 bitand ] "" map-as
|
||||
100 [ >base64 base64> ] times
|
||||
drop ;
|
||||
|
||||
MAIN: base64-benchmark
|
||||
|
|
@ -5,7 +5,7 @@ IN: benchmark.beust2
|
|||
|
||||
! http://crazybob.org/BeustSequence.java.html
|
||||
|
||||
:: (count-numbers) ( remaining first value used max listener -- ? )
|
||||
:: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? )
|
||||
10 first - [| i |
|
||||
[let* | digit [ i first + ]
|
||||
mask [ digit 2^ ]
|
||||
|
|
@ -26,7 +26,7 @@ IN: benchmark.beust2
|
|||
] if
|
||||
] [ f ] if
|
||||
]
|
||||
] contains? ; inline
|
||||
] contains? ; inline recursive
|
||||
|
||||
:: count-numbers ( max listener -- )
|
||||
10 [ 1+ 1 1 0 max listener (count-numbers) ] contains? drop ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: binary-search math.primes.list math.ranges sequences
|
||||
prettyprint ;
|
||||
IN: benchmark.binary-search
|
||||
|
||||
: binary-search-benchmark ( -- )
|
||||
1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ;
|
||||
|
||||
MAIN: binary-search-benchmark
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
USING: math math.private kernel sequences ;
|
||||
IN: benchmark.empty-loop-0
|
||||
|
||||
: empty-loop-0 ( n -- )
|
||||
dup 0 fixnum< [ drop ] [ 1 fixnum-fast empty-loop-0 ] if ;
|
||||
|
||||
: empty-loop-main ( -- )
|
||||
5000000 empty-loop-0 ;
|
||||
|
||||
MAIN: empty-loop-main
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
USING: math math.private kernel sequences ;
|
||||
IN: benchmark.empty-loop-1
|
||||
|
||||
: empty-loop-1 ( n -- )
|
||||
[ drop ] each-integer ;
|
||||
|
||||
: empty-loop-main ( -- )
|
||||
5000000 empty-loop-1 ;
|
||||
|
||||
MAIN: empty-loop-main
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
USING: math math.private kernel sequences ;
|
||||
IN: benchmark.empty-loop-2
|
||||
|
||||
: empty-loop-2 ( n -- )
|
||||
[ drop ] each ;
|
||||
|
||||
: empty-loop-main ( -- )
|
||||
5000000 empty-loop-2 ;
|
||||
|
||||
MAIN: empty-loop-main
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
USING: math math.private kernel sequences ;
|
||||
IN: benchmark.empty-loop
|
||||
|
||||
: empty-loop-0 ( n -- )
|
||||
dup 0 fixnum< [ drop ] [ 1 fixnum-fast empty-loop-0 ] if ;
|
||||
|
||||
: empty-loop-1 ( n -- )
|
||||
[ drop ] each-integer ;
|
||||
|
||||
: empty-loop-2 ( n -- )
|
||||
[ drop ] each ;
|
||||
|
||||
: empty-loop-main ( -- )
|
||||
5000000 empty-loop-0
|
||||
5000000 empty-loop-1
|
||||
5000000 empty-loop-2 ;
|
||||
|
||||
MAIN: empty-loop-main
|
||||
|
|
@ -26,7 +26,7 @@ IN: benchmark.mandel
|
|||
|
||||
: iter ( c z nb-iter -- x )
|
||||
over absq 4.0 >= over zero? or
|
||||
[ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline
|
||||
[ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline recursive
|
||||
|
||||
SYMBOL: cols
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,29 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math locals hints ;
|
||||
IN: benchmark.nested-empty-loop-1
|
||||
|
||||
:: nested-empty-loop ( n -- )
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [
|
||||
n [ ] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times ;
|
||||
|
||||
HINTS: nested-empty-loop fixnum ;
|
||||
|
||||
: nested-empty-loop-main ( -- ) 7 nested-empty-loop ;
|
||||
|
||||
MAIN: nested-empty-loop-main
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.ranges sequences locals hints ;
|
||||
IN: benchmark.nested-empty-loop-2
|
||||
|
||||
: times ( seq quot -- ) [ drop ] prepose each ; inline
|
||||
|
||||
:: nested-empty-loop ( n -- )
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [
|
||||
1 n [a,b] [ ] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times
|
||||
] times ;
|
||||
|
||||
HINTS: nested-empty-loop fixnum ;
|
||||
|
||||
: nested-empty-loop-main ( -- ) 7 nested-empty-loop ;
|
||||
|
||||
MAIN: nested-empty-loop-main
|
||||
|
|
@ -7,7 +7,7 @@ bit-arrays namespaces io ;
|
|||
3drop
|
||||
] [
|
||||
f 2over set-nth-unsafe >r over + r> clear-flags
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: (nsieve-bits) ( count i seq -- count )
|
||||
2dup length < [
|
||||
|
|
@ -17,7 +17,7 @@ bit-arrays namespaces io ;
|
|||
] when >r 1+ r> (nsieve-bits)
|
||||
] [
|
||||
2drop
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: nsieve-bits ( m -- count )
|
||||
0 2 rot 1+ <bit-array> dup set-bits (nsieve-bits) ;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ arrays namespaces io ;
|
|||
3drop
|
||||
] [
|
||||
f 2over set-nth-unsafe >r over + r> clear-flags
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: (nsieve) ( count i seq -- count )
|
||||
2dup length < [
|
||||
|
|
@ -17,7 +17,7 @@ arrays namespaces io ;
|
|||
] when >r 1+ r> (nsieve)
|
||||
] [
|
||||
2drop
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: nsieve ( m -- count )
|
||||
0 2 rot 1+ t <array> (nsieve) ;
|
||||
|
|
|
|||
|
|
@ -3,14 +3,14 @@ IN: benchmark.recursive
|
|||
|
||||
: fib ( m -- n )
|
||||
dup 2 < [ drop 1 ] [ [ 1 - fib ] [ 2 - fib ] bi + ] if ;
|
||||
inline
|
||||
inline recursive
|
||||
|
||||
: ack ( m n -- x )
|
||||
{
|
||||
{ [ over zero? ] [ nip 1+ ] }
|
||||
{ [ dup zero? ] [ drop 1- 1 ack ] }
|
||||
[ [ drop 1- ] [ 1- ack ] 2bi ack ]
|
||||
} cond ; inline
|
||||
} cond ; inline recursive
|
||||
|
||||
: tak ( x y z -- t )
|
||||
2over <= [
|
||||
|
|
@ -21,7 +21,7 @@ IN: benchmark.recursive
|
|||
[ 1- -rot tak ]
|
||||
3tri
|
||||
tak
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: recursive ( n -- )
|
||||
[ 3 swap ack . flush ]
|
||||
|
|
|
|||
Loading…
Reference in New Issue