UP | HOME

4.1 - The Metacircular Evaluator

We will be writing a Lisp evaluator implemented in Lisp (hence, metacircular: an evaluator written in the same language it evaluates).

4.1-lisp.jpg

4.1-eval-apply.svg

The evaluator will be specified using procedures defining the syntax of the expressions to be evaluated. Data abstraction will be used to make the evaluator independent of the representation of the language.

The Core of the Evaluator

Eval

(define (eval exp env)
  (cond ((self-evaluating? exp) 
         exp)
        ((variable? exp) 
         (lookup-variable-value exp env))
        ((quoted? exp) 
         (text-of-quotation exp))
        ((assignment? exp) 
         (eval-assignment exp env))
        ((definition? exp) 
         (eval-definition exp env))
        ((if? exp) 
         (eval-if exp env))
        ((lambda? exp)
         (make-procedure 
          (lambda-parameters exp)
          (lambda-body exp)
          env))
        ((begin? exp)
         (eval-sequence 
          (begin-actions exp) 
          env))
        ((cond? exp) 
         (eval (cond->if exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values 
                 (operands exp) 
                 env)))
        (else
         (error "Unknown expression 
                 type: EVAL" exp))))

Apply

(define apply-in-underlying-scheme apply)
(define (apply procedure arguments)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure 
          procedure 
          arguments))
        ((compound-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters 
            procedure)
           arguments
           (procedure-environment 
            procedure))))
        (else
         (error "Unknown procedure 
                 type: APPLY" 
                procedure))))

Procedure Arguments

(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (cons (eval (first-operand exps) env)
            (list-of-values 
             (rest-operands exps) 
             env))))

Conditionals

(define (eval-if exp env)
  (if (true? (eval (if-predicate exp) env))
      (eval (if-consequent exp) env)
      (eval (if-alternative exp) env)))

In this case, the language being implemented and the implementation language are the same. Contemplation of the meaning of true? here yields expansion of consciousness without the abuse of substance.

Sequences

(define (eval-sequence exps env)
  (cond ((last-exp? exps) 
         (eval (first-exp exps) env))
        (else 
         (eval (first-exp exps) env)
         (eval-sequence (rest-exps exps) 
                        env))))

Assignments and definitions

