Implement till 3.8

ex-3_01-08.scm

@@ -36,6 +36,9 @@
 
 (define (make-account balance password)
   (define invalid-pw-attempts 0)
+  (define passwords (list password))
+  (define (password-valid? pw)
+    (contains pw passwords))
   (define (withdraw amount)
     (if (>= balance amount)
         (begin (set! balance (- balance amount))
@@ -44,17 +47,21 @@
   (define (deposit amount)
     (set! balance (+ balance amount))
     balance)
+  (define (add-password new-pw)
+    (set! passwords (cons new-pw passwords))
+    dispatch)
   (define (incorrect-password value)
     "Incorrect password")
   (define (call-the-cops value)
     "Call the cops!")
   (define (dispatch pw m)
-    (if (eq? pw password)
+    (if (password-valid? pw)
       (begin
         (set! invalid-pw-attempts 0)
         (cond
           ((eq? m 'withdraw) withdraw)
           ((eq? m 'deposit) deposit)
+          ((eq? m 'add-pw) add-password)
           (else (error "Unknown request -- MAKE-ACCOUNT" m))))
       (cond
          ((= invalid-pw-attempts 3) call-the-cops)
@@ -147,5 +154,36 @@
 
 (display "\nex-3.7\n")
 
+(define peter-acc (make-account 100 'open-sesame))
+
+(assert ((peter-acc 'open-sesame 'withdraw) 10) 90)
+
+(define (make-joint account password additional-password)
+  ((account password 'add-pw) additional-password))
+
+(define paul-acc
+  (make-joint peter-acc 'open-sesame 'rosebud))
+
+(assert ((peter-acc 'open-sesame 'withdraw) 10) 80)
+(assert ((paul-acc 'rosebud 'withdraw) 10) 70)
+
 (display "\nex-3.8\n")
 
+(define f
+  (let ((x 'notset))
+    (lambda (n)
+      (if (eq? x 'notset)
+        (begin (set! x n) 0)
+        x))))
+
+(display (+ (f 0) (f 1))) (newline)
+
+(define f
+  (let ((x 'notset))
+    (lambda (n)
+      (if (eq? x 'notset)
+        (begin (set! x n) 0)
+        x))))
+
+(display (+ (f 1) (f 0))) (newline)
+

util.scm

@@ -58,4 +58,10 @@
   (let ((range (- high low)))
     (+ low (random range))))
 
+(define (contains x xs)
+  (cond
+    ((null? xs) #f)
+    ((eq? x (car xs)) #t)
+    (else (contains x (cdr xs)))))
+
 'util-loaded