partial hw1

diff --git a/1hw.fs b/1hw.fs
index e6275d51d35eadea8a9fdb897a8ed4f6169f3da4..1bbdc00850b2ca1221af777678f522f40f2b29d1 100644 (file)
--- a/1hw.fs
+++ b/1hw.fs
@@ -1,5 +1,34 @@
+\ 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 =========================================
 
 \ ============================== 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 ;
 \          Given:          How do you get:
 \          1 2 3           3 2 1
 : ass36.1.1 1 2 3 rot rot swap .s 2drop drop ;


@@ -20,10 +49,20 @@
 : ass36.1.6 1 2 3 4 swap 2swap swap ;
 
 \          1 2 3           1 2 3 1 2 3
 : 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
 \          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
 \          1 2 3

+: ass36.1.9 1 2 3 2drop drop .s ;
+

 \          1 2 3           1 2 3 4
 \          1 2 3           1 2 3 4

+\ WTF??
+: ass36.1.10 1 2 3 4 .s 2drop 2drop ;
+

 \          1 2 3           1 3
 \          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.
 
 
 \ Assignment: Write 17^3 and 17^4 in Forth, without writing 17 more than once.


@@ -34,3 +73,67 @@
 : ass36.3 17 dup 2dup * * * ;
 : ass36.4 ( a b -- erg)
        over swap - swap 1 + * ;
 : 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 ;
+
+\ TODO
+\ ============================== 3.22 ========================================
+\ ============================== 3.23 ========================================