今回は micro Scheme コンパイラに「末尾再帰最適化」を実装しましょう。なお、ここでいう末尾再帰最適化は処理速度のことではなく、次に示すような関数呼び出しにおいて、メモリを消費せずに実行できることです。
>>> (define foo (lambda () (foo))) foo >>> (foo) => 無限ループになる
末尾再帰最適化が行われる場合、foo を評価すると無限ループになります。
末尾再帰の末尾とは最後に行われる処理のことで、一般に末尾で関数を呼び出すことを「末尾呼び出し」といいます。関数を呼び出す場合、そのあとに行う処理のために、必要な情報を保存しておかなければいけません。ところが、末尾呼び出しはそのあと実行する処理がないので、情報を保存しておく必要がありません。このため、末尾再帰は繰り返しに変換することができるのです。
簡単な例として、Common Lisp で階乗を計算する関数 fact を作りましょう。
リスト : 末尾再帰を繰り返しに変換する
(defun fact (x a)
(if (= x 0)
a
(fact (- x 1) (* a x))))
(defun facti (x a)
(tagbody
loop
(if (= x 0)
(return-from facti a))
(setf a (* a x)
x (- x 1))
(go loop)))
fact は末尾再帰になっています。これを繰り返しに変換すると facti のようになります。引数 x と a の値を保存する必要が無いので、値を書き換えてから先頭の処理へジャンプします。tagbody はジャンプ命令 go を使うための特殊形式 (シンタックス形式) です。Scheme に tagbody と go はありませんが、末尾再帰は最適化が行われるため効率的に処理することができます。
micro Scheme の場合、仮想マシン vm は末尾再帰になっています。Scheme で vm を動かす場合、Scheme は末尾再帰最適化が行われるので、vm の実行でメモリを消費することはありません。問題は命令 sel と app を実行するときです。たとえば、fact を micro Scheme でコンパイルすると次のようになります。
リスト : 階乗 (末尾再帰)
(define fact
(lambda (n a)
(if (= n 0)
a
(fact (- n 1) (* a n)))))
(closure
(
ld (0 . 0)
ldc 0
args 2
ldg =
app
sel
(
ld (0 . 1)
join
)
(
ld (0 . 0)
ldc 1
args 2
ldg -
app
ld (0 . 1)
ld (0 . 0)
args 2
ldg *
app
args 2
ldg fact
app
join
)
rtn
)
())
SECD 仮想マシンは sel 命令を実行するとき、コードレジスタ C をダンプに保存します。ここでメモリが消費されます。fact の場合、if は末尾呼び出しであり、その後の命令は rtn しかありません。この場合、join を rtn に変更すると、コードレジスタ C をダンプに保存する必要がなりなります。
そこで、仮想マシンに新しい命令 selr を追加します。selr の状態遷移を図に示します。
(v . s) e (selr ct cf . c) d = v (真) => s e ct d
= v (偽) => s e cf d
sel はコード c をダンプ d に保存します。selr 命令の場合、ct と cf が末尾呼び出しになるので、コード c をダンプに保存する必要はありません。また、ct と cf は join 命令ではなく rtn 命令で終了します。
selr 命令を使うと、fact は次のようにコンパイルされます。
(closure
(
ld (0 . 0)
ldc 0
args 2
ldg =
app
selr
(
ld (0 . 1)
rtn
)
(
ld (0 . 0)
ldc 1
args 2
ldg -
app
ld (0 . 1)
ld (0 . 0)
args 2
ldg *
app
args 2
ldg fact
app
rtn
)
)
())
ここで fact を呼び出す app 命令に注目してください。fact は末尾呼び出しで、その後に実行する命令は rtn しかありません。この場合、レジスタ S, E, C をダンプレジスタに保存する必要はありません。そこで、新しい命令 tapp を追加します。tapp の状態遷移を示します。
((closure code env) vs . s) e (tapp . c) d => s (vs . env) code d
app は s, e, c をダンプ d に保存します。tapp 命令の場合、実行する関数は末尾呼び出しになるので、s, e, c をダンプに保存する必要はありません。コード code を環境 (v . env) の元で評価するだけです。
このように、selr と tapp 命令を追加することで、micro Scheme で末尾再帰最適化を実現することができます。
それではプログラムを修正しましょう。S 式をコンパイルする関数 comp は次のようになります。
リスト : コンパイルの修正
(define (comp expr env code tail)
(cond ((self-evaluation? expr) ; 自己評価フォーム
(list* 'ldc expr code))
((symbol? expr) ; 変数
(let ((pos (location expr env)))
(if pos
;; 局所変数
(list* 'ld pos code)
;; 大域変数
(list* 'ldg expr code))))
((eq? (car expr) 'quote)
(list* 'ldc (cadr expr) code))
((eq? (car expr) 'if)
(if tail
;; 末尾呼び出し
(let ((t-clause (comp (caddr expr) env '(rtn) #t))
(f-clause
(if (null? (cdddr expr))
(list 'ldc '*undef 'rtn)
(comp (cadddr expr) env '(rtn) #t))))
(comp (cadr expr) env (list* 'selr t-clause f-clause (cdr code)) #f))
(let ((t-clause (comp (caddr expr) env '(join) #f))
(f-clause
(if (null? (cdddr expr))
(list 'ldc '*undef 'join)
(comp (cadddr expr) env '(join) #f))))
(comp (cadr expr) env (list* 'sel t-clause f-clause code) #f))))
((eq? (car expr) 'lambda)
(let ((body (comp-body (cddr expr) (cons (cadr expr) env) '(rtn))))
(list* 'ldf body code)))
((eq? (car expr) 'define)
(comp (caddr expr) env (list* 'def (cadr expr) code) #f))
((eq? (car expr) 'define-macro)
(comp (caddr expr) env (list* 'defm (cadr expr) code) #f))
((eq? (car expr) 'set!)
(let ((pos (location (cadr expr) env)))
(if pos
;; 局所変数
(comp (caddr expr) env (list* 'lset pos code) #f)
;; 大域変数
(comp (caddr expr) env (list* 'gset (cadr expr) code) #f))))
((eq? (car expr) 'call/cc)
(list* 'ldct code 'args 1 (comp (cadr expr) env (cons 'app code) #f)))
((eq? (car expr) 'apply)
(complis (cddr expr)
env
(list* 'args-ap
(length (cddr expr))
(comp (cadr expr) env (cons 'app code) #f))))
((macro? (car expr))
;; マクロ展開してからコンパイルする
(let ((new-expr (vm '()
(list (cdr expr))
(get-macro-code (car expr))
(list (list '() '() '(stop))))))
(comp new-expr env code #f)))
(else ; 関数呼び出し
(complis (cdr expr)
env
(list* 'args
(length (cdr expr))
(comp (car expr) env (cons (if tail 'tapp 'app) code) #f))))))
comp の引数に末尾呼び出しを示すフラグ tail を追加します。tail が真の場合、引数 expr は末尾呼び出しです。tail が真になるときは、ラムダ式本体の最後尾の S 式をコンパイルするときと、tail が真のときに if の then 節と else 節をコンパイルするときです。あとはすべて #f になります。
if をコンパイルするとき、tail が偽の場合は今までと同じです。tail が真の場合、then 節と else 節をコンパイルするとき、tail に #t を指定して、最後の命令を rtn にします。生成するコードは (list* 'selr t-clause f-clause (cdr code)) となります。このとき、code の先頭は rtn 命令になります。rtn が重複するので cdr で取り除きます。
関数呼び出しの場合、tail が真であれば命令を tapp に、そうでなければ app にします。tail が真の場合、code の先頭は rtn 命令になります。評価する関数がクロージャの場合、この rtn を削除することができますが、primitive の場合は rtn が必要になります。コンパイルの段階では区別がつかないので、rtn は削除しないでそのままにしておきます。
ラムダ式本体をコンパイルする関数 comp-body は簡単です。
リスト : ラムダ式本体のコンパイル
(define (comp-body body env code)
(if (null? (cdr body))
(comp (car body) env code #t)
(comp (car body)
env
(list* 'pop
(comp-body (cdr body) env code))
#f)))
本体末尾の S 式をコンパイルするとき、comp の引数 tail を #t にセットします。それ以外の場合は #f にセットします。
次は仮想マシン vm を修正します。
リスト : 仮想マシン vm の修正
(define (vm s e c d)
(case (pop! c)
...
((tapp)
(let ((clo (car s)) (lvar (cadr s)))
(case (pop! clo)
((primitive)
(vm (cons (apply (car clo) lvar) (cddr s)) e c d))
((continuation)
(vm (cons (car lvar) (car clo)) (cadr clo) (caddr clo) (cadddr clo)))
(else
(vm (cddr s) (cons lvar (cadr clo)) (car clo) d)))))
...
((selr)
(let ((t-clause (car c))
(e-clause (cadr c)))
(if (car s)
(vm (cdr s) e t-clause d)
(vm (cdr s) e e-clause d))))
...
))
tapp の場合、primitive と continuation の処理は app と同じです。それ以外の場合はコード (car clo) を環境 (cons lvar (cadr clo)) の元で評価します。s, e, c をダンプ d に保存する必要はありません。selr も簡単です。then 節 (t-clause) と else 節 (e-clause) どちらを評価するにしても、ダンプ d にコード c を保存する必要はありません。
それでは簡単な実行例を示しましょう。なお、簡単にテストできるように、primitive に算術演算子 (+, -, *, /) と比較演算子 (=, <, >, <=, >=) を追加しました。簡単な例として 1 から x までの合計値を求めるプログラムを作ります。次のリストを見てください。
リスト : 1 から x までの合計値を求める
(define sum
(lambda (x)
(if (= x 0)
0
(+ x (sum (- x 1))))))
(define sum1
(lambda (x a)
(if (= x 0)
a
(sum1 (- x 1) (+ a x)))))
関数 sum は末尾再帰になっていないので、大きな値を計算するとメモリを大量に消費します。関数 sum1 は末尾再帰になっているので、大きな値でもメモリを消費せずに計算することができます。実行結果は次のようになりました。
>>> (sum 1000000) 500000500000 >>> (sum1 1000000 0) 500000500000
Gauche version 0.9.10, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz で実行した場合、どちらの関数でも値を求めることができました。実行時間は sum が 16 秒、sum1 が 12 秒になり、末尾再帰のほうが少し速くなりました。
また、次の関数を実行するとメモリを消費せずに無限ループとなります。
>>> (define foo (lambda () (foo))) foo >>> (foo) => 無限ループになる
次は「たらいまわし関数」でインタプリタとコンパイラの実行速度を計測してみましょう。プログラムリストと実行結果を示します。
リスト : たらいまわし関数
(define tarai
(lambda (x y z)
(if (<= x y)
y
(tarai (tarai (- x 1) y z) (tarai (- y 1) z x) (tarai (- z 1) x y)))))
(define tak
(lambda (x y z)
(if (<= x y)
z
(tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y)))))
表 : たらいまわし関数の実行結果
| A | B
---------------+------+------
(tarai 10 5 0) | 4.15 | 3.80
(tak 14 7 0) | 5.07 | 3.83
A : インタプリタ (micro.scm)
B : コンパイラ (secd.scm)
単位 : 秒
Gauche version 0.9.10, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
インタプリタよりもコンパイラの方が少しだけ速くなりました。簡単なコンパイラなので、処理速度が劇的に高速化するわけではありません。それでも、マクロを多用したプログラムでは、もっと差がつくでしょう。コンパイラの性能ですが、末尾呼び出し以外の最適化はほとんど行っていないので、改良する余地はまだまだあると思います。興味のある方はいろいろ試してみてください。
関数 tarai は「遅延評価 (delayed evaluation または lazy evaluation)」を行う処理系、たとえば関数型言語の Haskell では高速に実行することができます。また、Scheme でも delay と force を使って遅延評価を行うことができます。
tarai のプログラムを見てください。x <= y のときに y を返しますが、このとき引数 z の値は必要ありませんね。引数 z の値は x > y のときに計算するようにすれば、無駄な計算を省略することができます。なお、関数 tak は x <= y のときに z を返しているため、遅延評価で高速化することはできません。ご注意ください。
Scheme の delay と force は、micro Scheme でもマクロを使って簡単に実装することができます。次のリストを見てください。
リスト : delay と force
(define-macro delay
(lambda (expr)
`(make-promise (lambda () ,expr))))
(define make-promise
(lambda (f)
(let ((flag #f) (result #f))
(lambda ()
(if (not flag)
(let ((x (f)))
(if (not flag)
(begin (set! flag #t)
(set! result x)))))
result))))
(define force
(lambda (promise) (promise)))
リストの delay と force は参考文献『プログラミング言語 SCHEME』に掲載されているプログラムを micro Scheme で書き直したものです。delay の引数 expr をクロージャに格納して関数 make-promis に渡します。make-promise はクロージャを生成して返します。このデータを Scheme では「プロミス」といいます。force は簡単で、引数 promise を評価するだけです。
make-promise はクロージャを生成し、その中にクロージャ f の評価結果を格納します。flag が #f の場合は f を評価していないので、f を評価して返り値を result にセットし、flag の値を #t に書き換えます。flag が #t ならば f は評価済みなので result を返します。
簡単な使用例を示しましょう。
>>> (define a (delay (+ 10 20))) a >>> (force a) 30
(delay (+ 10 20)) の返り値を変数 a にセットします。このとき、S 式 (+ 10 20) は評価されていません。プロミスの値を実際に求める関数が force です。(force a) を評価すると、S 式 (+ 10 20) を評価して値 30 を返します。
また、プロミスは式の評価結果をキャッシュします。したがって、(force a) を再度実行すると、同じ式を再評価することなく値を求めることができます。次の例を見てください。
>>> (define b (delay (begin (display "oops! ") (+ 10 20)))) b >>> (force b) oops! 30 >>> (force b) 30
最初に (force b) を実行すると、S 式 (begin (display "oops! ") (+ 10 20)) が評価されるので、画面に oops! が表示されます。次に、(force b) を実行すると、式を評価せずにキャッシュした値を返すので oops! は表示されません。
delay と force を使うと、tarai は次のようになります。
リスト : delay と force による遅延評価
(define tarai
(lambda (x y z)
(if (<= x y)
y
(let ((zz (force z)))
(tarai (tarai (- x 1) y (delay zz))
(tarai (- y 1) zz (delay x))
(delay (tarai (- zz 1) x (delay y))))))))
関数 tarai の引数 z にデータを渡すとき、delay で遅延オブジェクトを生成します。そして、その値を取り出すときは (force z) とします。これで遅延評価を行うことができます。
それでは、実際に実行してみましょう。
(tarai 80 40 (delay 0)) インタプリタ : 1.52 [s] コンパイラ : 0.10 [s]
tarai に大きな値を与えても、高速に実行することができます。遅延評価の効果は十分に出ていると思います。また、インタプリタよりもコンパイラのほうが約 15 倍高速になりました。マクロを使ったプログラムは、コンパイラのほうが高速に実行できることがわかります。
;;;
;;; secd.scm : SECD 仮想マシンによる Scheme コンパイラ (R7RS-small 対応版)
;;;
;;; (1) 基本機能の実装
;;; (2) 伝統的なマクロの実装
;;; (3) 継続の実装
;;; (4) 末尾再帰最適化
;;;
;;; Copyright (C) 2009-2021 Makoto Hiroi
;;;
(import (scheme base) (scheme cxr) (scheme write) (scheme read)
(scheme file) (scheme process-context) (scheme time))
;;; データの追加
(define-syntax push!
(syntax-rules ()
((_ place x) (set! place (cons x place)))))
;;; データの取得
(define-syntax pop!
(syntax-rules ()
((_ place)
(let ((x (car place)))
(set! place (cdr place))
x))))
;;; ドットリストの生成
(define (list* . xs)
(if (null? (cdr xs))
(car xs)
(cons (car xs) (apply list* (cdr xs)))))
;;; 変数の位置を求める
(define (position-var sym ls)
(let loop ((i 0) (ls ls))
(cond ((null? ls) #f)
((symbol? ls)
(if (eq? sym ls) (- (+ i 1)) #f))
((eq? sym (car ls)) i)
(else
(loop (+ i 1) (cdr ls))))))
;;; フレームと変数の位置を求める
(define (location sym ls)
(let loop ((i 0) (ls ls))
(if (null? ls)
#f
(let ((j (position-var sym (car ls))))
(if j
(cons i j)
(loop (+ i 1) (cdr ls)))))))
;;; 自己評価フォームか
(define (self-evaluation? expr)
(and (not (pair? expr)) (not (symbol? expr))))
;;; マクロか
(define (macro? expr)
(let ((val (assoc expr *global-environment*)))
(and val (pair? (cdr val)) (eq? 'macro (cadr val)))))
;;; マクロのコードを取得する
(define (get-macro-code expr)
(caddr (get-gvar expr)))
;;; S 式をコンパイルする
(define (compile expr)
(comp expr '() '(stop) #f))
;;; コンパイル本体
(define (comp expr env code tail)
(cond ((self-evaluation? expr) ; 自己評価フォーム
(list* 'ldc expr code))
((symbol? expr) ; 変数
(let ((pos (location expr env)))
(if pos
;; 局所変数
(list* 'ld pos code)
;; 大域変数
(list* 'ldg expr code))))
((eq? (car expr) 'quote)
(list* 'ldc (cadr expr) code))
((eq? (car expr) 'if)
(if tail
;; 末尾呼び出し
(let ((t-clause (comp (caddr expr) env '(rtn) #t))
(f-clause
(if (null? (cdddr expr))
(list 'ldc '*undef 'rtn)
(comp (cadddr expr) env '(rtn) #t))))
(comp (cadr expr) env (list* 'selr t-clause f-clause (cdr code)) #f))
(let ((t-clause (comp (caddr expr) env '(join) #f))
(f-clause
(if (null? (cdddr expr))
(list 'ldc '*undef 'join)
(comp (cadddr expr) env '(join) #f))))
(comp (cadr expr) env (list* 'sel t-clause f-clause code) #f))))
((eq? (car expr) 'lambda)
(let ((body (comp-body (cddr expr) (cons (cadr expr) env) '(rtn))))
(list* 'ldf body code)))
((eq? (car expr) 'define)
(comp (caddr expr) env (list* 'def (cadr expr) code) #f))
((eq? (car expr) 'define-macro)
(comp (caddr expr) env (list* 'defm (cadr expr) code) #f))
((eq? (car expr) 'set!)
(let ((pos (location (cadr expr) env)))
(if pos
;; 局所変数
(comp (caddr expr) env (list* 'lset pos code) #f)
;; 大域変数
(comp (caddr expr) env (list* 'gset (cadr expr) code) #f))))
((eq? (car expr) 'call/cc)
(list* 'ldct code 'args 1 (comp (cadr expr) env (cons 'app code) #f)))
((eq? (car expr) 'apply)
(complis (cddr expr)
env
(list* 'args-ap
(length (cddr expr))
(comp (cadr expr) env (cons 'app code) #f))))
((macro? (car expr))
;; マクロ展開してからコンパイルする
(let ((new-expr (vm '()
(list (cdr expr))
(get-macro-code (car expr))
(list (list '() '() '(stop))))))
(comp new-expr env code #f)))
(else ; 関数呼び出し
(complis (cdr expr)
env
(list* 'args
(length (cdr expr))
(comp (car expr) env (cons (if tail 'tapp 'app) code) #f))))))
;;; ラムダ式本体のコンパイル
(define (comp-body body env code)
(if (null? (cdr body))
(comp (car body) env code #t)
(comp (car body)
env
(list* 'pop
(comp-body (cdr body) env code))
#f)))
;;; 引数を評価するコードを生成
(define (complis expr env code)
(if (null? expr)
code
(comp (car expr) env (complis (cdr expr) env code) #f)))
;;;
;;; 仮想マシン
;;;
;;; ls の先頭から n 個の要素を取り除く
(define (drop ls n)
(if (zero? n)
ls
(drop (cdr ls) (- n 1))))
;;; 局所変数の値を求める
(define (get-lvar e i j)
(if (<= 0 j)
(list-ref (list-ref e i) j)
(drop (list-ref e i) (- (+ j 1)))))
;;; 局所変数の値を更新する
(define (set-lvar! e i j val)
(if (<= 0 j)
(set-car! (drop (list-ref e i) j) val)
(if (= j -1)
(set-car! (drop e i) val)
(set-cdr! (drop (list-ref e i) (- (+ j 2))) val))))
;;; 大域変数の値を求める
(define (get-gvar sym)
(let ((val (assoc sym *global-environment*)))
(if val
(cdr val)
(error "unbound variable " sym))))
;;; 大域変数の値を更新する
(define (set-gvar! sym val)
(let ((cell (assoc sym *global-environment*)))
(if cell
(set-cdr! cell val)
(error "unbound variable " sym))))
;;; 仮想マシンでコードを実行する
(define (vm s e c d)
(case (pop! c)
((ld)
(let ((pos (car c)))
(vm (cons (get-lvar e (car pos) (cdr pos)) s) e (cdr c) d)))
((ldc)
(vm (cons (car c) s) e (cdr c) d))
((ldg)
(vm (cons (get-gvar (car c)) s) e (cdr c) d))
((ldf)
(vm (cons (list 'closure (car c) e) s) e (cdr c) d))
((ldct)
(vm (cons (list 'continuation s e (car c) d) s) e (cdr c) d))
((lset)
(let ((pos (car c)))
(set-lvar! e (car pos) (cdr pos) (car s))
(vm s e (cdr c) d)))
((gset)
(set-gvar! (car c) (car s))
(vm s e (cdr c) d))
((app)
(let ((clo (car s)) (lvar (cadr s)))
(case (pop! clo)
((primitive)
(vm (cons (apply (car clo) lvar) (cddr s)) e c d))
((continuation)
(vm (cons (car lvar) (car clo)) (cadr clo) (caddr clo) (cadddr clo)))
(else
(vm '() (cons lvar (cadr clo)) (car clo) (cons (list (cddr s) e c) d))))))
((tapp)
(let ((clo (car s)) (lvar (cadr s)))
(case (pop! clo)
((primitive)
(vm (cons (apply (car clo) lvar) (cddr s)) e c d))
((continuation)
(vm (cons (car lvar) (car clo)) (cadr clo) (caddr clo) (cadddr clo)))
(else
(vm (cddr s) (cons lvar (cadr clo)) (car clo) d)))))
((rtn)
(let ((save (car d)))
(vm (cons (car s) (car save)) (cadr save) (caddr save) (cdr d))))
((sel)
(let ((t-clause (car c))
(e-clause (cadr c)))
(if (car s)
(vm (cdr s) e t-clause (cons (cddr c) d))
(vm (cdr s) e e-clause (cons (cddr c) d)))))
((selr)
(let ((t-clause (car c))
(e-clause (cadr c)))
(if (car s)
(vm (cdr s) e t-clause d)
(vm (cdr s) e e-clause d))))
((join)
(vm s e (car d) (cdr d)))
((pop)
(vm (cdr s) e c d))
((args)
(let loop ((n (car c)) (a '()))
(if (zero? n)
(vm (cons a s) e (cdr c) d)
(loop (- n 1) (cons (pop! s) a)))))
((args-ap)
(let loop ((n (- (car c) 1)) (a (list-copy (pop! s))))
(if (zero? n)
(vm (cons a s) e (cdr c) d)
(loop (- n 1) (cons (pop! s) a)))))
((def)
(let ((sym (car c)))
(push! *global-environment* (cons sym (car s)))
(vm (cons sym (cdr s)) e (cdr c) d)))
((defm)
(let ((sym (car c)))
(push! *global-environment*
(cons sym (cons 'macro (car s))))
(vm (cons sym (cdr s)) e (cdr c) d)))
((stop) (car s))
(else (error "unknown opcode"))))
;;; 大域変数
(define *global-environment*
(list
(list 'car 'primitive car)
(list 'cdr 'primitive cdr)
(list 'cons 'primitive cons)
(list 'eq? 'primitive eq?)
(list 'eqv? 'primitive eqv?)
(list 'pair? 'primitive pair?)
(list 'display 'primitive display)
(list 'newline 'primitive newline)
(list '+ 'primitive +)
(list '- 'primitive -)
(list '* 'primitive *)
(list '/ 'primitive /)
(list '= 'primitive =)
(list '< 'primitive <)
(list '> 'primitive >)
(list '<= 'primitive <=)
(list '>= 'primitive >=)
))
;;; read-eval-print-loop
(define (repl)
(let loop ()
(display "\n>>> ")
(guard (err
(else (display "ERROR: ")
(display (error-object-message err))
(unless
(null? (error-object-irritants err))
(display (car (error-object-irritants err))))
(newline)))
(let* ((expr (compile (read)))
(s (current-jiffy))
(v (vm '() '() expr '())))
(when (eof-object? v) (exit))
(display v)
(newline)
(display (inexact (/ (- (current-jiffy) s) (jiffies-per-second))))
(newline)))
(loop)))
;;; ファイルの読み込み
(for-each
(lambda (name)
(with-input-from-file name
(lambda ()
(let loop ()
(let ((output (vm '() '() (compile (read)) '())))
(display output)
(newline)
(if (not (eof-object? output))
(loop)
#f))))))
(cdr (command-line)))
;;; 実行
(repl)