海野秀之（うんのひでゆき）の外部記憶
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 のまったく無い処理系を目の前にして固まる感じかな。
つづく。
vm.scm で、関数の定義がいっこ抜けていたのを追加。<br><br>この版をいろいろ触って学べることは多いと思うけど、早く 4 章にいきたいので、3 章は駆け抜けることにしよう。<br><br>でも、3.5 節の改良は、4 章でも同じことやるようなので、飛ばさずにやっておく。