第四章习题 4.16 - 4.37 的解答。

E-4.16:

(a) 如果匹配到相应的变量再检查一下变量值是否为“unassigned”。

(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))
             (let ((v (car vals)))
               (if (eq? v '*unassigned*)
                 (error "Unbound variable" var)
                 v)))
            (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))

(b) 先找出 define 列表，再做相应的转换。所有的 define 都应该位于执行语句之前。

(load "4.1-the.metacircular.evaluator.scm")

(define (scan-out-defines proc-body)

  (define (get-definition-list body)
    (cond ((null? body)
           '())
          ((not (definition? (car body)))
           '())
          (else
            (append (list (list (definition-variable (car body))
                                (definition-value (car body))))
                    (get-definition-list (cdr body))))))

  (define (get-other-parts body)
    (cond ((null? body)
           '())
          ((not (definition? (car body)))
           body)
          (else (get-other-parts (cdr body)))))

  (define (var->list var-list)
    (if (null? var-list)
      '()
      (append (list (list (car var-list) ''*unassigned*))
              (var->list (cdr var-list)))))

  (define (val->list definition-list)
    (map (lambda (x) (append (list 'set! (car x)) (cdr x))) definition-list))

  (define (definition->let definition-list)
    (define (recur l)
      (if (null? l)
        '()
        (append (list 'let)
                (list (var->list (map car l)))
                (val->list l))))

    (recur definition-list))

  (append (definition->let (get-definition-list proc-body))
          (get-other-parts proc-body)))

; ------------------------------------------------------------

(define body-str '((define (even? n) (if (= n 0) true (odd?  (- n 1))))
                   (define (odd? n) (if (= n 0) false (even? (- n 1))))
                   #t))

(scan-out-defines body-str)

(c) 我觉得放在 make-procedure 里比较好，这样后续要用到 body 的时候直接返回就行，不用每次都重复解析。

E-4.17: 图略。如果 define 是顺序解析的话，u 和 v 都属于 lambda 中的命名空间；如果转换成 let 形式，在 lambda 中创建了一个新的命名空间（位于let内）。从程序正确性上来说，u，v 和 <e3> 都属于同一个命名空间。一个不需要创建额外命名空间的方法是，把第2，3，...个 define 值都先赋值为“unassigned”，然后在后面再赋予正确的值，像这样：

(define v '*unassigned*)
(define w '*unassigned*)
(define u (...))
(set! v (...))
(set! w (...))

E-4.18:

实验证明课本上的做法可以正常运行，而这里的做法不行：

(load "../chapter3/3.5.4-streams-and-delayed-evaluation.scm")

(define (solve-2 f y0 dt)
  (let ((y '*unassigned*)
        (dy '*unassigned*))
    (let ((a (integral (delay dy) y0 dt))
          (b (stream-map f y)))
      (set! y a)
      (set! dy b))
    y))

(define (solve-3 f y0 dt)
  (let ((y '*unassigned*)
        (dy '*unassigned*))
    (set! y (integral (delay dy) y0 dt))
    (set! dy (stream-map f y))
    y))

; ----------------------------------------------------------------

(stream-ref (solve-2 (lambda (y) y) 1 0.001) 1000)
(stream-ref (solve-3 (lambda (y) y) 1 0.001) 1000)

函数不能正常工作是因为在进入内层的 let 语句的时候，b 是要被计算出来的，这时候取到的 y 还没有正确的值。因为 let 和 set! 的效果不一样，set! 只是改变了 y 的关联，并没有真正去计算 y 的值。

E-4.19: 我同意 Eva 的观点。既然 define 在整个作用域内有效（也就是书中说的“simultaneous scope”），那么在“(define b ...)”时 a 的值应该为 5。要实现 Eva 的观点，E-4.17 的方法应该行得通。

E-4.20: 不知道怎样分配不同的临时变量，先用同样的字母代替。

(define (letrec-assign-body expression)
  (cadr expression))

(define (letrec-expression expression)
  (cdr (cdr expression)))

(define (letrec-variables body)
  (map car body))

(define (letrec-values body)
  (map cadr body))

(define (variables->list var-list)
  (map (lambda (x) (list x ''*unassigned*)) var-list))

(define (values->list val-list)
  (map (lambda (x) (list 'v x)) val-list)) ; FIXME: assign tmp variables

(define (associate-vars var-list val-list)
  (map (lambda (x y) (list 'set! x (car y)))
       var-list (values->list val-list)))

(define (letrec->let expression)
  (let* ((body (letrec-assign-body expression))
         (var-list (letrec-variables body))
         (val-list (letrec-values body)))
    (append (list 'let) (list (variables->list var-list))
            (list (append (list 'let) (list (values->list val-list))
                          (associate-vars var-list val-list)))
            (letrec-expression expression))))

; ---------------------------------------------

(define str '(letrec
               ((even? (lambda (n)
                         (if (= n 0)
                           #t
                           (odd?  (- n 1)))))
                (odd? (lambda (n)
                        (if (= n 0)
                          #f
                          (even? (- n 1))))))

               (even? x)
               (old? x)))

(letrec->let str)

E-4.21:

(a) 程序分析如下：

(0) "(lambda (n) ...)"：创建一个函数，这个函数有一个整数参数。
(1) "(lambda (fact) (fact fact n))"：创建一个函数（第 0 层的返回值），这个函数有一个参数 fact，参数 fact 也是一个函数，并且 fact 的参数是它本身和一个整数。
(2) "(lambda (ft k) ...)"：创建一个函数，这个函数有两个参数，第一个是一个函数，第二个是一个整数。结果作为参数传递给第 1 层（成为参数 fact）。

((lambda (n)
   ((lambda (fact) (fact fact n))
    (lambda (fib k)
      (cond ((= k 0) 0)
            ((= k 1) 1)
            (else (+ (fib fib (- k 2)) (fib fib (- k 1))))))))
 10)

(b) 结合上面的分析可知，第一个匿名函数是 even?，第二个匿名函数是 odd?。从第二个匿名函数的参数列表中可以看到，odd? 接收的参数分别是：ev?，od?，n，这样第一条空缺的语句就能填上了。even? 的参数同样可知。函数原理是，把一个正整数每次减一，最后为0的时候看落在哪个函数（even? 还是 odd?）中。

(define (f x)
  ((lambda (even? odd?) (even? even? odd? x))
   (lambda (ev? od? n)
     (if (= n 0)
       #t
       (od? ev? od? (- n 1))))
   (lambda (ev? od? n)
     (if (= n 0)
       #f
       (ev? ev? od? (- n 1))))))

E-4.22:

(load "4.06.scm")

(define (analyze-let expression)
  (lambda (env)
    ((analyze-lambda (let->combination expression)) env)))

E-4.23: 课本中的做法是，先把所有的语句都分析完了，然后去遍历这些语句；题目中的做法是，每次只分析一条语句，如果有更多的语句，则递归调用分析函数。课本中的做法在 analyze 阶段把所有分析的活都做完了；而题目中的做法，分析的工作是在 execute 的时候做的，虽然效果一样，但是违背了将 analyze 和 execute 分开的初衷。

E-4.24: 跳过。

E-4.25: 在 applicative-order 会进入死循环，normal-order 下得到正确结果。unless 被定义为一个函数，在 applicative-order 的情况下，每次进入 unless 时都要先计算“(factorial n)”的值；而要计算“(factorial n)”的值，又必须先进入 unless，结果就出现死循环了。

E-4.26: Ben 的观点：当 unless 被作为特殊形式时（和if类似），对于条件语句使用 applicative-order 的形式，而对于 condition-value 和 exception-value 则随便哪种都可以。Alyssa 的观点：如果 unless 作为一个特殊形式，那么就不能将 unless 将某些高阶函数连接起来（应该是说遇到表达式就只能计算它的值，而不是像 cons 这样可以把函数或变量连接起来）。

(define (unless->if expression)
  (let ((condition (cadr expression))
        (usual-value (caddr expression))
        (exception-value (cadddr expression)))
    (list 'if condition exception-value usual-value)))

; ----------------------------------------------------

(define str '(unless (= n 0) 1 0))
(unless->if str)

E-4.27: 第一个结果为 0，因为根据 eval 中处理 define 的函数“add-binding-to-frame!”，只是把变量和对应的值分别加到 frame 中，并没有实际去计算；第二个结果为 10；第三个结果为 2，因为在第二步中要求 w 求值，因此执行了两次 id 函数。

E-4.28: 例如 operator 是一个返回函数的函数。

E-4.29: 一个例子是 fibonacci，如果没有记忆，每次都要从头算起。第一个结果是 100；如果有记忆功能，第二个结果是 1，没有记忆功能的话是 2。

E-4.30: Cy 认为，在处理像“(begin ...)”这样的序列时，除了最后一个表达式的值会被作为返回值返回外，其它表达式的返回值都没有被使用，因此可能导致其它表达式最后根本不会被求值。所以在执行时，应该对序列中除了最后一个表达式以外的表达式都使用强制求值，以保证这些表达式会被执行。

(a) 因为 display 是原语，会强制表达式求值。

(b) 通过加打印语句发现，使用课本中的方法，“(p1 1)”得到的值是 (1 2)，“(p2 1)”的值是 1。在执行“(p2 1)”时，程序找到 p2 的定义就结束了，没执行函数部分：

=======> in my-eval, exp -> (define (p2 x) (define (p e) e x) (p (set! x (cons x (quote (2))))))
--------> is definition...
---------> enter eval-definition...
------------> enter definition-value...
=======> in my-eval, exp -> (lambda (x) (define (p e) e x) (p (set! x (cons x (quote (2))))))
lambda-parameters: (x)
lambda-body: ((define (p e) e x) (p (set! x (cons x (quote (2))))))
---------------> enter define-variable!...
---------> enter add-binding p2 -> (procedure (x) ((define (p e) e x) (p (set! x (cons x (quote (2)))))) (((a b c) 1 2 3))) to frame!
;Value: ok

使用习题中的方法能得到正确的结果“(1 2)”。

(c) 因为强制求值是按列表顺序进行的。

(d) 我更喜欢 Cy 的做法，从这个题里看，序列应该被看作一个原语，立即求值。

E-4.31: 跳过。

E-4.32: 第 3 章的延迟求值利用了原语 delay 和 force，而这里的延时求值是把整个表达式保存起来（使用lambda），在需要的时候返回表达式求值。

E-4.33: 将“(quote x)”变为“(lambda (x) x)”。

E-4.34: 跳过。

E-4.35:

(define (an-integer-between lower upper)
  (require (<= lower upper))
  (amb lower (an-integer-between (+ lower 1) upper)))

E-4.36: 因为 an-integer-starting-from 不能保证 i<=j<=k。程序如下：

(define (pythagorean-triple)
  (let ((k (an-integer-starting-from 1)))
    (let ((j (an-integer-between 1 k)))
      (let ((i (an-integer-between 1 j)))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

E-4.37: 我觉得题目的效率比较低，因为如果不满足条件，hsq 就白算了。