+\ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Tutorial.html
+\ all `ass*' words are `( -- )' if not stated otherwise.
+
+: rr ( -- ) s" 1hw.fs" included ;
+: :r rr ; \ ghci style
+
+\ ============================== 3.4 =========================================
+: ass34 5 6 7 .s 2drop drop ;
+
+\ ============================== 3.5 =========================================
+\ postfix | infix
+\ 3 4 + 5 * = (3 + 4) * 5
+\ 3 4 5 * + = (4 * 5) + 3
+
+
+\ Assignment: What are the infix expressions corresponding to the Forth code
+\ above? Write 6-7*8+9 in Forth notation1.
+: ass35.1 6 7 8 * - 9 + .s drop ;
+
+\ Assignment: Convert -(-3)*4-5 to Forth.
+: ass35.2 3 negate 4 * negate 5 - .s drop ;
+
\ ============================== 3.6 =========================================
+\ Assignment: Replace nip and tuck with combinations of other stack
+\ manipulation words.
+: ass36nip ( a b -- a )
+ swap drop ;
+: ass36tuck ( a b -- b a b )
+ swap over ;
+
\ Given: How do you get:
\ 1 2 3 3 2 1
: ass36.1.1 1 2 3 rot rot swap .s 2drop drop ;
: ass36.1.6 1 2 3 4 swap 2swap swap ;
\ 1 2 3 1 2 3 1 2 3
+: ass36.1.7 1 2 3 dup 2over rot .s 2drop 2drop 2drop ;
+
\ 1 2 3 4 1 2 3 4 1 2
+: ass36.1.8 1 2 3 4 2over .s 2drop 2drop 2drop ;
+
\ 1 2 3
+: ass36.1.9 1 2 3 2drop drop .s ;
+
\ 1 2 3 1 2 3 4
+\ WTF??
+: ass36.1.10 1 2 3 4 .s 2drop 2drop ;
+
\ 1 2 3 1 3
+: ass36.1.11 1 2 3 nip .s 2drop ;
\ Assignment: Write 17^3 and 17^4 in Forth, without writing 17 more than once.
: ass36.3 17 dup 2dup * * * ;
: ass36.4 ( a b -- erg)
over swap - swap 1 + * ;
+
+\ ============================== 3.9 =========================================
+\ Assignment: Write colon definitions for nip, tuck, negate, and /mod in terms
+\ of other Forth words, and check if they work (hint: test your tests on the
+\ originals first). Don't let the `redefined'-Messages spook you, they are
+\ just warnings.
+
+: nip ( a b -- b ) swap drop ;
+: tuck ( a b -- b a b ) swap over ;
+: negate ( a -- -a ) -1 * ;
+: /mod 2dup mod rot rot / ;
+
+\ ============================== 3.15 ========================================
+\ Assignment: Rewrite your definitions until now with locals
+: nip { a b } b ;
+: tuck { a b } b a b ;
+: /mod { a b } a b mod a b / ;
+
+\ ============================== 3.16 ========================================
+\ Assignment: Write min without else-part (hint: what's the definition of nip?).
+: min ( n1 n2 -- n )
+ 2dup < if swap then nip ;
+
+\ ============================== 3.17 ========================================
+\ Assignment: Write min without if.
+: min ( n1 n2 -- n ) 2dup < dup
+ 2swap ( v v n1 n2)
+ rot ( v n1 n2 v )
+ invert and ( v n1 n2v )
+ rot rot and ( n2v n1v )
+ or ( n ) ;
+
+\ ============================== 3.18 ========================================
+\ Assignment: Write a definition for computing the greatest common divisor.
+: gcd ( a b -- x )
+ begin
+ 2dup mod ( a b r )
+ rot drop ( b r -> a b in next step )
+ dup 0=
+ until drop ;
+
+
+\ ============================== 3.19 ========================================
+\ Assignment: Write a definition for computing the nth Fibonacci number.
+
+: fibit ( n -- fib (n)
+ 0 1 ( u v -- initial values )
+ rot 0 u+do
+ 2dup + ( u_old u_new v_new )
+ rot drop ( u_new v_new )
+ loop nip ;
+
+\ ============================== 3.20 ========================================
+\ Assignment: Write a recursive definition for computing the nth Fibonacci
+\ number.
+: fibrec ( n -- fib (n)
+ dup 1 > if dup 1- recurse swap 2 - recurse +
+ else dup 0= if drop 1 then then ;
+
+: show20fib cr 20 0 u+do i dup dup . ." : " fibit . ." , " fibrec . cr loop ;
+
+\ ============================== 3.22 ========================================
+\ Assignment: Can you rewrite any of the definitions you wrote until now in a
+\ better way using the return stack?
+: min ( n1 n2 -- n)
+ 2dup < >r r@ ( n1 n2 v )
+ invert and swap r> and or ;
+
+\ ============================== 3.23 ========================================
+\ Assignment: Write a definition sum ( addr u -- n ) that computes the sum of u
+\ cells, with the first of these calls at addr, the next one at addr cell+ etc.
+: sum ( addr u -- n )
+ >r
+ 1 cells - 0 ( addr-4 0)
+ r> 0 ( addr-4 0 u 0 )
+ u+do
+ swap cell+ dup ( 0 addr addr )
+ @ ( 0 addr val )
+ rot ( addr val 0 )
+ + ( addr sum )
+ loop swap drop ;
+
+create v3
+ 5 , 4 , 3 , 2 , 1 ,
+: sumexample v3 5 sum ;