第五章习题解答，跳过了大部分题目。
E-5.1: 流程图略。
---
/ \ +---+
+--------> | > | <---- | n |
| \ / +---+
| ---
|
+---------+ +---------+
+--->| product | | counter |<--------------------+
| +---------+ +---------+ |
| | | | |
| | | | +---+ |
| +------+ +------+ +----+ +------| 1 | |
| | | | | +---+ |
| .-+---+-. .-+---+-. |
| \ * / \ + / |
| --+-- --+-- |
| | | |
+------(X)--------+ +-------(X)------+
E-5.2:
(controller
test-counter
(test (op >) (reg counter) (reg n))
(branch (label factorial-done))
(assign product (op *) (reg product) (reg counter))
(assign counter (op +) (reg counter) (const 1))
(goto (label test-counter))
factorial-done)
E-5.3:
; version 1: good-enough? and improve are both primitives
(controller
test-good-enough
(test (op good-enough?) (reg guess))
(branch (label sqrt-done))
(assign guess (op improve) (reg guess))
(goto (label test-good-enough))
sqrt-done)
; version 2
(controller
test-good-enough
; good-enough?
(assign t (op square) (reg guess))
(assign t (op -) (reg t) (reg x))
(assign t (op abs) (reg t))
(test (op <) (reg t) (const 0.001))
(branch (label sqrt-done))
; improve
(assign t (op /) (reg x) (reg guess))
(assign guess (op average) (reg guess) (reg t))
(goto (label test-good-enough))
sqrt-done)
E-5.4: 递归版本的模仿阶乘的做法即可。
; recursive
(controller
(assign continue (label expt-done))
expt-loop
(test (op =) (reg n) (const 0))
(branch (label base-case))
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-expt))
(goto (label expt-loop))
after-expt
(restore n)
(restore continue)
(assign val (op *) (reg b) (reg val))
(goto (reg continue))
base-case
(assign val (const 1))
(goto (reg continue))
expt-done)
; iterative
(controller
(assign counter (reg n))
(assign product (const 1))
test-counter
(test (op =) (reg counter) (const 0))
(branch (label expt-done))
(assign counter (op -) (reg counter) (const 1))
(assign product (op *) (reg b) (reg product))
(goto (label test-counter))
expt-done)
E-5.5: 跳过。
E-5.6: 在 afterfib-n-1 中的“(restore continue)”和“(save continue)”。这两步之间没有对 continue 进行修改或使用。
E-5.7: 略。
E-5.8: 执行完后寄存器 a 的值为 4，因为 extract-labels 找到一个 label 时把新的 label 放在旧的之前，而 lookup-label 则会找第一个匹配的 label。修改后的 extract-labels 如下：
(define (extract-labels text receive)
(if (null? text)
(receive '() '())
(extract-labels
(cdr text)
(lambda (insts labels)
(let ((next-inst (car text)))
(if (symbol? next-inst)
(let ((val (assoc next-inst labels)))
(if val
(map display (list "label " next-inst " exists.\n"))
(receive insts
(cons (make-label-entry next-inst insts)
labels))))
(receive (cons (make-instruction next-inst)
insts)
labels)))))))
E-5.9: 在执行实际的创建函数前先判断一下。
(define (make-operation-exp exp machine labels operations)
(let ((op (lookup-prim (operation-exp-op exp)
operations))
(aprocs
(map (lambda (e)
(if (label-exp? e)
(display "error\n")
(make-primitive-exp e machine labels)))
(operation-exp-operands exp))))
(lambda ()
(apply op (map (lambda (p) (p)) aprocs)))))
E-5.10: 把自定义的操作注册到“(make-execution-procedure ...)”即可。
E-5.11:
(a) （参考资料[1]）把“(assign n (reg val))”和“(restore val)”替换成“(restore n)”。原来的做法：执行了这两条语句后，n 的值是 Fib(n-2)，val 的值是 Fib(n-1)，接着执行的操作是 Fib(n-2) + Fib(n-1)；替换后，n 的值是 Fib(n-1)，val 的值是 Fib(n-2)，得到的和仍然是一样的。
(b) 跳过了。想到的一个方法是在 save 的时候把变量名和值一起压到栈里，pop 的时候用另一个临时栈保存 pop 出来的不符合要求的值，等找到需要的值后再把 pop 出来的不符合要求的值放回去。
(c) 跳过。
E-5.12 - 5.14: 跳过。
E-5.15: 想到的方法是，用一个闭包 counter，在每个 make-* 函数入口调用一下，最后获得计数。每次 make-new-machine 的时候生成 counter。
E-5.16: 方法同 E-5.15。
E-5.17 - 5.19: 跳过。
E-5.20:
+---+---+ +---+---+
| * | * | -> | * | / |
+---+---+ +---+---+
| |
| v
| +---+---+ +---+---+
+--------> | * | * | -> | * | / |
+---+---+ +---+---+
| |
+---+ +---+
| 1 | | 2 |
+---+ +---+
index 0 1 2 3 4
+---+----+----+----+----+
the-cars | | n1 | n2 | p1 | p1 |
+---+----+----+----+----+
the-cdrs | | p3 | e0 | p4 | e0 |
+---+----+----+----+----+
x 的值是 p1，y 的值是 p3。
E-5.21 - 5.23: 跳过。
E-5.24: 见参考资料 [2]。各个标签之间的寄存器和栈依赖实在太麻烦，只有大概的逻辑，寄存器和栈内容没有仔细确认；有些函数是在第四章中定义的，有些找不到，但是从名字上也能看出是干啥的。
ev-cond
(save env)
(save continue)
(assign unev (op cond-clauses) (reg exp))
ev-cond-loop
(test (op null?) (reg unev))
(branch (label ev-cond-unset)) ; predicates are false
(assign exp (op cond-first-clause-predicate) (reg unev))
(test (op cond-else-predicate?) (reg exp)) ; else clause is always true
(branch ev-cond-actions)
(save unev)
(save env) ; save env for ev-cond-decide
(assign continue (label ev-cond-decide))
(goto (label eval-dispatch))
ev-cond-decide
(restore env) ; current env
(restore unev)
(test (op true?) (reg val))
(branch ev-cond-actions)
(assign unev (op cond-rest-clauses) (reg unev))
(save unev)
(goto (label ev-cond-loop)) ; next clause
ev-cond-actions
(assign unev (op cond-first-clause-action) (reg unev))
(save unev)
(goto (label ev-sequence))
ev-cond-unset
(assign val '*unset*)
(restore env)
(restore continue)
(goto (reg continue))
E-5.25 - 5.30: 跳过。
E-5.31: 第一个和第二个都是多余的，因为参数是常量，并且只调用了 f；第三个和第四个需要保存 proc 和 argl，因为另一个函数 g 被调用（proc 被修改），并且 g 的参数列表不一样（argl 被修改）。
E-5.32 - 5.38: 跳过。
E-5.39:
(load "../chapter4/4.1-the.metacircular.evaluator.scm") ; frame and environment operations
(define (find-frame env frame-number)
(define (iter e count)
(if (null? e)
*unassigned*
(if (= count frame-number)
(first-frame e)
(iter (enclosing-environment e) (+ count 1)))))
(iter env 0))
(define (lexical-address-lookup env address)
(let ((frame-number (car address))
(variable-number (cdr address)))
(let ((frame (find-frame env frame-number)))
(if (eq? frame *unassigned*)
*unassigned*
(let ((value-list (frame-values frame)))
(if (< (length value-list) variable-number)
*unassigned*
(list-ref value-list variable-number)))))))
(define (lexical-address-set! env address value)
(let ((frame-number (car address))
(variable-number (cdr address)))
(let ((frame (find-frame frame-number env)))
(if (eq? frame *unassigned*)
*unassigned*
(let ((value-list (frame-values frame)))
(if (< (length value-list) variable-number)
*unassigned*
(set! (list-ref value-list variable-number) value)))))))
E-5.40: 跳过。
E-5.41:
(define (find-variable variable env)
(define (find-variable-number frame)
(define (iter-value variable-list count)
(if (null? variable-list)
'not-found
(if (eq? variable (car variable-list))
count
(iter-value (cdr variable-list) (+ count 1)))))
(iter-value frame 0))
(define (iter-frame frame-list count)
(if (null? frame-list)
'not-found
(let ((variable-number (find-variable-number (car frame-list))))
(if (eq? variable-number 'not-found)
(iter-frame (cdr frame-list) (+ count 1))
(cons count variable-number)))))
(iter-frame env 0))
; -----------------------------------------------------------------------------
(find-variable 'c '((y z) (a b c d e) (x y)))
(find-variable 'x '((y z) (a b c d e) (x y)))
(find-variable 'w '((y z) (a b c d e) (x y)))
E-5.42 - 5.52: 跳过。
参考资料
[1] sicp-ex-5.11
[2] sicp-ex-5.24