sicp 笔记 (13)

第五章习题解答,跳过了大部分题目。

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

发表回复

您的电子邮箱地址不会被公开。 必填项已用 * 标注