Free Monadで言語内DSLをつくろう

抽象構文木の構築とその評価の分離

インタプリタやコンパイラでは最初に、コードの文字列を構文解析して抽象構文木 (AST) を構築する。その表現形式はDAGやSSAなどに変化して行くことも多いが、基本的にはこれらの中間表現に対して様々な最適化がほどこされる。インタプリタの場合にはこれが評価され実行されるが、コンパイラの場合にはこれがアセンブリの命令に置き換えられ、スケジューリングされ、レジスタが割り当てられ、最終的にはバイナリが生成される。こうした構文解析や構文木の構築と、中間表現の最適化、その評価の分離は、各工程をそれぞれ独立に作成し、必要に応じて取り替えられるという意味で、とても便利だ。

言語内DSLの処理系をそこまで重くするのは本末転倒感があるが、少なくとも構文木を構築しその評価と分離することは、抽象化の手段として適切な場合もあると思う。Haskellでは、言語内DSLのコードとその評価の分離には色々な方法 (型クラスによる抽象など) が考えられるが、ここではFree Monadを取り上げたい。自分で定義した、DSLを表現するデータ型をFunctorにし、Free Monadに入れれば、Monad計算で構文木を構築できる。これを評価するインタプリタは独立に複数用意できるし、評価先の型も自由に変えられる。

目次

Free Monadで言語内DSLをつくる

構文木を表現するデータ型の準備

まずは、自分のDSLの構文木を表現するデータ型を定義する。Freeに包むためにはFunctorである必要があるが、この場合その定義は自明なので、簡単のためGHCのDeriveFunctor拡張を使ってderiving Functorしている。(この導出では型コンストラクタの最後の型変数に対応する値を写すようなfmapをつくってくれる。) またこのあと使う予定のモジュールもimportしておく。Freeには色々な実装や、関連するライブラリ、派生形などがあるが、ここでは最初の素朴な物を使っている。(処理効率を考えて実装されたControl.Monad.Free.Churchや、ASTのデータ型からFreeのアクションを導出してくれるControl.Monad.Free.THなどを参照されたし。)

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad.Free
import Control.Monad.State.Lazy
import Control.Monad.Writer.Lazy

data MyAST r = Open r
             | Elephant String r
             | Close r
             | End
  deriving Functor

値コンストラクタはノードに対応し、型変数rは残りの木を表している。Freeに包むと、FreeとMyASTが交互に入ることになる。

構文木構築のための、FunctorからのFreeの作成

次に、MyASTの値から対応するFreeのアクションを作成する。Freeの値コンストラクタを使ってもいいが、liftFを使うと少し簡単に書ける。これらのFreeをつなげれば、Free MyAST a型の構文木が構築されていく。

{-
data Free f a = Pure a | Free (f (Free f a))
instance Functor f => Monad (Free f) where
  Free x >>= f = Free $ fmap (>>= f) x
  Pure a >>= f = f a
  return = Pure
liftF = Free . fmap return
-}

-- (対応するFreeの値) = liftF (DSLのデータ型の値)
-- (open = Free $ Open (Pure ()))
open  = liftF $ Open ()
close = liftF $ Close ()
end   = liftF End

putElephant :: String -> Free MyAST ()
putElephant name = liftF $ Elephant name ()

扉を開けて象を入れて扉を閉めてプログラムを終わらせるような命令を用意してみる。Freeは構文木の構築手段を用意しているだけなので、実際に何が行われるかはインタプリタが決める。

インタプリタの作成

最後に構文木を評価するためのインタプリタをつくる。Free MyAST a型の構文木を渡すと、最初のノードにパターンマッチして、何か処理を行い (例えばIntegerやStringなどの値に評価してもいいし、Monad計算に評価してもいい)、残りの木に対する処理を再帰的に呼び出す。葉はPureで表される。

interpretPrint :: Free MyAST a -> IO ()
interpretPrint f = case f of
  Free (Open r)       -> putStrLn "open" >> interpretPrint r
  Free (Elephant e r) -> putStrLn ("elephant: " ++ e) >> interpretPrint r
  Free (Close r)      -> putStrLn "close" >> interpretPrint r
  Free End            -> putStrLn "end"
  Pure _              -> return ()

