Zenn
⛳

Free Monadでコンパイル型言語内DSL

2024/04/13に公開
Haskell
#
dsl
tech

はじめに

元記事はこれです。
https://blog.3qe.us/entry/2024/04/03/130606

上の記事で言われている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