使用 data-directed，我们可以看到模块化的可加性在解释器这里非常优雅地被展现出来了。但有一个问题目前也是比较难以解决的。
eval
首先对于 eval 本身来说，我们对于 self-evaluating? 和 variable? 是没有办法放到表中的，所以只能单独写到 eval 里面。另外一个是 application 的判断的问题，见 `问题`_ 。
(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
(else
(let ((eval-action (get 'eval (type-of-expression exp))))
(cond (eval-action (eval-action (datum-of-expression exp) env))
((pair? exp)
((get 'eval application-tag) exp env)) ; hopefully this will not conflict
(else (error "Unknown expression type -- EVAL" exp)))))))
(define (type-of-expression exp) (car exp))
(define (datum-of-expression exp) (cdr exp))
quote
quote 模块的主要过程是 eval-quote。
(define (install-eval-quote)
;; procedure helper
(define (text-of-quotation exp) (car exp))
;; main handler
(define (eval-quote exp env)
(text-of-quotation exp))
;; install
(put 'eval quote-tag eval-quote))assignment
assignment 模块的主要过程是 eval-assignment。
到目前为止 assignment 模块中还缺少一个 set-variable-value! 的过程。
(define (install-eval-assignment)
;; procedure helper
(define (assignment-variable exp) (car exp))
(define (assignment-value exp) (cadr exp))
;; lack set-variable-value!
;; main handler
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(eval (assignment-value exp) env)
env)
'ok)
(put 'eval assignment-tag eval-assignment))definition
definition 的主要过程是 eval-definition。这在里，我们的过程 definition-value 中需要用到 make-lambda 过程，这个过程是在 install-eval-lambda 模块中的，这就需要我们在 install-eval-lambda 包中将这个过程导出。
(define (install-eval-definition)
;; procedure helper
(define (definition-variable exp)
(if (symbol? (car exp))
(car exp)
(caar exp)))
(define (definition-value exp)
(if (symbol? (car exp))
(cadr exp)
(make-lambda (cdar exp) ; formal parameters
(cdr exp)))) ; body
(define (make-lambda parameter body)
((get 'constructor lambda-tag) parameter body))
;; main handler
(define (eval-definition exp env)
(define-variable! (definition-variable exp)
(eval (definition-value exp) env)
env)
'ok)
(put 'eval definition-tag eval-definition))if
if 的主要过程是 eval-if
(define (install-eval-if)
;; procedure helper
(define (if-predicate exp) (car exp))
(define (if-consequent exp) (cadr exp))
(define (if-alternative exp)
(if (not (null? (cddr exp)))
(caddr exp)
'false))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
;; main handler
(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
(put 'eval if-tag eval-if)
(put 'constructor if-tag make-if))lambda
lambda 包中需要导出 make-lambda 过程。我们这里选择使用一个新的行叫 constructor，将 make-lambda 放到列 lambda 中。
(define (install-eval-lambda)
(define (lambda-parameters exp) (car exp))
(define (lambda-body exp) (cdr exp))
(define (make-lambda parameters body)
(cons lambda-tag (cons parameters body)))
(define (eval-lambda exp env)
(make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
;;
(put 'eval lambda-tag eval-lambda)
(put 'constructor lambda-tag make-lambda))sequence
sequence 中同样需要导出 sequence->exp，这个过程会被 cond 用到。这里我们暂时使用一个叫 type-convert 的行，begin 列存放 sequence->exp 过程。
(define (install-eval-sequence)
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(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))
;; main handler
(define (eval-sequences exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (eval (first-exp exps) env)
(eval-sequences (rest-exps exps) env))))
(put 'eval sequence-tag eval-sequences)
(put 'constructor sequence-tag make-begin)
(put 'export-1 sequence-tag sequence->exp))
cond
cond 需要使用到 sequence->exp。当然，我们也可以自己来写一个 sequence->exp 的过程。
(define (install-eval-cond)
(define (eval-cond exp env)
(eval (expand-clauses exp) env))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (sequence->exp seq)
((get 'export-1 sequence-tag) seq))
(define (make-if tst thn els)
((get 'constructor if-tag) tst thn els))
(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))))))
(put 'eval cond-tag eval-cond))application
application 几乎是不可以判断的。它只能是所有的判断结束之后，剩下的那个操作。
这里注意的是，我们选取了一个叫 application 的列名来存储 application 的解释过程。
我们也许会担心，如果我们要解释的过程里面，恰好过程的名字为 application 怎么办？比如
(eval
'(begin (define (application x) (+ x 1))
(application 1))
env)
当解释到 (application 1) 的时候，我们的解释器在
(let ((eval-action (get 'eval (type-of-expression exp))))
(cond (eval-action (eval-action exp env))
(...)))
这一步，相当于运行了 (get ‘eval ‘application)，一样，eval-action 将被赋值为 eval-application 这一过程。
但这并不影响继续解释执行下去，因为我们的 (eval-action exp env) 与 ((get ‘eval ‘application) exp env) 是等同的。
(define (install-eval-application)
(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))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
(define (eval-application exp env)
(apply1 (eval (operator exp) env)
(list-of-values (operands exp) env)))
(put 'eval application-tag eval-application))问题
模块化的程序，比如这个 data-directed 风格的解释器，是比较难以做到模块之间互通有无的。比如我们的 cond 模块需要用到 sequence 模块中的 sequence->exp 过程，就必须在 sequence 模块中，将 sequence 保存到一个位置才行，但这一个需求就将浪费掉一整行的空间。
application 判断的问题也是比较麻烦的。我们将 application 的操作放到了一列名字叫 ‘%%application 的列中。这个名字必须不能是要解释的代码中的一个过程的名称，否则解释器即将会去运行 (eval-application (datum-of-expression exp) env)，这个语句将会去掉第一个元素–这里即去掉了过程的名称，只把参数传递给了 eval-application。
当然我们也可以做到解释时参数传递的统一。
(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
(else
(let ((eval-action (get 'eval (type-of-expression exp))))
(cond (eval-action (eval-action exp env))
((pair? exp)
((get 'eval application-tag) exp env)) ; hopefully this will not conflict
(else (error "Unknown expression type -- EVAL" exp)))))))
这样就可以为随意为 application 列取名字了–cond 都是将整个 exp 传递到相应的过程中的。
但这样做，比如想要导出 eval-sequence 给 apply 过程使用的时候， eval-sequence 所处理的表达式是带有 begin 的表达式，于是我们需要手动给 apply 中加上 make-begin（也需要导出）。这样不如让 eval 来去掉各表达式的明显的标示符。