DSLのプログラムを書く

準備ができたので、幾つかDSLのプログラムを書いて、インタプリタで評価してみよう。

program1 :: Free MyAST ()
program1 = do
  open
  putElephant "Sally"
  putElephant "Emet"
  end

program2 :: Free MyAST ()
program2 = do
  open
  putElephant "Emet"
  close
  putElephant "Sally"
  end

先ほど定義した、MyASTの値が入ったFreeをつなげることで、このプログラムを表現する構文木が作成される。

> interpretPrint program1
open
elephant: Sally
elephant: Emet
end

これをインタプリタで評価すれば結果が返る。このインタプリタでは標準出力にプログラムの構成を表示するだけ。

色々なインタプリタをつくる

操作のログを取る

構文木の構築とその評価が分離されているので、同じプログラムを評価する色々なインタプリタをつくることができる。interpretPrintはプログラムをIOにしていたが、interpretNamesは象の名前のリストに評価してくれる。

interpretNames :: Free MyAST () -> Writer [String] ()
interpretNames f = case f of
  Free (Open r)       -> interpretNames r
  Free (Elephant e r) -> tell [e] >> interpretNames r
  Free (Close r)      -> interpretNames r
  Free End            -> return ()
  Pure _              -> return ()

WriterにMonoidをtellすると、後ろでmappendしてくれる。Monoidは単位元memptyを持ち、結合法則を満たす2項演算mappendが使えることを要請する型クラスで、例えばリストのmemptyは[]でmappendは(++)。完成したWriterをexecWriterすれば、このMonoidの演算結果を返してくれる。

> execWriter $ interpretNames program2
["Emet","Sally"]

操作の解析をする

冷蔵庫の状態を表現する型を用意してStateと一緒に使うことで、冷蔵庫が適切に使われているか、最後にどんな状態になっているかを調べてくれるようなinterpretRefもつくってみよう。

data Refregirator = Opened | Closed | Broken deriving (Show, Eq)

interpretRef :: Free MyAST () -> State Refregirator ()
interpretRef f = case f of
  Free (Open r) -> do x <- get
                      case x of Broken -> return ()
                                _ -> put Opened >> interpretRef r
  Free (Elephant _ r) -> do x <- get
                            case x of Opened -> interpretRef r
                                      _ -> put Broken
  Free (Close r) -> do x <- get
                       case x of Broken -> return ()
                                 _ -> put Closed >> interpretRef r
  Free End -> return ()
  Pure _ -> return ()

閉まっているのに象を入れると壊れてしまうことにした。Stateはputやget、stateで明示的に状態を操作できるMonadで、execStateに完成したStateと初期状態をあたえれば、最後の状態を返してくれる。

> execState (interpretRef program1) Closed
Opened
> execState (interpretRef program2) Closed
Broken

DSLのコードはそのままに、IOから切り離して、インタプリタを取り替えて色々なテストや検証もできそうだ。

動的な制御と評価時の環境の利用

分岐する木の構築と評価時の動的な制御

ここまでは構文木と言いながら、リストに近いものしか扱ってこなかった。プログラムは1列に並んだ命令列のような構造を持っていた。それというのも言語内DSLではその言語の制御構文がそのまま使えるので、制御フローが静的に決定できるなら、構文木の構築時に分岐のない1つの命令列を選択できるためである。(分岐条件などの値は、インタプリタでの評価時に構文木の構築時点に送り込むこともできる。) 一方で、どうしてもインタプリタでの評価時に制御フロー自体を動的に決定したい時は、構文木を分岐する木として表現したいこともあるかもしれない。

data ArithAST a r = Unary (a -> a) r
                  | Binary (a -> a -> a) r r
                  | Branch (a -> Bool) r r r
                  | Val a
  deriving Functor

type FA a = Free (ArithAST a) ()

unary :: (a -> a) -> FA a
unary op = liftF $ Unary op ()

binary :: (a -> a -> a) -> FA a -> FA a
binary op l = Free $ Binary op l (Pure ())

branch :: (a -> Bool) -> FA a -> FA a -> FA a
branch cp t f = Free $ Branch cp t f (Pure ())

val :: a -> FA a
val x = liftF $ Val x

