From dc5cdbbc6a6b21822693415505d25dca1fc2cc7c Mon Sep 17 00:00:00 2001
From: Bernhard Urban <lewurm@gmail.com>
Date: Thu, 20 Oct 2011 01:20:59 +0200
Subject: [PATCH] partial hw1

---
 1hw.fs | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)

diff --git a/1hw.fs b/1hw.fs
index e6275d5..1bbdc00 100644
--- 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 =========================================
 
+\ 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 ;
@@ -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.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.
@@ -34,3 +73,67 @@
 : 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 ========================================
-- 
2.25.1