;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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 food (quote nothing))

(define glutton
  (lambda (x-thing)
    (set! food x-thing)
    (cons (quote more)
	  (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

(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))))