(define (eval-assignment exp env)
  (set-variable-value! 
   (assignment-variable exp)
   (eval (assignment-value exp) env)
   env)
  'ok)

(define (eval-definition exp env)
  (define-variable! 
    (definition-variable exp)
    (eval (definition-value exp) env)
    env)
  'ok)

Exercise 4.1

Notice that we cannot tell whether the metacircular evaluator evaluates operands from left to right or from right to left. Its evaluation order is inherited from the underlying Lisp: If the arguments to cons in list-of-values are evaluated from left to right, then list-of-values will evaluate operands from left to right; and if the arguments to cons are evaluated from right to left, then list-of-values will evaluate operands from right to left.

Write a version of list-of-values that evaluates operands from left to right regardless of the order of evaluation in the underlying Lisp. Also write a version of list-of-values that evaluates operands from right to left.


(define (list-of-values-ltr exps env)
  (if (no-operands? exps)
      '()
      (let ((first (eval (first-operand exps) env))
            (rest (list-of-values-ltr
                   (rest-operands exps)
                   env)))
        (cons first rest))))
(define (list-of-values-rtl exps env)
  (if (no-operands? exps)
      '()
      (let ((rest (list-of-values-rtl
                   (rest-operands exps)
                   env))
            (first (eval (first-operand exps) env)))
        (cons first rest))))

Representing Expressions

  • The only self-evaluating items are numbers and strings:
    (define (self-evaluating? exp)
      (cond ((number? exp) true)
            ((string? exp) true)
            (else false)))
    
  • Variables are represented by symbols:
    (define (variable? exp) (symbol? exp))
    
  • Quotations have the form (quote 〈text-of-quotation〉):
    (define (quoted? exp)
      (tagged-list? exp 'quote))
    
    (define (text-of-quotation exp)
      (cadr exp))
    

    Quoted? is defined in terms of the procedure tagged-list?, which identifies lists beginning with a designated symbol:

    (define (tagged-list? exp tag)
      (if (pair? exp)
          (eq? (car exp) tag)
          false))
    
  • Assignments have the form (set! 〈var〉 〈value〉):
    (define (assignment? exp)
      (tagged-list? exp 'set!))
    
    (define (assignment-variable exp) 
      (cadr exp))
    
    (define (assignment-value exp) (caddr exp))
    
  • Definitions have the form
    (define ⟨var⟩ ⟨value⟩)
    

    or the form

    (define (⟨var⟩ ⟨param₁⟩ … ⟨paramₙ⟩)
      ⟨body⟩)
    

    The latter form (standard procedure definition) is syntactic sugar for

    (define ⟨var⟩
      (lambda (⟨param₁⟩ … ⟨paramₙ⟩)
        ⟨body⟩))
    

    The corresponding syntax procedures are the following:

    (define (definition? exp)
      (tagged-list? exp 'define))
    
    (define (definition-variable exp)
      (if (symbol? (cadr exp))
          (cadr exp)
          (caadr exp)))
    
    (define (definition-value exp)
      (if (symbol? (cadr exp))
          (caddr exp)
          (make-lambda 
           (cdadr exp)   ; formal parameters
           (cddr exp)))) ; body
    
  • Lambda expressions are lists that begin with the symbol lambda:
    (define (lambda? exp) 
      (tagged-list? exp 'lambda))
    (define (lambda-parameters exp) (cadr exp))
    (define (lambda-body exp) (cddr exp))
    

    We also provide a constructor for lambda expressions, which is used by definition-value, above:

    (define (make-lambda parameters body)
      (cons 'lambda (cons parameters body)))
    
  • Conditionals begin with if and have a predicate, a consequent, and an (optional) alternative. If the expression has no alternative part, we provide false as the alternative.
    (define (if? exp) (tagged-list? exp 'if))
    (define (if-predicate exp) (cadr exp))
    (define (if-consequent exp) (caddr exp))
    (define (if-alternative exp)
      (if (not (null? (cdddr exp)))
          (cadddr exp)
          'false))
    

    We also provide a constructor for if expressions, to be used by cond->if to transform cond expressions into if expressions:

    (define (make-if predicate 
                     consequent 
                     alternative)
      (list 'if 
            predicate 
            consequent 
            alternative))
    
  • Begin packages a sequence of expressions into a single expression. We include syntax operations on begin expressions to extract the actual sequence from the begin expression, as well as selectors that return the first expression and the rest of the expressions in the sequence.
    (define (begin? exp) 
      (tagged-list? exp 'begin))
    (define (begin-actions exp) (cdr exp))
    (define (last-exp? seq) (null? (cdr seq)))
    (define (first-exp seq) (car seq))
    (define (rest-exps seq) (cdr seq))
    

    We also include a constructor sequence->exp (for use by cond->if) that transforms a sequence into a single expression, using begin if necessary:

    (define (sequence->exp seq)
      (cond ((null? seq) seq)
            ((last-exp? seq) (first-exp seq))
            (else (make-begin seq))))
    
    (define (make-begin seq) (cons 'begin seq))
    
  • A procedure application is any compound expression that is not one of the above expression types. The car of the expression is the operator, and the cdr is the list of operands:
    (define (application? exp) (pair? exp))
    (define (operator exp) (car exp))
    (define (operands exp) (cdr exp))
    (define (no-operands? ops) (null? ops))
    (define (first-operand ops) (car ops))
    (define (rest-operands ops) (cdr ops))
    

Derived expressions

Cond can be represented as a nest of if expressions.

(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))
(define (cond->if exp)
  (expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
  (if (null? clauses)
      'false     ; no else clause
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
            (if (null? rest)
                (sequence->exp 
                 (cond-actions first))
                (error "ELSE clause isn't 
                        last: COND->IF"
                       clauses))
            (make-if (cond-predicate first)
                     (sequence->exp 
                      (cond-actions first))
                     (expand-clauses 
                      rest))))))

Expressions (such as cond) that we choose to implement as syntactic transformations are called derived expressions. Let expressions are also derived expressions (see Exercise 4.6).

Practical Lisp systems provide a mechanism that allows a user to add new derived expressions and specify their implementation as syntactic transformations without modifying the evaluator. Such a user-defined transformation is called a macro. Although it is easy to add an elementary mechanism for defining macros, the resulting language has subtle name-conflict problems. There has been much research on mechanisms for macro definition that do not cause these difficulties. See, for example, Kohlbecker 1986, Clinger and Rees 1991, and Hanson 1991.

Exercise 4.2

Louis Reasoner plans to reorder the cond clauses in eval so that the clause for procedure applications appears before the clause for assignments. He argues that this will make the interpreter more efficient: Since programs usually contain more applications than assignments, definitions, and so on, his modified eval will usually check fewer clauses than the original eval before identifying the type of an expression.

  1. What is wrong with Louis’s plan? (Hint: What will Louis’s evaluator do with the expression (define x 3)?)

    The procedure application check requires only that the expression be a pair, which any list will satisfy. For example, the expression (define x 3) would trigger application instead of assignment, and end up failing.

  2. Louis is upset that his plan didn’t work. He is willing to go to any lengths to make his evaluator recognize procedure applications before it checks for most other kinds of expressions. Help him by changing the syntax of the evaluated language so that procedure applications start with call. For example, instead of (factorial 3) we will now have to write (call factorial 3) and instead of (+ 1 2) we will have to write (call + 1 2).
    (define (application? exp)
      (tagged-list exp 'call))
    
    (define (operator exp) (cadr exp))
    (define (operands exp) (cddr exp))
    

Exercise 4.3

Rewrite eval so that the dispatch is done in data-directed style. Compare this with the data-directed differentiation procedure of Exercise 2.73. (You may use the car of a compound expression as the type of the expression, as is appropriate for the syntax implemented in this section.)


Borrowed from Weiqun Zhang's blog, for working implementations of get and put.

;; -------------------------------------------------------------------
;; Exercise 4.3
;; -------------------------------------------------------------------

(define eval-table (make-eq-hash-table))
(define (get key)
  (hash-table/get eval-table key #f))
(define (put key proc)
  (hash-table/put! eval-table key proc))

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((get (car exp))
         ((get (car exp)) exp env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))

(put 'quote
     (lambda (exp env)
       (text-of-quotation exp)))
(put 'set!
     (lambda (exp env)
       (eval-assignment exp env)))
(put 'define eval-definition)
(put 'if eval-if)
(put 'lambda
     (lambda (exp env)
       (make-procedure (lambda-parameters exp)
                       (lambda-body exp)
                       env)))
(put 'begin
     (lambda (exp env)
       (eval-sequence (begin-actions exp) env)))
(put 'cond
     (lambda (exp env)
       (eval (cond->if exp) env)))

Exercise 4.4

Recall the definitions of the special forms and and or from Chapter 1:

  • and: The expressions are evaluated from left to right. If any expression evaluates to false, false is returned; any remaining expressions are not evaluated. If all the expressions evaluate to true values, the value of the last expression is returned. If there are no expressions then true is returned.
  • or: The expressions are evaluated from left to right. If any expression evaluates to a true value, that value is returned; any remaining expressions are not evaluated. If all expressions evaluate to false, or if there are no expressions, then false is returned.

Install and and or as new special forms for the evaluator by defining appropriate syntax procedures and evaluation procedures eval-and and eval-or. Alternatively, show how to implement and and or as derived expressions.


;; -------------------------------------------------------------------
;; Exercise 4.4
;; -------------------------------------------------------------------

;; Special forms

(define (eval-and exp env)
  (define (eval-and-operands exps)
    (if (no-operands? exps)
        true
        (let ((first (eval (first-operand exps) env))
              (rest (rest-operands exps)))
          (if (false? first)
              false
              (if (no-operands? rest)
                  first
                  (eval-and-operands rest))))))
  (eval-and-operands (operands exp)))

(define (eval-or exp env)
  (define (eval-or-operands exps)
    (if (no-operands? exps)
        false
        (let ((first (eval (first-operand exps) env))
              (rest (rest-operands exps)))
          (if (true? first)
              first
              (eval-or-operands rest)))))
  (eval-or-operands (operands exp)))

(put 'and eval-and)
(put 'or eval-or)

;; Derived expressions

(define (and->if exp)
  (define (expand exps)
    (if (null? exps)
        'true
        (make-if (list 'false? (car exps))
                 'false
                 (if (null? (cdr exps))
                     (car exps)
                     (expand (cdr exps))))))
  (expand (cdr exp)))

(define (or->if exp)
  (define (expand exps)
    (if (null? exps)
        'false
        (make-if (list 'true? (car exps))
                 (car exps)
                 (expand (cdr exps)))))
  (expand (cdr exp)))

Exercise 4.5

Scheme allows an additional syntax for cond clauses, (⟨test⟩ => ⟨recipient⟩). If ⟨test⟩ evaluates to a true value, then ⟨recipient⟩ is evaluated. Its value must be a procedure of one argument; this procedure is then invoked on the value of the ⟨test⟩, and the result is returned as the value of the cond expression. For example

(cond ((assoc 'b '((a 1) (b 2))) => cadr)
      (else false))

returns 2. Modify the handling of cond so that it supports this extended syntax.


;; -------------------------------------------------------------------
;; Exercise 4.5
;; -------------------------------------------------------------------

(define (cond-actions clause)
  (if (tagged-list? (cdr clause) '=>)
      (list (list (caddr clause) (cond-predicate clause)))
      (cdr clause)))

Exercise 4.6

Let expressions are derived expressions, because

(let ((var₁ exp₁)  (varₙ expₙ))
  body)

is equivalent to

((lambda (var₁  varₙ)
   body)
 exp₁
 
 expₙ)

Implement a syntactic transformation let->combination that reduces evaluating let expressions to evaluating combinations of the type shown above, and add the appropriate clause to eval to handle let expressions.


;; -------------------------------------------------------------------
;; Exercise 4.6
;; -------------------------------------------------------------------

(define (let->combination exp)
  (let ((var-alist (cadr exp))
        (body (cddr exp)))
    (append (list (append (list 'lambda
                                (map car var-alist))
                          body))
            (map cadr var-alist))))


(put 'let
     (lambda (exp env)
       (eval (let->combination exp) env)))

Exercise 4.7

Let* is similar to let, except that the bindings of the let* variables are performed sequentially from left to right, and each binding is made in an environment in which all of the preceding bindings are visible. For example

(let* ((x 3)
       (y (+ x 2))
       (z (+ x y 5)))
  (* x z))

returns 39. Explain how a let* expression can be rewritten as a set of nested let expressions, and write a procedure let*->nested-lets that performs this transformation. If we have already implemented let (Exercise 4.6) and we want to extend the evaluator to handle let*, is it sufficient to add a clause to eval whose action is

(eval (let*->nested-lets exp) env)

or must we explicitly expand let* in terms of non-derived expressions?


Let* can be written as a set of nested let expressions like so:

(let ((x 3))
  (let ((y (+ x 2)))
    (let ((z (+ x y 5)))
      (* x z))))
;; -------------------------------------------------------------------
;; Exercise 5.7
;; -------------------------------------------------------------------

(define (let*->nested-lets exp)
  (define (nested-let var-alist body)
    (if (null? var-alist)
        body
        (let ((var-pair (car var-alist))
              (var-rest (cdr var-alist)))
          (append (list 'let (list var-pair)
                        (nested-let var-rest body))))))
  (nested-let (cadr exp)
              (cddr exp)))

(put 'let*
     (lambda (exp env)
       (eval (let*->nested-lets exp) env)))

Adding the new clause to eval is sufficient; it will recursively evaluate the resulting expressions, translating let* to let to combinations along the way.

Exercise 4.8

“Named let~” is a variant of ~let that has the form

(let var bindings body)

The ⟨bindings⟩ and ⟨body⟩ are just as in ordinary let, except that ⟨var⟩ is bound within ⟨body⟩ to a procedure whose body is ⟨body⟩ and whose parameters are the variables in the ⟨bindings⟩. Thus, one can repeatedly execute the ⟨body⟩ by invoking the procedure named ⟨var⟩. For example, the iterative Fibonacci procedure (1.2.2) can be rewritten using named let as follows:

(define (fib n)
  (let fib-iter ((a 1) (b 0) (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) 
                  a 
                  (- count 1)))))

Modify let->combination of Exercise 4.6 to also support named let.


;; -------------------------------------------------------------------
;; Exercise 4.7
;; -------------------------------------------------------------------

(define (let->combination exp)
  (define (let-combination var-alist body)
    (append (list (append (list 'lambda
                                (map car var-alist))
                          body))
            (map cadr var-alist)))
  (define (named-let-combination name var-alist body)
    (let-combination var-alist
                     (append (list (append (list 'define
                                                 (cons name (map car var-alist)))
                                           body))
                             (list (cons name (map car var-alist))))))
  (cond ((alist? (cadr exp))
         (let-combination (cadr exp) (cddr exp)))
        ((symbol? (cadr exp))
         (named-let-combination (cadr exp)
                                (caddr exp)
                                (cdddr exp)))
        (else (error "Invalid expression -- LET"))))

(put 'let
     (lambda (exp env)
       (eval (let->combination exp) env)))

Exercise 4.9

Many languages support a variety of iteration constructs, such as do, for, while, and until. In Scheme, iterative processes can be expressed in terms of ordinary procedure calls, so special iteration constructs provide no essential gain in computational power. On the other hand, such constructs are often convenient. Design some iteration constructs, give examples of their use, and show how to implement them as derived expressions.

Exercise 4.10

By using data abstraction, we were able to write an eval procedure that is independent of the particular syntax of the language to be evaluated. To illustrate this, design and implement a new syntax for Scheme by modifying the procedures in this section, without changing eval or apply.

Evaluator Data Structures

Testing of predicates

(define (true? x)
  (not (eq? x false)))

(define (false? x)
  (eq? x false))

Representing procedures

(define (make-procedure parameters body env)
  (list 'procedure parameters body env))
(define (compound-procedure? p)
  (tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))

Operations on Environments

(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
(define (make-frame variables values)
  (cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
  (set-car! frame (cons var (car frame)))
  (set-cdr! frame (cons val (cdr frame))))
(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) base-env)
      (if (< (length vars) (length vals))
          (error "Too many arguments supplied" 
                 vars 
                 vals)
          (error "Too few arguments supplied" 
                 vars 
                 vals))))
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop 
              (enclosing-environment env)))
            ((eq? var (car vars))
             (car vals))
            (else (scan (cdr vars) 
                        (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))
(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop 
              (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) 
                        (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable: SET!" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))
(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! 
              var val frame))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) 
                        (cdr vals)))))
    (scan (frame-variables frame)
          (frame-values frame))))

Running the Evaluator as a Program

(define (primitive-procedure? proc)
  (tagged-list? proc 'primitive))

(define (primitive-implementation proc) 
  (cadr proc))
(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
        ;; ⟨more primitives⟩
        (list '= =)
        (list '+ +)
        (list '- -)
        (list '* *)
        (list '/ /)
        ))

(define (primitive-procedure-names)
  (map car primitive-procedures))

(define (primitive-procedure-objects)
  (map (lambda (proc) 
         (list 'primitive (cadr proc)))
       primitive-procedures))
(define (setup-environment)
  (let ((initial-env
         (extend-environment 
          (primitive-procedure-names)
          (primitive-procedure-objects)
          the-empty-environment)))
    (define-variable! 'true true initial-env)
    (define-variable! 'false false initial-env)
    initial-env))

(define the-global-environment 
  (setup-environment))
(define (apply-primitive-procedure proc args)
  (apply-in-underlying-scheme
   (primitive-implementation proc) args))
(define input-prompt  ";;; M-Eval input:")
(define output-prompt ";;; M-Eval value:")

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output 
           (eval input 
                 the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))

(define (prompt-for-input string)
  (newline) (newline) 
  (display string) (newline))

(define (announce-output string)
  (newline) (display string) (newline))
(define (user-print object)
  (if (compound-procedure? object)
      (display 
       (list 'compound-procedure
             (procedure-parameters object)
             (procedure-body object)
             '<procedure-env>))
      (display object)))

Now all we need to do to run the evaluator is to initialize the global environment and start the driver loop. Here is a sample interaction:

(define the-global-environment 
  (setup-environment))

(driver-loop)

;;; M-Eval input:
(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

;;; M-Eval value:
ok

;;; M-Eval input:
(append '(a b c) '(d e f))

;;; M-Eval value:
(a b c d e f)

Data as Programs

our evaluator is seen to be a universal machine. It mimics other machines when these are described as Lisp programs. This is striking.

The fact that the machines are described in Lisp is inessential. If we give our evaluator a Lisp program that behaves as an evaluator for some other language, say C, the Lisp evaluator will emulate the C evaluator, which in turn can emulate any machine described as a C program. Similarly, writing a Lisp evaluator in C produces a C program that can execute any Lisp program. The deep idea here is that any evaluator can emulate any other. Thus, the notion of “what can in principle be computed” (ignoring practicalities of time and memory required) is independent of the language or the computer, and instead reflects an underlying notion of computability. This was first demonstrated in a clear way by Alan M. Turing (1912-1954), whose 1936 paper laid the foundations for theoretical computer science. In the paper, Turing presented a simple computational model—now known as a Turing machine—and argued that any “effective process” can be formulated as a program for such a machine. (This argument is known as the Church-Turing thesis.) Turing then implemented a universal machine, i.e., a Turing machine that behaves as an evaluator for Turing-machine programs. He used this framework to demonstrate that there are well-posed problems that cannot be computed by Turing machines (see Exercise 4.15), and so by implication cannot be formulated as “effective processes.” Turing went on to make fundamental contributions to practical computer science as well. For example, he invented the idea of structuring programs using general-purpose subroutines. See Hodges 1983 for a biography of Turing.

Internal Definitions

Separating Syntatic Analysis from Execution

By separating syntax analysis from execution in eval, we can ensure we don't need to repeat the expensive analysis step for each subsequent execution.

(define (eval exp env) ((analyze exp) env))

The result of calling analyze is the execution procedure to be applied to the environment. The analyze procedure is the same case analysis as performed by the original eval of 1, except that the procedures to which we dispatch perform only analysis, not full evaluation:

(define (analyze exp)
  (cond ((self-evaluating? exp)
         (analyze-self-evaluating exp))
        ((quoted? exp) 
         (analyze-quoted exp))
        ((variable? exp) 
         (analyze-variable exp))
        ((assignment? exp) 
         (analyze-assignment exp))
        ((definition? exp) 
         (analyze-definition exp))
        ((if? exp) 
         (analyze-if exp))
        ((lambda? exp) 
         (analyze-lambda exp))
        ((begin? exp) 
         (analyze-sequence 
          (begin-actions exp)))
        ((cond? exp) 
         (analyze (cond->if exp)))
        ((application? exp) 
         (analyze-application exp))
        (else
         (error "Unknown expression 
                 type: ANALYZE" 
                exp))))
(define (analyze-self-evaluating exp)
  (lambda (env) exp))

(define (analyze-quoted exp)
  (let ((qval (text-of-quotation exp)))
    (lambda (env) qval)))

(define (analyze-variable exp)
  (lambda (env) 
    (lookup-variable-value exp env)))

(define (analyze-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze 
                (assignment-value exp))))
    (lambda (env)
      (set-variable-value! 
       var (vproc env) env)
      'ok)))

(define (analyze-definition exp)
  (let ((var (definition-variable exp))
        (vproc (analyze 
                (definition-value exp))))
    (lambda (env)
      (define-variable! var (vproc env) env)
      'ok)))

(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))))

(define (analyze-sequence exps)
  (define (sequentially proc1 proc2)
    (lambda (env) (proc1 env) (proc2 env)))
  (define (loop first-proc rest-procs)
    (if (null? rest-procs)
        first-proc
        (loop (sequentially first-proc 
                            (car rest-procs))
              (cdr rest-procs))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
        (error "Empty sequence: ANALYZE"))
    (loop (car procs) (cdr procs))))

(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 ((primitive-procedure? proc)
         (apply-primitive-procedure proc args))
        ((compound-procedure? proc)
         ((procedure-body proc)
          (extend-environment 
           (procedure-parameters proc)
           args
           (procedure-environment proc))))
        (else (error "Unknown procedure type: 
                      EXECUTE-APPLICATION"
                     proc))))

Our new evaluator uses the same data structures, syntax procedures, and run-time support procedures as in 2, 3, and 4.

Author: Correl Roush

Created: 2015-01-26 Mon 20:12

Emacs 24.4.2 (Org mode 8.2.10)

Validate