Scheme 方面では有名らしく、 ファイル名由来だと思うんだけど、通称 3imp と呼ばれて親しまれているみたい。(@nfunato さん、情報ありがとうございます)
これはその読書メモだ。3章まで読んでいる。続きはまた後日。
概要
- (当時)Scheme実装モデルには3パターンあるらしい。当時主流のヒープベース、論文著者がChez Schemeとして実装した性能がいいスタックベース、FFPマシン用ストリングベース。
- FFPとは何なのか謎。「マルチプロセッサ、ストリングリダクション」と書いてあるが、よくわからず。マシンは(当時)まだないようだが、FFP言語を直接実行するFFPマシンが実現されればストリングベースのモデルで実装したSchemeがFFPの代わりに高水準言語として便利に使えるらしい
- このへんは論文のイントロとSchemeそのものについての概要だ。
- Chez Schemeがスタックモデルで実装された最初(1983,1984時点)のSchemeだったようだ。
- 同時にMLなどでも同様のテクニックで実装されたものがあったらしい。
- FFP マシンって http://www.cs.unc.edu/techreports/87-014.pdf かな?
- Schemeの由来とかCommon Lisp(当時すでにあったのね)とかその他関数言語の話とか。
- この論文でも実装はほとんどSchemeで書いてあるらしい。結局S式操作だからそれでいいでしょってことなんだろう。
- スタックベースやストリングベースはSchemeが関数プログラミングスタイル中心なのでイケてるらしい。代入しないコードを高速化して、代入を多用するコードは(もしかしたら)遅くする。
- 関数プログラミング言語とは、とか。
- 偽が #f じゃなく '() だった時代があったのね。
- beginがlambdaに展開できることに驚いた。評価順序を考えると確かにこれで意図したとおり動く。
- alternate は多分動かない。+の代わりに絶対値を増加させるような関数にすればよさげ。
- record-case は面白い。case + destructing-bind みたいな動作。リストの car 部で処理を分岐させたうえで、 cdr 部を指定の変数に束縛してbodyを実行、って感じ。
- execという小さい超循環評価器。Lispで書くとほんとに楽だな。
- call/cc が2つあるのはミスだろうか。中身は違うが結局同じ動きっぽい。
チャプター3
- いよいよ本題に入る。チャプター3はヒープベースの実装。
- シンプルな動作のVMを考え、そこで動作するアセンブリコードにcompilerで翻訳する。
- いきなり難易度が上がった気がする。VMの動きを理解しないとcompilerも理解できない(なぜそのアセンブリコードにするのかわからないので)
- ということで写経。やっぱ実際に実装してみると理解が進む。
- 論文のコードにはいくつか間違いがある(ほとんどtypoレベルだが。recordの引数の順序が違うとか)。
- あと論文のVMコードにはプリミティブな関数(実装言語側の関数)を適用するコードがない。
- プリミティブな関数をどうやって適用するのかしばらく悩んだけど、applyのときにaレジスタがprocedure?なら (VM (apply a r) '(return) e r s) すればよさげ。procedure?でなければlambda式をコンパイルしたものなので論文のコードの通りに実行すればよい。
- 他の方法はあるかなぁ。どうにかして実行できるコードにコンパイルしとくとか。でもVMのapplyが「aレジスタから関数のbodyとかを取り出して次の実行コードとしてセット、同じく取り出した変数シンボルリストとrレジスタで環境を作ってVM実行」だから結局プリミティブをapplyする手段がないとむりぽ
- Yコンビネータで再帰させたりもできた(例によってfactorialを定義して実行してみた)。
- 変数lookupの高速化おもしろい。確かに環境ツリーの位置で記憶しておけば一個ずつeq?する必要がないので早そう。
- 継続のコンパイルとVMの動きがあんまり理解できてない。コード上ではだいたいわかるけど、自分のものにできてない感じ。
- コンパイラのapply部分のコードを見る限りTCOもされてるっぽいけどまだ確信を持てない。
- lambdaのbody部に暗黙のbeginがないのか。シンタックスもコンパイル前に展開するようにして色々実行できるようにしたいけど、スタックベースを読むのが先かな。
とりあえず途中で写経したコンパイラとVMをGistに載せといた。(以下に貼り付けたもの)
- 変数ルックアップの高速化は実施してない段階のコード。
- 原文にあった引数順序ミス修正ずみ
- プリミティブ関数適用コードの追加
- evaluate内の初期環境にプリミティブ関数を登録した状態にしてある
- Gaucheで動作確認。(define recur let)がGauche依存かもしれんが、これが動かない処理系なら論文の通りにdefine-syntaxで実装すれば動くはず
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; | |
;; A heap model lisp compiler and virtual machine. | |
;; | |
;; Based on Section 3 of "Three Implementation Models for Scheme" by R. Kent Dybvig | |
;; + some simple fixes | |
;; + application for primitive procedures | |
;; | |
(define recur let) | |
(define-syntax record | |
(syntax-rules () | |
[(_ vars val exp ...) | |
(apply (lambda vars exp ...) val)])) | |
(define-syntax record-case | |
(syntax-rules (else) | |
[(_ exp | |
[key vars exp2 ...] | |
... | |
[else exp3 ...]) | |
(let ((r exp)) | |
(cond | |
[(eq? (car r) 'key) | |
(record vars (cdr r) exp2 ...)] | |
... | |
[else exp3 ...]))] | |
[(_ exp | |
[arg ...] | |
...) | |
(record-case exp | |
[arg ...] | |
... | |
[else #f])])) | |
(define tail? | |
(lambda (next) | |
(eq? (car next) 'RETURN))) | |
(define compile | |
(lambda (x next) | |
(cond | |
[(symbol? x) | |
(list 'REFER x next)] | |
[(pair? x) | |
(record-case x | |
[quote (obj) | |
(list 'CONSTANT obj next)] | |
[lambda (vars body) | |
(list 'CLOSE vars (compile body '(RETURN)) next)] | |
[if (test then else) | |
(let ([thenc (compile then next)] | |
[elsec (compile else next)]) | |
(compile test (list 'TEST thenc elsec)))] | |
[set! (var x) | |
(compile x (list 'ASSIGN var next))] | |
[call/cc (x) | |
(let ([c (list 'CONTI | |
(list 'ARGUMENT | |
(compile x '(APPLY))))]) | |
(if (tail? next) | |
c | |
(list 'FRAME next c)))] | |
[else | |
(recur loop ([args (cdr x)] | |
[c (compile (car x) '(APPLY))]) | |
(if (null? args) | |
(if (tail? next) | |
c | |
(list 'FRAME next c)) | |
(loop (cdr args) | |
(compile (car args) | |
(list 'ARGUMENT c)))))])] | |
[else | |
(list 'CONSTANT x next)]))) | |
(define lookup | |
(lambda (var e) | |
(recur nxtrib ([e e]) | |
(recur nxtelt ([vars (caar e)] [vals (cdar e)]) | |
(cond | |
[(null? vars) (nxtrib (cdr e))] | |
[(eq? vars var) (list vals)] | |
[(eq? (car vars) var) vals] | |
[else (nxtelt (cdr vars) (cdr vals))]))))) | |
(define extend | |
(lambda (env vars vals) | |
(cons (cons vars vals) env))) | |
(define closure | |
(lambda (body e vars) | |
(list body e vars))) | |
(define continuation | |
(lambda (s) | |
(closure (list 'NUATE s 'V) '() '(V)))) | |
(define call-frame | |
(lambda (x e r s) | |
(list x e r s))) | |
(define VM | |
(lambda (a x e r s) | |
#; | |
(begin | |
(print "accm " a) | |
(print "expr " x) | |
(print "envi " e) | |
(print "ribs " r) | |
(print "stck " s) | |
(newline)) | |
(record-case x | |
[HALT () a] | |
[REFER (var x) | |
(VM (car (lookup var e)) x e r s)] | |
[CONSTANT (obj x) | |
(VM obj x e r s)] | |
[CLOSE (vars body x) | |
(VM (closure body e vars) x e r s)] | |
[TEST (then else) | |
(VM a (if a then else) e r s)] | |
[ASSIGN (var x) | |
(set-car! (lookup var e) a) | |
(VM a x e r s)] | |
[CONTI (x) | |
(VM (continuation s) x e r s)] | |
[NUATE (s var) | |
(VM (car (lookup var e)) '(RETURN) e r s)] | |
[FRAME (ret x) | |
(VM a x e '() (call-frame ret e r s))] | |
[ARGUMENT (x) | |
(VM a x e (cons a r) s)] | |
[APPLY () | |
(if (procedure? a) | |
(VM (apply a r) '(RETURN) e r s) | |
(record (body e vars) a | |
(VM a body (extend e vars r) '() s)))] | |
[RETURN () | |
(record (x e r s) s | |
(VM a x e r s))] | |
[else #f]))) | |
(define evaluate | |
(lambda (exp) | |
(VM '() | |
(compile exp '(HALT)) | |
`(( (+ * - / = < > not car cdr cons) | |
,@(list + * - / = < > not car cdr cons))) | |
'() | |
'()))) |
0 件のコメント:
コメントを投稿