6.001 Structure and Interpretation of Computer Programs
Recitation #20
Friday, November 19, 2004

Review

Practice

Change the interpreter to support the following special forms, some of which should already be familiar to you from Scheme. BR>

1. (set!* var exp) evaluates exp and assign its value to var.  Although set! in Scheme has an undefined return value, your set!* should return var's previous value.

First we modify eval to check for a set! special form:
(define (eval exp env)
  (cond
   ((number? exp) exp)
   ((symbol? exp) (lookup exp env))
   ((define? exp) (eval-define exp env))
   ((if? exp) (eval-if exp env))
   ((lambda? exp) (eval-lambda exp env))
   ((let? exp) (eval-let exp env))
   ((set!? exp) (eval-set! exp env))
   ((application? exp) (apply* (eval (car exp) env)
			      (map (lambda (e) (eval e env))
				   (cdr exp))))
   (else
    (error "unknown expression " exp))))
Then we define how set! is evaluated:
(define (set!? exp) (tag-check exp 'set!*))

(define (eval-set! exp env)
  (let ((name (second exp))
	(value (eval (third exp) env)))
    (let ((binding (lookup-binding name env)))
      (let ((old-value (binding-value binding)))
	(set-binding-value! binding value)
	old-value))))
Finally, we need a new form of lookup that returns bindings instead of values, and a mutator that lets us change a binding's value:
(define (lookup-binding name env)
  (if (null? env)
      (error "unbound variable:" name)
      (let ((binding (table-get (car env) name)))
	(if (pair? binding)
	    binding
	    (lookup-binding name (cdr env))))))

(define (set-binding-value! binding value)
  (set-car! (cdr binding) value))
2. (case* expr
     ((val val ...) consequent)
     ((val val  ...) consequent)
     ...
     (else* alternate))
Case* evaluates expr and compares its value (using eqv?) against each of the listed values (which are not evaluated).  When a match is found, the corresponding consequent expression is evaluated and returned as the result of the case*.  If no matches are found, the alternate expression is evaluated and returned instead.  You can assume the else* clause is required if you want.
(define (eval exp env)
  (cond
   ((number? exp) exp)
   ((symbol? exp) (lookup exp env))
   ((define? exp) (eval-define exp env))
   ((if? exp) (eval-if exp env))
   ((lambda? exp) (eval-lambda exp env))
   ((let? exp) (eval-let exp env))
   ((case? exp) (eval-case exp env))
   ((application? exp) (apply* (eval (car exp) env)
			      (map (lambda (e) (eval e env))
				   (cdr exp))))
   (else
    (error "unknown expression " exp))))

(define (case? exp) (tag-check exp 'case*))

(define (eval-case exp env)
  (let ((target-value (eval (second exp) env)))
    (eval-case-clauses target-value (cddr exp) env)))

(define (eval-case-clauses target-value clauses env)
  (if (null? clauses)
      'undefined 
      (let ((clause (car clauses)))
	(cond ((else-clause? clause) (eval (second clause) env))
	      ((value-found? target-value (first clause))
	       (eval (second clause) env))
	      (else (eval-case-clauses target-value (cdr clauses) env))))))

(define (else-clause? clause) (tag-check clause 'else*))

(define (value-found? target values)
  (not (null? (memv target values))))

3. (quote* expr) returns expr without evaluating it.
(define (eval exp env)
  (cond
   ((number? exp) exp)
   ((symbol? exp) (lookup exp env))
   ((define? exp) (eval-define exp env))
   ((if? exp) (eval-if exp env))
   ((lambda? exp) (eval-lambda exp env))
   ((let? exp) (eval-let exp env))
   ((quote? exp) (eval-quote exp env))
   ((application? exp) (apply* (eval (car exp) env)
			      (map (lambda (e) (eval e env))
				   (cdr exp))))
   (else
    (error "unknown expression " exp))))

(define (quote? exp) (tag-check exp 'quote*))

(define (eval-quote exp env)
  (second exp))


4. (begin* e1 e2 ... eN) evaluates each expression in sequence, returning the value of eN as its final result.
(define (eval exp env)
  (cond
   ((number? exp) exp)
   ((symbol? exp) (lookup exp env))
   ((define? exp) (eval-define exp env))
   ((if? exp) (eval-if exp env))
   ((lambda? exp) (eval-lambda exp env))
   ((let? exp) (eval-let exp env))
   ((begin? exp) (eval-begin exp env))
   ((application? exp) (apply* (eval (car exp) env)
			      (map (lambda (e) (eval e env))
				   (cdr exp))))
   (else
    (error "unknown expression " exp))))


(define (begin? exp) (tag-check exp 'begin*))

(define (eval-begin exp env)
  (eval-begin-body (cdr exp) env))

(define (eval-begin-body body env)
  (if (null? body)
      'undefined
      (let ((value (eval (car body) env)))
	(if (null? (cdr body))
	    value
	    (eval-begin-body (cdr body) env)))))


5.  (ask* obj message args ...) evaluates obj and args but not message, and then uses ask to send the message to the object. This special form allows us to avoid quoting the message all the time --- instead of writing (ask person 'NAME), a Scheme* programmer writes (ask* person NAME).
(define (eval exp env)
  (cond
   ((number? exp) exp)
   ((symbol? exp) (lookup exp env))
   ((define? exp) (eval-define exp env))
   ((if? exp) (eval-if exp env))
   ((lambda? exp) (eval-lambda exp env))
   ((let? exp) (eval-let exp env))
   ((ask? exp) (eval-ask exp env))
   ((application? exp) (apply* (eval (car exp) env)
			      (map (lambda (e) (eval e env))
				   (cdr exp))))
   (else
    (error "unknown expression " exp))))

(define (ask? exp) (tag-check exp 'ask*))

(define (eval-ask exp env)
  (let ((object (eval (second exp)))
	(message (third exp))
	(args (map (lambda (e) (eval e env)) (cdddr exp))))
    (apply ask object message args)))


6. (define* (name arg arg ...) body) defines a procedure name with arguments (arg arg ...) and body body.
(define (eval-define exp env)
  (if (procedure-define? exp)
      (eval-procedure-define exp env)
      (eval-variable-define exp env)))

(define (procedure-define? exp)
  (and (tag-check exp 'define*)
       (pair? (second exp))))

(define (eval-procedure-define exp env)
  (let ((name (first (second exp)))
	(args (cdr (second exp)))
	(body (third exp)))
    (table-put! (car env) name (make-compound args body env))
    'undefined))

(define (eval-variable-define exp env)
  (let ((name (cadr exp))
	(defined-to-be (caddr exp)))
    (table-put! (car env) name (eval defined-to-be env))
    'undefined))