Just $ A sandbox

プログラミングと計算機科学とかわいさ

Free Monadic Parser

動機

Haskellでは * -> * カインドを持つデータ型からFreeモナド(Operational)を使って5秒でDSLが作れることは有名だけど、 そうやって作ったDSLスクリプトとして外部ファイルから読み込むようなことがしたいこともあるかもしれない。 そういう時にわざわざパーサーを頑張って1から書くのはしんどいし、うまい具合にやってくれてもいいのだろうか、という話。

結論から言うとある程度うまい具合にできます

Freeモナドについて

FreeモナドはFreeなので特別なprimitive operationは定義されていないから、モナドのoperationだけをパースすることを考えればいい。 つまり、

ex = do
  Con1 x y
  t <- Con3 a b c
  Con4 t

のようなものがパースできればよさそうなことがわかる。 本来はモナドで定義可能な関数(whenとか)は使えるようにするべきなのかもしれないけど今回は面倒なのでパス。

さて、do式では好きな変数にbindすることができて、実体は適当な型の値がそこには束縛されている。 それを上手くパースして適当なデータ型に押し込める必要がある。

そこで、データ型の定義をする際に、実際に来るべき型とリファレンス(変数名)をどちらも取れるようにしておくことにしよう。

例えば上の例では Con4 がIntを受け取るとしたい場合、コードでは

Con4 :: ref Int Var -> DSL ()

のように定義することにする。 ref は後で具体的に適当な型が来るが、今は Int, Var のいずれも来る可能性があることを示していると思えば十分だと思う(=Var= はString)。

例: Add-Double計算機

一番下に今回使うコードを貼っておくので見てもらうとして、いくつか抜粋して解説をする。

例として、次のような命令を持つDSLを考えよう。

data DSL ref a where
  Add :: ref Int Var -> DSL ref ()
  Double :: DSL ref ()
  Get :: DSL ref Int
  Print :: DSL ref ()

これは内部に1つのIntを持つ計算機で、加算、内部の値を2倍、内部の値を取得、内部の値を出力できる。 ただし型を見ると分かるとおり、 Add は普通に値を受け取ることもできれば、 Get で取得して束縛したreferenceを渡すこともできる。

これのパーサーを書き、さらにそれのインタープリターをFreeモナドを使って書くことを考えよう。 従来なら DSL と同じような(ただしreferenceを保持する等の微妙な違いがある)Syntaxに沿ったデータ型を作ってパーサーを書いていたけれど、それをやめて上の DSL だけでパーサーもインタープリターも書いてしまうことにする。

パーサー

いきなり上のパーサーを書いてしまう。

pDSL :: Parser [Syntax (DSL Either)]
pDSL = fromConParsers $ 
  [ pbind padd
  , pbind pduplicate
  , pbind pget
  , pbind pprint
  ]

  where
    padd = do
      symbol "Add"
      choice $ fmap try $
    [ Add . Left . fromInteger <$> integer
    , Add . Right <$> some letter <* newline
    ]
    pduplicate = (\_ -> Double) <$> symbol "Double"
    pget = (\_ -> Get) <$> symbol "Get"
    pprint = (\_ -> Print) <$> symbol "Print"

ここではtrifecta(persecみたいなもの)を使っているけれど、 DSL の各コンストラクタを fromConParsers に渡していることだけ分かればOK。 fromConParsers はコンストラクタのパーサーからFreeモナドのパーサーを作るやつ。

実際は、bind syntax x <- Get みたいなのをパースするんだけどあまり細かいことは気にしなくていいと思う。 パーサーでは色々型やらなんやらをごまかして書いたので、インタープリターを書くためには少しだけトリックが必要になる。

Value Universe

上でも述べたけれどreferenceを受け取ることを常に考える必要があり、さらにそれらには型がついているので、型が合わない操作を許容するわけにはいかない。 例えば x : String のときに Add x を解釈することは出来ないので、つまりどんな型が来るかも込みでインタープリターを書く必要がある。

ただし当然どんな型が来るべきかはコンパイル時には決定できないので、結論としてこのDSLが取りうる値を全て含んだ型を作ることになる。

今回のDSL(), Int しかないので、それを含んだ型を定義する。

data BindVal = VU () | VInt Int

Resolver

インタープリターを書くためには、次のようなことを気にする必要がある。 コンストラクタごとに、どうやって上のValue Universe(BindVal のこと)に変換するかを指定する必要がある。 それと、上でも述べたreferenceの解決を行いたい。つまり、今は Add : ref Int Var -> DSL ref () なるコンストラクタがあるけれど、 Add (varX)Add 10 みたいに変換する機構が必要になる。

ここでは、Resolverという型クラスを用意した。

class Resolver dsl where
  type ValUniv dsl :: *
  toValue :: dsl Either a -> (a -> ValUniv dsl)
  resolve :: M.Map Var (ValUniv dsl) -> dsl Either a -> dsl Const a

ValUnivDSLのコンストラクタが取りうる値を全て集めた型で、今の場合は BindVal になる。 toValue は、各コンストラクタをどうやって ValUniv に変換するかを指定する。 resolve は、 dsl Eitherdsl Const に変換する。ここで先程の Add を思い出すと、 Add (Either Int Var)Add (Const Int Var) 、つまり Add Int に変換すれば良いことが分かる。

resolve は現在束縛されている変数とその値のMapも引数にあるので、これを使って Add (Right ref) はMapからrefに対応する値を引っ張ってくるだけでよい。

このResolverのinstanceを書けば、欲しかったFreeモナドのデータが得られるので、最後はインタープリター部分を書けばOK。

interpret

インタープリターは適当に書けば良い。 DSL Const が来るので、bindの問題はなく、ただの値が入ったコンストラクタを受け取って動くものを書くだけでいい。

interpret :: Skeleton (DSL Const) () -> IO ()
interpret = go 0 where
  go :: Int -> Skeleton (DSL Const) () -> IO ()
  go st skel = case debone skel of
    (Add (Const n) :>>= next) -> go (st + n) (next ())
    (Double :>>= next) -> go (st * 2) (next ())
    (Get :>>= next) -> go st (next st)
    (Print :>>= next) -> print st >> go st (next ())
    Return _ -> return ()

動かす

Print
Add 10
Print
n <- Get
Double
m <- Get
Print
Add n
Add m
Print

みたいな文字列を渡すとパースしてインタープリットして動くプログラムが得られる。

やったね!

エラーハンドリングについて

型エラー、つまり x: String のとき Add x などと書くものは、上でのresolveできっちりキャッチできる。 上のresolveではMapから値を引っ張ってくるが、引っ張ってきたデータに Int 以外の値が入っている場合は、パースした文字列で型エラーが起きていることが分かるので適当なエラーを書けば良い。

補足

今はモナドの構文としてbind x <- f しか使えないけれど、他にletやifやらもちゃんとサポートするのもありだと思う。

また注意として、上の方法では常にValue Universeが必要になるので返す型が多相になったり複雑になったりするとまた考えないといけないことが出てくるかもしれない。 あんまりちゃんと考えてないけど実用したいときは注意。

コード