SICP 全笔记

Exercise 5.22. Exercise 3.12 of section 3.3.1 presented an append procedure that appends two lists to form a new list and an append! procedure that splices two lists together. Design a register machine to implement each of these procedures. Assume that the list-structure memory operations are available as primitive operations.

append 可以如下实现,val 寄存器保存最后的结果。

(load "machine-stack-module.scm")
(load "machine-register-module.scm")
(load "machine-machine-module.scm")
(load "machine-assemble-module.scm")

(define controller
  '((assign continue (label append-done))
    append-loop
      (test (op null?) (reg x))
      (branch (label base-case))

      (save continue)
      (assign continue (label after-append-cdr))

      (save x)
      (assign x (op cdr) (reg x))
      (goto (label append-loop))

    after-append-cdr
      (restore x)
      (assign x (op car) (reg x))
      (assign val (op cons) (reg x) (reg val))
      (restore continue)
      (goto (reg continue))

    base-case
      (assign val (reg y))
      (goto (reg continue))

    append-done
    ))

(define machine-append
  (make-machine
   '(x continue val y)
   (list (list 'null? null?)
         (list 'cdr cdr)
         (list 'car car)
         (list 'cons cons))
   controller))

(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

(load "../testframe.scm")
(let ((x (list 'a 'b))
      (y (list 'c 'd)))
  (set-register-contents! machine-append 'x x)
  (set-register-contents! machine-append 'y y)
  (start machine-append)
  (assertequal? (get-register-contents machine-append 'val)
                (append x y)))

``append!`` 的实现需要注意寄存器的使用。下面是一个错误的实现

(define machine-append!
  (make-machine
   '(x y tmp val)
   (list (list 'cdr cdr)
         (list 'set-cdr! set-cdr!)
         (list 'null? null?))
   '(last-pair
       (assign tmp (op cdr) (reg x))
       (test (op null?) (reg tmp))
       (branch (label last-pair-done))
       (assign x (op cdr) (reg x))
       (goto (label last-pair))
     last-pair-done
       (perform (op set-cdr!) (reg x) (reg y))
       (assign val (reg x))
     )))

在逻辑上,last-pair 首先调用,最后 x 将会保存 last-pair 的值,append! 再继续使用 x 的值。在测试的时候,我们会发现 x 的值是 (b c d) 而不是 (a b c d)

(let* ((x (list 'a 'b))
       (y (list 'c 'd)))
  (set-register-contents! machine-append! 'x x)
  (set-register-contents! machine-append! 'y y)
  (start machine-append!)
  (display (get-register-contents machine-append! 'x)))
; (b c d)

这是因为 machine 中,assign 是用 set! 实现的, set! 会改变 x 的指针位置,在 last-pair 之后 x 就变成了最后一个 pair (b),所以 append 之后,x 是 (b c d)

我们只需要稍微修改,使用另外一个寄存器而不使用 x 就可以。

(define machine-append!-wrong
  (make-machine
   '(x y tmp val)
   (list (list 'cdr cdr)
         (list 'set-cdr! set-cdr!)
         (list 'null? null?))
   '(last-pair
       (assign tmp (op cdr) (reg x)) 
       (test (op null?) (reg tmp))
       (branch (label last-pair-done))
       (assign x (op cdr) (reg x))
       (goto (label last-pair))
     last-pair-done
       (perform (op set-cdr!) (reg x) (reg y))
       (assign val (reg x))
     )))

(define machine-append!
  (make-machine
   '(x y x1 tmp val)
   (list (list 'cdr cdr)
         (list 'set-cdr! set-cdr!)
         (list 'null? null?))
   '((assign x1 (reg x))
     last-pair ;input x1, output val
       (assign tmp (op cdr) (reg x1)) 
       (test (op null?) (reg tmp))
       (branch (label last-pair-done))
       (assign x1 (op cdr) (reg x1))
       (goto (label last-pair))
     last-pair-done
       (perform (op set-cdr!) (reg x1) (reg y))
       (assign val (reg x))
     )))

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(let* ((x (list 'a 'b))
       (y (list 'c 'd))
       (w (append x y)))
  (set-register-contents! machine-append! 'x x)
  (set-register-contents! machine-append! 'y y)
  (start machine-append!)
  ;; the content of x should have been changed now!
  (assertequal? (get-register-contents machine-append! 'x) w))