Announcements

Quiz 2 tomorrow

Analyzing Evaluator

(define (eval exp env)
  ;; First call ANALYZE to build a bag of code
  ;; from the original EXPression, then call the
  ;; bag of code with the ENVironment.
  ((analyze exp) env))

(define (analyze exp)
  ;; Convert the EXPression into a bag of code
  (cond ((self-evaluating? exp) 
         (analyze-self-evaluating exp))
        ...
        ((variable? exp) (analyze-variable exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((application? exp) (analyze-application exp))
        (else ...)))

IF and LAMBDA, Analyze Style

(define (analyze-if exp)
  (let ((pproc (analyze (if-predicate exp)))
        (cproc (analyze (if-consequent exp)))
        (aproc (analyze (if-alternative exp))))
    (lambda (env)
      (if (true? (pproc env))
          (cproc env)
          (aproc env)))))

(define (analyze-lambda exp)
  (let ((vars (lambda-parameters exp))
        (bproc (analyze-sequence (lambda-body exp))))
    (lambda (env) (make-procedure vars bproc env))))

Procedure Application, Analyze Style

(define (analyze-application exp)
  (let ((fproc (analyze (operator exp)))
        (aprocs (map analyze (operands exp))))
    (lambda (env)
      (execute-application
        (fproc env)
       	(map (lambda (aproc) (aproc env)) aprocs)))))

(define (execute-application proc args)
  (cond ...
        ((compound-procedure? proc)
         ((procedure-body proc)
          (extend-environment 
            (procedure-parameters proc)
            args
            procedure-environment proc))))
        ...))

CATCH and OOPS

(define (add-up l)
  (if (null? l)
      0
      (+ (car l) (add-up (cdr l)))))

(define (average values)
 (catch Divide-by-Zero 
   (divide (add-up values) (length values))
   0))

(define (divide x y)
  (if (zero? y)
      (oops divide-by-zero)
      (/ x y)))

(average (list 10 20)) ==> 15
(average '()) ==> 0

Support: Label Lookup

(define *labels* '())

(define (add-label name procedure)
  (set! *labels* (cons (list name procedure) *labels*)))

(define (find-label name)
  (let ((entry (assq name *labels*)))
    (and entry (second entry))))

Implementing OOPS

(define (analyze-oops exp)
  ;; (OOPS <name>)
  (let ((name (second exp)))
    (lambda (env)
      (let ((label (find-label name)))
	(if label
	    (label)
	    (error "No handler for error" name))))))

A Bug in the Code

(catch george (oops george) 'george) ==>  george
(catch george (+ 2 3) 'george) ==> 5
(catch george
  (begin (oops george) (+ 2 3))
  'george) ==> 5 ; Should be GEORGE