path: root/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week9

CS 61A -- Week 9 solutions

LAB ACTIVITIES:

1.  Use a LET to keep both initial and current balance

(define (make-account init-amount)
  (let ((BALANCE INIT-AMOUNT))                ;;;  This is the change.
    (define (withdraw amount)
      (set! balance (- balance amount)) balance)
    (define (deposit amount)
      (set! balance (+ balance amount)) balance)
    (define (dispatch msg)
      (cond
        ((eq? msg 'withdraw) withdraw)
        ((eq? msg 'deposit) deposit)))
    dispatch))


2.  Add messages to read those variables.

(define (make-account init-amount)
  (let ((balance init-amount))
    (define (withdraw amount)
      (set! balance (- balance amount)) balance)
    (define (deposit amount)
      (set! balance (+ balance amount)) balance)
    (define (dispatch msg)
      (cond
        ((eq? msg 'withdraw) withdraw)
        ((eq? msg 'deposit) deposit)
	((EQ? MSG 'BALANCE) BALANCE)                  ;; two lines added here
	((EQ? MSG 'INIT-BALANCE) INIT-AMOUNT)))
    dispatch))


3.  Add transaction history.

(define (make-account init-amount)
  (let ((balance init-amount)
        (TRANSACTIONS '()))                       ;; add local state var
    (define (withdraw amount)
      (SET! TRANSACTIONS (APPEND TRANSACTIONS
				 (LIST (LIST 'WITHDRAW AMOUNT))))    ;; update
      (set! balance (- balance amount)) balance)
    (define (deposit amount)
      (SET! TRANSACTIONS (APPEND TRANSACTIONS
				 (LIST (LIST 'DEPOSIT AMOUNT))))     ;; update
      (set! balance (+ balance amount)) balance)
    (define (dispatch msg)
      (cond
        ((eq? msg 'withdraw) withdraw)
        ((eq? msg 'deposit) deposit)
	((eq? msg 'balance) balance)
	((eq? msg 'init-balance) init-amount)
	((EQ? MSG 'TRANSACTIONS) TRANSACTIONS)))      ;; message to examine it
    dispatch))


4.  Why substitution doesn't work.

(plus1 5)  becomes

(set! 5 (+ 5 1))
5

The first line (the SET!) is syntactically wrong; "5" isn't a variable
and it doesn't make sense to substitute into an unevaluated part of a
special form.

The second line (returning the value 5) is syntactically okay but
gives the wrong answer; it ignores the fact that the SET! was supposed
to change the result.


HOMEWORK:

3.3  Accounts with passwords

(define (make-account balance password)
  (define (withdraw amount) ; Starting here exactly as in p. 223
    (if (>= balance amount)
	(begin (set! balance (- balance amount))
	       balance)
	"Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch pw m) ; Starting here different because of pw
    (cond ((not (eq? pw password))
	   (lambda (x) "Incorrect password"))
	  ((eq? m 'withdraw) withdraw) ; Now the same again
	  ((eq? m 'deposit) deposit)
	  (else (error "Unknown request -- MAKE-ACCOUNT"
		       m))))
  dispatch)

The big question here is why withdraw can get away with returning
        "Insufficient funds"
while dispatch has to return this complicated
        (lambda (x) "Incorrect password")
The answer is that ordinarily the result returned by withdraw is supposed
to be a number, which is just printed.  In case of an error, withdraw can
return a string instead, and that string will just get printed.  But
dispatch is ordinarily supposed to return a PROCEDURE.  In the example
        ((acc 'some-other-password 'deposit) 50)
if dispatch just returned the string, it would be as if we'd typed
        ("Incorrect password" 50)
which makes no sense.  Instead this version is as if we typed
        ((lambda (x) "Incorrect password") 50)
which does, as desired, print the string.

A simpler solution would be to say (error "Incorrect password") because
the ERROR primitive stops the computation and returns to toplevel after
printing its argument(s).  But you should understand the version above!


3.4 call-the-cops

(define (make-account balance password)
  (define error-count 0) ; THIS LINE ADDED
  (define (withdraw amount)
    (if (>= balance amount)
	(begin (set! balance (- balance amount))
	       balance)
	"Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch pw m)
    (cond ((eq? pw password) ; REARRANGED STARTING HERE
	   (set! error-count 0)
	   (cond ((eq? m 'withdraw) withdraw)
	  	 ((eq? m 'deposit) deposit)
	  	 (else (error "Unknown request -- MAKE-ACCOUNT"
		       	      m)) ))
	  (else
	   (set! error-count (+ error-count 1))
	   (if (> error-count 7) (call-the-cops))
	   (lambda (x) "Incorrect password") )))
  dispatch)

In this version, call-the-cops will be invoked before the dispatch procedure
goes on to return the nameless procedure that will, eventually, be invoked and
print the string "Incorrect password", so whatever call-the-cops prints will
appear before that message.  If you'd like it to appear instead of the string,
change the last few lines to

           (lambda (x)
	     (if (> error-count 7)
		 (call-the-cops)
		 "Incorrect password"))


3.7  Joint accounts

What we want here is a new dispatch procedure that has access to the same
environment frame containing the balance of the original account.  You could
imagine a complicated scheme in which we teach make-account's dispatch
procedure a new message, make-joint, such that
	((acc 'old-password 'make-joint) 'new-password)
will return a new dispatch procedure in a new frame with its own password
binding but inheriting acc's balance binding.  This can work, and we'll
do it later in this solution, but it's a little tricky because you have to
avoid the problem of needing to write a complete dispatch procedure within
a cond clause in the dispatch procedure!

Instead, one thing to do is to create a new function that invokes f from
within a prepared frame.

Here is a first, simple version that does almost what we want:

(define (make-joint old-acc old-pw new-pw)
  (lambda (pw m)
    (if (eq? pw new-pw)
	(old-acc old-pw m)
	(lambda (x) "Incorrect password"))))

It's important to understand how easy this is if we're willing to treat
the old account procedure as data usable in this new make-joint procedure.
This version works fine, with proper password protection, but it differs
in one small detail from what the problem asked us to do.  I'd be very happy
with this version of the program, but for those of you who are sticklers for
detail, here's a discussion of the problem and a revised solution.

Suppose you don't know the password of the old account but you try to make a
joint-account by guessing.  Make-joint will return a procedure, without
complaining, and it isn't until you try to use that returned procedure that
the old account will complain about getting the wrong password.  The problem
says, "The second argument must match the password with which the account
was defined in order for the make-joint operation to proceed."  They want us
to catch a password error as soon as make-joint itself is invoked.  To do
this, make-joint must be able to ask old-acc whether or not the given old-pw
is correct.  So we'd like a verify-password message so that

==> (peter-acc 'open-sesame 'verify-password)
#t
==> (peter-acc 'garply 'verify-password)
#f

Given such a facility in make-account, we can write make-joint this way:

(define (make-joint old-acc old-pw new-pw)
  (if (old-acc old-pw 'verify-password)
      (lambda (pw m)
	(if (eq? pw new-pw)
	    (old-acc old-pw m)
	    (lambda (x) "Incorrect password")))
      (display "Incorrect password for old account")))

This approach only makes sense if we use (display ...) to signal the error.
We can't just return a string because the string won't be printed; it'll
be bound to a symbol like paul-acc as that symbol's value.  Later, when we
try to invoke paul-acc as a procedure, we'll get a "Application of
non-procedure object" error message.  We also can't just do the trick of
returning (lambda (x) "string").  That won't blow up our program, but again
the printing of the error message won't happen until paul-acc is applied to
something.  If we wanted to wait until then to see the error message, we
could just use my first solution.  So we're stuck with explicitly printing
the message.  What gets returned is whatever print returns; if we ignore
the message and try to invoke paul-acc later, it'll blow up.

To make this work we need to invent the verify-password message:

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
	(begin (set! balance (- balance amount))
	       balance)
	"Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch pw m)
    (cond ((eq? m 'verify-password) ; This clause is new
	   (eq? pw password))
 	  ((not (eq? pw password))
	   (lambda (x) "Incorrect password"))
	  ((eq? m 'withdraw) withdraw)
	  ((eq? m 'deposit) deposit)
	  (else (error "Unknown request -- MAKE-ACCOUNT"
		       m))))
  dispatch)

Note the order of the cond clauses in dispatch.  The verify-password message
is not considered an error even if the password doesn't match; it just returns
#f in that case.  So we first check for that message, then if not we check
for an incorrect password, then if not we check for the other messages.

By the way, we could avoid inventing the new verify-password method by using
the existing messages in an unusual way.  Instead of

(define (make-joint old-acc old-pw new-pw)
  (if (old-acc old-pw 'verify-password)
      ...))

we could say

(define (make-joint old-acc old-pw new-pw)
  (if (NUMBER? ((OLD-ACC OLD-PW 'DEPOSIT) 0))
      ...)


If you want to add a make-joint message to the account dispatch procedure,
the corresponding method has to return a new dispatch procedure.  This is
the approach that I rejected earlier as too complicated, but it's not bad
once you understand how to do it: instead of having a
        (define (dispatch pw m) ...)
so that there is one fixed dispatch procedure, you do the object-oriented
trick of allowing multiple dispatch procedure objects, so we have a
higher-order procedure that makes dispatch procedures.  Every time a new
person is added to the account, we make a new dispatch procedure for that
person, with a new password.  Even the first user of the account gets a
dispatch procedure through this mechanism, as you'll see below:

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
	(begin (set! balance (- balance amount))
	       balance)
	"Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (new-dispatch new-pw) ; This is new.  We have a dispatch maker
    (lambda (pw m)              ; instead of just one dispatch procedure.
      (cond ((not (eq? pw new-pw))
	     (lambda (x) "Incorrect password"))
	    ((eq? m 'withdraw) withdraw)
	    ((eq? m 'deposit) deposit)
	    ((eq? m 'make-joint) new-dispatch)
	    (else (error "Unknown request -- MAKE-ACCOUNT"
			 m)))))
  (new-dispatch password)) ; We have to make a dispatcher the first time too.


3.8  Procedure for which order of evaluation of args matters

The procedure f will be invoked twice.  We want the results to depend on the
past invocation history.  That is, (f 1) should have a different value
depending on whether or not f has been invoked before.

Given the particular values we're supposed to produce, I think the easiest
thing is if (f 0) is always 0, while (f 1) is 1 if (f 0) hasn't been invoked
or 0 if it has.

(define f
  (let ((history 1))
    (lambda (x)
      (set! history (* history x))
      history)))

If we evaluate (f 1) first, then history has the value 1, and the result (and
new value of history) is (* 1 1) which is 1.  On the other hand, if we
evaluate (f 0) first, that sets history to 0, so a later (f 1) returns
(* 0 1) which is 0.

The above solution only works the first time we try
	(+ (f 0) (f 1))
however.  After the first time, (f x) always returns 0 for any x.  Here's
another solution that doesn't have that defect:

(define f
  (let ((invocations 0))
    (lambda (x)
      (set! invocations (+ invocations 1))
      (cond ((= x 0) 0)
	    ((even? invocations) 0)
	    (else 1)))))

Many other possible solutions are equally good.


3.10  Let vs. parameter

                                               args: initial-amount
                                           --> body: (let ...)
global env:                                |
|------------------------------|           |
| make-withdraw: --------------------> (function) --> global env
|                              |
| W1: -- (this pointer added later) -> (function A below)
|                              |
| W2: -- (this one added later too) -> (function B below)
|------------------------------|

The first invocation of make-withdraw creates a frame

E1:
|--------------------|
|initial-amount: 100 |---> global env
|--------------------|

and in that frame evaluates the let, which makes an unnamed function

                                       (function) --> E1
                                           |
                                           |    args: balance
                                           ---> body: (lambda (amount) ...)

then the same let applies the unnamed function to the argument expression
initial-amount.  We are still in frame E1 so initial-amount has value 100.
To apply the function we make a new frame:

E2:
|--------------------|
|balance: 100        |---> E1
|--------------------|

Then in that frame we evaluate the body, the lambda expression:

                                     (function A) --> E2
                                         |
                                         |    args: amount
                                         ---> body: (if ...)

Then the outer define makes global W1 point to this function.

Now we do (W1 50).  This creates a frame:

E3:
|------------|
|amount:  50 |---> E2
|------------|

Frame E3 points to E2 because function A (i.e. W1) points to E2.
Within frame E3 we evaluate the body of function A, the (if ...).
During this evaluation the symbol AMOUNT is bound in E3, while
BALANCE is bound in E2.  So the set! changes BALANCE in E2 from
100 to 50.

Now we make W2, creating two new frames in the process:

E4:
|--------------------|
|initial-amount: 100 |---> global env
|--------------------|

                                       (function) --> E4
                                           |
                                           |    args: balance
                                           ---> body: (lambda (amount) ...)

E5:
|--------------------|
|balance: 100        |---> E4
|--------------------|

                                     (function B) --> E5
                                         |
                                         |    args: amount
                                         ---> body: (if ...)

Then the outer define makes global W2 point to this function.

Summary: the two versions of make-withdraw create objects with the same
behavior because in each case the functions A and B are defined within
individual frames that bind BALANCE.  The environment structures differ
because this new version has, for each account, an extra frame containing
the binding for initial-amount.



==================================================



3.11  Message-passing example

global env:
|------------------------------|
| make-account: --------------------> (function) ---> global env
|                              |
| acc: --(pointer added later)------> (function A below)
|------------------------------|

When we (define acc (make-account 50)), a new frame is created that
includes both make-account's parameters (balance) and its internal
definitions (withdraw, deposit, dispatch):

E1:
|------------------------------|
| balance: 50                  |----> global env
|                              |
| withdraw: -------------------------> (function W) ---> E1
|                              |
| deposit: --------------------------> (function D) ---> E1
|                              |
| dispatch: -------------------------> (function A) ---> E1
|------------------------------|

(The arrow I have in the top right corner has nothing to do with the
binding of BALANCE; it's the back pointer for this frame.)

At this point the symbol ACC is bound, in the global environment, to
function A.

Now we do ((acc 'deposit) 40).

E2:
|--------------------|
| m: deposit         |----> E1
|--------------------|

The above results from evaluating (acc 'deposit), whose returned value is
function D above.

E3:
|--------------------|
| amount: 40         |----> E1
|--------------------|

The above frame results from (D 40) [so to speak].  Note that its back
pointer points to E1, not E2, because that's what D points to.  Now we
evaluate the body of D, which includes (set! balance (+ balance amount))
The value for AMOUNT comes from E3, and the value for BALANCE from E1.
The set! changes the value to which BALANCE is bound in E1, from 50 to 90.

((acc 'withdraw) 60)

similarly creates two new frames:

E4:
|--------------------|
| m: withdraw        |----> E1
|--------------------|

E5:
|--------------------|
| amount: 60         |----> E1
|--------------------|

Again BALANCE is changed in E1, which is where ACC's local state is kept.
If we define another account ACC2, we'll produce a new frame E6 that has
the same symbols bound that E1 does, but bound to different things.  The
only shared environment frame between ACC1 and ACC2 is the global environment.
The functions in E6 are *not* the same as the functions D, W, and A in E1.
(They may, depending on the implementation, have the same list structure
as their bodies, but they don't have the same environment pointers.)


Extra for experts:

First the easy part, generating unique symbols:

(define gensym
  (let ((number 0))
    (lambda ()
      (set! number (+ number 1))
      (word 'g number))))

Each call to GENSYM generates a new symbol of the form G1, G2, etc.
(This isn't a perfect solution; what if there is a global variable
named G1 that's used within the argument expression?  But we won't worry
about that for now -- there are solutions, but they're pretty complicated.)

The renaming procedure will need to keep an association list with
entries converting symbols in the argument expression to gensymmed symbols.

The problem says that all *local* variables are to be renamed.  Symbols
that aren't bound within this expression (such as names of primitive
procedures!) will remain unchanged in the result.

(define (unique-rename exp)
  (define (lookup sym alist)		; find replacement symbol
    (let ((entry (assoc sym alist)))
      (if entry
	  (cdr entry)
	  sym)))			; not in alist, keep original

  (define (make-newnames vars)		; make (old . new) pairs for lambda
    (map (lambda (var) (cons var (gensym))) vars))

  (define (help exp alist)
    (cond ((symbol? exp) (lookup sym alist))
	  ((atom? exp) exp)		; self-evaluating
	  ((equal? (car exp) 'lambda)
	   (let ((newnames (make-newnames (cadr exp))))
	     (let ((newalist (append newnames alist)))
	       (cons 'lambda
		     (cons (map cdr newalist)
			   (map (lambda (subexp) (help subexp newalist))
				(cddr exp)))))))
	  (else (map (lambda (subexp) (help subexp alist)) exp))))
  (help exp '()))

There are four cases in the COND:
1.  A symbol is replaced by its gensym equivalent.
2.  A non-symbol atom is returned unchanged (self-evaluating expression).
3.  A lambda expression is processed by making a new gensym name for each
    of its parameters (found in the cadr of the lambda expression), then
    making a new association list with these new pairs in front (so that
    the new ones will be seen first by assoc and will take preference over
    the same name used in an outer lambda), then recursively rename all the
    expressions in the body of the lambda expression.
4.  A compound expression that isn't a lambda is processed by recursively
    renaming all its subexpressions.


The way to use unique-rename to allow evaluation of Scheme programs
with only one frame is that on every procedure call, the evaluator
should call unique-rename on the procedure that the user is trying
to call, then call the resulting modified procedure.  You can't just
call unique-rename when the procedure is created (by a lambda
expression), because of recursive procedures.  Many recursive
invocations might be active at the same time, and each of them needs
a unique renaming.

We'll see that something very similar to this is actually done
in the query-language evaluator in week 15.