3imp 読書メモ(2)

今回はチャプター4の最初の第1節について書く。
3imp 未読の人には何が何やらわからない内容だと思う。 読んだことがある人は間違い探しでもしながら読んでもらえればと思う。

チャプター4 はスタックベースモデルの章だ。



ヒープベースモデルでは変数ルックアップと関数呼び出しのコストが大きい。一方でスタックベース言語の代表みたいなCなんかは、 コールフレームや環境にヒープを必要としないのでそのへんが速いようだ。でも(定義場所からリターンした後も使えるような本物の)ファーストクラス関数、 TCO, 継続などをスタックベースで実装するのは簡単ではない。(Cなどでそういった機能が限定的なのもそれが理由だろう)

そこでチャプター4ではまずこの辺のサポートをしないSchemeライクな言語をスタックベースで実装し、最終的にこれらの機能のサポートを目指す。

つまり 4.1節で考えるのは、 TCO, 継続はなし。関数を変数に渡すことはできるが、関数を定義したコールフレームからリターンしている場合は使えない、というSchemeライクな言語だ。


コールフレームについて

今回の言語でコールフレームとは、ある計算コンテキストにおいてスタックに積まれた以下の情報を言う。

• A: 変数ルックアップのための環境。つまり探索の起点となるスタック位置
• B: リターンアドレス。アドレスと言っても具体的にはVMのxにセットする次の命令。関数からreturnするときは、あらかじめスタックに積まれたこのリターンアドレスと、同じく保存しておいた環境をスタックから取り出してそれぞれ x と e レジスタにセットすることで関数呼び出し前の実行環境を復元する。
• C: 引数。引数を評価した結果の値は順次スタックに積んでいく。 

基本的には VM の環境レジスタ e 値がコールフレームのベースポインタとなっている、つまり e が指すスタック位置が実行中の関数呼び出しにおける引数のオフセットベースとなっている、と考えれば良い。 引数の数や、それに依存する return 時のスタックを巻き戻る数はコンパイル時に埋め込まれたものを使用する点は注意。これらはコンパイル時にわかっているのでスタックには積まれない。
この論文でややこしいのはスタックから取り出して e レジスタに載せるべき値(上記のA)の連なりが2種類あることだろう。それらはダイナミックリンクとスタティックリンクと呼ばれている。


ダイナミックリンクとスタティックリンクについて

変数ルックアップのための e レジスタに値がスタックから取り出されてセットされるのは2パターンある。

ひとつは上に書いたとおり、関数から return するときにセットするパターン。これはもともと frame 命令実行時、つまり Scheme のもともとのコードで言えば関数適用の場合の (...) というカッコで囲まれたリストの要素(つまり引数とオペレータ)の評価を開始する時にスタックに積んだものを取り出してセットしている。(関数適用以外、つまりifなどの構文はコンパイル時に違う命令になるのでframe命令にはならない)
これは同じくスタックに積んでいたリターンアドレスも x レジスタに復帰させていることを考えれば、(...) という呼び出し時にスタックに保存していた動的な計算コンテキストを、 return で復帰させていることがよくわかる。
このような環境の保存・復帰が必要な理由は (+ 1 (...) 3) など、さらに大きな関数呼び出しの途中で関数呼び出しがある場合を考えると明らかだ。さらにこの (+ 1 (...) 3) も他の式の引数の一部である場合を考えると、frame 呼び出し時にスタックに積んで return で復帰するような一連の環境レジスタ e にのせる値の連なりが構成されていることがわかる。これをこの論文ではダイナミックリンクと呼んでいる。関数適用から return する場合はダイナミックリンク系列の環境を e にセットしていると言える。

もうひとつのパターンは apply 実行時にファンクショナル(このモデルにおける不完全なクロージャだと思えば良い。後述する。)の作成時に保存された e の値を取り出してスタックに push し、その push した位置を新しい e としてセットするパターンだ。
こちらはスタティックリンクと呼ばれている。スタティックリンクは VM の e レジスタをベースに、レジスタが指す位置にある値を辿っていける e の値の連なりだ。ここには上に書いたとおりファンクショナル作成時の e が保存されている。ファンクショナルが作成されるのは、もとの Scheme コードでいえば、 (lambda (vars ...) ...) を評価しているときだ。つまり、これによって lambda 定義のレキシカルな環境を辿れることになる。VMが e レジスタをどのように使うかといえば、変数ルックアップのためだ。変数ルックアップでは VM の e レジスタから目的の環境フレームまでスタック上に保存された e の値をたどり、目的のフレームにたどり着いたらオフセットで指定された位置に積まれた引数の値を取り出す。これはつまり実行中の関数の定義が実行された環境へ向かう連なりが構成されていると言える。これをスタティックリンクと呼んでいる。

