SICP 読み (266) 5.2 レジスタ計算機での計算

なんとなく ch5-regsim.scm を眺めていたら make-stack の中に initialize とゆー手続きを発見。まぢッスか。てーか何見てんだ < わし

問題 5.14

成果物としてすごい微妙な手続きがでっち上がった。

(define (make-factorial-machine n)
  (let ((m (make-machine '(n continue val)
			 (list (list '= =)
			       (list '- -)
			       (list '* *))
			 '(controller
			   (assign continue (label fact-done))
			   fact-loop
			   (test (op =) (reg n) (const 1))
			   (branch (label base-case))
			   (save continue)
			   (save n)
			   (assign n (op -) (reg n) (const 1))
			   (assign continue (label after-fact))
			   (goto (label fact-loop))
			   after-fact
			   (restore n)
			   (restore continue)
			   (assign val (op *) (reg n) (reg val))
			   (goto (reg continue))
			   base-case
			   (assign val (const 1))
			   (goto (reg continue))
			   fact-done))))
    (define (start)
      (define (start-iter num)
	(cond ((= num 0) 
	       'done)
	      (else
	       (set-register-contents! m 'n num)
	       ((m 'stack) 'initialize)
	       (display (list 'n '= (get-register-contents m 'n)))
	       (m 'start)
	       (newline)
	       (display (list 'val '= (get-register-contents m 'val)))
	       ((m 'stack) 'print-statistics)
	       (newline)
	       (newline)
	       (start-iter (- num 1))))
	)
      (start-iter n)
      )
    (define (dispatch msg)
      (cond ((eq? msg 'start) (start))
	    (else
	     (error "Unknown request -- FACT MACHINE" msg)))
      )
    dispatch)
  )

上記を ch5-regsim.scm に追加しています。これを gosh 上でナニすると以下。

gosh> (load "ch5-regsim")
#t
gosh> (define f (make-factorial-machine 5))
f
gosh> (f 'start)
(n = 5)
(val = 120)
(total-pushes = 8 maximum-depth = 8)

(n = 4)
(val = 24)
(total-pushes = 6 maximum-depth = 6)

(n = 3)
(val = 6)
(total-pushes = 4 maximum-depth = 4)

(n = 2)
(val = 2)
(total-pushes = 2 maximum-depth = 2)

(n = 1)
(val = 1)
(total-pushes = 0 maximum-depth = 0)

done
gosh> 

順も微妙ですが ...
昨晩あたりからモチベーション的に微妙なカンジかも。(何

追記

って、良く見たら make-new-machine に手続きがあるじゃん。てーか計算プログラムで使える形で定義してあるじゃん。これは

(perform (op initialize-stack))

とか

(perform (op print-stack-statistics))

ってデキるってコトですかそうですか。(とほほほ
こうでも OK ってーか、最初からこうしろって言ってるんだろうな。

(define (factorial-machine n)
  (let ((m (make-machine '(n continue val)
			 (list (list '= =)
			       (list '- -)
			       (list '* *))
			 '(controller
			   (perform (op initialize-stack))
			   (assign continue (label fact-done))
			   fact-loop
			   (test (op =) (reg n) (const 1))
			   (branch (label base-case))
			   (save continue)
			   (save n)
			   (assign n (op -) (reg n) (const 1))
			   (assign continue (label after-fact))
			   (goto (label fact-loop))
			   after-fact
			   (restore n)
			   (restore continue)
			   (assign val (op *) (reg n) (reg val))
			   (goto (reg continue))
			   base-case
			   (assign val (const 1))
			   (goto (reg continue))
			   fact-done
			   (perform (op print-stack-statistics))))))
    (define (fact-run-iter num)
      (cond ((> num n) 'done)
	    (else
	     (set-register-contents! m 'n num)
	     (newline)
	     (display (list 'n '= (get-register-contents m 'n)))
	     (m 'start)
	     (newline)
	     (display (list 'val '= (get-register-contents m 'val)))
	     (fact-run-iter (+ num 1)))))
    (fact-run-iter 1)))

以下が実行時の出力ッス。

gosh> (load "ch5-regsim")
#t
gosh> (factorial-machine 5)

(n = 1)
(total-pushes = 0 maximum-depth = 0)
(val = 1)
(n = 2)
(total-pushes = 2 maximum-depth = 2)
(val = 2)
(n = 3)
(total-pushes = 4 maximum-depth = 4)
(val = 6)
(n = 4)
(total-pushes = 6 maximum-depth = 6)
(val = 24)
(n = 5)
(total-pushes = 8 maximum-depth = 8)
(val = 120)done
gosh> 

いやはや。最後の done は微妙ですが対処は略。