SICP 読書ノート#76 - 5.5 翻訳系(1) (pp.339-343)

いよいよ最後のセクション。

これまでレジスタマシン、積極制御評価機(解釈系=インタプリタ)と来て、ここでは翻訳系(=コンパイラ)について学びます。

翻訳系の概観

ひとことで言うと「環境をenvに保持し、引数リストをarglに集積し、適用する手続きをprocに、手続きが戻る場所をcontinueに入れ、手続き適用の評価結果をvalに入れて戻る」機械語のオブジェクトプログラムを作ること。

積極制御評価機は式の中でレジスタ命令にぶつかるとすぐに評価するのに対し、翻訳系はそれをシーケンスに集積しオブジェクトコードへ変換していく。

これは積極制御評価機が§4.1.1〜4.1.3の超循環評価機がに似ていたのに対し、翻訳系は§4.1.7のソースプログラムを解釈して実行手続きを生成する評価機に似ている。

まさか§4.1がここに至る伏線だったとは。SICPやっぱすごいわ。

5.5.1 翻訳系

§4.1.7の評価機と同じく、翻訳系でも解釈と実行を分離する
解釈と実行を分離する手続きcompileは、ターゲット(taget)とリンク記述子(linkage)を引数に取る
- targetは式の返す値の格納先レジスタ
- linkageはコードが実行を終えたときの継続先のラベル。ただしnextが指定された場合は、シーケンスの次の命令から実行を続ける
シーケンスを組み合わせる際に、レジスタの退避や復元はpreservingに任せる。実装の詳細はここではよくわからない

とりあえず、細かいことは置いといて、今回もMITのサンプルコードを Racketで動作するよう修正した。

https://github.com/uents/sicp/tree/master/ch5.5-compiler

問題 5.31

よくわからないので、それぞれコンパイルしてみた。

a. `(f 'x 'y)`

翻訳系の実行結果からすると、何も退避しなくてよい。

compiler.scm<feff>> (compile '(f 'x 'y) 'val 'next)

'((env)
  (env proc argl continue val)
  ((assign proc (op lookup-variable-value) (const f) (reg env))
   (assign val (const y))
   (assign argl (op list) (reg val))
   (assign val (const x))
   (assign argl (op cons) (reg val) (reg argl))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch1))
   compiled-branch2
   (assign continue (label after-call3))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch1
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call3))

b. `((f) 'x 'y)`

aと比較すると(f ...)が((f) ...)に変わっただけ。

(f)には非演算子(の部分式)が存在しないため、 (f)を評価する際にスタックの退避が発生せず、結果はaと同じになる。

compiler.scm<feff>> (compile '((f) 'x 'y) 'val 'next)

'((env)
  (env proc argl continue val)
  ((assign proc (op lookup-variable-value) (const f) (reg env))
   (assign argl (const ()))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch4))
   compiled-branch5
   (assign continue (label proc-return7))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   proc-return7
   (assign proc (reg val))
   (goto (label after-call6))
   primitive-branch4
   (assign proc (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call6
   (assign val (const y))
   (assign argl (op list) (reg val))
   (assign val (const x))
   (assign argl (op cons) (reg val) (reg argl))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch8))
   compiled-branch9
   (assign continue (label after-call10))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch8
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call10))

c. `(f (g 'x) y)`

おおよその処理の流れは以下の通り。

fを環境フレームから探し出しprocに格納
procをスタックに退避する
fの引数について、まずはyが評価されarglに格納
次に(g 'x)の評価を行うために、agrlをスタックに退避
gを環境フレームから探し出しprocに格納
'xを評価しagrlに格納
gにarglを適用して評価し、返り値をvalに格納
3でスタックに退避したarglを復元
arglに7のvalの値を追加
fにarglを適用して評価し、返り値をvalに格納

compiler.scm<feff>> (compile '(f (g 'x) y) 'val 'next)

'((env)
  (env proc argl continue val)
  ((assign proc (op lookup-variable-value) (const f) (reg env))
   (save proc)
   (assign val (op lookup-variable-value) (const y) (reg env))
   (assign argl (op list) (reg val))
   (save argl)
   (assign proc (op lookup-variable-value) (const g) (reg env))
   (assign val (const x))
   (assign argl (op list) (reg val))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch11))
   compiled-branch12
   (assign continue (label after-call13))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch11
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call13
   (restore argl)
   (assign argl (op cons) (reg val) (reg argl))
   (restore proc)
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch14))
   compiled-branch15
   (assign continue (label after-call16))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch14
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call16))

ウェブで色々な回答を見ていると「envが退避or復元される」といったものがあったが、今回のコンパイル結果には見当たらなかった。

明示的に新たな変数束縛があるわけでないのでenvが拡張されないから、翻訳系の最適化でenvの退避or復元はされないんじゃないかなぁ。外してるかもしれないけど。

