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, other space-critical applications
Note, Forth, strictly speaking, is not concatenative, but it *looks* like it is. Charles Moore pursued different goals,
but in doing so he almost discovered concatenative languages.
Consider the evolution of conditionals, for example,
from forth's "IF word" to postscript's "if operator" to joy and factor's "if combinator".
ALGORITHM 1A: NAIVE BINARY RECURSION |
: fib
dup 1 > if
1- dup 1- recurse swap recurse + then
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth-fast ./f1a.fs <n>" cr then
;
main
bye
|
ALGORITHM 1B: CACHED BINARY RECURSION / MEMOIZATION |
: mfib
dup 1 > if
2dup cells + @ dup 0= if
drop dup >r
1- 2dup 1- recurse 2swap recurse nip +
2dup swap r> cells + !
else nip then then
;
: fib
dup 1+ cells allocate throw
swap 2dup 1+ cells erase
over cell+ 1 swap !
mfib swap free throw
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f1b.fs <n>" cr then
;
main
bye
|
ALGORITHM 2A: CACHED LINEAR RECURSION / RANDOM-ACCESS CONTAINER |
: fibrec
1- dup 0> if
over 3 pick + swap recurse else
drop then
;
: fib
dup 0> if 0 1 rot
fibrec
>r begin 0= until r> then
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f2a.fs <n>" cr then
;
main
bye
|
ALGORITHM 2B: LINEAR RECURSION WITH ACCUMULATOR |
: fib
rot 1- dup 0< if 2drop else
over 2swap + recurse then
;
: f ( n1 -- n2 )
dup abs 0 1 fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f2b.fs <n>" cr then
;
main
bye
|
ALGORITHM 2C: IMPERATIVE LOOP WITH MUTABLE VARIABLES |
: fib
1 0 rot 0 ?do swap over + loop nip
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f2c.fs <n>" cr then
;
main
bye
|
ALGORITHM 3A: MATRIX MULTIPLICATION |
: make-mat
dup >r dup * dup cells allocate throw
swap 0 u+do swap over i cells + ! loop r>
;
: dup-mat
dup dup * dup cells allocate throw
swap 3 pick 2 pick rot cells move over
;
: drop-mat
drop free throw
;
: .m
2dup dup * 0 u+do dup i cells + @ . loop cr drop
;
: make-zero-mat
dup dup * 0 u+do 0 swap loop make-mat
;
: *m
drop swap dup make-zero-mat
0 u+do i 2 pick 0 u+do i 3 pick 0 u+do i
4 pick 3 pick * over + 7 pick swap cells + @
over 6 pick * 3 pick + 7 pick swap cells + @ *
5 pick 4 pick * 3 pick + 5 pick swap cells +
dup @ rot + swap !
drop loop drop loop drop loop
over 2swap drop-mat rot over drop-mat
;
: mat-power
dup 1 > if
2 /mod 2swap dup-mat 4 roll recurse
dup-mat *m
2swap 4 roll 0= if drop-mat
else *m then
else drop then
;
: fib
dup 0= if 0 else
0 1 1 1 2 make-mat rot 1- mat-power
over @ -rot drop-mat then
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f3a.fs <n>" cr then
;
main
bye
|
ALGORITHM 3B: FAST RECURSION |
: fast-fib
dup 0<= if drop 0 0 else
dup 1 = if drop 0 1 else
2 /mod recurse 2dup + 3 roll 0= if
-rot 2dup dup * swap dup * + 2swap + rot * else
rot over + rot tuck dup * -rot * rot dup * rot +
then then then
;
: fib
fast-fib nip
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f3b.fs <n>" cr then
;
main
bye
|
ALGORITHM 3C: BINET'S FORMULA WITH ROUNDING |
: fib
s>f 5e fsqrt fdup 1e f+ f2/ frot f** fswap f/ fround f>s
;
: f
dup abs fib swap
dup 0< swap 2 mod 0= and if negate then
;
: fib_print
dup . ." th Fibonacci number is " f . cr
;
: main
argc @ 2 =
next-arg s>number?
3 roll and if
d>s fib_print else
." Usage: gforth ./f3c.fs " cr then
;
main
bye
|
|