ASTを構築する言語内DSLについて色々考えたメモ

AstDsl.hs

module AstDsl where

import Control.Monad.State
import Control.Monad.Identity
import Data.Monoid
import Control.Monad.Writer

-- こんな普通のAST定義があるとする
data Expr = Let String Expr Expr
          | Var String
          | Val Int
          | Add Expr Expr
  deriving (Eq, Show)

-- 普通にASTを構築するとこんな感じ
buildSimple :: Expr
buildSimple =
  Let "a" (Val 42)
  $ Let "b" (Val 21)
  $ Add (Add (Var "a") (Var "b")) (Val 1)

-- Stateモナドを使ってユニークな変数を生成する
-- この後の拡張を考えてモナド変換子を使う
newVar :: Monad m => String -> StateT Int m String
newVar x = do
  a <- get
  modify (+1)
  return $ x <> show a

-- これで同名の変数を作ってしまうヒューマンエラーが防げる
buildState :: Expr
buildState = runIdentity $ flip evalStateT 0 $ do
  a <- newVar "a"
  b <- newVar "a"
  return
    $ Let a (Val 42)
    $ Let b (Val 21)
    $ Add (Add (Var a) (Var b)) (Val 1)

-- Letを自動生成する
let_ :: Monad m => Expr -> StateT Int m (Expr, Expr -> Expr)
let_ expr = do
  x <- newVar "x"
  return (Var x, Let x expr)

-- これでVarを省略できる
buildGenLet :: Expr
buildGenLet = runIdentity $ flip evalStateT 0 $ do
  (a, letA) <- let_ $ Val 42
  (b, letB) <- let_ $ Val 21
  return $ letA $ letB $ Add (Add a b) (Val 1)

-- WriterモナドとEndoを使って継続を暗黙的に処理する
def :: Expr -> StateT Int (Writer (Endo Expr)) Expr
def expr = do
  x <- newVar "x"
  tell $ Endo $ Let x expr
  return (Var x)
  
-- コンストラクタを剥がす部分が若干ゴツくなるが、doの中身はスッキリ
buildDSL :: Expr
buildDSL = uncurry (flip appEndo) $ runWriter $ flip evalStateT 0 $ do
  a <- def $ Val 42
  b <- def $ Val 21
  return $ Add (Add a b) (Val 1)

main :: IO ()
main = do
  print buildSimple
  print buildState
  print buildGenLet
  print buildDSL