Haskell (GHC) 上で DSL (Domain Specific Language) を構築する際、操作の定義とその解釈（実行）の分離は強力な手法です。しかし、一度定義した DSL に後から新しい操作を追加し、既存のプログラムを壊さずに拡張性を持たせるには、工夫が必要です。

この記事では、Free Monad を用いた DSL 構築の手法とその限界に触れた後、Tagless-Final 方式を用いて拡張可能な DSL を実現する方法を紹介します。

なお、この記事で例に挙げている、ghci で対話的に試すことができるコードは Github-Git*1 にアップロード済みです。

Free Monad による DSL の構築と限界

DSL の操作を連結するための一般的なアプローチとして、Free Monad を利用する方法があります。

まずは、ベースとなる Free Monad の実装を用意します。

data Free f a
  = Pure a
  | Nest (f (Free f a))
  deriving Functor

freeBind
  :: Functor f
  => Free f a -> (a -> Free f b) -> Free f b
Pure x  `freeBind` g = g x
Nest op `freeBind` g = Nest ( fmap (\x -> x `freeBind` g) op )

freeAp
  :: Functor f
  => Free f (a -> b) -> Free f a -> Free f b
freeAp m1 m2 = m1 `freeBind` \x1 -> m2 `freeBind` \x2 -> Pure (x1 x2)

instance Functor f => Applicative (Free f) where
  pure = Pure
  (<*>) = freeAp

instance Functor f => Monad (Free f) where
  (>>=) = freeBind

`DSL1` の定義とプログラム例

この Free を使って、簡単な操作を行う DSL1 を定義してみましょう。 DSL1 は値の取り出し(GetI)、値の保存(PutI)、加算(Add) の機能を持っています。

data DSL1 a
  = GetI (Int -> a)
  | PutI Int a
  | Add Int (Int -> a)
  deriving Functor

getI :: Free DSL1 Int
getI = Nest $ GetI Pure

putI :: Int -> Free DSL1 ()
putI v = Nest $ PutI v (Pure ())

add :: Int -> Free DSL1 ()
add a = Nest $ Add a (\_ -> Pure ())

これらの操作を組み合わせて、DSL1 を使用したプログラム example1 を記述します。

example1 :: Free DSL1 ()
example1 = do
  putI 2         --  => 2
  v1 <- getI     --  v1 = 2
  add 3          --  => 3 + 2
  v2 <- getI     --  v2 = 5
  add (v1 + v2)  --  => ((2 + 5) + 5)

`DSL1` の実行器

Free Monad によって組み上げた、DSL データ構造だけでは具体的な処理は行われません。これに実際の振る舞いを与えるための実行器を定義します。

import Control.Monad.Trans.State

runF1 :: (Int -> Int) -> State Int Int
runF1 f = modify' f >> get

runDSL1_ :: Free DSL1 a -> State Int a
runDSL1_ (Pure x)           = return x
runDSL1_ (Nest (GetI f))    = get          >>= \v -> runDSL1_ (f v)
runDSL1_ (Nest (PutI v x))  = put v        >>        runDSL1_ x
runDSL1_ (Nest (Add a f))   = runF1 (a +)  >>= \v -> runDSL1_ (f v)

runDSL1 :: Free DSL1 a -> IO ()
runDSL1 f = print $ execState (runDSL1_ f) 0

ghci で実行すると、期待通りに状態が更新されていることがわかります。

ghci> runDSL1 example1
12

`DSL2` への拡張と「閉じた直和型」の制約

次に、乗算(Mul) と出力(Prt) の機能を追加した DSL2 を定義することとします。

data DSL2 a
  = GetI (Int -> a)
  | PutI Int a
  | Add Int (Int -> a)
  | Mul Int (Int -> a)
  | Prt (Int -> a)
  deriving Functor

getI :: Free DSL2 Int
getI = Nest $ GetI Pure

putI :: Int -> Free DSL2 ()
putI v = Nest $ PutI v (Pure ())

add :: Int -> Free DSL2 ()
add a = Nest $ Add a (\_ -> Pure ())

mul :: Int -> Free DSL2 ()
mul a = Nest $ Mul a (\_ -> Pure ())

prt :: Free DSL2 ()
prt = Nest $ Prt (\_ -> Pure ())

DSL2 を使用したプログラム例 example2 は以下のようになります。

example2 :: Free DSL2 ()
example2 = do
  putI 2         --  => 2
  v1 <- getI     --  v1 = 2
  add 3          --  => 3 + 2
  prt
  v2 <- getI     --  v2 = 5
  mul (v1 + v2)  --  => ((2 + 5) * 5)

そして、DSL2 の実行器を実装します。Prt で IO を扱うため、StateT Int IO になっています。

runF1 :: (Int -> Int) -> StateT Int IO Int
runF1 f = modify' f >> get

