cubbi.com: fibonacci numbers in Forth

cubbi.com: fibonacci numbers in forth

serious stuff
  www.cubbi.com
personal
programming
  fibonacci numbers
    algorithms
    benchmarks
    forth
    postscript examples
    muf examples
    joy examples
    j examples
    scheme examples
    hope examples
    ocaml examples
    haskell examples
    prolog examples
    c++ examples
    java examples
    assembly language examples
    fortran examples
    c examples
    sh examples
    awk examples
    perl examples
    tcl examples
  asmix
  hacker test
  resume
science
martial arts
fun stuff
  www.cubbi.org

Forth
Date: 1960 (Standardized in ANSI X3.215-1994)
Type: Concatenative language
Usage: embedded systems, OS loaders, anything written by its fans, everything written for forth-processors

ALGORITHM 1A: BINARY RECURSION

( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 1A: BINARY RECURSION               )
: f ( n -- n )
  DUP 2 U< IF DROP 1 EXIT THEN
  1- DUP 1- RECURSE SWAP RECURSE +
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 2A-3: DATA STRUCTURE - SIMPLE LIST

( The word mm multiplies two 2x2 matrices represented )
( as four-element lists                               )
: mm ( A B -- C )
  OVER 7 PICK * 8 PICK 5 PICK * +
  OVER 8 ROLL * 4 PICK 9 ROLL * +
  3 ROLL 6 PICK * 7 PICK 6 ROLL * +
  3 ROLL 5 ROLL * 4 ROLL 5 ROLL * +
;
: mswap ( A B -- B A   ) 7 ROLL 7 ROLL 7 ROLL 7 ROLL ;
( The word mp raises matrix A to n'th power            )
: mp ( A n -- A )
  DUP 1 > IF
   2 /MOD 5 PICK 5 PICK 5 PICK 5 PICK 4 ROLL RECURSE                      
   3 PICK 3 PICK 3 PICK 3 PICK mm 4 ROLL 0=
   IF mswap 2DROP 2DROP ELSE mm THEN
  ELSE DROP THEN
;
( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 3A: MATRIX EQUATION                )
: f ( n -- n )
  1 1 1 0 4 ROLL mp DROP 2DROP
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 2B: SIMPLE RECURSION

: l ( n1 n2 ni -- n )
  ROT 1-
  DUP 0 U> INVERT IF 2DROP EXIT THEN
  OVER 2SWAP + RECURSE
;
( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 2B: SIMPLE RECURSION               )
: f ( n -- n )
  1 2 l
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 2C: NON-RECURSIVE LOOP

( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 2C: NON-RECURSIVE LOOP             )
: f ( n -- n )
  1 1 ROT 1 DO SWAP OVER + LOOP SWAP DROP
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 3A: MATRIX EQUATION

( The word mm multiplies two 2x2 matrices represented )
( as four-element lists                               )
: mm ( A B -- C )
  OVER 7 PICK * 8 PICK 5 PICK * +
  OVER 8 ROLL * 4 PICK 9 ROLL * +
  3 ROLL 6 PICK * 7 PICK 6 ROLL * +
  3 ROLL 5 ROLL * 4 ROLL 5 ROLL * +
;
: mswap ( A B -- B A   ) 7 ROLL 7 ROLL 7 ROLL 7 ROLL ;
( The word mp raises matrix A to n'th power            )
: mp ( A n -- A )
  DUP 1 > IF
   2 /MOD 5 PICK 5 PICK 5 PICK 5 PICK 4 ROLL RECURSE                      
   3 PICK 3 PICK 3 PICK 3 PICK mm 4 ROLL 0=
   IF mswap 2DROP 2DROP ELSE mm THEN
  ELSE DROP THEN
;
( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 3A: MATRIX EQUATION                )
: f ( n -- n )
  1 1 1 0 4 ROLL mp DROP 2DROP
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 3B: FAST RECURSION

: l ( n -- n1 n2 )
  DUP 2 U< IF DROP 1 1 ELSE
  DUP 2 = IF DROP 2 1 ELSE
  2 /MOD SWAP IF RECURSE
    2DUP OVER * 2OVER + ROT * +
    ROT DUP * ROT DUP * +
  ELSE 1- RECURSE 
    2DUP OVER + TUCK * 2SWAP OVER * ROT +
    ROT DUP * ROT DUP * + SWAP
  THEN THEN THEN
; 
( The word f returns the n'th Fibonacci number     )
( It uses ALGORITHM 3B: FAST RECURSION             )
: f ( n -- n )
  l DROP
;
( The word f_print prints the n'th Fibonacci number)
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " f U. CR
;
46 f_print
BYE

ALGORITHM 3C: BINET'S FORMULA

S" floating-ext" ENVIRONMENT? [IF]
( The word f returns the n'th Fibonacci number         )
( It uses ALGORITHM 3C: BINET'S FORMULA                )
: f ( d -- d )
  D>F 1E F+ 5E FSQRT FDUP 1E F+ 2E F/
  FROT FOVER 1E SWAP F- FOVER
  F** FROT FROT F** FSWAP F- FSWAP F/
  FROUND F>D
;
( The word f_print prints the n'th Fibonacci number    )
: f_print ( n -- )
  DUP U. ." th Fibonacci number is " 0 f D. CR
;
69 f_print
[ELSE] ." no floating wordset available " [THEN] BYE