1 \ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Tutorial.html
2 \ all `ass*' words are `( -- )' if not stated otherwise.
4 : rr ( -- ) s" 1hw.fs" included ;
7 \ ============================== 3.4 =========================================
8 : ass34 5 6 7 .s 2drop drop ;
10 \ ============================== 3.5 =========================================
12 \ 3 4 + 5 * = (3 + 4) * 5
13 \ 3 4 5 * + = (4 * 5) + 3
16 \ Assignment: What are the infix expressions corresponding to the Forth code
17 \ above? Write 6-7*8+9 in Forth notation1.
18 : ass35.1 6 7 8 * - 9 + .s drop ;
20 \ Assignment: Convert -(-3)*4-5 to Forth.
21 : ass35.2 3 negate 4 * negate 5 - .s drop ;
23 \ ============================== 3.6 =========================================
25 \ Assignment: Replace nip and tuck with combinations of other stack
27 : ass36nip ( a b -- a )
29 : ass36tuck ( a b -- b a b )
32 \ Given: How do you get:
34 : ass36.1.1 1 2 3 rot rot swap .s 2drop drop ;
37 : ass36.1.2 1 2 3 over .s 2drop 2drop ;
40 : ass36.1.3 1 2 3 dup .s 2drop 2drop ;
43 : ass36.1.4 1 2 3 swap drop dup .s 2drop drop ;
46 : ass36.1.5 1 2 3 rot swap .s 2drop drop ;
49 : ass36.1.6 1 2 3 4 swap 2swap swap ;
52 : ass36.1.7 1 2 3 dup 2over rot .s 2drop 2drop 2drop ;
55 : ass36.1.8 1 2 3 4 2over .s 2drop 2drop 2drop ;
58 : ass36.1.9 1 2 3 2drop drop .s ;
62 : ass36.1.10 1 2 3 4 .s 2drop 2drop ;
65 : ass36.1.11 1 2 3 nip .s 2drop ;
68 \ Assignment: Write 17^3 and 17^4 in Forth, without writing 17 more than once.
69 \ Write a piece of Forth code that expects two numbers on the stack (a and b,
70 \ with b on top) and computes (a-b)(a+1).
72 : ass36.2 17 dup dup * * ;
73 : ass36.3 17 dup 2dup * * * ;
74 : ass36.4 ( a b -- erg)
75 over swap - swap 1 + * ;
77 \ ============================== 3.9 =========================================
78 \ Assignment: Write colon definitions for nip, tuck, negate, and /mod in terms
79 \ of other Forth words, and check if they work (hint: test your tests on the
80 \ originals first). Don't let the `redefined'-Messages spook you, they are
83 : nip ( a b -- b ) swap drop ;
84 : tuck ( a b -- b a b ) swap over ;
85 : negate ( a -- -a ) -1 * ;
86 : /mod 2dup mod rot rot / ;
88 \ ============================== 3.15 ========================================
89 \ Assignment: Rewrite your definitions until now with locals
91 : tuck { a b } b a b ;
92 : /mod { a b } a b mod a b / ;
94 \ ============================== 3.16 ========================================
95 \ Assignment: Write min without else-part (hint: what's the definition of nip?).
97 2dup < if swap then nip ;
99 \ ============================== 3.17 ========================================
100 \ Assignment: Write min without if.
101 : min ( n1 n2 -- n ) 2dup < dup
104 invert and ( v n1 n2v )
105 rot rot and ( n2v n1v )
108 \ ============================== 3.18 ========================================
109 \ Assignment: Write a definition for computing the greatest common divisor.
113 rot drop ( b r -> a b in next step )
118 \ ============================== 3.19 ========================================
119 \ Assignment: Write a definition for computing the nth Fibonacci number.
121 : fibit ( n -- fib (n)
122 0 1 ( u v -- initial values )
124 2dup + ( u_old u_new v_new )
125 rot drop ( u_new v_new )
128 \ ============================== 3.20 ========================================
129 \ Assignment: Write a recursive definition for computing the nth Fibonacci
131 : fibrec ( n -- fib (n)
132 dup 1 > if dup 1- recurse swap 2 - recurse +
133 else dup 0= if drop 1 then then ;
135 : show20fib cr 20 0 u+do i dup dup . ." : " fibit . ." , " fibrec . cr loop ;
138 \ ============================== 3.22 ========================================
139 \ ============================== 3.23 ========================================