runDSL2_ :: Free DSL2 a -> StateT Int IO a
runDSL2_ (Pure x)           = return x
runDSL2_ (Nest (GetI f))    = get          >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (PutI v x))  = put v        >>        runDSL2_ x
runDSL2_ (Nest (Add a f))   = runF1 (a +)  >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (Mul a f))   = runF1 (a *)  >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (Prt f))     = get          >>= \v -> lift (print v) >> runDSL2_ (f v)

runDSL2 :: Free DSL2 a -> IO ()
runDSL2 f = execStateT (runDSL2_ f) 0 >>= print

example1 と同様に ghci で実行することができます。

ghci> runDSL2 example2
5
35

しかし、ここで拡張性の問題に直面します。DSL2 の操作は DSL1 の操作を包含しているにもかかわらず、example1 を runDSL2 で直接実行することはできません。

Haskell の代数的データ型は「閉じた直和型」であり、OCaml の多相バリアント*2のような「開いた直和型」ではありません。そのため、Free DSL1 として構築された構造をそのまま Free DSL2 を期待する関数に渡すことはできず、両方の実行器に同時に適用できるような多相性を持ったプログラムを記述することができません。

Tagless-Final 方式による解決

Tagless-Final 方式*3 を使用すると、拡張性の問題を綺麗に解決できます。

Haskell で簡潔に Tagless-Final 方式を実現する場合、操作をデータ型として定義するのではなく、型クラスの拡張可能なインターフェースとして定義することになります。 Haskell の型クラスは superclass関係*4 を持てるため、機能の包含関係を、多相性を保って表現できます。

型クラスによる DSL の定義

class Monad m => DSL1 m where
  getI  :: m Int
  putI  :: Int -> m ()
  add   :: Int -> m ()

class DSL1 m => DSL2 m where
  mul   :: Int -> m ()
  prt   :: m ()

拡張可能なインターフェースとなっている型クラスのメソッドを使って記述することで、多相的な型を持ったプログラムを記述できます。

example1 :: DSL1 m => m ()
example1 = do
  putI 2
  v1 <- getI
  add 3
  v2 <- getI
  add (v1 + v2)

example2 :: DSL2 m => m ()
example2 = do
  putI 2
  v1 <- getI
  add 3
  prt
  v2 <- getI
  mul (v1 + v2)

example1 は DSL1 制約のみを要求しているため、DSL1 を満たす任意の実行器で動かすことができます。

拡張可能な実行器の実装

DSL1 のみを実行できる実行器 runBase と、DSL2 まで実行できる実行器 runExt を定義します。

newtype Base a
  = Base (State Int a)
  deriving (Functor, Applicative, Monad, MonadState Int)

instance DSL1 Base where
  getI = get
  putI = put
  add a = modify' (a +)

runBase :: Base a -> IO ()
runBase (Base s) = print $ execState s 0

-----

newtype Ext a
  = Ext (StateT Int IO a)
  deriving (Functor, Applicative, Monad, MonadState Int)

-- Ext は DSL1 と DSL2 両方のインスタンスにする
instance DSL1 Ext where
  getI = get
  putI = put
  add a = modify' (a +)

instance DSL2 Ext where
  mul a = modify' (a *)
  prt = get >>= Ext . lift . print

runExt :: Ext a -> IO ()
runExt (Ext s) = execStateT s 0 >>= print

実行結果

example1 は多相的に定義されているため、runBase と runExt のどちらの実行器でもそのまま実行できます。

ghci> runBase example1
12
ghci> runExt example1
12
ghci> runExt example2
5
35

拡張可能インターフェースを利用した多相型を使用し、拡張前と拡張後で、共有できるプログラムを記述できました。

DNS フルリゾルバ bowline での応用

私は Haskell で DNS フルリゾルバ bowline*5 を開発していますが、この Tagless-Final 方式はこの実装でも大いに役立っています。

パーサーのインターフェース拡張

bowline の設定ファイルの解釈器や、DNS Zonefile の解釈器のインターフェース定義*6に Tagless-Final 方式を使用しています。型クラスで拡張可能にしているため、例えば後からパフォーマンスの最適化を理由に try コンビネータといった新しい操作を既存のコードベースを破壊せずに追加することが容易です。

モナドの拡張インターフェースによる操作の制御

bowline の反復検索器のインターフェース定義*7にも使用しています。ここでは拡張性を利用して、「キャッシュへの操作のみが許可されているコンテキスト」と、「ネットワークの外部サーバーへ実際のクエリを行えるコンテキスト」を型レベルで厳密に区別しています。具体的には、ネットワーク通信を行う部分は MonadQuery*8 という型クラスが実装されているかどうかで制限をかけ、意図しない呼び出しをコンパイル時に禁止しています。

このようにTagless-Final方式は、DSLに拡張性をもたらすだけでなく、型クラスの制約を通じて計算効果を安全に区別できる、実用性の高いパターンと言えます。