SICP 読み (353) 5.5 翻訳系 - yamanetoshi's diary

問題 5.46

とりあえず fib を評価させてみた。

gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "load-eceval-compiler")
#t
gosh> (load "ch5-compiler")
#t
gosh> (define true #t)
true
gosh> (define false #f)
false
gosh> (compile-and-go '(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))

(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(fib 0)

(total-pushes = 7 maximum-depth = 3)
;;; EC-Eval value:
0

;;; EC-Eval input:
(fib 1)

(total-pushes = 7 maximum-depth = 3)
;;; EC-Eval value:
1

;;; EC-Eval input:
(fib 2)

(total-pushes = 17 maximum-depth = 5)
;;; EC-Eval value:
1

;;; EC-Eval input:
(fib 3)

(total-pushes = 27 maximum-depth = 8)
;;; EC-Eval value:
2

;;; EC-Eval input:
(fib 4)

(total-pushes = 47 maximum-depth = 11)
;;; EC-Eval value:
3

;;; EC-Eval input:
(fib 5)

(total-pushes = 77 maximum-depth = 14)
;;; EC-Eval value:
5

;;; EC-Eval input:
(fib 6)

(total-pushes = 127 maximum-depth = 17)
;;; EC-Eval value:
8

;;; EC-Eval input:
(fib 7)

(total-pushes = 207 maximum-depth = 20)
;;; EC-Eval value:
13

;;; EC-Eval input:
(fib 8)

(total-pushes = 337 maximum-depth = 23)
;;; EC-Eval value:
21

;;; EC-Eval input:

ええと、とりあえず問題 5.28 の出力を(297)からコピーしておいて比べてみます。

;;; EC-Eval input:
(define (fib n)
  (if (< n 2)
      n
      (+ (fib (- n 1)) (fib (- n 2)))))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(fib 2)

(total-pushes = 72 maximum-depth = 13)
;;; EC-Eval value:
1

;;; EC-Eval input:
(fib 3)

(total-pushes = 128 maximum-depth = 18)
;;; EC-Eval value:
2

;;; EC-Eval input:
(fib 4)

(total-pushes = 240 maximum-depth = 23)
;;; EC-Eval value:
3

;;; EC-Eval input:
(fib 5)

(total-pushes = 408 maximum-depth = 28)
;;; EC-Eval value:
5

;;; EC-Eval input:
(fib 6)

(total-pushes = 688 maximum-depth = 33)
;;; EC-Eval value:
8

;;; EC-Eval input:
(fib 7)

(total-pushes = 1136 maximum-depth = 38)
;;; EC-Eval value:
13

;;; EC-Eval input:
(fib 8)

(total-pushes = 1864 maximum-depth = 43)
;;; EC-Eval value:
21

;;; EC-Eval input:

ええとこっちの fib の場合は

fib(2) なら fib(0) の 16 と fib(1) の 16 に 40 を加えて 72 回
fib(3) なら fib(1) の 16 と fib(2) の 72 に 40 を加えて 128 回
fib(4) なら fib(2) の 72 と fib(3) の 128 に 40 を加えて 240 回
fib(5) なら fib(3) の 128 と fib(4) の 240 に 40 を加えて 408 回
fib(6) なら fib(4) の 240 と fib(5) の 408 に 40 を加えて 688 回
fib(7) なら fib(5) の 408 と fib(6) の 688 に 40 を加えて 1136 回
fib(8) なら fib(6) の 688 と fib(7) の 1136 に 40 を加えて 1864 回

で、これ式で翻訳したソレの数を見てみますと以下。

(fib 0) が (total-pushes = 7 maximum-depth = 3)
(fib 1) が (total-pushes = 7 maximum-depth = 3)
(fib 2) が (total-pushes = 17 maximum-depth = 5)
(fib 3) が (total-pushes = 27 maximum-depth = 8)
(fib 4) が (total-pushes = 47 maximum-depth = 11)
(fib 5) が (total-pushes = 77 maximum-depth = 14)
(fib 6) が (total-pushes = 127 maximum-depth = 17)
(fib 7) が (total-pushes = 207 maximum-depth = 20)
(fib 8) が (total-pushes = 337 maximum-depth = 23)

fib(n) の push 回数は

(+ (fib(- n 1) の push 回数) (fib(- n 2) の push 回数) 3)

というカンジでしょうか。意味はありませんが arc で検算。

$ mzscheme -m -f as.scm
Use (quit) to quit, (tl) to return here after an interrupt.
arc> (+ 7 7 3)
17
arc> (+ 7 17 3)
27
arc> (+ 17 27 3)
47
arc> (+ 27 47 3)
77
arc> (+ 47 77 3)
127
arc> (+ 77 127 3)
207
arc> (+ 127 207 3)
337
arc>

合ってる模様。これはしかしアレですな違いを列挙してみると

fib(0) とか fib(1) の push 回数が解釈系だと 16 で翻訳系だと 7
(+ (fib (- n 1)) (fib (- n 2))) の演算で必要な push の回数が解釈系だと 40 で翻訳系だと 3

むむ、えらい効率良いな、と言いつつひさびさの散髪に行ってまいります。年末に散髪に行きそびれたんですがいつから行ってないんだろ。

帰宅後

なんでこんなに違うのか、と言いつつ fib なソレを compile してみた。何度も同じコトしてて微妙ですが整形したナニを以下に。

gosh> (compile '(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) 'val 'return)
((env continue) (val) 
 ((assign val (op make-compiled-procedure) (label entry1) (reg env)) 
  (goto (label after-lambda2)) 

  entry1 
  (assign env (op compiled-procedure-env) (reg proc)) 
  (assign env (op extend-environment) (const (n)) (reg argl) (reg env)) 
  (save continue) 
  (save env) 
  (assign proc (op lookup-variable-value) (const <) (reg env)) 
  (assign val (const 2)) 
  (assign argl (op list) (reg val)) 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op cons) (reg val) (reg argl)) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch6)) 
  compiled-branch7 
  (assign continue (label after-call8)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch6 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call8 
  (restore env) 
  (restore continue) 

  (test (op false?) (reg val)) 
  (branch (label false-branch4)) 
  true-branch3 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (goto (reg continue)) 
  false-branch4 
  (assign proc (op lookup-variable-value) (const +) (reg env)) 
  (save continue) 
  (save proc) 
  (save env) 
  (assign proc (op lookup-variable-value) (const fib) (reg env)) 
  (save proc) 
  (assign proc (op lookup-variable-value) (const -) (reg env)) 
  (assign val (const 2)) 
  (assign argl (op list) (reg val)) 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op cons) (reg val) (reg argl)) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch15)) 
  compiled-branch16 
  (assign continue (label after-call17)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch15 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call17 
  (assign argl (op list) (reg val)) 
  (restore proc) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch18)) 
  compiled-branch19 
  (assign continue (label after-call20)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch18 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call20 
  (assign argl (op list) (reg val)) 
  (restore env) 
  (save argl) 
  (assign proc (op lookup-variable-value) (const fib) (reg env)) 
  (save proc) 
  (assign proc (op lookup-variable-value) (const -) (reg env)) 
  (assign val (const 1)) 
  (assign argl (op list) (reg val)) 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op cons) (reg val) (reg argl)) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch9)) 
  compiled-branch10 
  (assign continue (label after-call11)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch9 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call11 
  (assign argl (op list) (reg val)) 
  (restore proc) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch12)) 
  compiled-branch13 
  (assign continue (label after-call14)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch12 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call14 
  (restore argl) 
  (assign argl (op cons) (reg val) (reg argl)) 
  (restore proc) 
  (restore continue) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch21)) 
  compiled-branch22 
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val)) 
  primitive-branch21 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  (goto (reg continue)) 
  after-call23 
  after-if5 
  after-lambda2 

  (perform (op define-variable!) (const fib) (reg val) (reg env)) 
  (assign val (const ok)) 
  (goto (reg continue)))

