9

Haskell で EDSL を実装しようとしています。バインドされている変数名を使用して AST をきれいに出力したいと思います (実際の名前を取得できない場合は、生成された名前で十分です)。

これは、簡単な例でどこまで到達したかです。

import Control.Monad.State

data Free f a = Roll (f (Free f a))
              | Pure a

instance Functor f => Monad (Free f) where
  return         = Pure
  (Pure a) >>= f = f a
  (Roll f) >>= g = Roll $ fmap (>>= g) f

data Expr a = I a
            | Plus (Expr a) (Expr a)
            deriving (Show)

data StackProgram a next = Pop  (a -> next)
                         | Push a next

instance Functor (StackProgram a) where
  fmap f (Pop    k) = Pop (f.k)
  fmap f (Push i x) = Push i (f x)

liftF :: Functor f => f a -> Free f a
liftF l = Roll $ fmap return l

push :: a -> Free (StackProgram a) ()
push i = liftF $ Push i ()

pop :: Free (StackProgram a) a
pop = liftF $ Pop id

prog3 :: Free (StackProgram (Expr Int)) (Expr Int)
prog3 = do
  push (I 3)
  push (I 4)
  a <- pop
  b <- pop
  return (Plus a b)

showSP' :: (Show a, Show b) => Free (StackProgram a) b -> [a] -> State Int String
showSP' (Pure a)           _        = return $ "return " ++ show a
showSP' (Roll (Pop f))    (a:stack) = do 
  i <- get
  put (i+1)
  rest <- showSP' (f a) stack
  return $ "var" ++ show i ++ " <- pop " ++ show (a:stack) ++ "\n" ++ rest
showSP' (Roll (Push i n))  stack    = do
  rest <- showSP' n (i:stack) 
  return $ "push " ++ show i ++ " " ++ show stack ++ "\n" ++ rest

showSP :: (Show a, Show b) => Free (StackProgram a) b -> [a] -> String
showSP prg stk = fst $ runState (showSP' prg stk) 0

これを実行すると、次のようになります。

*Main> putStrLn $ showSP prog3 []
push I 3 []
push I 4 [I 3]
var0 <- pop [I 4,I 3]
var1 <- pop [I 3]
return Plus (I 4) (I 3)

だから私が欲しいのはに置き換えることPlus (I 4) (I 3)ですPlus var0 var1。ツリーの残りの部分を調べて、バインドされた変数を名前と値のタプルに置き換えることを考えましたが、それが機能するかどうか、またはどのように機能するかは 100% わかりません。また、元の変数名を保持したいのですが、これを行う簡単な方法が思いつきません。Haskell でかなり軽量な構文を使用することをお勧めします (上記のようなものです)。

また、これらの種類のことを行う最善の方法を教えてくれる資料へのポインタもいただければ幸いです。私はフリーモナドと GADT について少し読んだことがありますが、それらをすべてまとめる方法が欠けていると思います。

4

2 に答える 2

5

あなたが持っている構造では、「純粋な」Haskellコードでこれを行うことはできません。コードがコンパイルされると、「参照透過性」（変数とその値の交換可能性）を区別(Plus a b)して維持することができないためです。(Plus (I 4) (I 3))

ただし、この種のことを可能にする危険なハック (つまり、動作が保証されていない) があります。それらは一般に「観察可能な共有」という名前で行われ、 StableNameを使用して値がどのように表現されるかの内部へのアクセスに基づいています。a基本的に、これにより、値への参照と新しいコピーを区別できるポインター等価演算が提供されます(I 4)。

この機能をまとめるのに役立つパッケージの 1 つがdata-reifyです。

ソースで使用されている実際の変数名は、コンパイル中に取り返しのつかないほど失われます。Paradiseでは、プリプロセッサを使用してコンパイル前に変換foo <~ barしますfoo <- withName "foo" $ barが、これはハックであり、ビルドがかなり遅くなります。

于 2013-02-16T00:30:25.353 に答える
4

@Gabriel Gonzales のリンクされた回答に基づいてこれを理解しました。基本的な考え方は、Expr 型に新しい変数コンストラクターを導入し、ツリーを解釈するときにこれらに一意の ID を割り当てることです。それとコードを少しクリーンアップすると、次のようになります。

import Control.Monad.Free
import Data.Map

newtype VInt = VInt Int

data Expr = IntL Int
          | IntV VInt
          | Plus Expr Expr

instance Show Expr where
  show (IntL i)        = show i
  show (IntV (VInt i)) = "var" ++ show i
  show (Plus e1 e2)    = show e1 ++ " + " ++ show e2

data StackProgF next = Pop  (VInt -> next)
                     | Push Expr next

instance Functor StackProgF where
  fmap f (Pop    k) = Pop (f.k)
  fmap f (Push e x) = Push e (f x)

type StackProg = Free StackProgF
type Stack = [Expr]

push :: Expr -> StackProg ()
push e = liftF $ Push e ()

pop :: StackProg Expr
pop = liftF $ Pop IntV

prog3 :: StackProg Expr
prog3 = do
  push (IntL 3)
  push (IntL 4)
  a <- pop
  b <- pop
  return (Plus a b)

showSP :: StackProg Expr -> String
showSP prg = go 0 prg []
  where
    go i (Pure a)          _     = show a
    go i (Free (Pop n))    (h:t) = "var" ++ show i ++ " <- pop " ++ show (h:t) ++ "\n" ++ 
                                   go (i+1) (n (VInt i)) t
    go i (Free (Pop _))    []    = "error: pop on empty stack\n"
    go i (Free (Push e n)) stk   = "push " ++ show e ++ ", " ++ show stk ++ "\n" ++ go i n (e:stk)

type Env = Map Int Expr

evalExpr :: Expr -> Env -> Int
evalExpr (IntL i)        _   = i
evalExpr (IntV (VInt k)) env = evalExpr (env ! k) env
evalExpr (Plus e1 e2)    env = evalExpr e1 env + evalExpr e2 env

evalSP :: StackProg Expr -> Int
evalSP prg = go 0 prg [] empty
  where
    go i (Free (Pop _))    []    env = error "pop on empty stack\n"    
    go i (Free (Pop n))    (h:t) env = go (i+1) (n (VInt i)) t       (insert i h env)
    go i (Free (Push e n)) stk   env = go i     n            (e:stk) env
    go i (Pure a)          _stk  env = evalExpr a env

きれいな印刷と実行：

*Main> putStrLn $ showSP prog3
push 3, []
push 4, [3]
var0 <- pop [4,3]
var1 <- pop [3]
var0 + var1
*Main> evalSP prog3
7
于 2013-02-17T14:23:10.330 に答える