ここでは簡単のため、単項演算と2項演算と条件分岐を含む1つの式を表現する構文木をつくり、Branchの制御フローを変えたインタプリタを用意してみる。

type ASTF = Free (ArithAST Double) ()

interpretArith :: ASTF -> Double
interpretArith f = case f of
  Free (Unary f r)      -> f $ interpretArith r
  Free (Binary f r l)   -> f (interpretArith r) (interpretArith l)
  Free (Branch f l r c) -> if f (interpretArith c)
                             then interpretArith l else interpretArith r
  Free (Val x)          -> x
  Pure _                -> 0

interpretArithBr :: ASTF -> Double
interpretArithBr f = case f of
-- same as interpretArith ...
  Free (Branch f c l r) -> if f (interpretArith c)
                             then interpretArith l else interpretArith r
-- same as interpretArith ...

コードを書いてそれぞれのインタプリタで評価してみる。ノードに演算子があり、木が下向きに延びているので、計算の流れは下から上になる。

-- ((*3) (-2))
calc1 :: ASTF
calc1 = do
  unary (*3)
  val (-2)

-- (log (max calc1 ((**2.5) 0.5)))
calc2 :: ASTF
calc2 = do
  unary log
  binary max calc1
  unary (**2.5)
  val 0.5

-- if (>0) 1.0 then calc1 else calc2 -- interpretArith
-- if (>0) calc1 then calc2 else 1.0 -- interpretArithBr
calc3 :: ASTF
calc3 = do
  branch (>0) calc1 calc2
  val 1.0

> interpretArith calc3
0.9535708819095106
> interpretArithBr calc3
-4.75415180475803e-2

評価時の環境からの変数束縛

それは入れ子の無名関数でしかないが、do記法の変数束縛記法は直感的で便利だ。ASTを表現するデータ型 (ここではStAST) で関数のフィールド (これがfmapされるようにする) を使えば、インタプリタでの評価時の環境から構文木の (実際の) 構築時点に値を送り込み、Freeのdoの中で変数束縛できる。DSLの中で、例えば評価時にIOから取り出した値を利用したり、StateのようにStASTの文脈から取り出した値を利用したりできる。

data StAST s cs r = Read (s -> r)
                  | Const (cs -> r)
                  | Write s r
  deriving Functor

readS :: Free (StAST s cs) s
readS = liftF $ Read id
-- (readS = Free $ Read (\x -> Pure x))

constS :: Free (StAST s cs) cs
constS = liftF $ Const id

writeS :: s -> Free (StAST s cs) ()
writeS x = liftF $ Write x ()

StASTに変化する状態を表現するフィールドsと、変化しない定数を表現するフィールドcsを作り、それぞれを操作するためのFreeのアクションを用意する。

interpretStAST :: Free (StAST s cs) a -> s -> cs -> s
interpretStAST f x c = case f of
  Free (Read g)    -> interpretStAST (g x) x c
  Free (Const h)   -> interpretStAST (h c) x c
  Free (Write y r) -> interpretStAST r y c
  Pure _           -> x

execStateに相当するインタプリタを作成する。FreeのプログラムとStASTの初期状態をあたえると、最後の状態を返してくれる。プログラムを書いて評価してみよう。

sproc1 :: Free (StAST Double Double) ()
sproc1 = do
  x <- readS
  if x < 0.0
    then constS >>= writeS
    else writeS $ sqrt x
  y <- readS
  writeS (x + y)

> interpretStAST sproc1 2.0 0.0
3.414213562373095
> interpretStAST sproc1 (-2.0) 1.0
-1.0

こうした方法を使えば、StASTの状態をDSLの中から確認して制御を変えたりもできる。

まとめと参考文献

Freeを使うと、DSLの構文木構築とその評価を分離できる。同じDSLのコードに対して複数のインタプリタを使い分けられるので、例えばIOから切り離してテストや検証などにも利用できる。Freeの中では評価時の状態を制御に組み込めるし、どうしても必要なら制御フロー自体を評価時に選ぶこともできる。Freeの便利さや使い方については、より進んだ内容についてもたくさんの良い記事が書かれているので、参照されたい。

free: Monads for free
Haskell for all: Why free monads matter
Haskell for all: Purify code using free monads
dlaing.org
Free and Freer Monads