SICP 問題 5.22

appendとappend!をレジスタマシン上に実装する．
　
append

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

(define append
  (make-machine
   '(x y val continue)
   (list (list 'cons cons) (list 'null? null?) (list 'car car) (list 'cdr cdr))
   '(start
       (assign continue (label append-done))
     x-loop
       (test (op null?) (reg x))
       (branch (label after-x))
       (save x)
       (assign x (op cdr) (reg x))
       (save continue)
       (assign continue (label construct))
       (goto (label x-loop))
     after-x
       (assign val (reg y))
       (goto (label construct))
     construct
       (restore continue)
       (restore x)
       (assign x (op car) (reg x))
       (assign val (op cons) (reg x) (reg val))
       (goto (reg continue))
     append-done)))

test

gosh> (set-register-contents! append 'x '(1 2 3))
done
gosh> (set-register-contents! append 'y '(a b c))
done
gosh> (start append)
done
gosh> (get-register-contents append 'val)
(1 2 3 a b c)

　
append!

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

(define append!
  (make-machine
   '(x y temp)
   (list (list 'set-cdr! set-cdr!) (list 'cdr cdr) (list 'null? null?))
   '(start
       (assign temp (reg x))
     x-loop
       (test (op null?) (reg temp))
       (branch (label after-loop))
       (save temp)
       (assign temp (op cdr) (reg temp))
       (goto (label x-loop))
     after-loop
       (restore temp)
       (perform (op set-cdr!) (reg temp) (reg y))
     append!-done )))

test

gosh> (set-register-contents! append! 'x '(1 2 3))
done
gosh> (set-register-contents! append! 'y '(a b c))
done
gosh> (start append!)
done
gosh> (get-register-contents append! 'x)
(1 2 3 a b c)