海野秀之（うんのひでゆき）の外部記憶
Twitter (twilog) / RSS / アンテナ / ぶくま
これみて読もうと思ったんだから、 2007 年頃に印刷して、ずっと手元に置いているのに読めていなかった 3imp を読む。 ぼーと読んでいても、一生あたまに入ってこなさそうだったので、書いてあるコードを動かしながら。
また、「スタックベースのやつをつくりたい」とかいって、 あたま飛ばして 4 章から読もうとして一度失敗しているので、今回は、 ちゃんと 3 章も読むことにする。
動かすのは、Gauche で。
今回は、3.4.2 のコンパイラと 3.4.3 の VM を組み合わせてなんとか動かすところまで。 インタラクティブに動かして結果を見られるように、REPL (read-eval-print-loop) もくっつけてみる。
コンパイラや VM で用いられているマクロ。3imp では 2.1.3 節で述べられている。
record-case.scm
; record and record-case are syntax exptensions described in 3imp p.27 and 28.
;
; I couldn't implement with define-syntax but I found a useful article:
; http://chobitscheme.blog87.fc2.com/?mode=m&no=3
;
; These code are from the article.
; The record syntax extension binds a set of variables to the element of a list
; (this list, or record, must contain as many elements as there are variables;
; the variables name the fields of the record).
;
; (record (var ...) val exp ...) ->
; (apply (lambda (var ...) exp ...) val)
;
(define-syntax record
(syntax-rules ()
((_ (var ...) val exp ...)
(apply (lambda (var ...) exp ...) val))))
; The record-case syntax extension is a special combination of cond and record.
; It is useful for destructuring a record based on the "key" that appears as
; the record's first element:
;
; (record-case exp1
; (key vars exp2 ...)
; :
; :
; (else exp3 ...)) ->
;
; (let ((r exp1))
; (cond
; ((eq? (car r) 'key)
; (record vars (cdr r) exp2 ...))
; (else exp3 ...)))
;
; The variable r is introduced so that exp is only evaluated once. Care must
; be taken to prevent r from capturing any free variables.
;
(define-syntax record-case
(syntax-rules (else)
((_ exp1 (else exp2 ...))
(begin exp2 ...))
((_ exp1 (key vars exp2 ...))
(let ((r exp1))
(if (eq? (car r) 'key)
(record vars (cdr r) exp2 ...))))
((_ exp1 (key vars exp2 ...) clause ...)
(let ((r exp1))
(if (eq? (car r) 'key)
(record vars (cdr r) exp2 ...)
(record-case r clause ...))))))
rec-recur.scm
;; rec-recur.scm
;
; Syntax extensions from 3imp.
; The rec syntactic form allows the creation of self-recursive closures.
; The binding of var to () by let encloses the expression exp to which var is
; assigned. (The original vlue () is never references.)
(define-syntax rec
(syntax-rules ()
((_ var exp)
(let ((var '()))
(set! var exp)))))
; Quite often, a rec expression whose body is lambda is directly applied to
; arguments, usually to implement a loop. The syntactic form recur makes the
; code more readable
(define-syntax recur
(syntax-rules ()
((_ f ((var init) ...) exp ...)
((rec f (lambda (var ...) exp ...))
init ...))))
3.4.2 節に書かれているものそのまま。
compiler.scm
;; compiler.scm
; 3imp chapter 3: The Heap-Based Model
; 3.4.2 Translation
;(add-load-path ".")
(load "record-case")
(load "rec-recur")
; 3imp p.59
(define tail?
(lambda (next)
(eq? (car next) 'return)))
; 3imp p.56
(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)))))
インデントが、なんかきしょいことになってますね。あとで直そう。 （ファイル名もいまいち）
vm.scm
;; vm.scm
; 3imp 3.4.3 Evaluation
; (add-load-path ".")
(load "record-case")
(load "rec-recur")
(load "compiler")
(define lookup
(lambda (var e)
(recur nxtrib ((e e))
(recur nxtelt ((vars (caar e)) (vals (cdar e)))
(cond
((null? vars) (nxtrib (cdr e)))
((eq? (car vars) var) vals)
(else (nxtelt (cdr vars) (cdr vals))))))))
(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 extend
(lambda (e vars vals)
(cons (cons vars vals) e)))
(define VM
(lambda (a x e r s)
(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 ()
(record (body e vars) a ; 3imp has a typo here
(VM a body (extend e vars r) '() s)))
(return ()
(record (x e r s) s ; 3imp has a typo here
(VM a x e r s))))))
コメントにも書いたのですが、 3.4.2 節に書かれているコードには、 ちょびっと typo がある（と思う）。
repl1.scm:
#!/usr/local/bin/gosh
(add-load-path ".")
(load "vm")
(define evaluate
(lambda (x)
(VM '() (compile x '(halt)) '() '() '())))
(define (repl)
(let loop ((s '()))
(display "\n>>> ")
(set! s (read))
(display (compile s '(halt)))
(newline)
(display "\n==> ")
(display (evaluate s))
(newline)
(loop '())))
(define (main args)
(repl))
とりあえず、一行入力したら、そのコンパイル結果と実行結果を示すものを。 複数うけつけて、ケツからコンパイルして……とか想像していたのですが、まだです。
% gosh repl1.scm >>> ((lambda (x) x) 1) (frame (halt) (constant 1 (argument (close (x) (refer x (return)) (apply))))) ==> 1 >>> (if #t 1 2) (constant #t (test (constant 1 (halt)) (constant 2 (halt)))) ==> 1 >>> (if #f 1 2) (constant #f (test (constant 1 (halt)) (constant 2 (halt)))) ==> 2
うむ。built-in function のまったく無い処理系を目の前にして固まる感じかな。
つづく。
record-case.scm, rec-recur.scm は昨日のをそのまま。
compiler2.scm:
;; compiler2.scm
; Translater shown in 3.5.1 of 3imp.
(load "record-case")
(load "rec-recur")
; tail: 3imp p.59
(define tail?
(lambda (next)
(eq? (car next) 'return)))
; extend: p.65
(define extend
(lambda (e r)
(cons r e)))
; extend: p.65
(define compile-lookup
(lambda (var e)
(recur nxtrib ((e e) (rib 0))
(recur nxtelt ((vars (car e)) (elt 0))
(cond
((null? vars) (nxtrib (cdr e) (+ rib 1)))
((eq? (car vars) var) (cons rib elt))
(else (nxtelt (cdr vars) (+ elt 1))))))))
; compile: p.64
(define compile
(lambda (x e next)
(cond
((symbol? x)
(list 'refer (compile-lookup x e) next))
((pair? x)
(record-case x
(quote (obj)
(list 'constant obj next))
(lambda (vars body)
(list 'close
(compile body (extend e vars) '(return))
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)
(let ((access (compile-lookup var e)))
(compile x e (list 'assign access next))))
(call/cc (x)
(let ((c (list 'conti
(list 'argument
(compile x e '(apply))))))
(if (tail? next)
c
(list 'frame next c))))
(else
(recur loop ((args (cdr x))
(c (compile (car x) e '(apply))))
(if (null? args)
(if (tail? next)
c
(list 'frame next c))
(loop (cdr args)
(compile (car args)
e
(list 'argument c))))))))
(else
(list 'constant x next)))))
vm2.scm:
;; vm2.scm
; 3imp 3.5.2 Evaluation
(load "record-case")
(load "rec-recur")
(load "compiler2")
(define call-frame
(lambda (x e r s)
(list x e r s)))
(define closure
(lambda (body e)
(list body e)))
(define continuation
(lambda (s)
(closure (list 'nuate s '(0 . 0)) '())))
(define lookup
(lambda (access e)
(recur nxtrib ((e e) (rib (car access)))
(if (= rib 0)
(recur nxtelt ((r (car e)) (elt (cdr access)))
(if (= elt 0)
r
(nxtelt (cdr r) (- elt 1))))
(nxtrib (cdr e) (- rib 1))))))
(define VM
(lambda (a x e r s)
(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 (body x)
(VM (closure body e) 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 ()
(record (body e) a
(VM a body (extend e r) '() s)))
(return ()
(record (x e r s) s
(VM a x e r s))))))
repl2.scm:
#!/usr/local/bin/gosh
(add-load-path ".")
(load "vm2")
(define banner
(lambda ()
(display "3imp Heap-Based Compiler and VM")))
(define evaluate
(lambda (x)
(VM '() (compile x '() '(halt)) '() '() '())))
(define (repl)
(let loop ((s '()))
(display "\n>>> ")
(set! s (read))
(display (compile s '() '(halt)))
(newline)
(display "\n==> ")
(display (evaluate s))
(newline)
(loop '())))
(define (main args)
(banner)
(repl))
% ./repl2.scm 3imp Heap-Based Compiler and VM >>> 100 (constant 100 (halt)) ==> 100 >>> ((lambda (x) x) 1) (frame (halt) (constant 1 (argument (close (refer (0 . 0) (return)) (apply))))) ==> 1 >>> (if #f 1 2) (constant #f (test (constant 1 (halt)) (constant 2 (halt)))) ==> 2 >>> ((lambda (x) (set! x (call/cc (lambda (cont) (cont 20))))) '()) (frame (halt) (constant () (argument (close (frame (assign (0 . 0) (return)) (conti (argument (close (constant 20 (argument (refer (0 . 0) (apply)))) (apply))))) (apply))))) ==> 20
拡張したりするのは、Stack-Based のやつを元にしたいので、ささーと逃げるように 4 章にすすむよ！
4.5 章の Stack-Based 版を。 Gauche 上で動くようにするには、ただ写してくるだけではダメで、いくつか修正・追加が必要だった。
; 3imp_syntax_extensions.scm
; record and record-case are syntax exptensions described in 3imp p.27 and 28.
;
; I couldn't implement with define-syntax but I found a useful article:
; http://chobitscheme.blog87.fc2.com/?mode=m&no=3
;
; These code are from the article.
; The record syntax extension binds a set of variables to the element of a list
; (this list, or record, must contain as many elements as there are variables;
; the variables name the fields of the record).
;
; (record (var ...) val exp ...) ->
; (apply (lambda (var ...) exp ...) val)
;
(define-syntax record
(syntax-rules ()
((_ (var ...) val exp ...)
(apply (lambda (var ...) exp ...) val))))
; The record-case syntax extension is a special combination of cond and record.
; It is useful for destructuring a record based on the "key" that appears as
; the record's first element:
;
; (record-case exp1
; (key vars exp2 ...)
; :
; :
; (else exp3 ...)) ->
;
; (let ((r exp1))
; (cond
; ((eq? (car r) 'key)
; (record vars (cdr r) exp2 ...))
; (else exp3 ...)))
;
; The variable r is introduced so that exp is only evaluated once. Care must
; be taken to prevent r from capturing any free variables.
;
(define-syntax record-case
(syntax-rules (else)
((_ exp1 (else exp2 ...))
(begin exp2 ...))
((_ exp1 (key vars exp2 ...))
(let ((r exp1))
(if (eq? (car r) 'key)
(record vars (cdr r) exp2 ...))))
((_ exp1 (key vars exp2 ...) clause ...)
(let ((r exp1))
(if (eq? (car r) 'key)
(record vars (cdr r) exp2 ...)
(record-case r clause ...))))))
; The rec syntactic form allows the creation of self-recursive closures.
; The binding of var to () by let encloses the expression exp to which var is
; assigned. (The original vlue () is never references.)
(define-syntax rec
(syntax-rules ()
((_ var exp)
(let ((var '()))
(set! var exp)))))
; Quite often, a rec expression whose body is lambda is directly applied to
; arguments, usually to implement a loop. The syntactic form recur makes the
; code more readable
(define-syntax recur
(syntax-rules ()
((_ f ((var init) ...) exp ...)
((rec f (lambda (var ...) exp ...))
init ...))))
;; stack-operations.scm
; 3imp section 4.1.4
(define stack (make-vector 1000))
(define push
(lambda (x s)
(vector-set! stack s x)
(+ s 1)))
(define index
(lambda (s i)
(vector-ref stack (- (- s i) 1))))
(define index-set!
(lambda (s i v)
(vector-set! stack (- (- s i) 1) v)))
;; compile451.scm
; Translator from section 4.5.1 of 3imp.
(load "3imp_syntax_extensions.scm")
; p.95: compile-lookup, compile-refer
(define compile-lookup
(lambda (x e return-local return-free)
(recur nxtlocal ((locals (car e)) (n 0))
(if (null? locals)
(recur nxtfree ((free (cdr e)) (n 0))
(if (eq? (car free) x)
(return-free n)
(nxtfree (cdr free) (+ n 1))))
(if (eq? (car locals) x)
(return-local n)
(nxtlocal (cdr locals) (+ n 1)))))))
(define compile-refer
(lambda (x e next)
(compile-lookup x e
(lambda (n) (list 'refer-local n next))
(lambda (n) (list 'refer-free n next)))))
; p.93: help functions; set-member?, set-cons, set-union, set-minus, and set-intersect
(define set-member?
(lambda (x s)
(cond
((null? s) #f) ; modified from 3imp, '() can't be used as false.
((eq? x (car s)) #t)
(else (set-member? x (cdr s))))))
(define set-cons
(lambda (x s)
(if (set-member? x s)
s
(cons x s))))
(define set-union
(lambda (s1 s2)
(if (null? s1)
s2
(set-union (cdr s1) (set-cons (car s1) s2)))))
(define set-minus
(lambda (s1 s2)
(if (null? s1)
'()
(if (set-member? (car s1) s2)
(set-minus (cdr s1) s2)
(cons (car s1) (set-minus (cdr s1) s2))))))
(define set-intersect
(lambda (s1 s2)
(if (null? s1)
'()
(if (set-member? (car s1) s2)
(cons (car s1) (set-intersect (cdr s1) s2))
(set-intersect (cdr s1) s2)))))
; p.104: find-free
(define find-free
(lambda (x b)
(cond
((symbol? x) (if (set-member? x b) '() (list x)))
((pair? x)
(record-case x
(quote (obj) '())
(lambda (vars body)
(find-free body (set-union vars b)))
(if (test then else)
(set-union (find-free test b)
(set-union (find-free then b)
(find-free else b))))
(set! (var exp)
(set-union (if (set-member? var b) '() (list var))
(find-free exp b)))
(call/cc (exp) (find-free exp b))
(else
(recur next ((x x))
(if (null? x)
'()
(set-union (find-free (car x) b)
(next (cdr x))))))))
(else '()))))
; p.95: collect-free
(define collect-free
(lambda (vars e next)
(if (null? vars)
next
(collect-free (cdr vars) e
(compile-refer (car vars) e
(list 'argument next))))))
; p.101
(define find-sets
(lambda (x v)
(cond
((symbol? x) '())
((pair? x)
(record-case x
(quote (obj) '())
(lambda (vars body)
(find-sets body (set-minus v vars)))
(if (test then else)
(set-union (find-sets test v)
(set-union (find-sets then v)
(find-sets else v))))
(set! (var x)
(set-union (if (set-member? var v) (list var) '())
(find-sets x v)))
(call/cc (exp) (find-sets exp v))
(else
(recur next ((x x))
(if (null? x)
'()
(set-union (find-sets (car x) v)
(next (cdr x))))))))
(else '()))))
; p.102: make-boxes
(define make-boxes
(lambda (sets vars next)
(recur f ((vars vars) (n 0))
(if (null? vars)
next
(if (set-member? (car vars) sets)
(list 'box n (f (cdr vars) (+ n 1)))
(f (cdr vars) (+ n 1)))))))
; p.103
(define compile
(lambda (x e s next)
(cond
((symbol? x)
(compile-refer x e
(if (set-member? x s)
(list 'indirect next)
next)))
((pair? x)
(record-case x
(quote (obj) (list 'constant obj next))
(lambda (vars body)
(let ((free (find-free body vars))
(sets (find-sets body vars)))
(collect-free free e
(list 'close
(length free)
(make-boxes sets vars
(compile body
(cons vars free)
(set-union
sets
(set-intersect s free))
(list 'return (length vars))))
next))))
(if (test then else)
(let ((thenc (compile then e s next))
(elsec (compile else e s next)))
(compile test e s (list 'test thenc elsec))))
(set! (var x)
(compile-lookup var e
(lambda (n)
(compile x e s (list 'assign-local n next)))
(lambda (n)
(compile x e s (list 'assign-free n next)))))
(call/cc (x)
(list 'frame
next
(list 'conti
(list 'argument
(compile x e s '(apply))))))
(else
(recur loop ((args (cdr x))
(c (compile (car x) e s '(apply))))
(if (null? args)
(list 'frame next c)
(loop (cdr args)
(compile (car args)
e
s
(list 'argument c))))))))
(else (list 'constant x next)))))
set-member? が、Gauche 上で動かすには問題があった。 いまは、null は False じゃないんですね。
;; vm452.scm
; VM from section 4.5.2 of 3imp.
(load "3imp_syntax_extensions")
(load "stack-operations")
(load "compile451")
; box/unbox/set-box!, by higepon
; http://d.hatena.ne.jp/higepon/20071102/1193995703
(define (box v)
(cons 'box v))
(define (set-box! b v)
(set-cdr! b v))
(define (unbox b)
(cdr b))
; p.97; closure
(define closure
(lambda (body n s)
(let ((v (make-vector (+ n 1))))
(vector-set! v 0 body)
(recur f ((i 0))
(unless (= i n)
(vector-set! v (+ i 1) (index s i))
(f (+ i 1))))
v)))
; p.98: closure-body, index-closure
(define closure-body
(lambda (c)
(vector-ref c 0)))
(define index-clusure
(lambda (c n)
(vector-ref c (+ n 1))))
; p.83: save-stack, restore-stack
(define save-stack
(lambda (s)
(let ((v (make-vector s)))
(recur copy ((i 0))
(unless (= i s)
(vector-set! v i (vector-ref stack i))
(copy (+ i 1))))
v)))
(define restore-stack
(lambda (v)
(let ((s (vector-length v)))
(recur copy ((i 0))
(unless (= i s)
(vector-set! stack i (vector-ref v i))
(copy (+ i 1))))
s)))
; continuation, not shown in 3imp.
; http://cadr.g.hatena.ne.jp/mokehehe/20080510/1210388340
(define continuation
(lambda (s)
(closure
(list 'refer-local 0 (list 'nuate (save-stack s) '(return 0)))
0
'())))
; p.105
(define VM
(lambda (a x f c s)
(record-case x
(halt () a)
(refer-local (n x)
(VM (index f n) x f c s))
(refer-free (n x)
(VM (index-clusure c n) x f c s))
(indirect (x)
(VM (unbox a) x f c s))
(constant (obj x)
(VM obj x f c s))
(close (n body x)
(VM (closure body n s) x f c (- s n)))
(box (n x)
(index-set! s n (box (index s n)))
(VM a x f c s))
(test (then else)
(VM a (if a then else) f c s))
(assign-local (n x)
(set-box! (index f n) a)
(VM a x f c s))
(assign-free (n x)
(set-box! (index-closure c n) a)
(VM a x f c s))
(conti (x)
(VM (continuation s) x f c s))
(nuate (stack x)
(VM a x f c (restore-stack stack)))
(frame (ret x)
(VM a x f c (push ret (push f (push c s)))))
(argument (x)
(VM a x f c (push a s)))
(apply ()
(VM a (closure-body a) s a s))
(return (n)
(let ((s (- s n)))
(VM a (index s 0) (index s 1) (index s 2) (- s 3)))))))
3imp 中では、ここで使われている box/unbox と continuation のコードが明に示されていません。 いくつかのサイトにお世話になりました（URL はコメント中に）。
#!/usr/local/bin/gosh
(add-load-path ".")
(load "vm452")
(define banner
(lambda ()
(display "3imp Section 4.5 Compiler & VM")))
(define evaluate
(lambda (x)
(VM '() (compile x '() '() '(halt)) 0 '() 0)))
(define (repl)
(let loop ((s '()))
(display "\n>>> ")
(set! s (read))
(display (compile s '() '() '(halt)))
(newline)
(display "\n==> ")
(display (evaluate s))
(newline)
(loop '())))
(define (main args)
(banner)
(repl))
% ./repl4.5.scm 3imp Section 4.5 Compiler & VM >>> 1 (constant 1 (halt)) ==> 1 >>> (if #t 1 2) (constant #t (test (constant 1 (halt)) (constant 2 (halt)))) ==> 1 >>> (if #f 1 2) (constant #f (test (constant 1 (halt)) (constant 2 (halt)))) ==> 2 >>> (lambda (x) (lambda () x)) (close 0 (refer-local 0 (argument (close 1 (refer-free 0 (return 0)) (return 1)))) (halt)) ==> #((refer-local 0 (argument (close 1 (refer-free 0 (return 0)) (return 1))))) >>> ((lambda (x) (lambda () x)) 10) (frame (halt) (constant 10 (argument (close 0 (refer-local 0 (argument (close 1 (refer-free 0 (return 0)) (return 1)))) (apply))))) ==> #((refer-free 0 (return 0)) 10) >>> (((lambda (x) (lambda () x)) 10)) (frame (halt) (frame (apply) (constant 10 (argument (close 0 (refer-local 0 (argument (close 1 (refer-free 0 (return 0)) (return 1)))) (apply)))))) ==> 10 >>> ((lambda (x) (set! x (call/cc (lambda (cont) (cont 20))))) '()) (frame (halt) (constant () (argument (close 0 (box 0 (frame (assign-local 0 (return 1)) (conti (argument (close 0 (frame (return 1) (constant 20 (argument (refer-local 0 (apply))))) (apply)))))) (apply))))) ==> 20 >>>
まだ写経して、ちょっと動かしてみただけなので、きちんと理解できているわけじゃない。 この写経版を動かしたり改造したりしながら、 Stack-Based モデルを理解していきたい。 （改造しないと、できることが少なくて、「いろいろ動かす」のがムズいの）
だいたい、以下のような改造をやっていくつもり：
最初の３つは、だいたいこんな感じかなという想像がついているのだけど、 マクロはどうやるのがいいんだろうなぁ。
でも、begin くらいは使えないと、しんどい。なので、マクロもはやめにほしい。
んで、動作を理解してから、末尾呼び出しを含む最適化に取り組む。
3imp 4.5 節版処理系に改造をくわえていく。
普通に考えると、改造前の処理系について完全に理解してから、改造方針をたてて… とやるべきなのかも知れませんが、ここは触りながら理解していく方法で。
ひとまず、今回改造した版がこちら： sbscm-1.0.3.tar.bz2
Global 変数へのアクセス (define, set! および参照）をサポートし、 繰り返し VM を呼び出したときにグローバル変数が引き継がれるようにしました。
いくつかの組込み変数（四則と比較あたり）も追加してみました。
動かしてみた例：
Stack-Based Scheme Version 1.0.3 based on 3imp Section 4.5. >>> (+ 1 2) (frame (halt) (constant 2 (argument (constant 1 (argument (refer-global + (apply))))))) ==> 3 >>> (define x 1) (constant 1 (define-global x (halt))) ==> x >>> x (refer-global x (halt)) ==> 1 >>> (set! x (call/cc (lambda (cont) (cont 20)))) (frame (assign-global x (halt)) (conti (argument (close 0 (frame (return 1) (constant 20 (argument (refer-local 0 (apply))))) (apply))))) ==> 20 >>> (define fib (lambda (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))) (close 0 (frame (test (constant 1 (return 1)) (frame (return 1) (frame (argument (frame (argument (refer-global + (apply))) (frame (argument (refer-global fib (apply))) (constant 1 (argument (refer-local 0 (argument (refer-global - (apply))))))))) (frame (argument (refer-global fib (apply))) (constant 2 (argument (refer-local 0 (argument (refer-global - (apply)))))))))) (constant 1 (argument (refer-local 0 (argument (refer-global <= (apply))))))) (define-global fib (halt))) ==> fib >>> (fib 5) (frame (halt) (constant 5 (argument (refer-global fib (apply))))) ==> 8 >>> (fib 20) (frame (halt) (constant 20 (argument (refer-global fib (apply))))) ==> 10946
Global 変数は、e (environment) とは別のハッシュに格納している。 いまのところ、VM しかそのハッシュの中身を見ていないけど、define が組込み関数や syntax extension を隠す挙動を実現しようとすると、compile も global 変数を見ていないといけないような 気がするんだが。
…だいたい想像がつくような気もするけど、いまいちわかってないかも。 （だからこそ、作りながら理解する方針）
# うんの [vm.scm で、関数の定義がいっこ抜けていたのを追加。 この版をいろいろ触って学べることは多いと思うけど、早く ..]