典型的なスタックの様子は以下とおり:

static link  :: address of stack
arg 0        :: evaluated value
arg 1        :: evaluated value
arg 2        :: evaluated value
  ...
arg n        :: evaluated value
return addr  :: s-expr to be executed next
dynamic link :: address of stack

もともとの Scheme コードを実行する様子を考えると、感覚的には以下のようになる:

VM の e は現在実行中の関数が*呼びだされたとき*のスタック最上部(上の図で言う static link)の位置を指している。
e の値から引数順序分だけオフセットを引いた位置のスタックの内容を見ることで実行中の関数の*呼びだされたとき*の実引数にアクセスできる。
e の値が指す位置自体にあるスタック上の値、つまり上の図で言う statick link は実行中の関数が*定義されたとき*の e の値が保存されているので、ひとつ e を辿ってオフセットを引いた位置のスタックの内容を見れば、現在実行中の関数の定義場所で実行中だった関数の実引数にアクセスできる、つまりレキシカル環境へのアクセスが可能になる。e を辿った先のスタックの値自体は、その関数の定義場所で実行中だった e になるので、レキシカル環境をどんどん遡れる。これがスタティックリンクだ。
一方で、 実行中の関数が実行を終えたあと return する場合を考えると、スタックに積まれている static link と実行中関数の引数分だけスタックを巻き戻る。このあと e に何をセットすべきかだが、それが dynamic link に保存された e の値だ。戻った先も何かの関数実行であり、dynamic link を積んだ上のはずなので、そこから return すべき dynamic link の連なりがあるはず。これがダイナミックリンクだ。

なお、もし上の図の状態からさらに関数適用にむけた引数評価が行われるとしたら static link の上に arg m, arg (m-1), ... とどんどん引数が積まれていく。
(2015/02/08 次のように変更)
なお、もし上の図の状態からさらに関数適用にむけた引数評価が行われるとしたら、まず関数適用なのでVMは frame 命令によって現在の e レジスタの値を上図の static link の上に push し、関数適用後の計算を続けるためのアセンブリコードをさらにその上に push する。これらが新しい dynamic link と return addr となる。ただし、VMの e レジスタの値そのものは更新しないことに注意。その後関数適用のために引数を評価し、その結果が arg m, arg (m-1), ... とどんどん引数が積まれていく。(2015/02/08 変更ここまで)
その途中で引数が (...) という関数適用の形をしているなら、VM の e の値、つまり static link のあるスタック位置を新しい dynamic link としてスタックに載せ、その上に残りの引数評価を続けるための命令を新しい return addr として載せて、 (...) 内の引数を載せていく。(...)の引数をすべて評価し終わって、(...)先頭のファンクショナルを apply するときにはオペレータ定義時の e を 新しい static link としてスタックに乗せて、という感じでスタックが上に伸びていく。

ダイナミックリンクとスタティックリンクの概念はわかりづらいが、ダイナミックリンクはヒープモデルではスタック s の最後の要素の連なり、 スタティックリンクは同じく環境 e の背骨として現れていたもの。スタックモデルではこれらをスタックのアドレスで表していると考えれば良い。
後の章で出てくる継続作成ではダイナミックリンクの保全が、 クロージャ作成ではスタティックリンクの保全が重要になる。 これらはまさにヒープモデルの conti と close アセンブリコード実行時にそれぞれVMがやってたことだ。

ダイナミックリンクとスタティックリンクを理解すれば、この 4.1 は理解したも同然だ。残りの概念は簡単。

ファンクショナルとはクロージャみたいなもの。この章のスタックベースモデルでは完全なクロージャをサポートできないので、ファンクショナルという名前をつけていると思われる。
このモデルでは関数からreturnすると環境がなくなってしまう(いつ上書きされてもおかしくない)ので、「ファンクショナルを作って返す」ということはできない。もちろんファンクショナルを作成した関数のコールフレームから戻る前に他の関数に引数として渡すことは可能だ。