長いなぁ。ってなんで fib(0) とか fib(1) とかの total-pushes が 7 なの??
で、total-pushes って何だったかな、と言いつつ ch5-regsim.scm の make-stack 手続きに至る。単純に push された回数だなぁ。これって eceval の中での push の回数も入ってると見た。違うかなぁ。
という事で検証してみる。どうやるかなあ。とりあえず最初は compile-and-go で val に compile->assemble された命令列をセットして flag に true をセットして eceval が start して以下の命令を辿る

  (assign compapp (label compound-apply))
;; flag が true なので jmp する
  (branch (label external-entry))

external-entry
  (perform (op initialize-stack))
  (assign env (op get-global-environment))
  (assign continue (label print-result))
  (goto (reg val))

ここで compile->assemble された手続きに制御が移りますが push はナシ。その後、print-result に戻って以下。

print-result
  (perform (op print-stack-statistics))
  (perform
   (op announce-output) (const ";;; EC-Eval value:"))
  (perform (op user-print) (reg val))
  (goto (label read-eval-print-loop))
read-eval-print-loop
  (perform (op initialize-stack))
  (perform
   (op prompt-for-input) (const ";;; EC-Eval input:"))
  (assign exp (op read))

で入力待ちになる、と。この次に例えば (fib 0) とか入力された場合どうなるか、というと

;; exp には (fib 0) がセット

  (assign env (op get-global-environment))
  (assign continue (label print-result))
  (goto (label eval-dispatch))

;; eval-dispatch では application 認定

ev-application
  (save continue)
  (save env)
  (assign unev (op operands) (reg exp))
  (save unev)
  (assign exp (op operator) (reg exp))
  (assign continue (label ev-appl-did-operator))
  (goto (label eval-dispatch))

;; push 3 回
;; eval-dispatch では variable 認定 (fib)

ev-variable
  (assign val (op lookup-variable-value) (reg exp) (reg env))
  (goto (reg continue))

