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 ! HINTS: fib { fixnum float } ;
   8 !
   9 : ack ( m n -- x )
  10     over zero? [
  11         nip 1+
  12     ] [
  13         dup zero? [
  14             drop 1- 1 ack
  15         ] [
  16             dupd 1- ack >r 1- r> ack
  17         ] if
  18     ] if ;
  19
  20 ! HINTS: ack fixnum fixnum ;
  21
  22 : tak ( x y z -- t )
  23     pick pick swap < [
  24         [ rot 1- -rot tak ] 3keep
  25         [ -rot 1- -rot tak ] 3keep
  26         1- -rot tak
  27         tak
  28     ] [
  29         2nip
  30     ] if ;
  31
  32 ! HINTS: tak { fixnum float } { fixnum float } { fixnum float } ;
  33
  34 : recursive ( n -- )
  35     3 over ack . flush
  36     dup 27.0 + fib . flush
  37     1-
  38     dup 3 * over 2 * rot tak . flush
  39     3 fib . flush
  40     3.0 2.0 1.0 tak . flush ;
  41
  42 : recursive-main 11 recursive ;
  43
  44 MAIN: recursive-main