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))