プログラミング初心者がSICP(計算機プログラムの構造と解釈)を読んでみた
読む前の状態と動機
- 読み始めた時点でプログラミング歴約１年
- もうひとつのscheme入門でプログラミングに入門するも，高階関数で挫折．
- Ruby本二冊，Rails Tutorialを二周．
- 他読み始めたけど途中で飽きた本が何冊か．
- 仕事（非IT)が忙しく，プログラミング始めて一年でこれくらいしか出来なかった．
- 基本的なところがしっくりこない．
- でもコード書くのは楽しいし，出来ればそれを仕事にしたいので基礎を身に着けたい．
- 無職になって時間もあるから基礎を身につけるためにSICPを読もう．
読むための準備
- Scheme手習いとプログラミングGaucheを読んでからSICPにとりかかった．
- メインで読んだのは2版の和田訳．読んでわからない時は原著や1版の元吉訳に当たる．
- 後半になると真鍋訳が登場したためこちらにも助けられた．
SICPを読む過程で得たもの
- 括弧が気にならなくなった
- S式のほうが読みやすいのになんで中置記法のほうがメジャーなの？
- 再帰的プロセスと反復的プロセス
- 第一級手続き
- 抽象の壁
- メッセージパッシング
- 型によるディスパッチと強制型変換
- イベントドリヴン
- 制約の拡散
- 破壊的代入が怖くなった
- ストリーム
- 遅延評価
- 超循環評価器の実装を通して評価戦略を理解した．
- レジスタマシンのシミュレータによって低レベルで何が行われているのか理解した．
- コンパイラとインタプリタの効率の違い
感想
４ヶ月半近くかかった．
SICPは基礎と聞いていたけど，やっぱり基礎でした．
今の段階で読んでおいてよかった．
問題全部解くつもりはなかったけど，だんだんと自力で解きたくなってきたため結局ほとんど自力で解いていた．
解けないと悔しい．
問題やってみて思うのは，時間がめちゃくちゃかかるけど解かないと理解できなかった．
特に４章からは本文のコードを動かすにもデバッグが大変で，問題解くにもデバッグが大変．
でもそのデバッグを通して何度もコードや本文を読むことでそこで何をしているのか理解していけた．
最後はソースがコメントだらけになった．
C言語でやる問題が２問残っているのでCを勉強してから解きたい．
プログラミング楽しい！にプログラミング言語おもしろい！も追加された．
プログラミング初心者からプログラミング初級者へレベルアップできた・・・はず．
これから読む人にはScheme手習いを読んでおくことを勧めたい．
読みにくいし後半急激に難しくなるけど，そこで継続を渡すことを覚えておくと楽になる．
デバッグ方法も覚えておかないと４章から辛いので
Gauche使うならプログラミングGaucheにも一通り目を通しておいたほうがいい．
かなり苦しんだけど，それでも楽しい・おもしろいのほうが勝ってる．
まだ半年は生きていけそうなのでまだまだ勉強してコード書く仕事につけるように頑張ります．
とりあえずプログラミングの基礎 (Computer Science Library)でMLとデザインレシピに触れてからK&Rを読もうと思ってます．
- 作者: ハロルドエイブルソン,ジュリーサスマン,ジェラルド・ジェイサスマン,Harold Abelson,Julie Sussman,Gerald Jay Sussman,和田英一
- 出版社/メーカー: 翔泳社
- 発売日: 2014/05/17
- メディア: 大型本
- この商品を含むブログ (2件) を見る
- 作者: Daniel P. Friedman,Matthias Felleisen,元吉文男,横山晶一
- 出版社/メーカー: オーム社
- 発売日: 2010/10/22
- メディア: 単行本（ソフトカバー）
- 購入: 5人 クリック: 129回
- この商品を含むブログ (33件) を見る
- 作者: Kahuaプロジェクト,川合史朗
- 出版社/メーカー: オライリージャパン
- 発売日: 2008/03/14
- メディア: 大型本
- 購入: 22人 クリック: 713回
- この商品を含むブログ (272件) を見る
SICP 問題 5.50
4.1節の超循環評価器を5.5で作った翻訳系でコンパイルする．
問題5.50 – SICP（計算機プログラムの構造と解釈）その302 : Serendip - Webデザイン・プログラミング
http://himoiku.cocolog-nifty.com/blog/2008/07/sicp550_f385.html
ここを参考にしました．
まずここに書いてるmapがバグるっていうのがわからないところからスタート．
エラーメッセージを見ても原因がmapだとは気づかず，
この２つのブログを参考にしながら修正するも，翻訳系がダメなのかインタプリタがダメなのかもなかなかわからず．
三日間いろいろなバグに出会いながら最後まで残ったのが２つ．
一つ目はどこかで環境の保護がされていないために，再帰のベースケースから戻ってきても環境が回復されずその後の計算がおかしくなるバグ．
二つ目はレキシカルアドレッシングで翻訳時環境から得たアドレスが狂うバグ．
一つ目は最終的にソースをenvで検索してpreservingまたはmake-instruction-sequenceでenvが足らないところがないか探しました．
レキシカルアドレッシングの実装時に，作ったcompile-variablesとcompile-assignmentのmake-instruction-sequenceのneededにenvが入っていないためでした．
二つ目の原因は内部定義でした．
翻訳時環境が拡張されるのはcompile-lambda-bodyだけなので，内部定義でフレームが拡張されず，
find-variableが指すアドレスがこのシンボルがない時の環境でのアドレスなので実行時環境では違うものを指してしまいバグっていました．
これの解決策として，scan-out-definesでmake-letを使い内部定義を全てletに吐き出し，
それをlet->combinationでlambdaに変換することで解決しました．
根本的な解決ではないですが，とりあえず，コンパイルについては問題なく動きます．
以下はテスト．
翻訳系のREPLのEC-COMPからdriver-loopを呼び出し，
翻訳系でコンパイルしたインタプリタのREPL，MC-Evalに入っています．
;;;EC-COMP input: (driver-loop) ;;; MC-Eval input: (define (map proc lst) (if (null? lst) '() (cons (proc (car lst)) (map proc (cdr lst))))) ;;; MC-Eval value: ok ;;; MC-Eval input: (map car '((1 2) (3 4) (5 6))) ;;; MC-Eval value: (1 3 5) ;;; MC-Eval input: (define (fact n) (let iter ((count 1) (product 1)) (if (< n count) product (iter (+ 1 count) (* count product))))) ;;; MC-Eval value: ok ;;; MC-Eval input: (fact 5) ;;; MC-Eval value: 120 ;;; MC-Eval input: (define (factorial n) (if (< n 2) n (* (factorial (- n 1)) n))) ;;; MC-Eval value: ok ;;; MC-Eval input: (factorial 5) ;;; MC-Eval value: 120 ;;; MC-Eval input: (define (fact n) (define (iter count product) (if (< n count) product (iter (+ 1 count) (* count product)))) (iter 1 1)) ;;; MC-Eval value: ok ;;; MC-Eval input: (fact 5) ;;; MC-Eval value: 120
SICP 問題 5.49
compileとassembleを機械計算として持ち，REPLを行うレジスタ計算機を設計する．
はじめ，assembleを命令列の上でやる方法がわからずに，compile-and-assembleという手続きを作り，
それを機械演算として登録してRCEPLを実装したが，
問題5.49 – SICP（計算機プログラムの構造と解釈）その301 : Serendip - Webデザイン・プログラミング
ここでそれをうまく回避していたので真似た．
(load "./eval.scm") (load "./compiler.scm") (load "./register-machine-simulator.scm") (load "./eceval.scm") (define (rcepl) RCEPL) (define rcepl-proc (append eceval-procedure (list (list 'compile compile)) (list (list 'assemble assemble)) (list (list 'rcepl rcepl)) (list (list 'statements statements)))) (define RCEPL (make-machine rcepl-proc '((assign machine (op rcepl)) ;直接RCEPLを指せないので read-compile-execute-print-loop (perform (op initialize-stack)) (perform (op prompt-for-input) (const ";;;EC-COMP input:")) (assign exp (op read)) (assign env (op get-global-environment)) (assign continue (label print-result)) (goto (label read-compile-execute)) print-result (perform (op print-stack-statistics)) (perform (op announce-output) (const ";;;EC-COMP value":)) (perform (op user-print) (reg val)) (goto (label read-compile-execute-print-loop)) read-compile-execute (assign val (op compile) (reg exp) (const val) (const return) (const ())) (assign exp (op statements) (reg val)) (assign val (op assemble) (reg exp) (reg machine)) (goto (reg val))))) (define (start-rcepl) (set! the-global-environment (setup-environment)) (start RCEPL))
test
gosh> (start-rcepl) ;;;EC-COMP input: (define (factorial n) (if (< n 2) n (* (factorial (- n 1)) n))) (total-pushes = 0 maximum-depth = 0) ;;;EC-COMP value ok ;;;EC-COMP input: (factorial 20) (total-pushes = 78 maximum-depth = 40) ;;;EC-COMP value 2432902008176640000
SICP 問題 5.48
ECEVALのrepl上でコンパイル出来るようにする．
これで動くかなって思ったら動いた．
ただトレースした命令列を見ると，
apply-dispatchからprimitive-procedureにジャンプせずに先頭に戻っている．
なぜそうなるのかわからない．
;; 環境を拡張してprimitive-procedureとしてcompile-and-run を登録 (define (setup-environment-with-compile) (extend-environment (list 'compile-and-run) (list (list 'primitive compile-and-run)) (setup-environment))) ;; setup-environment-with-compileの環境からecevalに入るようにする (define (compile-and-go expression) (let ((instructions (assemble (statements (compile expression 'val 'return '())) eceval))) (set! the-global-environment (setup-environment-with-compile)) (set-register-contents! eceval 'val instructions) (set-register-contents! eceval 'flag true) (start eceval))) ; ; and-goとは違い環境の初期設定はいらない． (define (compile-and-run expression) (let ((instructions (assemble (statements (compile expression 'val 'return '())) eceval))) (set-register-contents! eceval 'val instructions) (set-register-contents! eceval 'flag true) (start eceval))) ;; 環境をwith-compileのほうにしてflagをfalseにしてからecevalに入る． (define (start-eceval) (set! the-global-environment (setup-environment-with-compile)) (set-register-contents! eceval 'flag false) (start eceval))
SICP 問題 5.47
コンパイルした手続きから積極制御評価器で定義した手続きを使えるようにする．
(define (compile-procedure-call target linkage) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (compound-branch (make-label 'compound-branch)) ;; compound-branchの作成 (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)))) ;; compiled-branchへの分岐を追加 (make-instruction-sequence '(proc) '() `((test (op compiled-procedure?) (reg proc)) (branch (label ,compiled-branch)))) ;; primitiveでもcompiledでもなかったらcompoundとして処理． (parallel-instruction-sequences (append-instruction-sequences compound-branch ;; compiledと同じようにcompound-proc-applで命令を作る (compound-proc-appl target compiled-linkage)) (parallel-instruction-sequences (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage)) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl)))))))) after-call)))) ;; ほとんどcompile-proc-applと同じで，continueをセーブしてからcompappにジャンプする． ;; compappには(label procedure-apply)が入っている． (define (compound-proc-appl target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '() all-regs `((assign continue (label ,linkage)) (save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) (save continue) (goto (reg compapp)) ,proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs `((save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE" target)))) ;; ec-evalの命令の先頭でcompappを初期化する． '((assign compapp (label compound-apply)) ;追加 (branch (label external-entry)) read-eval-print-loop (perform (op initialize-stack))
test
gosh> (compile-and-go '(begin (define (f x) (+ (g x) 1)) (define (g x) (+ x 10)))) (total-pushes = 0 maximum-depth = 0) ;;; EC-Eval value: ok ;;; EC-Eval input: (f 1) (total-pushes = 7 maximum-depth = 3) ;;; EC-Eval value: 12 ;;; EC-Eval input: (define (g x) (+ x 20)) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (f 1) (total-pushes = 16 maximum-depth = 7) ;;; EC-Eval value: 22 gosh> (compile-and-go '(define (f x) (* (g x) 2))) (total-pushes = 0 maximum-depth = 0) ;;; EC-Eval value: ok ;;; EC-Eval input: (define (g x) (+ x 1)) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (g 1) (total-pushes = 13 maximum-depth = 5) ;;; EC-Eval value: 2 ;;; EC-Eval input: (f 1) (total-pushes = 16 maximum-depth = 7) ;;; EC-Eval value: 4
SICP 問題 5.46
5.45と同様に今度はフィボナッチ数列の計算でそれぞれ比べる．
gosh> (define fib ;;一回目以外は省略 (make-machine (list (list '< <) (list '- -) (list '+ +)) '(controller (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) ;; Fib(n-1)を計算するよう設定 (save continue) (assign continue (label afterfib-n-1)) (save n) ;n の昔の値を退避 (assign n (op -) (reg n) (const 1)) ;n を n-1 に変える (goto (label fib-loop)) ;再帰呼び出しを実行 afterfib-n-1 ;戻った時 Fib(n-1) は val にある (restore n) (restore continue) ;; Fib(n-2)を計算するよう設定 (assign n (op -) (reg n) (const 2)) (save continue) (assign continue (label afterfib-n-2)) (save val) ;Fib(n-1) を退避 (goto (label fib-loop)) afterfib-n-2 ;戻った時 Fib(n-2) の値は val にある (assign n (reg val)) ;n には Fib(n-2) がある (restore val) ;val には Fib(n-1) がある (restore continue) (assign val ;Fib(n-1) + Fib(n-2) (op +) (reg val) (reg n)) (goto (reg continue)) ;呼び出し側に戻る．答えは val にある immediate-answer (assign val (reg n)) ;基底の場合: Fib(n)=n (goto (reg continue)) fib-done (perform (op print-stack-statistics))))) fib gosh> (set-register-contents! fib 'n 1) done gosh> (start fib) (total-pushes = 0 maximum-depth = 0)done gosh> (get-register-contents fib 'val) 1 gosh> (set-register-contents! fib 'n 2) done gosh> (start fib) (total-pushes = 4 maximum-depth = 2)done gosh> (get-register-contents fib 'val) 1 gosh> (set-register-contents! fib 'n 3) done gosh> (start fib) (total-pushes = 8 maximum-depth = 4)done gosh> (get-register-contents fib 'val) 2 gosh> (set-register-contents! fib 'n 4) done gosh> (start fib) (total-pushes = 16 maximum-depth = 6)done gosh> (get-register-contents fib 'val) 3 gosh> (set-register-contents! fib 'n 5) done gosh> (start fib) (total-pushes = 28 maximum-depth = 8)done gosh> (get-register-contents fib 'val) 5 gosh> (set-register-contents! fib 'n 5) done gosh> (start fib) (total-pushes = 28 maximum-depth = 8)done gosh> (get-register-contents fib 'val) 5 gosh> (set-register-contents! fib 'n 6) done gosh> (start fib) (total-pushes = 48 maximum-depth = 10)done gosh> (get-register-contents fib 'val) 8 gosh> (set-register-contents! fib 'n 7) done gosh> (start fib) (total-pushes = 80 maximum-depth = 12)done gosh> (get-register-contents fib 'val) 13 gosh> (set-register-contents! fib 'n 8) done gosh> (start fib) (total-pushes = 132 maximum-depth = 14)done gosh> (get-register-contents fib 'val) 21 gosh> (set-register-contents! fib 'n 9) done gosh> (start fib) (total-pushes = 216 maximum-depth = 16)done gosh> (get-register-contents fib 'val) 34 gosh> (set-register-contents! fib 'n 10) done gosh> (start fib) (total-pushes = 352 maximum-depth = 18)done gosh> (get-register-contents fib 'val) 55
翻訳系
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 1) (total-pushes = 7 maximum-depth = 3) ;;; EC-Eval value: 1 ;;; EC-Eval input: (fib 2) (total-pushes = 15 maximum-depth = 5) ;;; EC-Eval value: 1 ;;; EC-Eval input: (fib 3) (total-pushes = 23 maximum-depth = 7) ;;; EC-Eval value: 2 ;;; EC-Eval input: (fib 4) (total-pushes = 39 maximum-depth = 9) ;;; EC-Eval value: 3 ;;; EC-Eval input: (fib 5) (total-pushes = 63 maximum-depth = 11) ;;; EC-Eval value: 5 ;;; EC-Eval input: (fib 6) (total-pushes = 103 maximum-depth = 13) ;;; EC-Eval value: 8 ;;; EC-Eval input: (fib 7) (total-pushes = 167 maximum-depth = 15) ;;; EC-Eval value: 13 ;;; EC-Eval input: (fib 8) (total-pushes = 271 maximum-depth = 17) ;;; EC-Eval value: 21 ;;; EC-Eval input: (fib 9) (total-pushes = 439 maximum-depth = 19) ;;; EC-Eval value: 34 ;;; EC-Eval input: (fib 10) (total-pushes = 711 maximum-depth = 21) ;;; EC-Eval value: 55
積極制御評価器
;;; EC-Eval input: (define (ec-fib n) (if (< n 2) n (+ (ec-fib (- n 1)) (ec-fib (- n 2))))) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (ec-fib 1) (total-pushes = 16 maximum-depth = 8) ;;; EC-Eval value: 1 ;;; EC-Eval input: (ec-fib 2) (total-pushes = 72 maximum-depth = 13) ;;; EC-Eval value: 1 ;;; EC-Eval input: (ec-fib 3) (total-pushes = 128 maximum-depth = 18) ;;; EC-Eval value: 2 ;;; EC-Eval input: (ec-fib 4) (total-pushes = 240 maximum-depth = 23) ;;; EC-Eval value: 3 ;;; EC-Eval input: (ec-fib 5) (total-pushes = 408 maximum-depth = 28) ;;; EC-Eval value: 5 ;;; EC-Eval input: (ec-fib 6) (total-pushes = 688 maximum-depth = 33) ;;; EC-Eval value: 8 ;;; EC-Eval input: (ec-fib 7) (total-pushes = 1136 maximum-depth = 38) ;;; EC-Eval value: 13 ;;; EC-Eval input: (ec-fib 8) (total-pushes = 1864 maximum-depth = 43) ;;; EC-Eval value: 21 ;;; EC-Eval input: (ec-fib 9) (total-pushes = 3040 maximum-depth = 48) ;;; EC-Eval value: 34 ;;; EC-Eval input: (ec-fib 10) (total-pushes = 4944 maximum-depth = 53) ;;; EC-Eval value: 55
プッシュ数
| n | 計算機 | 翻訳系 | 評価器 | 評/機 | 翻/機 |
|---|---|---|---|---|---|
| 3 | 8 | 23 | 128 | 16.0 | 2.87 |
| 4 | 16 | 39 | 240 | 15.0 | 2.43 |
| 5 | 28 | 63 | 408 | 14.57 | 2.25 |
| 6 | 48 | 103 | 688 | 14.33 | 2.14 |
| 7 | 80 | 167 | 1136 | 14.2 | 2.08 |
| 8 | 132 | 271 | 1864 | 14.12 | 2.05 |
| 9 | 216 | 439 | 3040 | 14.07 | 2.03 |
| 10 | 352 | 711 | 4944 | 14.04 | 2.01| |
| 20 | 43780 | 87567 | 612936 | 14.0 | 2.0 |
最大スタック深さ
| 計算機 | 翻訳系 | 評価器 | 評/機 | 翻/機 |
|---|---|---|---|---|
| 2n-2 | 2n+1 | 5n+3 | 2.500 | 1.00 |
SICP 問題 5.45
コンパイルした階乗計算，積極制御評価器の階乗計算，特殊目的計算機のプッシュ数，最大スタック深さを調べて比較する．
まずはコンパイルしたものから
gosh> (compile-and-go '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) (total-pushes = 0 maximum-depth = 0) ;;; EC-Eval value: ok ;;; EC-Eval input: (factorial 1) (total-pushes = 5 maximum-depth = 3) ;;; EC-Eval value: 1 ;;; EC-Eval input: (factorial 2) (total-pushes = 7 maximum-depth = 3) ;;; EC-Eval value: 2 ;;; EC-Eval input: (factorial 3) (total-pushes = 9 maximum-depth = 4) ;;; EC-Eval value: 6 ;;; EC-Eval input: (factorial 4) (total-pushes = 11 maximum-depth = 6) ;;; EC-Eval value: 24 ;;; EC-Eval input: (factorial 5) (total-pushes = 13 maximum-depth = 8) ;;; EC-Eval value: 120 ;;; EC-Eval input: (factorial 6) (total-pushes = 15 maximum-depth = 10) ;;; EC-Eval value: 720 ;;; EC-Eval input: (factorial 7) (total-pushes = 17 maximum-depth = 12) ;;; EC-Eval value: 5040 ;;; EC-Eval input: (factorial 8) (total-pushes = 19 maximum-depth = 14) ;;; EC-Eval value: 40320 ;;; EC-Eval input: (factorial 9) (total-pushes = 21 maximum-depth = 16) ;;; EC-Eval value: 362880 ;;; EC-Eval input: (factorial 10) (total-pushes = 23 maximum-depth = 18) ;;; EC-Eval value: 3628800
プッシュ数は2n+3
最大スタック深さは2n-2
次に積極制御評価器で計測する．
;;; EC-Eval input: (define (ec-factorial n) (if (= n 1) 1 (* (ec-factorial (- n 1)) n))) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (ec-factorial 1) (total-pushes = 16 maximum-depth = 8) ;;; EC-Eval value: 1 ;;; EC-Eval input: (ec-factorial 2) (total-pushes = 48 maximum-depth = 13) ;;; EC-Eval value: 2 ;;; EC-Eval input: (ec-factorial 3) (total-pushes = 80 maximum-depth = 18) ;;; EC-Eval value: 6 ;;; EC-Eval input: (ec-factorial 4) (total-pushes = 112 maximum-depth = 23) ;;; EC-Eval value: 24 ;;; EC-Eval input: (ec-factorial 5) (total-pushes = 144 maximum-depth = 28) ;;; EC-Eval value: 120 ;;; EC-Eval input: (ec-factorial 6) (total-pushes = 176 maximum-depth = 33) ;;; EC-Eval value: 720 ;;; EC-Eval input: (ec-factorial 7) (total-pushes = 208 maximum-depth = 38) ;;; EC-Eval value: 5040 ;;; EC-Eval input: (ec-factorial 8) (total-pushes = 240 maximum-depth = 43) ;;; EC-Eval value: 40320 ;;; EC-Eval input: (ec-factorial 9) (total-pushes = 272 maximum-depth = 48) ;;; EC-Eval value: 362880 ;;; EC-Eval input: (ec-factorial 10) (total-pushes = 304 maximum-depth = 53) ;;; EC-Eval value: 3628800
プッシュ数は32n-16
最大スタック深さは5n+3
最後に階乗計算のための特殊計算機で計測する．
gosh> (define fact ;; 二回目以降の初期化は省略 (make-machine (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 (perform (op print-stack-statistics))))) fact gosh> (set-register-contents! fact 'n 1) done gosh> (start fact) (total-pushes = 0 maximum-depth = 0)done gosh> (get-register-contents fact 'val) 1 gosh> (set-register-contents! fact 'n 2) done gosh> (start fact) (total-pushes = 2 maximum-depth = 2)done gosh> (get-register-contents fact 'val) 2 gosh> (set-register-contents! fact 'n 3) done gosh> (start fact) (total-pushes = 4 maximum-depth = 4)done gosh> (get-register-contents fact 'val) 6 gosh> (set-register-contents! fact 'n 4) done gosh> (start fact) (total-pushes = 6 maximum-depth = 6)done gosh> (get-register-contents fact 'val) 24 gosh> (set-register-contents! fact 'n 5) done gosh> (start fact) (total-pushes = 8 maximum-depth = 8)done gosh> (get-register-contents fact 'val) 120 gosh> (set-register-contents! fact 'n 6) done gosh> (start fact) (total-pushes = 10 maximum-depth = 10)done gosh> (get-register-contents fact 'val) 720 gosh> (set-register-contents! fact 'n 7) done gosh> (start fact) (total-pushes = 12 maximum-depth = 12)done gosh> (get-register-contents fact 'val) 5040 gosh> (set-register-contents! fact 'n 8) done gosh> (start fact) (total-pushes = 14 maximum-depth = 14)done gosh> (get-register-contents fact 'val) 40320 gosh> (set-register-contents! fact 'n 9) done gosh> (start fact) (total-pushes = 16 maximum-depth = 16)done gosh> (get-register-contents fact 'val) 362880 gosh> (set-register-contents! fact 'n 10) done gosh> (start fact) (total-pushes = 18 maximum-depth = 18)done gosh> (get-register-contents fact 'val) 3628800
プッシュ数が2n-2 最大スタック深さが2n-2．
比べると，積極制御評価器は
total: 32n-16
max: 5n+3
翻訳系は
total: 2n+3
max: 2n-2
階乗計算機は
total: 2n-2
max: 2n-2
本来はここで翻訳系と階乗計算機のほうがはるかに優れていることを確認するはずが
ここまでの問題で最適化したため，ほとんど性能差がなくなっている．
比率を出すと積極制御評価器とは
totalが1:16
maxは2:5の性能差になる．
ここで本当に翻訳系が2nで収まっているのか確認のためにコンパイルした命令列を出力させる．
saveしているところを確認する．
gosh> (compile '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n))) 'val 'next '()) ((env) (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)) (assign arg1 (op lexical-address-lookup) (const (0 0)) (reg env)) (assign arg2 (const 1)) (assign val (op =) (reg arg1) (reg arg2)) (test (op false?) (reg val)) (branch (label false-branch4)) true-branch3 (assign val (const 1)) (goto (reg continue)) false-branch4 (save continue) ;; false-branchのcontinue (save env) ;; false-branchのenv (assign proc (op get-global-environment)) (assign proc (op lookup-variable-value) (const factorial) (reg proc)) (assign arg1 (op lexical-address-lookup) (const (0 0)) (reg env)) (assign arg2 (const 1)) (assign val (op -) (reg arg1) (reg arg2)) (assign argl (op list) (reg val)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch6)) compiled-branch7 (assign continue (label proc-return9)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) proc-return9 (assign arg1 (reg val)) (goto (label after-call8)) primitive-branch6 (assign arg1 (op apply-primitive-procedure) (reg proc) (reg argl)) after-call8 (restore env) (assign arg2 (op lexical-address-lookup) (const (0 0)) (reg env)) (assign val (op *) (reg arg1) (reg arg2)) (restore continue) (goto (reg continue)) after-if5 after-lambda2 (perform (op define-variable!) (const factorial) (reg val) (reg env)) (assign val (const ok))))
false-branchでcontinueとenvをsaveしているだけなので最大スタック深さが2n-2なのは確かなようだ．
プッシュ数が2n+3なのは(factorial 1)でも5回プッシュされてるところを見ると，
引数を適用する段階でされているのでこれ以上は無理だろう．
factorialは基本計算しか使っていないので，open-code最適化がかなり効いてるためのこれだけ性能がよくなってると思われる．
