From 9b37cbb3f730f3a4a3f13de8f3c5351b207f68f2 Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Fri, 16 Jan 2009 04:51:29 -0500
Subject: added play files for scheme textbooks

---
 little_schemer.scm   | 1335 ++++++++++++++++++++++++++++++++++++++++++++++++++
 seasoned_schemer.scm |  640 ++++++++++++++++++++++++
 2 files changed, 1975 insertions(+)
 create mode 100644 little_schemer.scm
 create mode 100644 seasoned_schemer.scm

diff --git a/little_schemer.scm b/little_schemer.scm
new file mode 100644
index 0000000..8a31425
--- /dev/null
+++ b/little_schemer.scm
@@ -0,0 +1,1335 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Play-along log to The Little Schemer by Friedman and Felleisen
+; Jan 2008, bryan newbold
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Preface: define and test primative
+
+(define atom?
+  (lambda (x)
+    (and (not (pair? x)) (not (null? x)))))
+
+(atom? (quote ()))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 01: Toys
+
+(car '(c b a)) ; returns c
+(cdr '(c b a)) ; returns '(b a)
+;(car ()) ; gives an error, () is null (but is still a list)
+
+; [[ Law of Car ]]
+; The primative car is defind only for non-empty lists.
+ 
+; [[ Law of Cdr ]]
+; The primative cdr is defined only for non-empty lists. The cdr of any 
+; non-empty list is always another list.
+
+(cons 2 3) ; returns (2 . 3), though book says undefined.
+(cons 'a ()) ; returns (a)
+
+; [[ Law of Cons ]]
+; The primative cons takes two arguments. The second argument to cons must be
+; a list. The result is a list.
+
+(null? ()) ; #t
+(null? 3) ; #f
+;(null? (() ())); error
+;(null? ('() '())) ; error
+(null? '(() ())) ; #f
+(null? 'asdf) ; #f, book says undefined
+
+;(cdr (1)) ; error!
+(cdr '(1)) ; reurns ()
+
+; [[ Law of Null? ]]
+; The primative null? is defined only for lists.
+
+; [[ Law of Eq? ]]
+; The primative eq? takes two arguments. Each must be a non-numeric atom.
+
+; in practice some numbers can be eq? ?
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 02: Do It, Do It Again, and Again, and Again...
+
+(define lat?
+  (lambda (l)
+    (cond
+     ((null? l) #t)
+     ((atom? (car l)) (lat? (cdr l)))
+     (else #f))))
+
+; lat = list of atoms
+(lat? '(a b c d)) ; #t
+(lat? '('(1 2 3) 4 5 6)) ; #f
+(lat? ()) ; #t
+
+(define member?
+  (lambda (a lat)
+    (cond
+     ((null? lat) #f)
+     (else (or (eq? (car lat) a)
+	       (member? a (cdr lat)))))))
+
+(member? 'beef '(meat and potatoes and beef)) ; #t
+(member? 'tofu ()) ; #f
+
+; {{ The First Commandment }}
+; When recurring on a list of atoms, lat, ask two questions about it:
+; (null? lat) and else.
+; When recurring on a number, n, ask two questions about it: (zero? n) and
+; else.
+; When recurring on a list of S-expressions, l, ask three questions about it: 
+; (null? l), (atom? (car l)), and else.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 03: Cons the Magnificent
+
+(define rember
+  (lambda (a lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? (car lat) a) (cdr lat))
+     (else (cons (car lat)
+		 (rember a (cdr lat)))))))
+
+(rember 'and '(peanut butter and jelly)) ; (peanut butter jelly)
+
+; {{ The Second Commandment }}
+; Use cons to build lists.
+
+; returns list of first elements off  each list in a list of lists ;)
+(define firsts
+  (lambda (l)
+    (cond
+     ((null? l) ())
+     (else (cons (car (car l)) (firsts (cdr l)))))))
+
+(firsts '((a b c) (1 2 3) (j k l))) ; (a 1 j)
+
+; {{ The Third Commandment }}
+; When building a list, describe the first typical element, and then
+; cons it onto the natural recursion.
+
+(define insertR
+  (lambda (new old lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? old (car lat)) (cons (car lat) (cons new (cdr lat))))
+     (else (cons (car lat) (insertR new old (cdr lat)))))))
+
+(insertR 'jalapeno 'and '(tacos tamales and salsa))
+; (tacos tamales and jalapeno salsa)
+
+(define insertL
+  (lambda (new old lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? old (car lat)) (cons new lat))
+     (else (cons (car lat) (insertL new old (cdr lat)))))))
+
+(insertL 'now 'please '(do it please)) ; (do it now please)
+
+(define subst
+  (lambda (new old lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? old (car lat)) (cons new (cdr lat)))
+     (else (cons (car lat) (subst new old (cdr lat)))))))
+
+(subst 'both 'and '(meat and potatoes)) ; (meat both potatoes)
+
+(define subst2
+  (lambda (new o1 o2 lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? o1 (car lat)) (cons new (cdr lat)))
+     ((eq? o2 (car lat)) (cons new (cdr lat)))
+     (else (cons (car lat) (subst2 new o1 o2 (cdr lat)))))))
+
+(subst2 'a 'q 'r '(a s d r q)) ; (a s d a q)
+(subst2 'a 'q 'r '(a s q d r)) ; (a s a d r)
+
+(define multirember
+  (lambda (a lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? (car lat) a) (multirember a (cdr lat)))
+     (else (cons (car lat) (multirember a (cdr lat)))))))
+
+(multirember 'd '(a d b d s g r c d d d w r)) ; (a b s g r c w r)
+
+; {{ The Fourth Commandment }}
+; Always change at least one argument while recurring. It must be changed to
+; be closer to termination. The changing argument must be tested in the
+; termination condition: when using cdr, test temrination with null?.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 04: Numbers Games
+
+(atom? 0) ; #t
+(atom? 3.123123132) ; #t
+(atom? -12i) ; #t
+
+(define add1
+  (lambda (n)
+    (+ n 1)))
+
+(add1 67)
+
+(define sub1
+  (lambda (n)
+    (- n 1)))
+
+(sub1 0) ; -1
+(sub1 -12i) ; -1-12i
+(sub1 +2i) ; -1+2i
+
+(zero? 2) ; #f
+
+; doesn't handle negatives!
+(define o+
+  (lambda (a b)
+    (cond
+     ((zero? b) a)
+     (else (o+ (add1 a) (sub1 b))))))
+
+(o+ 12 3)
+
+(define o-
+  (lambda (a b)
+    (cond
+     ((zero? b) a)
+     (else (o- (sub1 a) (sub1 b))))))
+
+(o- 12 3) ; 9
+(o- 10 25) ; -15
+;(o- 4 -1) ; infinite loop!
+
+(zero? ()) ; #f
+
+(define addtup
+  (lambda (tup)
+    (cond
+     ((null? tup) 0)
+     (else (o+ (car tup) (addtup (cdr tup)))))))
+
+(addtup '(1 1 1 1 1)) ; 5
+(addtup '()) ; 0
+
+(define ox
+  (lambda (a b)
+    (cond
+     ((zero? b) 0)
+     (else (o+ a (ox a (sub1 b)))))))
+
+(ox 4 4) ; 16
+;(ox 12983761498 12983472) ; max recursion depth exceeded ;(
+;(ox 39485 345) ; SLOW!
+
+; {{ The Fourth Commandment }}
+; Always change at least one argument while recurring. It must be changed to be
+; closer to termination. The changing argument must be tested in the 
+; termination condition: 
+; when using cdr, test termination with null? and
+; when using sub1, test termination with zero?.
+
+; {{ The Fifth Commandment }}
+; When building a value with +, always use 0 for the value of the terminating
+; line, for adding 0 does not change the value of an addition.
+; When building a value with x, always use 1 for the value of the terminating
+; line, for multiplying by 1 does not change the value of a multiplication.
+; When building a value with cons, always condsider () for the value of the
+; terminating line.
+
+(define tup+
+  (lambda (a b)
+    (cond
+     ((or (null? a) (null? b)) ())
+     (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b)))))))
+; the book uses 'and' instead of 'or' because it specifies the tups must
+; be of equal length
+
+(tup+ '(1 2 3 4 5) '(5 4 3 2 1)) ; (6 6 6 6 6)
+
+; improved version
+(define tup+
+  (lambda (a b)
+    (cond
+     ((and (null? a) (null? b)) (quote ()))
+     ((null? a) b)
+     ((null? b) a)
+     (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b)))))))
+
+(tup+ '(1 2 3 4 5) '(5 4)) ; (6 6 3 4 5)
+
+(define o> 
+  (lambda (a b)
+    (cond
+     ((zero? a) #f)
+     ((zero? b) #t)
+     (else (o> (sub1 a) (sub1 b))))))
+
+(o> 5 6) ; #t
+(o> 7 7) ; #f
+
+(define length
+  (lambda (lat)
+    (cond
+     ((null? lat) 0)
+     (else (add1 (length (cdr lat)))))))
+(length '(a b c d)) ; 4
+(length (quote ())) ; 0
+
+(define pick
+  (lambda (n lat)
+    (cond 
+     ((zero? (sub1 n)) (car lat))
+     (else (pick (sub1 n) (cdr lat))))))
+
+(define rempick
+  (lambda (n lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((zero? n) (cdr lat))
+     (else (cons (car lat) (rempick (sub1 n) (cdr lat)))))))
+
+(rempick 3 `(this sentance has like a billion words))
+
+(define no-nums
+  (lambda (lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((number? (car lat)) (no-nums (cdr lat)))
+     (else (cons (car lat) (no-nums (cdr lat)))))))
+
+(no-nums '(this 1 sentance has 56 other numbers 23 built-in))
+
+(define all-nums
+  (lambda (lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((number? (car lat)) (cons (car lat) (all-nums (cdr lat))))
+     (else (all-nums (cdr lat))))))
+
+(all-nums '(this 1 sentance has 56 other numbers 23 built-in))
+
+(define eqan?
+  (lambda (a b)
+    (cond
+     ((and (number? a) (number? b)) (= a b))
+     ((or (number? a) (number? b)) #f)
+     (else (eq? a b)))))
+
+(eq? 1 1) ; #t
+(eqan? 2 3) ; #f
+
+(define occur
+  (lambda (a lat)
+    (cond
+     ((null? lat) 0)
+     ((eq? a (car lat)) (add1 (occur a (cdr lat))))
+     (else (occur a (cdr lat))))))
+
+(occur 'n '(a n d that's all n folks!)) ; 2
+(occur 123 '(1 2 3 4)) ; 0
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 05: Oh My Gawd: It's full of Stars
+
+(define rember*
+  (lambda (a l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((eq? a (car l)) (cdr l))
+		       (else (cons (car l) (rember* a (cdr l))))))
+     (else (cons (rember* a (car l)) (rember* a (cdr l)))))))
+
+(rember* 'sauce '(((tomato sauce))
+		  ((bean) sauce)
+		  (and ((flying)) sauce)))
+
+(define insertR*
+  (lambda (new old l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((eq? old (car l)) (cons (car l) (cons new (cdr l))))
+		       (else (cons (car l) (insertR* new old (cdr l))))))
+     (else (cons (insertR* new old (car l)) (insertR* new old (cdr l)))))))
+
+(insertR* 'roast 'chuck '((how much (wood))
+			  could
+			  ((a (wood) chuck))
+			  (((chuck)))
+			  (if (a) ((wood chuck)))
+			  could chuck wood))
+
+(define occur*
+  (lambda (a l)
+    (cond
+     ((null? l) 0)
+     ((atom? (car l)) (cond 
+		       ((eq? (car l) a) (add1 (occur* a (cdr l))))
+		       (else (occur* a (cdr l)))))
+     (else (o+ (occur* a (car l)) (occur* a (cdr l)))))))
+
+(occur* 'banana '((banana)
+		  (split ((((banana ice)))
+			  (cream (banana))
+			  sherbet))
+		  (banana)
+		  (bread)
+		  (banana brandy)))
+
+(define subst*
+  (lambda (new old l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((eq? old (car l)) (cons new (subst* new old (cdr l))))
+		       (else (cons (car l) (subst* new old (cdr l))))))
+     (else (cons (subst* new old (car l)) (subst* new old (cdr l)))))))
+
+(subst* 'orange 'banana '((banana)
+			  (split ((((banana ice)))
+				  (cream (banana))
+				  sherbet))
+			  (banana)
+			  (bread)
+			  (banana brandy)))
+
+(define insertL*
+  (lambda (new old l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((eq? old (car l)) 
+			(cons new (cons
+				   (car l)
+				   (insertL* new old (cdr l)))))
+		       (else (cons (car l) (insertL* new old (cdr l))))))
+     (else (cons (insertL* new old (car l)) (insertL* new old (cdr l)))))))
+
+(insertL* 'pecker 'chuck '((how much (wood))
+			   could
+			   ((a (wood) chuck))
+			   (((chuck)))
+			   (id (a) ((wood chuck)))
+			   could chuck wood))
+
+(define member*
+  (lambda (a l)
+    (cond
+     ((null? l) #f)
+     ((atom? (car l)) (cond
+		       ((eq? a (car l)) #t)
+		       (else (member* a (cdr l)))))
+     (else (or (member* a (car l)) (member* a (cdr l)))))))
+
+(member* 'chips '((potato (chips ((with) fish) (chips))))) ; #t
+(member* 'beef '(meat ((and potatoes)) (with brocolli))) ; #f
+
+; list must not contain null list!
+(define leftmost
+  (lambda (l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (car l))
+     (else (leftmost (car l))))))
+
+(leftmost '(((hot) (tuna (and))) cheese))
+
+(define eqlist?
+  (lambda (a b)
+    (cond
+     ((and (null? a) (null? b)) #t)
+     ((or (null? a) (null? b)) #f)
+     ((and (atom? (car a)) (atom? (car b))) 
+      (and (eqan? (car a) (car b))
+	   (and (eqlist? (cdr a) (cdr b)))))
+     ((or (atom? (car a)) (atom? (car b))) #f)
+     (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b)))))))
+
+(eqlist?
+ '(beef ((sausage)) (and (soda)))
+ '(beef ((sausage)) (and (soda)))) ; #t
+
+(eqlist?
+ '(beef ((sausag)) (and (soda)))
+ '(beef ((sausage)) (and))) ; #f
+
+(eqlist? '(ff (1 2) (a)) '(ff (1 2) (b))) ; #f
+
+(eqan? 'sausag 'sausage) ; #f
+
+; new definition allows removal of S-expressions
+(define rember
+  (lambda (s l)
+    (cond 
+     ((null? l) (quote ()))
+     ((equal? s (car l)) (cdr l))
+     (else (cons (car l) (rember s (cdr l)))))))
+
+; these next two I just copied after the fact, didn't think I would
+; need them at the time
+(define equal?
+  (lambda (a b)
+    (cond
+     ((and (atom? a) (atom? b)) (eqan? a b))
+     ((or (atom? a) (atom? b)) #f)
+     (else (eqlist? a b)))))
+
+(equal? '(this ((is more) complicated))
+	'(this ((is more) complicated))) ; #t
+(equal? '(this ((is more) complicated))
+	'(this ((is) complicated))) ; #f
+(equal? '4' '(4 5)) ; #f
+
+(define rember
+  (lambda (s l)
+    (cond
+     ((null? l) (quote ()))
+     ((equal? (car l) s) (cdr l))
+     (else (cons (car l) (rember s (cdr l)))))))
+
+(rember 'q '(a b e d q))
+(rember '4 '(1 2 3 (4 5) 8))
+(rember '(4 5) '(1 2 3 (4 5) 6 7 8))
+
+; {{ The Sixth Commandment }}
+; Simplify only after the function is correct.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 06: Shadows
+
+(define numbered?
+  (lambda (aexp)
+    (cond
+     ((null? aexp) #f)
+     ((atom? aexp) (number? aexp))
+     ((or (eq? (car (cdr aexp)) (quote +))
+	  (eq? (car (cdr aexp)) (quote -))
+	  (eq? (car (cdr aexp)) (quote ^)))
+      (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
+     (else #f))))
+
+(numbered? '(1 + 3)) ; #t
+(numbered? '((4 ^ 3) - 4)) ; #t
+(numbered? '(a + 2 + (r ^ 2))) ; #f
+(numbered? '(1 _ 3 + 5 + Q)) ; #f
+(numbered? '(1 + 4 ^ 8 + r)) ; #t???? should only have two expressions
+(numbered? '((1 + 4) ^ (8 + r))) ; #f
+
+;book likes to make assumptions, namely that aexp is definately an algebraic
+;expression
+(define numbered?
+  (lambda (aexp)
+    (cond
+     ((atom? aexp) (number? aexp))
+     (else (and (numbered? (car aexp))
+		(numbered? (car (cdr (cdr aexp)))))))))
+
+(numbered? '1)
+(numbered? '(1 + 1))
+
+
+(define value
+  (lambda (aexp)
+    (cond
+     ((atom? aexp) aexp)
+     ((eq? (car (cdr aexp)) (quote +)) (+ (value (car aexp))
+					  (value (car (cdr (cdr aexp))))))
+     ((eq? (car (cdr aexp)) (quote -)) (- (value (car aexp))
+					  (value (car (cdr (cdr aexp))))))
+     ((eq? (car (cdr aexp)) (quote ^)) 
+      (expt (value (car aexp))
+	    (value (car (cdr (cdr aexp)))))))))
+
+(value '(1 + 1))
+(value '(3 ^ 3))
+(value '(5 - (2 ^ 2))) 
+
+(define 1st-sub-exp
+  (lambda (aexp)
+    (car aexp)))
+
+(define 2nd-sub-exp
+  (lambda (aexp)
+    (car (cdr (cdr aexp)))))
+
+(define operator
+  (lambda (aexp)
+    (car (cdr aexp))))
+
+; {{ The Seventh Commandment }}
+; Recur on the subpart that are of the same nature:
+; * on the sublists of a list.
+; * on the subexpressions of an arthmetic expression.
+
+; {{ The Eighth Commandment }}
+; Use help functions to abstract from representations.
+
+(define sero?
+  (lambda (n)
+    (null? n)))
+
+(sero? '()) ; #t
+(sero? '(() ())) ; #f
+
+(define edd1
+  (lambda (n)
+    (cons (quote ()) n)))
+
+(define zub1
+  (lambda (n)
+    (cdr n)))
+
+;(define o+
+;  (lambda (n m)
+;    (cond
+;     ((sero? m) n)
+;     (else (edd1 (o+ n (zub1 m)))))))
+
+;(o+ '(() ()) '(() () ())) ; (() () () () ())
+
+;(lat? (() () () () ())) ; error!
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 07: Friends and Relations
+
+(define set?
+  (lambda (lat)
+    (cond
+     ((null? lat) #t)
+     ((member? (car lat) (cdr lat)) #f)
+     (else (set? (cdr lat))))))
+
+(set? '(this is a sentance with no repeats)) ; #t
+(set? '()) ; #t
+(set? '(this is a sentance with repeats, so this is not a set)); #f
+
+(define makeset
+  (lambda (lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
+     (else (cons (car lat) (makeset (cdr lat)))))))
+
+(makeset '(a b c b c c c d e f))
+
+; is every element of the first in the second?
+(define subset?
+  (lambda (a b)
+    (cond
+     ((null? a) #t)
+     ((member? (car a) b) (subset? (cdr a) b))
+     (else #f))))
+
+(subset? '() '(1 2 3)) ; #t
+(subset? '(a b c) '(1 4 b 6 c 1 a)) ; #t
+(subset? '(a b c) '(1 4 b 6 1 a)) ; #f
+
+(define eqset?
+  (lambda (a b)
+    (and (subset? a b) (subset? b a))))
+
+(eqset? '(1 2 3 4) '(3 4 1 2)) ; #t
+(eqset? '(1 2 3 4 5) '(3 4 1 2)) ; #f
+
+(define intersect? 
+  (lambda (a b)
+    (cond
+     ((null? a) #f)
+     (else (or (member? (car a) b) (intersect? (cdr a) b))))))
+
+(intersect? '(a b c) '(1 2 3)) ; #f
+(intersect? '(a B c) '(1 2 3 B 5)) ; #t
+
+(define intersect
+  (lambda (a b)
+    (cond
+     ((null? a) (quote ()))
+     ((member? (car a) b) (cons (car a) (intersect (cdr a) b)))
+     (else (intersect (cdr a) b)))))
+
+(intersect '(a b c) '(1 2 3)) ; ()
+(intersect '(a b c) '(1 b c 4 5)) ; (b c)
+
+(define union
+  (lambda (a b)
+    (cond
+     ((null? a) b)
+     ((member? (car a) b) (union (cdr a) b))
+     (else (union (cdr a) (cons (car a) b))))))
+
+(union '(a b c) '(1 2 3))
+(union '(a b c) '(a b 3))
+
+(define intersectall 
+  (lambda (l-set)
+    (cond
+     ((null? (cdr l-set)) (car l-set))
+     (else (intersect (car l-set) (intersectall (cdr l-set)))))))
+
+(intersectall '((a b c) (c a d e) (e f g h a b))) ; (a)
+
+(define a-pair?
+  (lambda (x)
+    (cond
+     ((null? x) #f)
+     ((atom? x) #f)
+     ((null? (cdr x)) #f)
+     ((null? (cdr (cdr x))) #t)
+     (else #f))))
+
+(define first
+  (lambda (p) (car p)))
+
+(define second 
+  (lambda (p) (car (cdr p))))
+
+(define build
+  (lambda (a b) (cons a (cons b (quote ())))))
+
+(define third
+  (lambda (p) (car (cdr (cdr p)))))
+
+; a rel is a relation: a list of pairs
+
+(firsts '((a b) (c d) (e f))) ; # (a c e), from an earlier chapter
+
+(define fun?
+  (lambda (rel)
+    (set? (firsts rel))))
+
+(define revrel
+  (lambda (rel)
+    (cond
+     ((null? rel) (quote ()))
+     (else (cons (build (second (car rel)) (first (car rel)))
+		 (revrel (cdr rel)))))))
+
+(revrel '((a b) (1 2) (here there)))
+
+(define revpair
+  (lambda (p)
+    (build (second p) (first p))))
+
+(define revrel
+  (lambda (rel)
+    (cond
+     ((null? rel) (quote ()))
+     (else (cons (revpair (car rel)) (revrel (cdr rel)))))))
+
+(define fullfun?
+  (lambda (fun)
+    (set? (seconds fun))))
+
+(define one-to-one?
+  (lambda (fun)
+    (fun? (revrel fun))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 08: Lambda the Ultimate
+
+(define rember-f
+  (lambda (test? a l)
+    (cond
+     ((null? l) (quote ()))
+     ((test? a (car l)) (rember-f test? a (cdr l)))
+     (else (cons (car l) (rember-f test? a (cdr l)))))))
+
+(rember-f equal? '(pop corn) '(lemonade (pop corn) and (cake)))
+
+; Currying: Moses Schonfinkel and Haskell Curry
+
+(define eq?-c
+  (lambda (a)
+    (lambda (x)
+      (eq? x a))))
+
+((eq?-c 'salad) 'salad) ; #t
+(define eq?-salad (eq?-c 'salad))
+(eq?-salad 'salad) ; #t
+
+(define rember-f
+  (lambda (test?)
+    (lambda (a l)
+      (cond
+       ((null? l) (quote ()))
+       ((test? a (car l)) ((rember-f test?) a (cdr l)))
+       (else (cons (car l) ((rember-f test?) a (cdr l))))))))
+
+(define rember-eq? (rember-f eq?))
+(rember-eq? 'tuna '(tuna salad is good))
+
+(define insertL-f
+  (lambda (test?)
+    (lambda (new old l)
+      (cond
+       ((null? l) (quote ()))
+       ((test? (car l) old)
+	(cons new (cons old (cdr l))))
+       (else (cons (car l)
+		   ((insertL-f test?) new old (cdr l))))))))
+
+(define seqL
+  (lambda (new old l)
+    (cons new (cons old l))))
+
+(define seqR
+  (lambda (new old l)
+    (cons old (cons new l))))
+
+(define insert-g
+  (lambda (seq)
+    (lambda (new old l)
+      (cond
+       ((null? l) (quote ()))
+       ((eq? (car l) old) (seq new old (cdr l)))
+       (else (cons (car l) ((insert-g seq) new old (cdr l))))))))
+
+(define insertL (insert-g seqL))
+(define insertR (insert-g seqR))
+(define insertL (insert-g
+		 (lambda (new old l)
+		   (cons new (cons old l)))))
+
+(insertL 'BUT 'then '(where but for the end then))
+
+(define seqS
+  (lambda (new old l) (cons new l)))
+
+(define subst (insert-g seqS))
+
+(subst 'both 'and '(meat and potatoes))
+
+; {{ The Ninth Commandment }}
+; Abstract common patterns with a new function.
+
+(define atom-to-function
+  (lambda (x)
+    (cond
+     ((eq? x (quote +)) +)
+     ((eq? x (quote x)) ox)
+     (else expt))))
+
+(expt 4 4) ; 256
+(+ 4 4) ; 8
+(ox 4 4)
+(o+ 4 4)
+
+(atom-to-function (operator '(+ 5 3))) ; plus function
+
+(define value
+  (lambda (nexp)
+    (cond
+     ((atom? nexp) nexp)
+     (else
+      ((atom-to-function (operator nexp))
+       (value (1st-sub-exp nexp))
+       (value (2nd-sub-exp nexp)))))))
+
+(value '(4 + 2))
+
+(define multirember-f
+  (lambda (test?)
+    (lambda (a lat)
+      (cond
+       ((null? lat) (quote ()))
+       ((test? a (car lat)) ((multirember-f test?) a (cdr lat)))
+       (else (cons (car lat) ((multirember-f test?) a (cdr lat))))))))
+
+((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna))
+
+(define eq?-tuna (eq?-c (quote tuna)))
+(eq?-tuna (quote tuna)) ; #t
+
+(define multiremberT
+  (lambda (test? lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((test? (car lat)) (multiremberT test? (cdr lat)))
+     (else (cons (car lat) (multiremberT test? (cdr lat)))))))
+
+(multiremberT eq?-tuna '(shrimp salad tuna salad and tuna))
+
+(define a-friend
+  (lambda (x y)
+    (null? y)))
+
+; col is a collector
+
+(define multirember&co
+  (lambda (a lat col)
+    (cond
+     ((null? lat) (col (quote ()) (quote ())))
+     ((eq? (car lat) a) (multirember&co 
+			 a 
+			 (cdr lat)
+			 (lambda (newlat seen)
+			   (col newlat (cons (car lat) seen)))))
+     (else (multirember&co a (cdr lat) 
+			   (lambda (newlat seen)
+			     (col (cons (car lat) newlat) seen)))))))
+
+(define new-friend
+  (lambda (newlat seen)
+    (a-friend newlat (cons (quote tuna) seen))))
+
+; {{ The Tenth Commandment }}
+; Build functions to collect more than one value at a time.
+
+(define multiinsertL
+  (lambda (new old lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? (car lat) old) (cons new
+				(multiinsertL new old (cdr lat))))
+     (else (cons (car lat) (multiinsertL new old (cdr lat)))))))
+
+(define multiinsertR
+  (lambda (new old lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? (car lat) old) (cons new
+				(multiinsertR new old (cdr lat))))
+     (else (cons (car lat) (multiinsertR new old (cdr lat)))))))
+
+(define multiinsertLR
+  (lambda (new oldL oldR lat)
+    (cond
+     ((null? lat) (quote ()))
+     ((eq? (car lat) oldL) 
+      (cons new (cons oldL
+		      (multiinsertLR new oldL oldR (cdr lat)))))
+     ((eq? (car lat) oldR)
+      (cons new (multiinsertLR new oldL oldR (cdr lat))))
+     (else (cons (car lat) (multiinsertLR new oldL oldR (cdr lat)))))))
+
+(define multiinsertLR&co
+ (lambda (new oldL oldR lat col)
+   (cond
+    ((null? lat) (col (quote ()) 0 0))
+    ((eq? (car lat) oldL) 
+     (multiinsertLR&co new oldL oldR (cdr lat)
+		       (lambda (newlat L R)
+			 (col (cons new
+				    (cons oldL newlat)) (add1 L) R))))
+    ((eq? (car lat) oldR)
+     (multiinsertLR&co new oldL oldR (cdr lat)
+		       (lambda (newlat L R)
+			 (col (cons oldR (cons new newlat)) L (add1 R)))))
+    (else (multiinsertLR&co new oldL oldR
+			    (cdr lat)
+			    (lambda (newlat L R)
+			      (col (cons (car lat) newlat)
+				   L R)))))))
+
+(multiinsertLR&co 'salty 'fish 'chips
+		  '(chips and fish or fish and chips)
+		  (lambda (lat L R)
+		    R)) ; 2
+
+(multiinsertLR&co 'salty 'fish 'chips
+		  '(chips and fish or fish and chips)
+		  (lambda (lat L R)
+		    lat))
+
+(define even?
+  (lambda (n)
+    (= (* (round (/ n 2)) 2) n)))
+
+(round 3/2) ; 2
+(= 1 1) ; #t
+(/ 4 2) ; 2
+(* 4 2) ; 8
+(even? 3) ; #f
+
+(define evens-only*
+  (lambda (l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((even? (car l)) (cons (car l) 
+					      (evens-only* (cdr l))))
+		       (else (evens-only* (cdr l)))))
+     (else (cons (evens-only* (car l)) (evens-only* (cdr l)))))))
+
+(evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2))
+; ((2 8) 10 (() 6) 2)
+
+(define col-odds
+  (lambda (l p s) l))
+
+(define col-p
+  (lambda (l p s) p))
+
+(define col-s
+  (lambda (l p s) s))
+
+(define evens-only*&co
+  (lambda (l col)
+    (cond
+     ((null? l) (col (quote ()) 1 0))
+     ((atom? (car l)) 
+      (cond
+       ((even? (car l)) (evens-only*&co (cdr l)
+					(lambda (newl p s)
+					  (col (cons (car l) newl)
+					       (* p (car l))
+					       s))))
+       (else (evens-only*&co (cdr l)
+			     (lambda (newl p s)
+			       (col newl
+				    p
+				    (+ s (car l))))))))
+     (else
+      (evens-only*&co (car l)
+		      (lambda (al ap as)
+			(evens-only*&co (cdr l)
+					(lambda (dl dp ds)
+					  (col (cons al dl)
+					       (* ap dp)
+					       (+ as ds))))))))))
+
+(evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2)
+		(lambda (newl p s)
+		  (cons s (cons p newl)))) ; (38 1920 (2 8) 10 (() 6) 2)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 09: ... and Again, and Again, and Again, ...
+
+(define looking
+  (lambda (a lat)
+    (keep-looking a (pick 1 lat) lat)))
+
+; sorn is a symbol or a number
+
+(define keep-looking
+  (lambda (a sorn lat)
+    (cond
+     ((number? sorn) (keep-looking a (pick sorn lat) lat))
+     (else (eq? sorn a)))))
+
+(looking 'caviar '(6 2 4 caviar 5 7 3)) ; #t
+(looking 'caviar '(6 2 grits caviar 5 7 3)) ; #f
+
+; total functions terminate for all finite inputs?
+; partial functions terminate for only some inputs?
+
+(define shift
+  (lambda (pair)
+    (build (first (first pair))
+	   (build (second (first pair))
+		  (second pair)))))
+
+(shift '((a b) c)); (a (b c))
+;(shift '(a (b c))); error
+
+; pora = pair or atom
+(define align
+  (lambda (pora)
+    (cond
+     ((atom? pora) pora)
+     ((a-pair? (first pora)) (align (shift pora)))
+     (else (build (first pora) (align (second pora)))))))
+
+(define length*
+  (lambda (pora)
+    (cond
+     ((atom? pora) l)
+     (else (length* (first pora)) (length* (second pora))))))
+
+(define weight*
+  (lambda (pora)
+    (cond
+     ((atom? pora) 1)
+     (else (+ (* 2 (weight* (first pora)))
+	      (weight* (second pora)))))))
+
+(weight* '((a b) c)) ; 7
+(weight* '(a (b c))) ; 5
+
+(define shuffle
+  (lambda (pora)
+    (cond
+     ((atom? pora) pora)
+     ((a-pair? (first pora)) (shuffle (revpair pora)))
+     (else (build (first pora) (shuffle (second pora)))))))
+
+(shuffle '(a b)) ; (a b)
+; (shuffle '((a b) (c d))) ; infinite recursion
+
+; Collatz function?
+(define C
+  (lambda (n)
+    (cond
+     ((one? n) 1)
+     (else (cond
+	    ((even? n) (C (/ n 2)))
+	    (else (C (add1 (* 3 n)))))))))
+
+; (C 0) ; infinite recursion?
+(C 1) ; 1
+(C 2) ; 1
+(C 8) ; 1
+
+; Ackermann function
+(define A
+  (lambda (n m)
+    (cond
+     ((zero? n) (add1 m))
+     ((zero? m) (A (sub1 n) 1))
+     (else (A (sub1 n) (A n (sub1 m)))))))
+
+(A 1 0) ; 2
+(A 2 2) ; 7
+(A 3 3) ; 61
+(A 3 4) ; 125
+; (A 4 3) ; ocean boiling?
+
+(define eternity
+  (lambda (x) (eternity x)))
+
+; got lost here a bit...
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 10: What is the Value of All of This?
+
+(define new-entry build)
+
+(define lookup-in-entry
+  (lambda (name entry entry-f)
+    (lookup-in-entry-help name
+			  (first entry)
+			  (second entry)
+			  entry-f)))
+
+(define lookup-in-entry-help
+  (lambda (name names values entry-f)
+    (cond
+     ((null? names) (entry-f name))
+     ((eq? (car names) name) (car values))
+     (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f)))))
+
+(lookup-in-entry 'fish
+		 '((teach a man to fish)
+		   (1 2 3 4 5))
+		 (lambda (x) x))
+
+(define extend-table cons)
+
+(define lookup-in-table
+  (lambda (name table table-f)
+    (cond
+     ((null? table) (table-f name))
+     (else (lookup-in-entry name 
+			    (car table)
+			    (lambda (n)
+			      (lookup-in-table n (cdr table) table-f)))))))
+
+(lookup-in-table 'fish
+		 (extend-table '((teach a man to fish)
+				 (1 2 3 4 5))
+			       (quote ()))
+		 (lambda (x) x))
+
+(define atom-to-action
+  (lambda (e)
+    (cond
+     ((number? e) *const)
+     ((eq? e #t) *const)
+     ((eq? e #f) *const)
+     ((eq? e (quote cons)) *const)
+     ((eq? e (quote car)) *const)
+     ((eq? e (quote cdr)) *const)
+     ((eq? e (quote null?)) *const)
+     ((eq? e (quote eq?)) *const)
+     ((eq? e (quote atom?)) *const)
+     ((eq? e (quote zero?)) *const)
+     ((eq? e (quote add1)) *const)
+     ((eq? e (quote sub1)) *const)
+     ((eq? e (quote number?)) *const)
+     (else *identifier))))
+
+(atom-to-action 'number?); *const
+
+(define list-to-action
+  (lambda (e)
+    (cond
+     ((atom? (car e)) (cond
+		       ((eq? (car e) (quote quote)) *quote)
+		       ((eq? (car e) (quote lambda)) *lambda)
+		       ((eq? (car e) (quote cond)) *cond)
+		       (else *application)))
+     (else *application))))
+
+(list-to-action '(lambda (x) x)) ; *lambda
+(list-to-action '(cond ((eq? 1 2) #f) (else #t))) ; *cond
+
+(define expression-to-action
+  (lambda (e)
+    (cond
+     ((atom? e) (atom-to-action e))
+     (else (list-to-action e)))))
+
+(expression-to-action '#f) ; *const
+(expression-to-action '(lambda (x) x)) ; *lambda
+
+(define value
+  (lambda (e)
+    (meaning e (quote ()))))
+
+(define meaning
+  (lambda (e table)
+    ((expression-to-action e) e table)))
+
+(define *const
+  (lambda (e table)
+    (cond
+     ((number? e) e)
+     ((eq? e #t) #t)
+     ((eq? e #f) #f)
+     (else (build (quote primitive) e)))))
+
+(*const 'asdf '()) ; (primitive asdf)
+
+(define *quote
+  (lambda (e table)
+    (text-of e)))
+
+(define text-of second)
+
+(*quote '(quote stuff) '()) ; stuff
+
+(define *identifier
+  (lambda (e table)
+    (lookup-in-table e table initial-table)))
+
+; this will pass an error if called
+(define initial-table
+  (lambda (name)
+    (car (quote ()))))
+
+;(*identifier 'asdf '()) ; error
+(*identifier 'a '( ((1 2 3 a b c) (first second third 1 2 3)))) ; 1
+
+(define *lambda
+  (lambda (e table)
+    (build (quote non-primitive) (cons table (cdr e)))))
+
+(*lambda '(lambda (a b) (cond ((eq? a b) b) (else a))) '( ((1 2 3) (a b c))))
+
+(meaning '(lambda (x) (cons x y)) '(((y z) ((8) 9))))
+; (non-primative ((((y z) ((8) 9)))) (x) (cons x y))
+
+(define table-of first)
+(define formals-of second)
+(define body-of third)
+(third '(a b c)) ; c
+
+(define evcon
+  (lambda (lines table)
+    (cond
+     ((else? (question-of (car lines)))
+      (meaning (answer-of (car lines)) table))
+     ((meaning (question-of (car lines)) table)
+      (meaning (answer-of (car lines)) table))
+     (else (evcon (cdr lines) table)))))
+
+(define else?
+  (lambda (x)
+    (cond
+     ((atom? x) (eq? x (quote else)))
+     (else #f))))
+
+(define question-of first)
+(define answer-of second)
+
+(define *cond
+  (lambda (e table)
+    (evcon (cond-lines-of e) table)))
+
+(define cond-lines-of cdr)
+
+(define evlis
+  (lambda (args table)
+    (cond
+     ((null? args) (quote ()))
+     (else (cons (meaning (car args) table)
+		 (evlis (cdr args) table))))))
+
+(evlis '(cons #f 4) '()) ; ((primitive cons) #f 4)
+
+(define function-of car)
+(define arguments-of cdr)
+
+(define *application
+  (lambda (e table)
+    (apply
+     (meaning (function-of e) table)
+     (evlis (arguments-of e) table))))
+
+(define primitive?
+  (lambda (l)
+    (eq? (first l) (quote primitive))))
+
+(define non-primitive?
+  (lambda (l)
+    (eq? (first l) (quote non-primitive))))
+
+(define apply
+  (lambda (fun vals)
+    (cond
+     ((primitive? fun) (apply-primitive (second fun) vals))
+     ((non-primitive? fun) (apply-closure (second fun) vals)))))
+
+(define apply-primitive
+  (lambda (name vals)
+    (cond
+     ((eq? name (quote cons)) (cons (first vals) (second vals)))
+     ((eq? name (quote car)) (car (first vals)))
+     ((eq? name (quote cdr)) (cdr (first vals)))
+     ((eq? name (quote null?)) (null? (first vals)))
+     ((eq? name (quote eq?)) (eq? (first vals) (second vals)))
+     ((eq? name (quote atom?)) (:atom? (first vals)))
+     ((eq? name (quote zero?)) (zero? (first vals)))
+     ((eq? name (quote add1)) (add1 (first vals)))
+     ((eq? name (quote sub1)) (sub1 (first vals)))
+     ((eq? name (quote number?)) (number? (first vals))))))
+
+(first '(a b))
+(apply-primitive 'null? '(())) ; #t
+(*application '(null? 2) '()) ; #f
+(*application '(cdr (quote (a b))) '()) ; (b)
+(*application '(eq? 2 (add1 1)) '()) ; #t
+
+(define :atom?
+  (lambda (x)
+    (cond
+     ((atom? x) #t)
+     ((null? x) #f)
+     ((eq? (car x) (quote primitive)) #t)
+     ((eq? (car x) (quote non-primitive)) #t)
+     (else #f))))
+
+(define apply-closure
+  (lambda (closure vals)
+    (meaning (body-of closure)
+	     (extend-table (new-entry (formals-of closure) vals)
+			   (table-of closure)))))
+
+(value '(zero? 0))
+(value '(eq? 1 1))
+(value '#f) ; #f
+(value '(eq? 2 (add1 1))) ; #t
+
+(value '((lambda (a b) (a (add1 b))) (lambda (c) (add1 c)) 4)) ; 6
+
+(value '((lambda (x) x) 1)) ; 1
+
+;wheeee!
\ No newline at end of file
diff --git a/seasoned_schemer.scm b/seasoned_schemer.scm
new file mode 100644
index 0000000..50d882d
--- /dev/null
+++ b/seasoned_schemer.scm
@@ -0,0 +1,640 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Play-along log to The Seasoned Schemer by Friedman and Felleisen
+; Jan 2008, bryan newbold
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Preface: define and test primative
+
+(define atom?
+  (lambda (x)
+    (and (not (pair? x)) (not (null? x)))))
+
+(atom? (quote ()))
+
+(define add1
+  (lambda (n)
+    (+ 1 n)))
+
+(add1 6) ; 7
+
+(define sub1
+  (lambda (n)
+    (- n 1)))
+
+(sub1 7) ; 6
+
+; kind of guessing here
+(define Y
+  (lambda (thing)
+    ((lambda (le)
+       ((lambda (f) (f f))
+	(lambda (f) (le (lambda (x) ((f f) x))))))
+     thing)))
+
+(define eqlist?
+  (lambda (a b)
+    (cond
+     ((and (null? a) (null? b)) #t)
+     ((or (null? a) (null? b)) #f)
+     ((and (atom? (car a)) (atom? (car b)))
+	   (and (eqlist? (cdr a) (cdr b))))
+     ((or (atom? (car a)) (atom? (car b))) #f)
+     (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b)))))))
+
+(eqlist? '(((this) is (a)) nontrivial (list))
+	 '(((this) is (a)) nontrivial (list))) ; #t
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 01: Welsome Back to the Show
+
+(define member?
+  (lambda (a lat)
+    (cond
+     ((null? lat) #f)
+     (else (or (eq? a (car lat))
+	       (member? a (cdr lat)))))))
+
+(member? 'a '(1 2 a b c)) ; #t
+
+(define two-in-a-row?
+  (lambda (lat)
+    (cond
+     ((null? lat) #f)
+     (else (is-first-b? (car lat) (cdr lat))))))
+
+(define is-first-b?
+  (lambda (a lat)
+    (cond
+     ((null? lat) #f)
+     (else (or (eq? a (car lat)) (two-in-a-row? lat))))))
+
+(is-first-b? 'a '(a b)) ; #t
+(two-in-a-row? '(this sentance doesn't have that)) ; #f
+(two-in-a-row? '(but this one does right right right)) ; #t
+
+(define two-in-a-row-b?
+  (lambda (a lat)
+    (cond
+     ((null? lat) #f)
+     (else (or (eq? a (car lat)) (two-in-a-row-b? (car lat) (cdr lat)))))))
+
+(define two-in-a-row?
+  (lambda (lat)
+    (cond
+     ((null? lat) #f)
+     (else (two-in-a-row-b? (car lat) (cdr lat))))))
+
+(define sum-of-prefixes-b
+  (lambda (sonssf tup)
+    (cond
+     ((null? tup) (quote ()))
+     (else (cons (+ sonssf (car tup))
+		 (sum-of-prefixes-b (+ sonssf (car tup)) (cdr tup)))))))
+
+(define sum-of-prefixes
+  (lambda (tup)
+    (sum-of-prefixes-b 0 tup)))
+
+(sum-of-prefixes '(1 1 1 1)) ; (1 2 3 4)
+
+;;; {{ The Eleventh Commandment }}
+;;; Use additional arguments when a function needs to know what other 
+;;; arguments to the function have been like so far.
+
+(define pick
+  (lambda (n lat)
+    (cond
+     ((one? n) (car lat))
+     (else (pick (sub1 n) (cdr lat))))))
+
+(pick 5 '(a b c d e f g h)) ; e
+
+(define scramble-b
+  (lambda (tup rev-pre)
+    (cond
+     ((null? tup) (quote ()))
+     (else
+      (cons (pick (car tup) (cons (car tup) rev-pre))
+	    (scramble-b (cdr tup) (cons (car tup) rev-pre)))))))
+
+(define scramble
+  (lambda (tup)
+    (scramble-b tup (quote ()))))
+
+(scramble '(1 1 1 3 4 2 1 1 9 2)) ; (1 1 1 1 1 4 1 1 1 9)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 12: Take Cover
+
+(define multirember
+  (lambda (a lat)
+    ((Y (lambda (mr)
+	  (lambda (lat)
+	    (cond
+	     ((null? lat) (quote ()))
+	     ((eq? a (car lat)) (mr (cdr lat)))
+	     (else (cons (car lat) (mr (cdr lat))))))))
+     lat)))
+
+(multirember 'pie '(apple pie other pie what kind of pi?))
+
+(define multirember
+  (lambda (a lat)
+    ((letrec
+	 ((mr (lambda (lat)
+		(cond
+		 ((null? lat) (quote ()))
+		 ((eq? a (car lat))
+		  (mr (cdr lat)))
+		 (else (cons (car lat)
+			     (mr (cdr lat))))))))
+       mr)
+     lat)))
+
+(define multirember
+  (lambda (a lat)
+    (letrec
+	((mr (lambda (lat)
+	       (cond
+		((null? lat) (quote ()))
+		((eq? a (car lat))
+		 (mr (cdr lat)))
+		(else (cons (car lat)
+			    (mr (cdr lat))))))))
+      (mr lat))))
+
+; {{ The Twelfth Commandment }}
+; Use (letrec ..) to remove arguments that do not change for 
+; recursive applications.
+
+(define rember-f
+  (lambda (test?)
+    (lambda (a l)
+      (cond
+       ((null? l) (quote ()))
+       ((test? (car l) a) (cdr l))
+       (else (cons (car l)
+		   ((rember-f test?) a (cdr l))))))))
+
+(define rember-eq? (rember-f eq?))
+
+(define multirember-f
+  (lambda (test?)
+    (letrec ((m-f (lambda (a lat)
+		    (cond
+		     ((null? lat) (quote ()))
+		     ((test? (car lat) a) (m-f a (cdr lat)))
+		     (else (cons (car lat)
+				 (m-f a (cdr lat))))))))
+      m-f)))
+
+(define member?
+  (lambda (a lat)
+    (letrec
+	((yes? (lambda (l)
+		 (cond
+		  ((null? l) #f)
+		  ((eq? (car l) a) #t)
+		  (else (yes? (cdr l)))))))
+      (yes? lat))))
+
+(member? 'a '(1 2 3 a b)) ; #t
+(member? 'a '(1 2 3 b)) ; #f
+
+(define union
+  (lambda (a b)
+    (cond
+     ((null? b) a)
+     ((member? (car b) a) (union a (cdr b)))
+     (else (union (cons (car b) a) (cdr b))))))
+
+(union '(tomatoes and macaroni casserole) '(macaroni and cheese))
+
+(define union
+  (lambda (a b)
+    (letrec
+	((U (lambda (s)
+	      (cond
+	       ((null? s) b)
+	       ((member? (car s) b) (U (cdr s)))
+	       (else (cons (car s) (U (cdr s))))))))
+      (U a))))
+
+; if member? had the order of its parameters swapped union would no longer work
+
+(define union
+  (lambda (a b)
+    (letrec
+	((U (lambda (s)
+	      (cond
+	       ((null? s) b)
+	       ((member? (car s) b) (U (cdr s)))
+	       (else (cons (car s) (U (cdr s)))))))
+	 (member? (lambda (a lat)
+		    (cond
+		     ((null? lat) #f)
+		     ((eq? a (car lat)) #t)
+		     (else (member? a (cdr lat)))))))
+      (U a))))
+
+; {{ The Thirteenth Commandment }}
+; Use (letrec ...) to hide and protect functions.
+
+(define union
+  (lambda (a b)
+    (letrec
+	((U (lambda (s)
+	      (cond
+	       ((null? s) b)
+	       ((M? (car s) b) (U (cdr s)))
+	       (else (cons (car s) (U (cdr s)))))))
+	 (M? (lambda (x y)
+	       (letrec
+		   ((N? (lambda (lat)
+			  (cond
+			   ((null? lat) #f)
+			   ((eq? x (car lat)) #t)
+			   (else (member? x (cdr lat)))))))
+		 (N? y)))))
+      (U a))))
+
+(define two-in-a-row?
+  (letrec
+      ((W (lambda (a lat)
+	    (cond 
+	     ((null? lat) #f)
+	     (else (or (eq? (car lat) a)
+		       (W (car lat)
+			  (cdr lat))))))))
+    (lambda (lat)
+      (cond
+       ((null? lat) #f)
+       (else (W (car lat) (cdr lat)))))))
+
+(two-in-a-row? '(are there two in a row here)) ; #f
+(two-in-a-row? '(what about around around here)) ; #t
+(define sum-of-prefixes
+  (lambda (tup)
+    (letrec
+	((B (lambda (sum t)
+	      (cond
+	       ((null? t) (quote ()))
+	       (else (cons (+ (car t) sum) (B (+ (car t) sum) (cdr t))))))))
+      (B 0 tup))))
+
+(sum-of-prefixes '(1 1 1 1 1 1)) ; (1 2 3 4 5 6)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 13: Hop, Skip, and Jump
+
+(define intersect
+  (lambda (a b)
+    (cond
+     ((null? a) (quote ()))
+     ((member? (car a) b)
+      (cons (car a) (intersect (cdr a) b)))
+     (else (intersect (cdr a) b)))))
+
+(intersect '(1 2 3 4 a s d f) '(1 a b c d)) ; (1 a d)
+
+(define intersect
+  (lambda (a b)
+    (letrec
+	((I (lambda (set)
+	      (cond
+	       ((null? set) (quote ()))
+	       ((member (car set) b) 
+		(cons (car set) (I (cdr set))))
+	       (else (I (cdr set)))))))
+      (I a))))
+
+(define intersectall
+  (lambda (lset)
+    (letrec
+	((A (lambda (lset)
+	      (cond
+	       ((null? (cdr lset)) (car lset))
+	       (else (intersect (car lset) (A (cdr lset))))))))
+      (cond
+       ((null? lset) (quote ()))
+       (else (A lset))))))
+
+(intersectall '(() ()))
+(intersectall '( (a b c) (a s d f) (nice day for a walk))) ; (a)
+
+; (letcc hop ...) is the same as 
+; (call-with-current-continuation (lambda (hop) ...))
+
+(define intersectall
+  (lambda (lset)
+    (call-with-current-continuation
+     (lambda (hop)
+       (letrec
+	   ((A (lambda (lset)
+		 (cond
+		  ((null? (car lset)) (hop (quote ())))
+		  ((null? (cdr lset)) (car lset))
+		  (else (intersect (car lset) (A (cdr lset))))))))
+	 (cond
+	  ((null? lset) (quote ()))
+	  (else (A lset))))))))
+
+
+;(define intersectall
+;  (lambda (lset)
+;    (letcc hop
+;	   (letrec
+;	       ((A (lambda (lset)
+;		     (cond
+;		      ((null? (car lset)) (hop (quote ())))
+;		      ((null? (cdr lset)) (car lset))
+;		      (else (intersect (car lset) (A (cdr lset))))))))
+;	     (cond
+;	      ((null? lset) (quote ()))
+;	  (else (A lset)))))))
+
+(intersectall '( (A B C) (A B D) (A B C))) ; (A B)
+
+; letcc ; not found
+
+(define intersectall
+  (lambda (lset)
+    (call-with-current-continuation
+     (lambda (hop)
+       (letrec
+	   ((A (lambda (lset)
+		 (cond
+		  ((null? (car lset)) (hop (quote ())))
+		  ((null? (cdr lset)) (car lset))
+		  (else (intersect (car lset) (A (cdr lset)))))))
+	    (I (lambda (a b)
+		 (letrec
+		     ((J (lambda (set)
+			   (cond
+			    ((null? set) (quote ()))
+			    ((member? (car set) b) (J (cdr set)))
+			    (else (cons (car set) (J (cdr set))))))))
+		   (cond
+		    ((null? b) (hop (quote ())))
+		    (else (J a)))))))
+	 (cond
+	  ((null? lset) (quote ()))
+	  (else (A lset))))))))
+
+(define rember
+  (lambda (a lat)
+    (letrec
+	((R (lambda (lat)
+	      (cond
+	       ((null? lat) (quote ()))
+	       ((eq? (car lat) a) (cdr lat))
+	       (else (cons (car lat) (R (cdr lat))))))))
+      (R lat))))
+
+(rember 'k '(captain kangaroo k))
+
+(define rember-up-to-last
+  (lambda (a lat)
+    (call-with-current-continuation
+     (lambda (skip)
+       (letrec
+	   ((R (lambda (set)
+		 (cond
+		  ((null? set) (quote ()))
+		  ((eq? (car set) a) (skip (R (cdr set))))
+		  (else (cons (car set) (R (cdr set))))))))
+	 (R lat))))))
+
+(rember-up-to-last 'thing '(wait do we want this thing or that thing last))
+; (last)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 14: Let There be Names
+
+(define leftmost
+  (lambda (l)
+    (cond
+     ((atom? (car l)) (car l))
+     (else (leftmost (car l))))))
+
+(leftmost '((second level) first level)) ; second
+
+(define leftmost
+  (lambda (set)
+    (cond
+     ((null? set) (quote ()))
+     ((atom? (car set)) (car set))
+     (else
+      (cond 
+       ((atom? (leftmost (car set))) (leftmost (car set)))
+       (else (leftmost (cdr set))))))))
+
+(leftmost '(((() a) ()))) ; a
+
+(define leftmost
+  (lambda (set)
+    (cond
+     ((null? set) (quote ()))
+     ((atom? (car set)) (car set))
+     (else
+      (let ((thing (leftmost (car set))))
+	(cond
+	 ((atom? thing) thing)
+	 (else (leftmost (cdr set)))))))))
+
+(define rember1*
+  (lambda (a l)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (cond
+		       ((eq? (car l) a) (cdr l))
+		       (else (cons (car l) (rember1* a (cdr l))))))
+     (else
+      (let ((tried (rember1* a (car l))))
+	(cond
+	 ((eqlist? tried (car l))
+	  (cons (car l) (rember1* a (cdr l))))
+	 (else (cons tried (cdr l)))))))))
+
+(rember1* 'meat '((pasta meat) pasta (noodles meat sauce) meat tomatoes))
+; ((pasta) pasta (noodles meat sauce) meat tomatoes)
+
+(define depth*
+  (lambda (l)
+    (cond
+     ((null? l) 1)
+     ((atom? (car l)) (depth* (cdr l)))
+     (else 
+      (let 
+	  ((down (add1 (depth* (car l))))
+	   (across (depth* (cdr l))))
+	(cond
+	 ((> down across) down)
+	 (else across)))))))
+
+(> 1 2) ; #f
+(depth* '(c (b (a b) a) a)) ; 3
+
+; this version is redundant!
+(define depth*
+  (lambda (l)
+    (cond
+     ((null? l) 1)
+     (else
+      (let 
+	  ((across (depth* (cdr l))))
+	(cond 
+	 ((atom? (car l)) across)
+	 (else 
+	  (let
+	      ((down (add1 (depth* (car l)))))
+	    (cond
+	     ((> down across) down)
+	     (else across))))))))))
+
+(max 1 4) ; 4
+
+; {{ The Fifteenth Commandment }}
+; Use (let ...) to name the values of repeated expressions in a function
+; definition if they may be evaluated twice for one and same use of the
+; function. And use (let ...) to name the values of expressions (without
+; set!) that are re-evaluated every time a function is used.
+
+(define depth*
+  (lambda (l)
+    (cond
+     ((null? l) 1)
+     ((atom? (car l)) (depth* (cdr l)))
+     (else (max
+	    (add1 (depth* (car l)))
+	    (depth* (cdr l)))))))
+
+(depth* '(a (b (c d) (e (f g) 4) 4) 4 2 1)) ; 4
+
+(define leftmost
+  (lambda (l)
+    (call-with-current-continuation
+     (lambda (skip)
+       (lm l skip)))))
+
+(define lm
+  (lambda (l out)
+    (cond
+     ((null? l) (quote ()))
+     ((atom? (car l)) (out (car l)))
+     (else (let ()
+	     (lm (car l) out)
+	     (lm (cdr l) out))))))
+
+(leftmost '((() a) (b c))) ; a
+
+; could also use a (begin (...) (...) ...) statement instead of
+; (let () (...) (...) ...)
+
+(define leftmost
+  (lambda (l)
+    (call-with-current-continuation
+     (lambda (out)
+       (letrec ((L (lambda (l)
+		     (cond
+		      ((null? l) (quote ()))
+		      ((atom? (car l)) (out (car l)))
+		      (else (let ()
+			      (L (car l))
+			      (L (cdr l))))))))
+	 (L l))))))
+
+; try is undefined
+
+;(define rember1*
+;  (lambda (a l)
+;    (try oh (rm a l oh) l)))
+
+(define rember1*
+  (lambda (a l)
+    (call-with-current-continuation
+     (lambda (success)
+       (begin
+	 (call-with-current-continuation
+	  (lambda (oh)
+	    (success (rm a l oh))))
+	 l)))))
+
+(define rm
+  (lambda (a l oh)
+    (cond
+     ((null? l) (oh (quote no)))
+     ((atom? (car l)) (if (eq? (car l) a)
+			  (cdr l)
+			  (cons (car l) (rm a (cdr l) oh))))
+     (else
+      (call-with-current-continuation
+       (lambda (success)
+	 (begin
+	   (call-with-current-continuation
+	    (lambda (oh2)
+	      (success (cons (rm a (car l) oh2) (cdr l)))))
+	   (cons (car l) (rm a (cdr l) oh)))))))))
+
+(rember1* 'green '(jolly green giant)) ; (jolly giant)
+(rember1* 'blue '(((is the) (sky)) (ever so (blue da)))) ; good
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Chapter 15: The Difference Between Men and Boys...
+
+(define x-thing (cons 'chicago (cons 'pizza '())))
+
+(set! x-thing 'gone) ; returns (chicago pizza)
+(set! x-thing 'skins)
+
+(set! x-thing 'rings)
+
+(define gourmand
+  (lambda (food)
+    (set! x-thing food)
+    (cons food
+	  (cons x-thing (quote ())))))
+
+(gourmand 'potato)
+
+(define omnivore
+  (let ((x-thing (quote soup)))
+    (lambda (food)
+      (set! x-thing food)
+      (cons food (cons x-thing '())))))
+
+(omnivore 'bread)
+x-thing ; potato
+
+; {{ The Sixteenth Commandment }}
+; Use (set! ...) only with names define in (let ...)s
+
+; {{ The Seventeenth Commandment }}
+; Use (set! x ...) for (let ((x ..)) ..)) only if there is at least one
+; (lambda .. between it and the (let ..), or if the new value for x is a 
+; function that refers to x.
+
+(define nibbler
+  (lambda (food)
+    (let ((x-thing (quote donut)))
+      (set! x-thing food)
+      (cons food
+	    (cons x-thing '())))))
+
+(nibbler 'boat)
+x-thing ; not boat
+
+(define foody (quote nothing))
+
+
+(define glutton
+  (lambda (x-thing)
+    (set! food x-thing)
+    (cons (quote more)
+	  (cons x
+		(cons (quote more) (cons x (quote ())))))))
+
+(glutton 'garlic)
+
+
+
-- 
cgit v1.2.3