steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up recursive benchmark a tad

db4
Slava Pestov 2008-04-19 02:11:18 -05:00
parent 7516041e36
commit 27d60007e2
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
extra/benchmark/recursive/recursive.factor
View File

@ -1,38 +1,37 @@
USING: math kernel hints prettyprint io combinators ;
IN: benchmark.recursive IN: benchmark.recursive
USING: math kernel hints prettyprint io ;
: fib ( m -- n ) : fib ( m -- n )
dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; dup 2 < [ drop 1 ] [ [ 1 - fib ] [ 2 - fib ] bi + ] if ;
inline
: ack ( m n -- x ) : ack ( m n -- x )
over zero? [ {
nip 1+ { [ over zero? ] [ nip 1+ ] }
] [ { [ dup zero? ] [ drop 1- 1 ack ] }
dup zero? [ [ [ drop 1- ] [ 1- ack ] 2bi ack ]
drop 1- 1 ack } cond ; inline
] [
dupd 1- ack >r 1- r> ack
] if
] if ;
: tak ( x y z -- t ) : tak ( x y z -- t )
2over swap < [ 2over <= [
[ rot 1- -rot tak ] 3keep
[ -rot 1- -rot tak ] 3keep
1- -rot tak
tak
] [
2nip 2nip
] if ; ] [
[ rot 1- -rot tak ]
[ -rot 1- -rot tak ]
[ 1- -rot tak ]
3tri
tak
] if ; inline
: recursive ( n -- ) : recursive ( n -- )
3 over ack . flush [ 3 swap ack . flush ]
dup 27.0 + fib . flush [ 27.0 + fib . flush ]
1- [ 1- [ 3 * ] [ 2 * ] [ ] tri tak . flush ] tri
dup 3 * over 2 * rot tak . flush
3 fib . flush 3 fib . flush
3.0 2.0 1.0 tak . flush ; 3.0 2.0 1.0 tak . flush ;
HINTS: recursive fixnum ;
: recursive-main 11 recursive ; : recursive-main 11 recursive ;
MAIN: recursive-main MAIN: recursive-main