extra/benchmark/recursive/recursive.factor

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