;; ev-appl-did-operator に戻る

ev-appl-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (test (op no-operands?) (reg unev))
  (branch (label apply-dispatch))
  (save proc)

;; push 1 回

ev-appl-operand-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label ev-appl-last-arg))

;; push 1 回
;; llast-operand なので ev-appl-last-arg に jmp

ev-appl-last-arg
  (assign continue (label ev-appl-accum-last-arg))
  (goto (label eval-dispatch))

;; eval-dispatch では self-eval 認定

ev-self-eval
  (assign val (reg exp))
  (goto (reg continue))

;; ev-appl-accum-last-arg に jmp

ev-appl-accum-last-arg
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (restore proc)
  (goto (label apply-dispatch))

以降は略。確かにこれで 7 回になるんだけど次の謎が ...
とりあえず買物に行くらしいのでひとまず中断。次の謎は何故に fib(2) の push 回数が 7 + 7 + 3 になるか、とゆー事ッス。

つづき

えーと、n が 0 とか 1 の (< n 2) が真なケイスでは fib の呼び出しまでに 5 回 push されて < な演算で 2 回 push で手続きが終わるので計 7 回。でも n が 2 以上のケイスで 7 + 7 + 3 ってのはタマタマ数値がそうなってるだけで実は違うカンジ。
例えば n が 2 だったらどうなるんだろうか。基本的には

eceval で fib を apply するまでに 5 回
fib(0) で 2 回
fib(1) で 2 回

の 9 回の push が発生する事が予測できる。n が 2 の時の total-pushes が 17 なので残りは 8 ですか。カウントしてみると

(< n 2) なソレで 2 回 (これは n が 0 だの 1 だのと同様)
+ を lookup した後に continue と proc と env を push で 3 回
最初の fib の引数の評価 (- n 1) の前に proc を push で 1 回
次の fib を lookup する前に argl を push で 1 回
次の fib の引数の評価 (- n 2) の前に proc を push で 1 回

という事ですか。てーコトは

eceval で fib を apply するまでの 5 回
n が 2 以上の場合は (+ (fib (- n 1)) (fib (- n 2))) なナニで 8 回

他はそれぞれの fib のソレに必要な push の回数になる (ただし、eceval な処理に必要な push 階数は引く必要あり)、とゆー事は

(fib 3) なら (+ 5 8 2 (- 17 5)) で 27
(fib 4) なら (+ 5 8 (- 17 5) (- 27 5)) で 47
(fib 5) なら (+ 5 8 (- 27 5) (- 47 5)) で 77
(fib 6) なら (+ 5 8 (- 47 5) (- 77 5)) で 127
(fib 7) なら (+ 5 8 (- 77 5) (- 127 5)) で 207
(fib 8) なら (+ 5 8 (- 127 5) (- 207 5)) で 337

という事ですかそうですか。しかし 5 引くのは微妙だな。どっちかとゆーと

(fib 2) は (+ 5 (+ 2 2 8))
(fib 3) は (+ 5 (+ 2 (+ 2 2 8) 8))
(fib 4) は (+ 5 (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8)
(fib 5) は (+ 5 (+ 2 (+ 2 2 8) 8) (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) 8)
(fib 6) は (+ 5 (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) (+ (+ 2 (+ 2 2 8) 8) (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) 8) 8)
(fib 7) は (+ 5 (+ (+ 2 (+ 2 2 8) 8) (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) 8) (+ (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) (+ (+ 2 (+ 2 2 8) 8) (+ (+ 2 2 8) (+ 2 (+ 2 2 8) 8) 8) 8) 8) 8)

こうすれば、ではありますが微妙。もう少しカシコい書き方がありそげ。しまった書き方じゃなくてアレだな。冗長ですがもう一回書きます。

(fib 2) は (+ 5 (+ 2 2 8))
(fib 3) は (+ 5 (+ 2 12 8))
(fib 4) は (+ 5 (+ 12 22 8))
(fib 5) は (+ 5 (+ 22 42 8))
(fib 6) は (+ 5 (+ 42 72 8))

という書き方であれば分かりやすいのかなぁ。(誰

で

書き方云々じゃなくって有効性を決めよ、とあるんですがどうすりゃええのか分からんぞ。とりあえず問題 5.29 な S(n) = aFib(n+1) + b なソレは

S(2) = 2 * x + y = 17
S(3) = 3 * x + y = 27

になりますな。上記の連立方程式の解は x が 10 で y が -3 になる。ちなみに問題 5.29 な x は 56 で y が -40 だそうな。push 回数のトータルが

翻訳系だと (+ (* 10 (fib (+ n 1))) -3)
解釈系だと (+ (* 56 (fib (+ n 1))) -40)

で、単純に 5 倍ですかそうですか、と思ってたら fib な数値 (しかも次の要素) にかけ算されてるのでもっと、なんだな。
ちょっとこれ以上は教養な部分で限界なんで勘弁して下さひ。