SICP 5.2 A Register-Machine Simulator

いよいよ本題な感じ。

ノート

Exercise 5.7

実装してみないことには何も分からないので、先の節の実装を写経してシムレータを作成してから実行してみる。
Racketではペアはimmutableでset-cdr!は使えないので、instructionのペアのメソッドを以下の様にmpairを使った実装に差し替える。

(define (make-instruction text)
  (mcons text '()))
(define (instruction-text inst)
  (mcar inst))
(define (instruction-execution-proc inst)
  (mcdr inst))
(define (set-instruction-execution-proc! inst proc)
  (set-mcdr! inst proc))

GCDの例で動作確認

> (set-register-contents! gcd-machine 'a 206)
'done
> (set-register-contents! gcd-machine 'b 40)
'done
> (start gcd-machine)
'done
> (get-register-contents gcd-machine 'a)
2
> 

動いていそう。

早速a.の再帰パターン

(define expt-machine-a
  (make-machine
   '(continue b n result)
   (list (list '= =)
         (list '- -)
         (list '* *))
   '(controller
     (assign continue (label expt-done))
     (save continue)
     expt-prep
     (test (op =) (reg n) (const 0))
     (branch (label expt-init))
     (assign n (op -) (reg n) (const 1))
     (assign continue (label expt-calc))
     (save continue)
     (goto (label expt-prep))
     expt-init
     (assign result (const 1))
     (restore continue)
     (goto (reg continue))
     expt-calc
     (assign result (op *) (reg result) (reg b))
     (restore continue)
     (goto (reg continue))
     expt-done)))

実行してみる

> (set-register-contents! expt-machine-a 'b 2)
'done
> (set-register-contents! expt-machine-a 'n 3)
'done
> (start expt-machine-a)
'done
> (get-register-contents expt-machine-a 'result)
8
> 

動いた。

b.の繰り返しパターン

(define expt-machine-b
  (make-machine
   '(b n count product)
   (list (list '= =)
         (list '- -)
         (list '* *))
   '(controller
     (assign count (reg n))
     (assign product (const 1))
     expt-iter
     (test (op =) (reg count) (const 0))
     (branch (label expt-done))
     (assign count (op -) (reg count) (const 1))
     (assign product (op *) (reg product) (reg b))
     (goto (label expt-iter))
     expt-done)))

実行してみる

> (set-register-contents! expt-machine-b 'b 2)
'done
> (set-register-contents! expt-machine-b 'n 3)
'done
> (start expt-machine-b)
'done
> (get-register-contents expt-machine-b 'product)
8
> 

どちらも一発で動いてくれて少し感動。