惰性求值解释器

核心思想

本节我们要实现一门正规序语言，它和 Scheme 完全相同，唯一的区别是：复合过程对每个参数都是非严格的，原始过程则仍然是严格的。 要改造第 12 课的求值器，让它解释的语言表现出这种行为，并不难。几乎所有需要改动的地方都集中在过程应用上。

（记住，上面这些选择只是选择而已！第 12 课的元循环求值器本身就工作得很好，只是有时候我们希望 Scheme 有不同的行为。本节要讲的就是修改 MCE 的代码，让被解释的 Scheme 变成正规序。）

基本思路是：应用过程时，解释器必须判断哪些参数要求值、哪些要延迟。被延迟的参数不求值，而是被转化成一种叫做 thunk（延迟计算单元）的对象。thunk 必须包含在需要时产生该参数值所需的全部信息，就好像这个值在过程应用的当时就已经求过值一样。因此，thunk 必须包含参数表达式，以及求值该过程应用时所处的环境。

在 thunk 中求值表达式的动作叫做强制（forcing）。一般来说，只有到了需要值的时候，thunk 才会被强制：把它传给一个会用到其值的原始过程时；它是某个条件判断的谓词值时；它是即将作为过程被应用的操作符时。我们有一个设计上的选择：要不要像第 11 课对延迟对象那样，对 thunk 做记忆化（memoization）。有了记忆化，thunk 第一次被强制时会把算出的值存下来，以后再强制就直接返回存好的值，不必重算。我们决定让解释器带上记忆化，因为对很多应用来说这样更高效。不过这里也有些棘手的细节要考虑。

修改求值器

惰性求值器与第 12 课的求值器，主要差别在于 eval 和 apply 中处理过程应用的方式。

eval 中 application? 子句变成：

((application? exp)
 (apply (actual-value (operator exp) env)
        (operands exp)
        env))

这和第 12 课 eval 中的 application? 子句几乎一样。但为了实现惰性求值，我们调用 apply 时传的是操作数表达式本身，而不是把它们求值后得到的参数。由于参数要延迟时构造 thunk 需要环境，我们还得把环境一并传过去。操作符我们仍然要求值，因为 apply 需要拿到实际要应用的过程，才能按类型分发（原始的还是复合的）并应用它。

凡是需要表达式的实际值时，我们都用

(define (actual-value exp env)
  (force-it (eval exp env)))

而不是直接用 eval。这样，如果表达式的值是个 thunk，它就会被强制。

修改 apply

新版的 apply 也和 MCE 中的版本几乎一样。区别在于：eval 传进来的是未求值的操作数表达式——对于原始过程（它们是严格的），先求值所有参数再应用；对于复合过程（它们是非严格的），先把所有参数延迟再应用。

(define (apply procedure arguments env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure
          procedure
          (list-of-arg-values arguments env)))  ; changed
        ((compound-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters procedure)
           (list-of-delayed-args arguments env) ; changed
           (procedure-environment procedure))))
        (else
         (error
          "Unknown procedure type -- APPLY" procedure))))

处理参数的过程和第 12 课的 list-of-values 很像，区别在于：list-of-delayed-args 是延迟参数而不是求值参数；list-of-arg-values 用 actual-value 而不是 eval：

(define (list-of-arg-values exps env)
  (if (no-operands? exps)
      '()
      (cons (actual-value (first-operand exps) env)
            (list-of-arg-values (rest-operands exps)
                                env))))
(define (list-of-delayed-args exps env)
  (if (no-operands? exps)
      '()
      (cons (delay-it (first-operand exps) env)
            (list-of-delayed-args (rest-operands exps)
                                  env))))

处理 if

另一处必须改动的地方是 if 的处理：必须用 actual-value 而不是 eval 来取得谓词表达式的值，然后再判断它是真还是假：

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

修改 driver-loop

最后，还要修改 driver-loop 过程（即 read-eval-print 循环），把 eval 换成 actual-value。这样，如果延迟的值一路传回到 read-eval-print 循环，打印前会先被强制。我们同时修改提示符，表明这是惰性求值器：

(define input-prompt ";;; L-Eval input:")
(define output-prompt ";;; L-Eval value:")
(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output
           (actual-value input the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))

测试一下

改完这些，我们就可以启动求值器做测试了。前面”正规序与应用序”一节讨论过的 try 表达式如果能成功求值，就说明解释器在执行惰性求值：

(define the-global-environment (setup-environment))
(driver-loop)
;;; L-Eval input:
(define (try a b)
  (if (= a 0) 1 b))
;;; L-Eval value:
ok
;;; L-Eval input:
(try 0 (/ 1 0))
;;; L-Eval value:
1

表示 thunk

我们的求值器必须安排好在过程应用于参数时创建 thunk，并在稍后强制这些 thunk。thunk 要把表达式和环境打包在一起，这样参数的值以后才能被算出来。强制 thunk 时，我们只需从中取出表达式和环境，在该环境中求值这个表达式。这里用 actual-value 而不是 eval，是为了在表达式的值本身也是 thunk 的情况下继续强制，如此反复，直到得到不是 thunk 的东西：

(define (force-it obj)
  (if (thunk? obj)
      (actual-value (thunk-exp obj) (thunk-env obj))
      obj))

把表达式和环境打包的一个简单办法，是构造一个包含表达式和环境的列表。于是，thunk 这样创建：

(define (delay-it exp env)
  (list 'thunk exp env))

(define (thunk? obj)
  (tagged-list? obj 'thunk))

(define (thunk-exp thunk) (cadr thunk))

(define (thunk-env thunk) (caddr thunk))

实际上，我们的解释器需要的并不完全是这个样子，而是带记忆化的 thunk。thunk 被强制时，我们把它变成一个已求值的 thunk：用值替换掉存储的表达式，并改掉 thunk 的标记，让它以后能被认出来已经求过值了。

(define (evaluated-thunk? obj)
  (tagged-list? obj 'evaluated-thunk))

(define (thunk-value evaluated-thunk)
  (cadr evaluated-thunk))
(define (force-it obj)
  (cond ((thunk? obj)
         (let ((result (actual-value
                        (thunk-exp obj)
                        (thunk-env obj))))
           (set-car! obj 'evaluated-thunk)
           (set-car! (cdr obj) result)  ; replace exp with its value
           (set-cdr! (cdr obj) '())     ; forget unneeded env
           result))
        ((evaluated-thunk? obj)
         (thunk-value obj))
        (else obj)))

请注意：同一个 delay-it 过程，带不带记忆化都能用。