SICP演習問題5.22

今回の問題は

(define (append lis1 lis2)
  (if (null? lis1)
      lis2
      (cons (car lis1)
            (append (cdr lis1) lis2))))
(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)

という，2種類のappendをレジスタ計算機で実装すること．

append

(define append-machine
  (make-machine
  '(continue lis1 lis2 val)
  (list (list 'null? null?) (list 'car car) (list 'cdr cdr) (list 'cons cons)
        (list 'print print))
  '(machine
      (assign continue (label append-done))
    append-loop
      (test (op null?) (reg lis1))
      (branch (label null))
      (save continue)
      (assign continue (label after))
      (save lis1)
      (assign lis1 (op cdr) (reg lis1))
      (goto (label append-loop))
    null
      (assign val (reg lis2))
      (goto (reg continue))
    after
      (restore lis1)
      (restore continue)
      (assign lis1 (op car) (reg lis1))
      (assign val (op cons) (reg lis1) (reg val))
      (goto (reg continue))
    append-done
      (perform (op print) (reg val)))))

実行

gosh> (set-register-contents! append-machine 'lis1 '(1 (2)))
done
gosh> (set-register-contents! append-machine 'lis2 '(3 4))
done
gosh> (start append-machine)
(1 (2) 3 4)
done

append!

(define append!-machine
  (make-machine
   '(continue x y z)
   (list (list 'null? null?) (list 'list list) (list 'car car)
         (list 'last-pair last-pair) (list 'set-cdr! set-cdr!)
         (list 'print print))
   '(machine
       (assign continue (label append!-done))
     append!-loop
       (test (op null?) (reg x))
       (branch (label append!-done))
       (assign z (op last-pair) (reg x))
       (perform (op set-cdr!) (reg z) (reg y))
     append!-done
       (perform (op print) (reg x)))))

実行

gosh> (set-register-contents! append!-machine 'x '(1 (2)))
done
gosh> (set-register-contents! append!-machine 'x '(1 (2)))
done
gosh> (set-register-contents! append!-machine 'y '(3 4))
done
gosh> (start append!-machine)
(1 (2) 3 4)
done