2016/01/23

SICP 問題 5.07

;; シミュレータを使い問題5.04で設計した計算機をテストせよ

;; 再帰的べき乗
(define factorial-recur-machine
  (make-machine
   '(b n val continue)
   (list (list '* *) (list '- -) (list '= =))
   '((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)))

(set-register-contents! factorial-recur-machine 'b 2)
(set-register-contents! factorial-recur-machine 'n 10)
(start factorial-recur-machine)
(get-register-contents factorial-recur-machine 'val) ;=> 1024が返ってくるはず


;; 反復的べき乗
(define factorial-iter-machine
  (make-machine
   '(b n product)
   (list (list '* *) (list '- -) (list '= =))
   '((assign product (const 1))
     expt-loop
       (test (op =) (reg n) (const 0))
       (branch (label fib-done))
       (assign n1 (op -) (reg n) (const 1))
       (assign p1 (op *) (reg product) (reg b))
       (assign n (reg n1))
       (assigin product (reg p1))
       (goto (label expt-loop))
     expt-done)))

(set-register-contents! factorial-iter-machine 'b 2)
(set-register-contents! factorial-iter-machine 'n 10)
(start factorial-iter-machine)
(get-register-contents factorial-iter-machine 'product)

© 2022 wat-aro