% -*- Mode: Tex -*-

\input /homes/welg/6001/fall96/6001mac.tex

\def\fbox#1{%
  \vtop{\vbox{\hrule%
              \hbox{\vrule\kern3pt%
                    \vtop{\vbox{\kern3pt#1}\kern3pt}%
                    \kern3pt\vrule}}%
        \hrule}}

\def\emptybox#1#2{\fbox{\vbox to #2{\hbox to #1 {\null}}}}

\begin{document}

\psetheader{Fall Semester, 1996}{Quiz II}

\centerline{\bf Closed Book}

\vskip 10pt

Please write clear and concise answers to the questions in  the spaces
provided in this booklet.  You may use scratch paper if you need, but the
spaces we provide are the {\bf only} places we will look at when grading.

Write your name: \emptybox{4in}{.5in}

\vskip 20pt

\centerline{
\begin{tabular}{|c|c|c|}
\hline
\multicolumn{3}{|c|}{\bf Circle Your Recitation Section}\\
\hline
Time & Instructor &T.A.\\
\hline
10&Rod Brooks&Becca Xiong\\
11&Rod Brooks&Mike McCandless\\
\hline
10&Pat LoPresti&Jay Ongg\\
11&Pat LoPresti&Jane Chang\\
\hline
11&Pam Lipson&Josh Tauber\\
12&Pam Lipson&Daniel Coore\\
\hline
1&Nir Shavit&Anthony Kam\\
2&Nir Shavit&Paul Van Eyk\\
\hline
\end{tabular}
}


Please do not write below this line:

\vskip 10pt

\hrule

\vskip 10pt


\begin{tabular}{|c|c|c|c||c|c|c|c|}
\hline
Problem & Value & Grade & Grader &Problem& Value & Grade &Grader \\
\hline
\hline
1& 20 & & &5 &10& & \\
\hline
2& 17& & &6& 26& &\\
\hline
3& 17& & & & & &\\
\hline
4& 10& & &Total&100 & &\\
\hline
\end{tabular}


\newpage

{\bf Question 1 {\bf (20 points)}:}

Consider the following sequence of expressions evaluated in the global
environment:

\begin{lisp}
(define memoize
  (lambda (p)
    (let ((results '()))
      (lambda (x)
        (let ((trial (assoc x results)))
          (cond (trial (cdr trial))
                (else 
                  (let ((val (p x)))
                    (set! results (cons (cons x val) results))
                    val))))))))
\null
(define (assoc key records)
  (cond ((null? records) false)
        ((equal? key (caar records)) (car records))
        (else (assoc key (cdr records)))))
\null
(define (c y) (* y y y))
\null
(define m-c (memoize c))
\null
(m-c 3)
\end{lisp}

Below are pieces from an environment diagram associated with the
evaluation of this sequence -- circles indicating procedure objects
(labeled P1 to P5), large squares indicating environments (E1 to E6
and the global environment GE), and boxes indicating box and pointer
diagrams (B1 to B4).  Your job is to figure out as much about these environment
diagram fragments as you can.  To do this, fill in the tables on page 5.

\newpage

\null

\newpage

We have provided a blank page here so that you can have some scratch
space in which we {\bf STRONGLY SUGGEST} that you work out the
environment diagram associated with the expression evaluations above.
Then you can match your diagram to the pieces of ours in order to
answer the questions on the following page.
However, PLEASE place all of your final answers in the tables on the
following page.

\newpage

First, for each procedure object, P1 through P5, identify, is possible, the
environment pointer of the procedure, by marking the appropriate
square in each row.

\begin{tabular}{l|c|c|c|c|c|c|c|c|}
\hline
&\multicolumn{8}{c|}{Environment Pointer}\\
\hline
Procedure&E1&E2&E3&E4&E5&E6&GE&Not Shown\\
\hline
P1& & & & & & & & \\
\hline
P2& & & & & & & & \\
\hline
P3& & & & & & & & \\
\hline
P4& & & & & & & & \\
\hline
P5& & & & & & & & \\
\hline
\end{tabular}

\vskip 20pt

Second, for each environment frame, indicate which environment is the
enclosing environment for that frame, by marking the appropriate
square in each row.

\begin{tabular}{l|c|c|c|c|c|c|c|c|c|}
\hline
&\multicolumn{9}{c|}{Enclosing Environment}\\
\hline
Frame&E1&E2&E3&E4&E5&E6&GE&None&Not Shown\\
\hline
E1& & & & & & & & & \\
\hline
E2& & & & & & & & & \\
\hline
E3& & & & & & & & & \\
\hline
E4& & & & & & & & & \\
\hline
E5& & & & & & & & & \\
\hline
E6& & & & & & & & & \\
\hline
GE& & & & & & & & & \\
\hline
\end{tabular}


\vskip 20pt

Finally, for each of the following variables, indicate to what it is
bound in the diagram (possibilities include one of the procedure
objects, P1, ..., P5, a number, a symbol, an environment, E1, ..., E6,
GE, or a box and pointer diagram B1, ..., B4).  Do this in terms of
the values associated with these variables after {\bf all} the expressions on
page 2 have been evaluated.

\begin{tabular}{l|l|l|}
\hline
Frame&Variable&Bound value \ \ \ \ \ \ \ \\
\hline
E1&{\tt trial}& \\
\hline
E2&{\tt x}& \\
\hline
E3&{\tt y}& \\
\hline
E4&{\tt p}& \\
\hline
E5&{\tt val}& \\
\hline
E6&{\tt results}& \\
\hline
GE&{\tt memoize}& \\
\hline
GE&{\tt m}-c& \\
\hline
\end{tabular}


\newpage

{\bf Question 2 {\bf (17 points)}:}

We want to add to our language the ability to keep track of how often
a procedure is used with particular arguments.  That is, we would like
to have procedures that remember how many times they were called with
each different value of their argument.  For simplicity, we will
restrict ourselves to procedures of one integer argument.  We will
keep a history of the calls of the procedure as a list of entries,
where each entry is a pair of the argument and the number of calls.
In particular, we have an abstraction for an entry:

\begin{lisp}
(define (make-entry arg)
  (cons arg 1)  ;; create an entry when argument is first used
  )
\null
(define entry-argument car)
\null
(define entry-number-of-calls cdr)
\null
(define (update-entry entry)
  $<$blob0$>$ 
  % (set-cdr! entry (+ 1 (cdr entry)))
  )
\end{lisp}

Updating an entry means that we have called the procedure with an
argument again (we will assume that it has already been called at
least once) and we need to record this fact in our history.  Fill in
the missing blob:

$<$blob0$>$

\emptybox{6in}{1in}

\vskip 10pt


Below is a template for creating such procedures.  Note that we want
to separate out the process of updating the history from the process
of using the actual procedure.  Thus {\tt increment-history} should
update an entry for an argument if there is an entry already in
the history, and otherwise should add a new entry to the history.  The
``historical'' procedure itself should be handled by the {\tt me}
procedure below.

\newpage

\begin{lisp}
(define (make-history proc)
  (let ((history (list 'history)))
    (define (increment-history m lst)
      (cond ((null? lst)
             $<$blob1$>$)
            ((= m (entry-argument (car lst)))
             $<$blob2$>$)
            (else
             $<$blob3$>$)))
     (define (me m)
       (cond ((number? m)
              $<$blob4$>$)
             ((eq? m 'reset)
              $<$blob5$>$)
             ((eq? m 'show)
              $<$blob6$>$)))
     me))
\null
(define my-square (make-history (lambda (x) (* x x))))
;Value: ``my-square --> \#[compound-procedure 20 me]''
\null
(my-square 3)
;Value: 9
\null
(my-square 3)
;Value: 9
\null
(my-square 5)
;Value: 25
\null
(my-square 'show)
;Value: (history (5 . 1) (3 . 2))
\null
(my-square 'reset)
;Value: (history)
\null
(my-square 'show)
;Value: (history)
\end{lisp}


Based on this observed behavior, you should be able to complete the
missing blobs:

\newpage

$<$blob1$>$

\emptybox{6in}{1in}
%(set-cdr! history (cons (make-entry m 1) (cdr history)))

\vskip 10pt

$<$blob2$>$

\emptybox{6in}{1in}
% (update-entry (car lst))

\vskip 10pt

$<$blob3$>$

\emptybox{6in}{1in}
% (increment-history m (cdr lst))

\vskip 10pt

$<$blob4$>$

\emptybox{6in}{1in}
% (increment-history m (cdr history))
% (proc m)

\vskip 10pt

$<$blob5$>$

\emptybox{6in}{1in}
% (set! history (list 'history))
% history

\vskip 10pt

$<$blob6$>$

\emptybox{6in}{1in}
% history

\vskip 10pt

\newpage

{\bf Question 3 (17 points)}

Earlier in the term, we saw an example of a system to take symbolic
derivatives of simple algebraic expressions.  For simplicity, assume
that we are only dealing with expressions composed of sums
of two arguments, of variables and of constants.

Below are some basic data abstractions for creating such expressions,
very similar to those you have seen earlier in the term:

\begin{lisp}
(define (attach-tag type-tag contents)
  (cons type-tag contents))
\null
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "bad tagged datum -- TYPE-TAG" datum)))
\null
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "bad tagged datum -- TYPE-TAG" datum)))
\null
(define (constant? exp) (eq? (type-tag exp) 'constant))

\null
(define (make-constant x) (attach-tag 'constant x))
\null
(define (variable? exp) (eq? (type-tag exp) 'variable))
\null
(define (make-variable x) (attach-tag 'variable x))
\null
(define (sum? exp) (eq? (type-tag exp) 'sum))
\null
(define (make-sum a b) (attach-tag 'sum (cons a b)))
\null
(define (addend exp) (car exp))  ;; NOTE THAT THIS IS NOT A BUG
\null
(define (augend exp) (cdr exp))  ;; NOTE THAT THIS IS NOT A BUG
\end{lisp}

Remember the rules of differentiation are:

\[{dc \over dx} = 0\]
\[{dx \over dx} = 1\]
\[{dy \over dx} = 0\]
\[{d(u+v) \over dx} = {du\over \dx} + {dv \over dx}\]


\newpage


{\bf Part a:}
We want to implement symbolic differentiation using a type dispatching
approach.  Fill in the slots in the structure below to do this.
An example of the expected behavior is:

\vskip 10pt

\begin{lisp}
(define one (make-constant 1))
(define x (make-variable 'x))
(define x+one (make-sum x one))
\null
(deriv one x)
;Value: (constant . 0)
\null
(deriv x+one x)
;Value: (sum (constant . 1) constant . 0)
\end{lisp}

\vskip 10pt

\begin{lisp}
(define (deriv exp var)
  (if (variable? var)
      (cond ((constant? exp)
             \emptybox{5in}{.75in}
             )
            ((variable? exp)
             \emptybox{5in}{1.5in}
             )
            ((sum? exp)
             \emptybox{5in}{1.5in}
             )
            (else (error "Cannot deal with this exp")))
       (error "Not a variable")))
\end{lisp}

\newpage

{\bf Part b:}  We want to implement symbolic differentiation using a data
directed approach.  Note that this Part is to be considered
completely independent of Part a.  The top level interface is:

\begin{lisp}
(define (deriv exp var)
  (if (variable? var)
      (apply-generic 'deriv exp var)
      (error "Cannot take derivative without a variable")))
\end{lisp}

We also have available a standard method for applying procedures,
using a put-get table.

\begin{lisp}
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (error "No method for the given types -- APPLY-GENERIC"
                 (list op type-tags))))))
\end{lisp}

Assume that we have already installed methods for dealing with
expressions that are constants and expressions that are variables.
Complete the system by adding a method to deal with expressions that
are sums.

\emptybox{6.5in}{5in}

\newpage

{\bf Question 4 (10 points)}

The meta-circular evaluator ({\tt eval}) in the textbook treats {\tt
cond} clauses as derived forms, that is, it converts a {\tt cond}
expression to a sequence of {\tt if} expressions, then evaluates the
result.  Suppose instead that we want to instead have {\tt cond}
expressions be evaluated directly.  Here are the pieces of the
evaluator associated with {\tt cond}:

\begin{lisp}
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
\end{lisp}

Below is a template for evaluating a {\tt cond}:

\begin{lisp}
(define (eval-cond exp env)
  (eval-clauses (cond-clauses exp) env))
\null
(define (eval-clauses clauses env)
  (if (null? clauses)
      'false
      (let ((first (car clauses))
            (rest (cdr clauses)))
        $<$blob1$>$)))
        % (cond ((cond-else-clause? first)
        %        (eval-sequence (cond-actions first) env))
        %       ((true? (eval (cond-predicate first) env))
        %        (eval-sequence (cond-actions first) env))
        %       (else 
        %        (eval-clauses rest env)))
\end{lisp}

Fill in $<$blob1$>$

\emptybox{6in}{1.75in}

\vskip 10pt

Currently the evaluator includes the following clause:

\begin{lisp}
   ((cond? exp) (eval (cond->if exp) env))
\end{lisp}

What should this be replaced with?

\emptybox{6in}{1in}

\newpage

{\bf Question 5 (10 points)}

Suppose we are given the following definition:

\begin{lisp}
(define a (list (cons 1 2) 3 4))
\end{lisp}

Here are a set of expressions, which you are to treat as independent,
that is, assume that the above definition is evaluated and then
expression A is evaluated, or the above definition is evaluated and then
expression B is evaluated, and so on.

\begin{tabular}{ll}
A&{\tt (set-car! (cdr a) (car a))}\\
B&{\tt (set-cdr! (car a) (cdr a))}\\
C&{\tt (set-cdr! a (car a))}\\
D&{\tt (set! a (car a))}\\
E&{\tt (set! (car a) (cdr a))}\\
\end{tabular}

Below are a set of possible {\tt cons} structures that may correspond
to the result of each alternative above.

\newpage

Fill in the following table for each expression, identifying the
appropriate resulting structure, or indicating if an error occurs in
the evaluation or stating if the structure is not shown in the set of
six above:

\begin{tabular}{l||c|c|c|c|c|c|c|c|}
&1&2&3&4&5&6&error&not shown\\
\hline
A&&&&&&&&\\
\hline
B&&&&&&&&\\
\hline
C&&&&&&&&\\
\hline
D&&&&&&&&\\
\hline
E&&&&&&&&\\
\hline
\end{tabular}

\newpage

{\bf Question 6 (26 points)}

Here are some procedures from the Object Oriented System that you used
in Problem Set 7.

  
\begin{lisp}
(define (delegate to from message . args)
  (let ((method (get-method message to)))
    (if (method? method)
        (apply method from args)
        (error "No method" message))))
\null
(define (ask object message . args)
  (apply delegate object object message args))
\null
(define (get-method message preferred . others)
  (define (loop objs)
    (let ((method (get-method-from-object
                     message (car objs)))
          (rest (cdr objs)))
      (if (or (method? method) (null? rest))
          method
          (loop rest))))
  (loop (cons preferred others)))
\null
(define (get-method-from-object message object)
  (object message))
\null
(define (no-method) '(NO-METHOD))
\null
(define (method? x)
  (cond ((procedure? x) \#)
        ((eq? x (no-method)) \#f)
        (else (error "Object returned non-message" x))))
\null
(define (delegate-to-all to-list from message . args)
  (foreach
    (lambda (to-whom)
      (apply delegate to-whom from message args))
    to-list)
\end{lisp}

{\bf Part A:}
First, complete the definition of the {\tt Appliance}
class.  An electrical appliance can be switched to the
state {\tt 'ON} or to {\tt 'OFF}, and has
a fuse which can be made to blow via the message {\tt 'BLOW-FUSE}.
One can also ask if the appliance is currently {\tt ON?}, which should
return a boolean.

\begin{lisp}
;; Example desired behavior
(define my-toaster (make-appliance))
(ask my-toaster 'SWITCH 'ON)
(ask my-toaster 'ON?) ==> \#t
(ask my-toaster 'BLOW-FUSE)
  Bang! Fuse Blown!
(ask my-toaster 'ON?) ==> \#f
\end{lisp}

\begin{lisp}
(define (make-appliance)
  (let ((switch-state 'OFF)
        (fuse-blown \#f))
    (lambda (message) 
      (case message
        ((SWITCH) 
         $<$blob1$>$)
%         (lambda (self on-off) (set! switch-state on-off))) ; <blob1>
        ((ON?)
         $<$blob2$>$)
%         (lambda (self) (eq? on-off 'ON)))
        ((BLOW-FUSE)
%         (lambda (self)
%           (cond (fuse-blown (display-message "Fuse already blown."))
%                 (else (set! fuse-blown \#t)
%                       (display-message "Bang! Fuse Blown!")))))
         $<$blob3$>$)
        (else (no-method))))))
\end{lisp}


Fill in the  missing pieces:

$<$blob1$>$

\emptybox{6in}{1in}

\vskip 10pt

$<$blob2$>$

\emptybox{6in}{1in}

\vskip 10pt

$<$blob3$>$

\emptybox{6in}{1.5in}


\newpage
{\bf Part B:} Now we implement some appliances.  A {\tt Blender} is an
appliance that also has a speed setting.  A {\tt TV} is an appliance
that also has a channel setting.  Complete the definitions of these
classes:

\begin{lisp}
;; Desired behavior
(define my-blender (make-blender))
(ask my-blender 'SET-SPEED 5)
(ask my-blender 'SPEED) ==> 5
(ask my-blender 'ON?) ==> \#F
\null
(define (make-blender)
  (let ((speed 0)
        (appliance (make-appliance)))
    (lambda (message)
      (case message
        ((SET-SPEED)
         $<$blob4$>$)
%         (lambda (self new-speed) (set! speed new-speed))) ;<blob>
        ((SPEED) (lambda (self) speed))
        (else (get-method message appliance))))))
\null
(define (make-TV)
  (let ((channel 0)
        (appliance (make-appliance)))
    (lambda (message)
      (case message
        ((SET-CHANNEL)
%         (lambda (self new-channel) (set! channel new-channel))) ;<blob>
         $<$blob5$>$)
        ((CHANNEL) (lambda (self) channel))
        (else (get-method message appliance))))))
\end{lisp}

\vskip 10pt

$<$blob4$>$

\emptybox{6in}{1in}

\vskip 10pt

$<$blob5$>$

\emptybox{6in}{1in}

\newpage
{\bf Part C:}
Ronco, Inc. has noticed that a lot of people watch TV while in the
kitchen, and has decided to market the ``BL-TV'' -- which is both a
blender AND a TV!  Only one problem: whenever the speed of the blender
goes above 3, and the TV part and blender part are both on, the fuses
in both parts blow.  Implement this behavior in the new class ``BL-TV''
which inherits from the blender and TV classes.

In the space below, create an implementation of a constructor for
BL-TVs.  The resulting objects should support three messages: {\tt
blow-if-overload, switch,} and {\tt set-speed}, as well as
inheriting or delegating to methods from appropriate internal objects.

\vskip 10pt

\begin{lisp}
%;; My inclination is to have them write this whole thing.  An alternative
%;; would be a <blob> oriented completion.
%\null
%;; ANSWER
%;;
%;; The trick is to wrap the SWITCH message *and* the SET-SPEED
%;; to watch for the over-load condition, and if so, to blow fuse.
%;;
(define (make-BL-TV)
  (let ((BL (make-blender))
        (TV (make-tv)))
    (lambda (message)
      (case message
        ((BLOW-IF-OVERLOAD)  ;; internal method for overload
         $<$blob6$>$)
%         (lambda (self)
%           (if (and (delegate BL self 'ON?)
%                    (delegate TV self 'ON?)
%                    (> (delegate BL self 'SPEED) 3))
%               (delegate-to-all (list BL TV) self BLOW-FUSE))))
        ((SWITCH)
         $<$blob7$>$)
%         (lambda (self on-off)
%           (delegate-to-all (list BL TV) self 'SWITCH on-off)
%           (ask self 'BLOW-IF-OVERLOAD)))
        ((SET-SPEED)
         $<$blob8$>$)
%         (lambda (self new-speed)
%           (delegate BL self 'SET-SPEED new-speed)
%           (ask self 'BLOW-IF-OVERLOAD)))
        (else (get-method message TV BL))))))
\end{lisp}

\vskip 10pt

$<$blob6$>$

\emptybox{6in}{2in}

\newpage

$<$blob7$>$

\emptybox{6in}{2in}

\vskip 10pt

$<$blob8$>$

\emptybox{6in}{2in}

\newpage

{\bf Question 7 (0 points)}

What is the worst joke that Prof.\ Grimson has told in lecture so far
this term?


\vskip 10pt

\emptybox{6in}{1in}


\end{document}