スタックは make-vector で作成したvectorを使う。 スタックへの値の push が楽にできるように、push 関数を定義しておく。 他には環境フレーム位置から指定の場所を参照/変更する index, index-set! を定義。 あとはスタティックリンクを指定回数たどるための find-link を定義。 VMコードではコンパイル時に確定した変数位置(スタティックリンク数とそのフレーム内の引数位置)をもとに、find-link でスタティッ クリンクを辿って index で変数の値を取得するかたちになる。

compile と VM のコードは下に貼ってある通りだが、先にも書いたとおり TCO がないので関数呼び出し (<operator> ...) コンパイル時にヒープベースモデルでやってた「次の実行コードが return だったら frame を作らない」というコードは compile から消えている(いつでも frame を作る)。 また、継続は一切サポートしないのでまるっと消去。 close はファンクショナルを作るために残っているが、クロージャをサポートしているわけではないので注意。他はだいたい一緒だ。 変数のスタック位置を確定する compile-lookup (およびコンパイル中の環境構造をコンパイル中に擬似的に構築する extend) は変数アクセス効率改善版のヒープベースモデルで使った関数をそのまま使える。

VM のほうはa, x レジスタはヒープベースモデルと全く同じだ。 ヒープベースモデルにあった r レジスタは評価済みの実引数をためていたレジスタだが、これはスタックに積まれるため不要なのでなくなっている。 e が指している内容は現在実行中のコールフレーム、と言えばよいだろう。上に書いたとおりだ。
s はスタック最上部(次に値を格納する位置)を指している。frame や apply, argument 命令で徐々に push され、return 命令で一気に戻る。

なお、論文掲載のオリジナルとの相違は以下の通り

