Toy VM (10)
土曜日が忙しかったので中途半端な状態だけど、まとめておこう。
Gauche の VM は、ほとんど SECD マシンとして扱えそうだ。
SECD マシンは単なる状態遷移で、マクロで書ける。
プログラムをベクトルで持ち、プログラムカウンタを持たせた変形の SECD マシンも、同じようにマクロで書ける。(まだ定義に無駄が含まれているけど)
INTERP> (def-secd-machine-vec secd-v1 "secd machine sample 2." ( s e (:NIL . c) d pc -> (nil . s) e c d (+ pc 1)) ( s e (:STOP . c) d pc -> s e c d -1) ( s e (:LDC x . c) d pc -> (x . s) e c d (+ pc 2)) ( s e (:LD m n . c) d pc -> (x . s) e c d (+ pc 3) where x = (locate m n e) ) ( s e (:LDF f |c'| . c) d pc -> ((f . e) . s) e c d |c'|) ( ((|c'| . |e'|) v . s) e (:AP . c) d pc -> nil (v . |e'|) |c'| (s e |pc'| . d) |c'| where |pc'| = (+ pc 1)) ( (x . z) |e'| (:RTN . |c'|) (s e |pc'| . d) pc -> (x . s) e c d |pc'|) ( (x . s) e (:SEL cT cF cont . c) d pc -> s e cX (cont . d) cX where cX = (if x cT cF) ) ( s e (:JOIN . c) (cr . d) pc -> s e c d cr ) ( (a b . s) e (:CONS . c) d pc -> ((a . b) . s) e c d (+ pc 1)) ( ((a . b) . s) e (:CAR . c) d pc -> (a . s) e c d (+ pc 1)) ( ((a . b) . s) e (:CDR . c) d pc -> (b . s) e c d (+ pc 1)) ( (a b . s) e (:+ . c) d pc -> (x . s) e c d (+ pc 1) where x = (+ a b) ) ( (a b . s) e (:- . c) d pc -> (x . s) e c d (+ pc 1) where x = (- a b) ) ( (a b . s) e (:* . c) d pc -> (x . s) e c d (+ pc 1) where x = (* a b) ) ( (a b . s) e (:= . c) d pc -> (x . s) e c d (+ pc 1) where x = (= a b) ) ( (a b . s) e (:> . c) d pc -> (x . s) e c d (+ pc 1) where x = (> a b) ) ( (a b . s) e (:< . c) d pc -> (x . s) e c d (+ pc 1) where x = (< a b) ) ) SECD-V1 INTERP> (secd-v1 's 'e 0 'd (compile-exp '(+ (+ 3 4) 3))) ;; code: #(:LDC 3 :LDC 4 :LDC 3 :+ :+ :STOP) STOP (10 . S)
同じように gauche vm を SECD マシンの変形(値レジスタを持つ)として以下のように書けそうだ。
(def-toy-vm tgvm "toy gauche vm" ( s e (:CONST val . c) d v pc -> s e c d val (+ pc 2)) ( s e (:CONSTI num . c) d v pc -> s e c d num (+ pc 2)) ( s e (:PUSH . c) d val0 pc -> (val0 . s) e c d val0 (+ pc 1)) ( s e (:CONSTI-PUSH num . c) d v pc -> (num . s) e c d v (+ pc 2)) ( (a . s) e (:CONS . c) d val0 pc -> s e c d (a . val0) (+ pc 1)) ( s e (:CAR . c) d (a . b) pc -> s e c d a (+ pc 1)) ( s e (:CDR . c) d (a . b) pc -> s e c d b (+ pc 1)) ( s e (:NUMADDI i . c) d val0 pc -> s e c d (+ pc 2) x where x = (+ i val0)) ( (a . s) e (:NUMMUL2 . c) d val0 pc -> s e c d x (+ pc 1) where x = (* a val0)) ( s e (:PRE-CALL |c'| . c) d v pc -> s e c (s e |c'| . d) v (+ pc 2)) ( s e (:GREF op . c) d v pc -> s e c d op (+ pc 2)) ( (a b . s) e (:CALL . c) (|s'| |e'| |c'| . d) op pc -> |s'| |e'| |c'| d x (+ pc 1) where x = (funcall op b a)) ( (a b . s) e (:TAIL-CALL . c) d op pc -> s e c d x (+ pc 1) where x = (funcall op b a)) ;; todo ( |s'| |e'| (:RET . |c'|) (s e c . d) v pc -> s e c d v c) ( |s'| |e'| (:RET . |c'|) d v pc -> |s'| |e'| |c'| d v -1) )
こんな感じで動く。gauche で disassemble して(手で加工して) sbcl の REPL に貼付ける。
INTERP> (tgvm 's 'e 0 'd #(:PRE-CALL 11 :CONST 1 :PUSH :CONST 3 :PUSH :GREF + :CALL :PUSH :PRE-CALL 23 :CONST 7 :PUSH :CONST 2 :PUSH :GREF - :CALL :PUSH :GREF * :TAIL-CALL :RET) 'val0) ;; code: #(:PRE-CALL 11 :CONST 1 :PUSH :CONST 3 :PUSH :GREF + :CALL :PUSH :PRE-CALL 23 :CONST 7 :PUSH :CONST 2 :PUSH :GREF - :CALL :PUSH :GREF * :TAIL-CALL :RET) (STOP :S S :VAL0 20)
- ホンモノの gauche vm とは構造がだいぶ違う(スタックをリストで持っているので効率は悪い、などなど)。Gauche の命令列の一部だけが動くおもちゃで、スタックマシンを理解することが目的。
- まだどんくさいので、状態遷移の定義が冗長。左辺はSECDマシンの s(STACK), e (ENVIRONMENT), c(CODE), d(DUMP) に加えて、値レジスタ v(Value Register) と pc(ProgramCounter)。右辺では c は何の意味も無い定義になっている。かといって左辺のc を無くしてしまうと対称性が無くって気持ち悪い。
- ベクトルに対するパターンマッチが書ければ少しはましにできるかもしれない。
- まだ命令はいっぱいあるのでこのやり方で最後までいけるかはまだ分からない。