extra/benchmark/recursive/recursive.factor

   1 USING: math kernel hints prettyprint io combinators ;
   2 IN: benchmark.recursive
   3
   4 : fib ( m -- n )
   5     dup 2 < [ drop 1 ] [ [ 1 - fib ] [ 2 - fib ] bi + ] if ;
   6     inline
   7
   8 : ack ( m n -- x )
   9     {
  10         { [ over zero? ] [ nip 1+ ] }
  11         { [ dup zero? ] [ drop 1- 1 ack ] }
  12         [ [ drop 1- ] [ 1- ack ] 2bi ack ]
  13     } cond ; inline
  14
  15 : tak ( x y z -- t )
  16     2over <= [
  17         2nip
  18     ] [
  19         [  rot 1- -rot tak ]
  20         [ -rot 1- -rot tak ]
  21         [      1- -rot tak ]
  22         3tri
  23         tak
  24     ] if ; inline
  25
  26 : recursive ( n -- )
  27     [ 3 swap ack . flush ]
  28     [ 27.0 + fib . flush ]
  29     [ 1- [ 3 * ] [ 2 * ] [ ] tri tak . flush ] tri
  30     3 fib . flush
  31     3.0 2.0 1.0 tak . flush ;
  32
  33 HINTS: recursive fixnum ;
  34
  35 : recursive-main ( -- ) 11 recursive ;
  36
  37 MAIN: recursive-main