1. 前回の読書メモでは論文の record の引数順序定義を正しいものとし、 record-case や VM に現れる record の引数の位置を修正していたが、 record の定義の引数順序が間違っていて record-case や VM に現れる record の引数順序が正しいと考えたほうがしっくりくる順序なので(あくまで感覚だが)、今回は record 定義のほうを修正してある。
2. 例によってプリミティブ関数を apply できるように改変してある。これに伴い、apply 命令が return に渡す数(引数の数)をとるようにしてある(プリミティブでない関数、つまり lambda は引数の数が定義から自明なので return 命令に埋め込めるが、プリミティブ関数はわからないので apply 時の引数の数をコンパイル時に調べて apply 命令に埋め込んでおき、VM での apply 命令実行時に return 命令をつくって x にセットするようにした)。 また、プリミティブ関数を一括でスタックに乗せて evaluate をスタートできるようにしてある。
3. スタックはデバッグ表示したときに使っているスタックの位置がわかりやすいように途中(1000)から使うようにしてある。また、スタック内は _ で初期化してある。
4. デバッグ情報の出力などのコードを埋め込んである。(使う場合はコメントアウトしてあるのを外せば良い)

	;;
	;; A stack model lisp compiler and virtual machine.
	;;
	;; Based on Section 4.1 of "Three Implementation Models for Scheme" by R. Kent Dybvig
	;; + some simple fixes
	;; + application for primitive procedures
	;; + debug code
	;;
	(define-syntax record
	(syntax-rules ()
	[(_ vals vars body ...)
	(apply (lambda vars body ...) vals)]))
	(define-syntax record-case
	(syntax-rules (else)
	[(_ exp
	[key vars body ...]
	...
	[else ebody ...])
	(let ((op (car exp))
	(vals (cdr exp)))
	(cond
	[(eq? op 'key) (record vals vars body ...)]
	...
	[else ebody ...]))]
	[(_ exp
	[keys vars ...]
	...)
	(record-case exp
	[keys vars ...]
	...
	[else #f])]))
	(define stack #f)
	(define (functional body e)
	(list body e))
	(define (push x s)
	(vector-set! stack s x)
	(+ s 1))
	(define (index s i)
	(vector-ref stack (- s i 1)))
	(define (index-set! s i v)
	(vector-set! stack (- s i 1) v))
	(define (compile-lookup var e return)
	(let nxtrib ([e e]
	[rib 0])
	(let nxtelt ([vars (car e)]
	[elt 0])
	(cond [(null? vars) (nxtrib (cdr e) (+ rib 1))]
	[(eq? (car vars) var) (return rib elt)]
	[else (nxtelt (cdr vars) (+ elt 1))]))))
	(define (extend e r)
	(cons r e))
	(define (compile x e next)
	(cond [(symbol? x)
	(compile-lookup x e
	(lambda (n m)
	(list 'refer n m next)))]
	[(pair? x)
	(record-case x
	[begin body
	(let loop ((rest (reverse body))
	(next next))
	(if (null? rest)
	next
	(loop (cdr rest)
	(compile (car rest)
	e
	next))))]
	[quote (obj)
	(list 'constant obj next)]
	[lambda (vars . body)
	(list 'close
	(compile (cons 'begin body)
	(extend e vars)
	(list 'return (+ (length vars) 1)))
	next)]
	[if (test then else)
	(let ([thenc (compile then e next)]
	[elsec (compile else e next)])
	(compile test e (list 'test thenc elsec)))]
	[set! (var x)
	(compile-lookup var e
	(lambda (n m)
	(compile x e (list 'assign n m next))))]
	[else
	(let loop ([args (cdr x)]
	[c (compile (car x) e (list 'apply (length (cdr x))))])
	(if (null? args)
	(list 'frame next c)
	(loop (cdr args)
	(compile (car args)
	e
	(list 'argument c)))))])]
	[else
	(list 'constant x next)]))
	(define (find-link n e)
	(if (zero? n)
	e
	(find-link (- n 1) (index e -1))))
	(define (arglist s n)
	(reverse! (vector->list stack (- s n) s)))
	(define (VM a x e s)
	#; (dbgpr a x e s)
	(record-case x
	[halt () a]
	[refer (n m x)
	(VM (index (find-link n e) m) x e s)]
	[constant (var x)
	(VM var x e s)]
	[close (body x)
	(VM (functional body e) x e s)]
	[test (then else)
	(VM a (if a then else) e s)]
	[assign (n m x)
	(index-set! (find-link n e) m a)
	(VM a x e s)]
	[frame (next x)
	(VM a x e (push next (push e s)))]
	[argument (x)
	(VM a x e (push a s))]
	[apply (n)
	(if (procedure? a)
	(VM (apply a (arglist s n)) (list 'return n) e s)
	(record a (body fe)
	(VM a body s (push fe s))))]
	[return (n)
	(let ((s (- s n)))
	(VM a (index s 0) (index s 1) (- s 2)))]))
	(define start-addr 1000)
	(define stack-size 10000)
	(define default-env '(+ - * / list zero? ))
	(define (evaluate expr)
	(set! stack (make-vector stack-size '_))
	(let ((s (init-env default-env))
	(x (compile expr (list default-env) '(halt))))
	#;
	(begin (print "CODE: " x)
	(newline))
	(VM '() x s s)))
	(define (init-env e)
	(let loop ((e (reverse e))
	(i start-addr))
	(if (null? e)
	i
	(begin
	(vector-set! stack i (eval (car e) (current-module)))
	(loop (cdr e) (+ i 1))))))
	(define (dbgpr a x e s)
	(display "a: ")
	(pp a)
	(display "x: ")
	(pp x)
	(display "e: ")
	(pp e)
	(display "s: ")
	(pp s)
	(newline)
	(dbgpr-stk s)
	(print "---------------------------------------------"))
	(define (dbgpr-stk s)
	(for-each (lambda (i)
	(format #t "~A: " i)
	(pp (vector-ref stack i)))
	(reverse! (iota (- s start-addr -1) start-addr))))
	(define (pp x)
	(define (plist x n)
	(cond [(or (null? x) (zero? n)) #t]
	[(pair? x)
	(rec (car x) (- n 1))
	(unless (null? (cdr x))
	(display " ")
	(plist (cdr x) (- n 1)))]
	[else
	(rec x (- n 1))]))
	(define (rec x n)
	(cond [(zero? n) (display "...")]
	[(pair? x)
	(display "(")
	(plist x n)
	(display ")")]
	[else
	(display x)]))
	(rec x 5)
	(newline))

view raw the3imp-stack41.scm hosted with ❤ by GitHub