⛳
Free Monadでコンパイル型言語内DSL
はじめに
元記事はこれです。
上の記事で言われているDSLを記事内で言及のあるFree Monadで作ります。とはいえ代入と足し算とprint関数だけですが。。。あとHaskellで実装しています。
DSLというか、普通の(?)言語内DSLって要は(言語内)DSLのインタプリタを作る話だと(勝手に)思っていて、なのでタイトルではとりあえずコンパイル型言語内DSLって名前を付けました。
実装
基本的な流れとしては、DSLからASTを作って、それを元にコンパイルします。
DSLはこんな感じです。
program :: Free Exp ()
program = do
assign "x" $ Int 10
assign "y" $ (Var "x") :+: (Int 10)
print_ $ Var "x"
これを型チェック&コンパイルするのが以下です。
main :: IO ()
main = do
let terms = execWriter $ genAst program
case checkType [] terms of
Right _ -> forM_ terms $ \t -> do
print $ compileTerm t
Left x -> print x
すると以下が出力されます。
"x = 10"
"y = x + 10"
"print (x)"
ここで、整数と文字列を足してみます。
program :: Free Exp ()
program = do
assign "x" $ Int 10
assign "y" $ (Var "x") :+: (String "Hello")
print_ $ Var "x"
すると出力は以下のようになります。
"Not Int"
エラー出力が雑すぎるのことは一旦忘れて、実装はこんな感じです。
DSLをAST(列)に変換する部分でFree Monadを使っています。
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Prelude
import qualified Data.List as L
import Control.Monad.Free
import Control.Monad.State.Lazy
import Control.Monad.Writer.Lazy
data Term
= Var String
| Int Int
| String String
| Assign String Term
| Print Term
| Term :+: Term
data Exp r
= AssignExp String Term r
| PrintExp Term r
deriving Functor
data Type
= TInt
| TString
| TFun Type Type
| TVoid
deriving (Show, Eq)
assign x t = liftF $ AssignExp x t ()
print_ x = liftF $ PrintExp x ()
genAst :: Free Exp () -> Writer [Term] ()
genAst f = case f of
Free (AssignExp x t r) -> tell [Assign x t] >> genAst r
Free (PrintExp x r) -> tell [Print x] >> genAst r
Pure _ -> return ()
compileTerm :: Term -> String
compileTerm f = case f of
Var x -> x
Int x -> show x
String x -> "'" ++ x ++ "'"
t1 :+: t2 -> compileTerm t1 ++ " + " ++ compileTerm t2
Assign x t -> x ++ " = " ++ compileTerm t
Print x -> "print (" ++ compileTerm x ++ ")"
typeOf :: TEnv -> Term -> Either String (Type, TEnv)
typeOf env (Int _) = return $ (TInt, env)
typeOf env (String _) = return $ (TString, env)
typeOf env (Var x) = case lookup x env of
Just y -> Right $ (y, env)
Nothing -> Left $ "Unbound Variable: " ++ x
typeOf env (Assign x t) = do
(typeOfRHS, newEnv) <- typeOf env t
return $ (TVoid, (x, typeOfRHS):newEnv)
typeOf env (Print x) = do
(typeOfArg, newEnv) <- typeOf env $ x
case typeOfArg of
TString -> return $ (TVoid, newEnv)
TInt -> return $ (TVoid, newEnv)
_ -> Left $ "Not String or Int"
typeOf env (t1 :+: t2) = do
(t1', _) <- typeOf env t1
(t2', _) <- typeOf env t2
case (t1', t2') of
(TInt, TInt) -> return $ (TInt, env)
(_, _) -> Left $ "Not Int"
checkType :: TEnv -> [Term] -> Either String ()
checkType tenv terms = do
case L.uncons terms of
Just (h, r) -> case typeOf tenv h of
Right (_, newTenv) -> checkType newTenv r
Left x -> Left x
Nothing -> return ()
type TEnv = [(String, Type)]
議論
これだとほぼAST直書きなので皆さんでもっといい感じのDSLを作ってください。
ところで元記事には以下のようにあります。
パーサや型システムをScalaに丸投げして
Scalaのコードとしてはもちろん型チェックが行われますが、コンパイルされるLuaのコードの「型チェック」は別途考えないといけないと思います。
結局TypeScriptならぬTypeLuaの型システムを考えて、DSLで型を指定するなり型推論をするなりしてコンパイル時に型チェックをする必要があるという理解です。
言語内DSLなのでパーサーを書かなくていいのはそうなんですが、逆にいうとパーサーさえ書けばLuaにコンパイルされる独自の静的型付き言語を作るのと同じくらいの手間な気がしました。でもこの記事のDSL書くよりはパーサー書いて
x: int = 10
y: int = x + 10
print (x)
とか書いた方が幸福度高そうですね。。。
Discussion