more chapters; 3 left\!

1 files changed, 421 insertions, 5 deletions

diff --git a/other/seasoned_schemer.scm b/other/seasoned_schemer.scm
index 50d882d..e81f07d 100644
--- a/other/seasoned_schemer.scm
+++ b/other/seasoned_schemer.scm
@@ -624,17 +624,433 @@ x-thing ; potato
 (nibbler 'boat)
 x-thing ; not boat
 
-(define foody (quote nothing))
-
+(define food (quote nothing))
 
 (define glutton
   (lambda (x-thing)
     (set! food x-thing)
     (cons (quote more)
-	  (cons x
-		(cons (quote more) (cons x (quote ())))))))
+	  (cons x-thing
+		(cons (quote more) (cons x-thing (quote ())))))))
+
+(glutton 'garlic); (more garlic more garlic)
+
+(define chez-nous
+  (lambda ()
+    (let ((a food))
+      (set! food x-thing)
+      (set! x-thing a))))
+
+food  ; garlic
+x-thing  ; potato
+(chez-nous)
+food  ; potato
+x-thing  ; garlic
+
+; {{ The Eighteenth Commandment }}
+; Use (set! x ...) only when the value that x refers to is no longer needed.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 16: Ready, Set, Bang!
+
+(define sweet-tooth
+  (lambda (food)
+    (cons food (cons (quote cake) (quote ())))))
+
+(define last (quote angelfood))
+
+(sweet-tooth last) ; (angelfood cake)
+
+(define sweet-toothL
+  (lambda (food)
+    (set! last food)
+    (cons food (cons (quote cake) (quote ())))))
+
+(sweet-toothL (quote chocolate)) ; (chocolate cake)
+last ; chocolate
 
-(glutton 'garlic)
+(define ingredients (quote ()))
+(define sweet-toothR
+  (lambda (food)
+    (set! ingredients (cons food ingredients))
+    (cons food (cons (quote cake) (quote ())))))
+
+(sweet-toothR 'chocolate)
+(sweet-toothR 'fruit)
+(sweet-toothR 'cheese)
+ingredients ; (cheese fruit chocolate)
+
+(define deep
+  (lambda (m)
+    (cond 
+     ((zero? m) (quote pizza))
+     (else (cons (deep (sub1 m)) (quote ()))))))
+
+(deep 4) ; ((((pizza))))
+
+(define Rs (quote ()))
+(define Ns (quote ()))
+
+(define deepR
+  (lambda (n)
+    (let ((result (deep n)))
+      (set! Ns (cons n Ns))
+      (set! Rs (cons result Rs))
+      result)))
+
+(deepR 4)
+(deepR 1)
+(deepR 2)
+Rs
+Ns ; (2 1 4)
+
+; {{ The Nineteenth Commandment }}
+; Use (set! ...) to remember valuable things between two distinct uses of a 
+; function.
+
+(define find
+  (lambda (n Ns Rs)
+    (letrec
+	((A (lambda (ns rs)
+	      (cond
+	       ((= (car ns) n) (car rs))
+	       (else (A (cdr ns) (cdr rs)))))))
+      (A Ns Rs))))
 
+(find 4 Ns Rs)
+
+(define deepM
+  (lambda (n)
+    (if (member? n Ns)
+	(find n Ns Rs)
+	(deepR n))))
 
+(deepM 4) ; ((((pizza))))
+(deepM 5) ; (((((pizza)))))
+Ns ; (5 2 1 4)
+
+(define deepM
+  (lambda (n)
+    (if (member? n Ns)
+	(find n Ns Rs)
+	(let ((result (deep n)))
+	  (set! Rs (cons result Rs))
+	  (set! Ns (cons n Ns))
+	  result))))
+
+(deepM 9) 
+Ns ; (9 5 2 1 4)
+
+(define deep
+  (lambda (m)
+    (cond
+     ((zero? m) (quote pizza))
+     (else (cons (deepM (sub1 m)) (quote ()))))))
+
+(deepM 12)
+Ns ; (12 11 10 9 5 2 1 4)
+
+(define deepM
+  (let ((Rs (quote ()))
+	(Ns (quote ())))
+    (lambda (n)
+      (if (member? n Ns)
+	  (find n Ns Rs)
+	  (let ((result (deep n)))
+	    (set! Rs (cons result Rs))
+	    (set! Ns (cons n Ns))
+	    result)))))
+
+(deepM 16)
+
+(define find
+  (lambda (n Ns Rs)
+    (letrec
+	((A (lambda (ns rs)
+	      (cond
+	       ((null? ns) #f)
+	       ((= (car ns) n) (car rs))
+	       (else (A (cdr ns) (cdr rs)))))))
+      (A Ns Rs))))
+
+(define deepM
+  (let ((Rs (quote ()))
+	(Ns (quote ())))
+    (lambda (n)
+	   (let ((exists (find n Ns Rs)))
+	     (if (atom? exists)
+		 (let ((result (deep n)))
+		   (set! Rs (cons result Rs))
+		   (set! Ns (cons n Ns))
+		   result)
+		 exits)))))
+
+(deepM 15)
+
+(length '(a b c d))
+
+(define length
+  (let ((h (lambda (l) 0)))
+    (set! h
+	  (lambda (l)
+	    (cond
+	     ((null? l) 0)
+	     (else (add1 (h (cdr l)))))))
+    h))
+
+(define L
+  (lambda (length)
+    (lambda (l)
+      (cond
+       ((null? l) 0)
+       (else (add1 (length (cdr l))))))))
+
+(define length
+  (let ((h (lambda (l) 0)))
+    (set! h (L (lambda (arg) (h arg))))
+    h))
+
+(length '(1 2 3)) ; 3
+
+(define Y-bang
+  (lambda (f)
+    (letrec
+	((h (f (lambda (arg) (h arg)))))
+      h)))
+
+(define length (Y-bang L))
+
+; Y-bang is the "applicative-order imperative Y combinator."
+
+(define D
+  (lambda (depth*)
+    (lambda (s)
+      (cond
+       ((null? s) 1)
+       ((atom? (car s)) (depth* (cdr s)))
+       (else
+	(max
+	 (add1 (depth* (car s)))
+	 (depth* (cdr s))))))))
+
+(define depth* (Y-bang D))
+
+(depth* '(((asdf d)) (d (a)))) ; 3
+
+(define bizarre
+  (let ((x 0))
+    (lambda (f)
+      (set! x (add1 x))
+      (lambda (a)
+	(if (= a x)
+	    0
+	    (f a))))))
+
+;((Y-bang bizarre) 3) ; infinite recurse
+((Y bizarre) 3) ; 0
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 17: We Change, Therefore We Are!
+
+(define deep
+  (lambda (m)
+    (if (zero? m)
+	(quote pizza)
+	(cons (deep (sub1 m))
+	      (quote ())))))
+
+(define deepM
+  (let ((Rs (quote ()))
+	(Ns (quote ())))
+    (letrec
+	((D (lambda (m)
+	      (if (zero? m)
+		  (quote pizza)
+		  (cons (deepM (sub1 m)) (quote ()))))))
+      (lambda (n)
+	(let ((exists (find n Ns Rs)))
+	  (if (atom? exists)
+	      (let ((result (D n)))
+		(set! Rs (cons result Rs))
+		(set! Ns (cons n Ns))
+		result)
+	      exists))))))
+
+(define deepM
+  (let ((Rs (quote ()))
+	(Ns (quote ())))
+    (lambda (n)
+      (let ((exists (find n Ns Rs)))
+	(if (atom? exists)
+	    (let ((result (if (zero? n)
+			      (quote pizza)
+			      (cons (deepM (sub1 n)) (quote ())))))
+	      (set! Rs (cons result Rs))
+	      (set! Ns (cons n Ns))
+	      result)
+	    exists)))))
+
+(deepM 30) ; good
+
+(define consC
+  (let ((N 0))
+    (lambda (x y)
+      (set! N (add1 N))
+      (cons x y))))
+
+; but then can't get the internal N!
+
+(define counter)
+(define consC
+  (let ((N 0))
+    (set! counter (lambda () N))
+    (lambda (x y)
+      (set! N (add1 N))
+      (cons x y))))
+
+(counter) ; 0
+
+(define deep
+  (lambda (m)
+    (if (zero? m)
+	(quote pizza)
+	(consC (deep (sub1 m)) (quote ())))))
+
+(deep 5)
+(counter) ; 5
+
+(define supercounter
+  (lambda (f)
+    (letrec
+	((S (lambda (n)
+	      (if (zero? n)
+		  (f n)
+		  (let ()
+		    (f n)
+		    (S (sub1 n)))))))
+      (S 1000)
+      (counter))))
+
+(supercounter deep) ; 1233002, b/c I ran with something else first
+
+(define counter)
+(define set-counter)
+(define consC
+  (let ((N 0))
+    (set! counter (lambda () N))
+    (set! set-counter
+	  (lambda (x)
+	    (set! N x)))
+    (lambda (x y)
+      (set! N (add1 N))
+      (cons x y))))
+
+(set-counter 0)
+
+(supercounter deep) ; 500500
+(set-counter 0)
+(define deepM
+  (let ((Rs (quote ()))
+	(Ns (quote ())))
+    (lambda (n)
+      (let ((exists (find n Ns Rs)))
+	(if (atom? exists)
+	    (let ((result (if (zero? n)
+			      (quote pizza)
+			      (consC (deepM (sub1 n)) (quote ())))))
+	      (set! Rs (cons result Rs))
+	      (set! Ns (cons n Ns))
+	      result)
+	    exists)))))
+
+(supercounter deepM) ; 1000
+
+; "A LISP programmer knows the value of everything but the cost of nothing"
+
+;(pp rember1*) ; refers to oh etc
+
+
+(define rember1*C
+  (lambda (a l)
+    (letrec
+	((R (lambda (l oh)
+	      (cond
+	       ((null? l) (oh (quote no)))
+	       ((atom? (car l)) (if (eq? (car l) a)
+				    (cdr l)
+				    (consC (car l) (R (cdr l) oh))))
+	       (else 
+		(let ((new-car
+		       (call-with-current-continuation
+			(lambda (oh)
+			  (R (car l) oh)))))
+		  (if (atom? new-car)
+		      (consC (car l)
+			     (R (cdr l) oh))
+		      (consC new-car (cdr l)))))))))
+      (let ((new-l (call-with-current-continuation
+		    (lambda (oh) (R l oh)))))
+	(if (atom? new-l)
+	    l
+	    new-l)))))
+
+(rember1*C 'noodles '((food) more (food))) ; ((food) more (food))
+(rember1*C 'noodles '((food) more (noodles food))) ; ((food) more (food))
+
+(define rember1*C2
+  (lambda (a l)
+    (letrec
+	((R (lambda (l)
+	      (cond
+	       ((null? l) (quote ()))
+	       ((atom? (car l)) (if (eq? (car l) a)
+				    (cdr l)
+				    (consC (car l) (R (cdr l)))))
+	       (else 
+		(let ((av (R (car l))))
+		  (if (eqlist? (car l) av)
+		      (consC (car l) (R (cdr l)))
+		      (consC av (cdr l)))))))))
+      (R l))))
+
+(set-counter 0)
+(rember1*C 'noodles '((food) more (food)))
+(counter) ; 0
+(rember1*C2 'noodles '((food) more (food)))
+(counter) ; 5
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 18: We Change, Therefore We Are the Same!
+
+(cons (quote ()) (quote ())) ; (())
+
+(define kons
+  (lambda (kar kdr)
+    (lambda (selector)
+      (selector kar kdr))))
+
+(define kar
+  (lambda (c)
+    (c (lambda (a d) a))))
+
+(define kdr
+  (lambda (c)
+    (c (lambda (a d) d))))
+
+(define bons
+  (lambda (kar)
+    (let ((kdr (quote ())))
+      (lambda (selector)
+	(selector
+	 (lambda (x) (set! kdr x))
+	 kar
+	 kdr)))))
+
+(define kar
+  (lambda (c)
+    (c (lambda (s a d) a))))
+
+(define kdr
+  (lambda (c)
+    (c (lambda (s a d) d))))