Toy VM (12) - 小まとめ

SECD マシン

もともと SECD マシンはとてもシンプルで、簡単に実装できるものですが、
その状態遷移ルールがそのままプログラムになるように、マクロを書いていました。定義したマクロを使うと以下のように SECD マシンを定義できます。

(def-secd-machine secd-1 "secd machine sample."
  ;; initial state -> transformed state
  ( s e (:NIL . c) d                            -> (nil . s) e c d )
  ( s e (:LDC x . c) d                          -> (x . s) e c d )
  ( s e (:LD (m . n) . c) d                     -> (x . s) e c d where x = (locate m n e) )
  ( s e (:LDF |c'| . c) d                       -> ((|c'| . e) . s) e c d )
  ( (x . s) e (:SEL cT cF . c) d                -> s e cX (c . d) where cX = (if x cT cF) )
  ( s e (:JOIN . c) (cr . d)                    -> s e cr d )
  ( ((|c'| . |e'|) v . s) e (:AP . c) d         -> nil (v . |e'|) |c'| (s e c . d) )
  ( (a b . s) e (:CONS . c) d                   -> ((a . b) . s) e c d )
  ( ((a . b) . s) e (:CAR . c) d                -> (a . s) e c d )
  ( ((a . b) . s) e (:CDR . c) d                -> (b . s) e c d )
  ( (x . z) |e'| (:RTN . |c'|) (s e c . d)      -> (x . s) e c d )
  ( s e (:DUM . c) d                            -> s (nil . e) c d)
  (((|c'| . |e'|) v . s) (nil . e) (:RAP . c) d -> nil |e''| |c'| (s e c . d) where |e''| = (rplaca |e'| v))
  ( (a b . s) e (:+ . c) d                      -> (x . s) e c d where x = (+ a b) )
  ( (a b . s) e (:- . c) d                      -> (x . s) e c d where x = (- a b) )
  ( (a b . s) e (:* . c) d                      -> (x . s) e c d where x = (* a b) )
  ( (a b . s) e (:= . c) d                      -> (x . s) e c d where x = (= a b) )
  ( (a b . s) e (:> . c) d                      -> (x . s) e c d where x = (> a b) )
  ( (a b . s) e (:< . c) d                      -> (x . s) e c d where x = (< a b) )
  )

このマクロは defun secd-1 と defparameter secd-1 に展開されます。パラメータ secd-1 は状態遷移表です。

INTERP> secd-1
"           INITIAL STATE                                             TRANSFORMED STATE
S                   E           C                  D                S                E           C    D             
--------------------------------------------------------------------------------------------------------------------
s                   e           (nil . c)          d             -> (nil . s)        e           c    d             
s                   e           (ldc x . c)        d             -> (x . s)          e           c    d             
s                   e           (ld (m . n) . c)   d             -> (x . s)          e           c    d             
                                                                    where x = (locate m n e)
s                   e           (ldf c' . c)       d             -> ((c' . e) . s)   e           c    d             
(x . s)             e           (sel ct cf . c)    d             -> s                e           cx   (c . d)       
                                                                    where cx = (if x ct cf)
s                   e           (join . c)         (cr . d)      -> s                e           cr   d             
((c' . e') v . s)   e           (ap . c)           d             -> nil              (v . e')    c'   (s e c . d)   
(a b . s)           e           (cons . c)         d             -> ((a . b) . s)    e           c    d             
((a . b) . s)       e           (car . c)          d             -> (a . s)          e           c    d             
((a . b) . s)       e           (cdr . c)          d             -> (b . s)          e           c    d             
(x . z)             e'          (rtn . c')         (s e c . d)   -> (x . s)          e           c    d             
s                   e           (dum . c)          d             -> s                (nil . e)   c    d             
((c' . e') v . s)   (nil . e)   (rap . c)          d             -> nil              e''         c'   (s e c . d)   
                                                                    where e'' = (rplaca e' v)
(a b . s)           e           (+ . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (+ a b)
(a b . s)           e           (- . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (- a b)
(a b . s)           e           (* . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (* a b)
(a b . s)           e           (= . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (= a b)
(a b . s)           e           (> . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (> a b)
(a b . s)           e           (< . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (< a b)
--------------------------------------------------------------------------------------------------------------------
"
INTERP> (run-secd-1 '(letrec ((fib (lambda (n)
                               (if (< n 2)
                                   n
                                   (+ (fib (- n 1)) (fib (- n 2)))))))
                      (fib 20)))
;; code: (DUM NIL LDF (LDC 2 LD (1 . 1) < SEL (LD (1 . 1) JOIN) (NIL LDC 2 LD (1 . 1) - CONS LD (2 . 1) AP NIL LDC 1 LD (1 . 1) - CONS LD (2 . 1) AP + JOIN) RTN) CONS LDF (NIL LDC 20 CONS LD (1 . 1) AP RTN) RAP)
((6765 . S) E NIL D)
INTERP> 

これだけでは、わざわざマクロを定義した恩恵はあまりありません。が、可能な限りシンプルに書けたことで、動くコンパイラVM を持ったまま、拡張と応用が容易になったはず、です。以下を考えています。

(1) Lisp Me を真似て、末尾再帰、継続、ベクトル、をサポートする。
(2) 処理系のリストを使わず、自前でリストを持つ SECD マシンを実装する。
(3) Gauche VM を真似て理解する。

  • Code をリストではなくベクトルで持つ変形 SECD マシンを実装する。
  • Gauche VM (レジスタ val を持つSECDマシン、と今は思っています)を実装する。

(1) はマクロのできと、考え方が正しいことを確認するのに良い試験となりそうです。
(2) は既にやりかかっていて、CLOS オブジェクトを使っていました。マクロを使えば、インタプリタと同じ定義から書き下せるはずです。
(3) もやりかかっていますが、これを奇麗に実装するためには util.match のようなベクトルに対するパターンマッチを Common Lisp で自前で実装する必要があります。

なお、問題点として現在のインタプリタで、 gauche より fib がずいぶん遅いです。コンシングが多いから、と思っていますが(2) でも解決しない可能性も十分あります。

github

http://github.com/cranebird/secd にここまでの記録を置いています。
※いろいろとごっちゃになっています。

  • secd.asd ASDF 定義ファイル。これをロードすればいい、はず。
  • package.lisp パッケージ定義。
  • compiler.lisp コンパイラ。compile-pass1 は S-式に、compile-pass2 はベクトルにコンパイルします。

 インタプリタは今のところ compile-pass1 の結果だけ使っています。

  • match.lisp パターンマッチマクロ。SECD マシンをシンプルに書くためだけに書かれました。
  • interp.lisp def-secd-machine マクロを定義。
  • defmachine.lisp SECD マシンの定義本体。secd-1

追記:
さっき気づいたバグ。let の body 部分とかには一つの式しか許しません。これは致命的だな。
(+, -, などはきっちり二つの引数だけを取ります。これは今のところ仕様)