d. `(f (g 'x) 'y)`

細かいことは省略。結果はcとほぼ同じ。

compiler.scm<feff>> (compile '(f (g 'x) 'y) 'val 'next)

'((env)
  (env proc argl continue val)
  ((assign proc (op lookup-variable-value) (const f) (reg env))
   (save proc)
   (assign val (const y))
   (assign argl (op list) (reg val))
   (save argl)
   (assign proc (op lookup-variable-value) (const g) (reg env))
   (assign val (const x))
   (assign argl (op list) (reg val))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch17))
   compiled-branch18
   (assign continue (label after-call19))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch17
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call19
   (restore argl)
   (assign argl (op cons) (reg val) (reg argl))
   (restore proc)
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch20))
   compiled-branch21
   (assign continue (label after-call22))
   (assign val (op compiled-procedure-entry) (reg proc))
   (goto (reg val))
   primitive-branch20
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call22))

問題 5.32 a.

積極的評価機に対して(+ 1 2)がどのように解釈されるかを理解していないので、まずは実行して追ってみる。

§5.2でせっせと作ったトレース機能を有効にして実行。

eceval.scm<feff>> (eceval 'trace-on)
eceval.scm<feff>> (start eceval)
'(label = read-eval-print-loop)
'(inst = (perform (op initialize-stack)))
'(inst = (perform (op prompt-for-input) (const ";;; EC-Eval input:")))

;;; EC-Eval input:
'(inst = (assign exp (op read)))

(+ 1 2)

;; snip...

'(label = ev-application)
'(inst = (save continue))
'(inst = (save env))
'(inst = (assign unev (op operands) (reg exp)))
'(inst = (save unev))
'(inst = (assign exp (op operator) (reg exp)))
'(inst = (assign continue (label ev-appl-did-operator)))
'(inst = (goto (label eval-dispatch)))
'(label = eval-dispatch)
'(inst = (test (op self-evaluating?) (reg exp)))
'(inst = (branch (label ev-self-eval)))
'(inst = (test (op variable?) (reg exp)))
'(inst = (branch (label ev-variable)))
'(label = ev-variable)
'(inst = (assign val (op lookup-variable-value) (reg exp) (reg env)))
'(inst = (goto (reg continue)))
'(label = ev-appl-did-operator)
'(inst = (restore unev))
'(inst = (restore env))
'(inst = (assign argl (op empty-arglist)))
'(inst = (assign proc (reg val)))
'(inst = (test (op no-operands?) (reg unev)))
'(inst = (branch (label apply-dispatch)))
'(inst = (save proc))
'(inst = (save argl))
'(inst = (assign exp (op first-operand) (reg unev)))
'(inst = (test (op last-operand?) (reg unev)))
'(inst = (branch (label ev-appl-last-arg)))
'(inst = (save env))
'(inst = (save unev))
'(inst = (assign continue (label ev-appl-accumulate-arg)))
'(inst = (goto (label eval-dispatch)))
'(label = eval-dispatch)
'(inst = (test (op self-evaluating?) (reg exp)))
'(inst = (branch (label ev-self-eval)))
'(label = ev-self-eval)
'(inst = (assign val (reg exp)))
'(inst = (goto (reg continue)))
'(label = ev-appl-accumulate-arg)
'(inst = (restore unev))
'(inst = (restore env))
'(inst = (restore argl))
'(inst = (assign argl (op adjoin-arg) (reg val) (reg argl)))
'(inst = (assign unev (op rest-operands) (reg unev)))
'(inst = (goto (label ev-appl-operand-loop)))
'(label = ev-appl-operand-loop)
'(inst = (save argl))
'(inst = (assign exp (op first-operand) (reg unev)))
'(inst = (test (op last-operand?) (reg unev)))
'(inst = (branch (label ev-appl-last-arg)))
'(label = ev-appl-last-arg)
'(inst = (assign continue (label ev-appl-accum-last-arg)))
'(inst = (goto (label eval-dispatch)))
'(label = eval-dispatch)
'(inst = (test (op self-evaluating?) (reg exp)))
'(inst = (branch (label ev-self-eval)))
'(label = ev-self-eval)
'(inst = (assign val (reg exp)))
'(inst = (goto (reg continue)))
'(label = ev-appl-accum-last-arg)
'(inst = (restore argl))
'(inst = (assign argl (op adjoin-arg) (reg val) (reg argl)))
'(inst = (restore proc))
'(inst = (goto (label apply-dispatch)))
'(label = apply-dispatch)
'(inst = (test (op primitive-procedure?) (reg proc)))
'(inst = (branch (label primitive-apply)))
'(label = primitive-apply)
'(inst = (assign val (op apply-primitive-procedure) (reg proc) (reg argl)))
'(inst = (restore continue))
'(inst = (goto (reg continue)))
'(label = print-result)
'(inst = (perform (op print-stack-statistics)))
'(total-pushes = 8 max-depth = 5 curr-depth = 0)
'(inst = (perform (op announce-output) (const ";;; EC-Eval value:")))

;;; EC-Eval value:
'(inst = (perform (op user-print) (reg val)))
3

'(inst = (goto (label read-eval-print-loop)))
'(label = read-eval-print-loop)
'(inst = (perform (op initialize-stack)))
'(inst = (perform (op prompt-for-input) (const ";;; EC-Eval input:")))

処理の大まかな流れは、

ev-application で
- envをスタックに退避
- 演算子をexp、非演算子をunevに格納して、eval-dispatchへ
eval-dispatchで
- expに格納されて演算子の手続きを環境フレームから探してev-appl-did-operatorへ
ev-appl-did-operatorで
- unenvとenvをスタックから復元
- 空の引数リストをarglに、演算子の手続きをprocに格納
- procとarglをスタックに退避
- 最初の非演算子をexpへ格納
- envとunevをスタックにをスタックに退避し、eval-dispatchへ

以降はこの流れの繰り返しで、非演算子の評価が進んでいく。

さらに、apply-dispatchへ飛ぶと、評価済みの非演算子が蓄積されたarglが手続きprocに適用・評価され、その返り値がvalに格納される。

ただし、演算子がシンボルの場合は、演算子を評価する際のeval-dispatchで、 envが拡張されることはないので、envの退避・復元を行わなくてもよいはず。

修正方法はいくつかあると思うが、今回は sicp-solutions の回答をそのまま拝借した。

ev-application 
  (save continue) 
  (assign unev (op operands) (reg exp)) 
  (assign exp (op operator) (reg exp)) 
  (test (op symbol?) (reg exp))    ;;the operator is symbol? 
  (branch (label ev-appl-operator-symbol)) 
  (save env) 
  (save unev) 
  (assign continue (label ev-appl-did-operator-with-restore)) 
  (goto (label eval-dispatch)) 

ev-appl-operator-symbol 
  (assign continue (label ev-appl-did-operator)) 
  (goto (label eval-dispatch)) 

ev-appl-did-operator-with-restore
  (restore unev)             
  (restore env) 

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

積極制御評価機に組み込んで試してみる。

eceval.scm<feff>> (eceval 'trace-on)
eceval.scm<feff>> (start eceval)
'(label = read-eval-print-loop)
'(inst = (perform (op initialize-stack)))
'(inst = (perform (op prompt-for-input) (const ";;; EC-Eval input:")))


;;; EC-Eval input:
'(inst = (assign exp (op read)))

(+ 1 2)

;; snip...

'(label = ev-application)
'(inst = (save continue))
'(inst = (assign unev (op operands) (reg exp)))
'(inst = (assign exp (op operator) (reg exp)))
'(inst = (test (op symbol?) (reg exp)))
'(inst = (branch (label ev-appl-operator-symbol)))
'(label = ev-appl-operator-symbol)
'(inst = (assign continue (label ev-appl-did-operator)))
'(inst = (goto (label eval-dispatch)))
'(label = eval-dispatch)
'(inst = (test (op self-evaluating?) (reg exp)))
'(inst = (branch (label ev-self-eval)))
'(inst = (test (op variable?) (reg exp)))
'(inst = (branch (label ev-variable)))
'(label = ev-variable)
'(inst = (assign val (op lookup-variable-value) (reg exp) (reg env)))
'(inst = (goto (reg continue)))
'(label = ev-appl-did-operator)
'(inst = (assign argl (op empty-arglist)))
'(inst = (assign proc (reg val)))

;; snip...

;;; EC-Eval value:
'(inst = (perform (op user-print) (reg val)))
3

狙い通り、演算子の評価でenvの退避・復元を行わなくても正しく動作する。

問題 5.32 b.

Alyssaの言いたいことはわからないでもないが、積極制御評価機の内部をいくら最適化しても、ソースコードを逐次評価して実行する解釈系なので、翻訳系以上の最適化は行えないように思う。

次回は「5.5.2 式の翻訳」から。

@uents blog

Code wins arguments.

SICP 読書ノート#76 - 5.5 翻訳系(1) (pp.339-343)

翻訳系の概観

5.5.1 翻訳系

問題 5.31

a. `(f 'x 'y)`

b. `((f) 'x 'y)`

c. `(f (g 'x) y)`

d. `(f (g 'x) 'y)`

問題 5.32 a.

問題 5.32 b.

翻訳系の概観

5.5.1 翻訳系

問題 5.31

a. (f 'x 'y)

b. ((f) 'x 'y)

c. (f (g 'x) y)

d. (f (g 'x) 'y)

問題 5.32 a.

問題 5.32 b.

a. `(f 'x 'y)`

b. `((f) 'x 'y)`

c. `(f (g 'x) y)`

d. `(f (g 'x) 'y)`