我正在尝试根据我在网上阅读的一些有用的文献来使用 Free monad 构建 AST。
我对在实践中使用这些类型的 AST 有一些疑问，我将其归结为以下示例。
假设我的语言允许以下命令：
{-# LANGUAGE DeriveFunctor #-}
data Command next
= DisplayChar Char next
| DisplayString String next
| Repeat Int (Free Command ()) next
| Done
deriving (Eq, Show, Functor)
我手动定义了 Free monad 样板：
displayChar :: Char -> Free Command ()
displayChar ch = liftF (DisplayChar ch ())
displayString :: String -> Free Command ()
displayString str = liftF (DisplayString str ())
repeat :: Int -> Free Command () -> Free Command ()
repeat times block = liftF (Repeat times block ())
done :: Free Command r
done = liftF Done
这允许我指定如下程序：
prog :: Free Command r
prog =
do displayChar 'A'
displayString "abc"
repeat 5 $
displayChar 'Z'
displayChar '\n'
done
现在，我想执行我的程序，这看起来很简单。
execute :: Free Command r -> IO ()
execute (Free (DisplayChar ch next)) = putChar ch >> execute next
execute (Free (DisplayString str next)) = putStr str >> execute next
execute (Free (Repeat n block next)) = forM_ [1 .. n] (\_ -> execute block) >> execute next
execute (Free Done) = return ()
execute (Pure r) = return ()
和
λ> execute prog
AabcZZZZZ
好的。这一切都很好，但现在我想了解我的 AST，并对其执行转换。像编译器中的优化一样思考。
这是一个简单的：如果一个Repeat块只包含DisplayChar命令，那么我想用适当的DisplayString. 换句话说，我想repeat 2 (displayChar 'A' >> displayChar 'B')用displayString "ABAB".
这是我的尝试：
optimize c@(Free (Repeat n block next)) =
if all isJust charsToDisplay then
let chars = catMaybes charsToDisplay
in
displayString (concat $ replicate n chars) >> optimize next
else
c >> optimize next
where
charsToDisplay = project getDisplayChar block
optimize (Free (DisplayChar ch next)) = displayChar ch >> optimize next
optimize (Free (DisplayString str next)) = displayString str >> optimize next
optimize (Free Done) = done
optimize c@(Pure r) = c
getDisplayChar (Free (DisplayChar ch _)) = Just ch
getDisplayChar _ = Nothing
project :: (Free Command a -> Maybe u) -> Free Command a -> [Maybe u]
project f = maybes
where
maybes (Pure a) = []
maybes c@(Free cmd) =
let build next = f c : maybes next
in
case cmd of
DisplayChar _ next -> build next
DisplayString _ next -> build next
Repeat _ _ next -> build next
Done -> []
在 GHCI 中观察 AST 表明这可以正常工作，而且确实如此
λ> optimize $ repeat 3 (displayChar 'A' >> displayChar 'B')
Free (DisplayString "ABABAB" (Pure ()))
λ> execute . optimize $ prog
AabcZZZZZ
λ> execute prog
AabcZZZZZ
但我不开心。在我看来，这段代码是重复的。每次我想检查它时，我都必须定义如何遍历我的 AST，或者定义像我project这样的函数来让我了解它。当我想修改树时，我必须做同样的事情。
所以，我的问题是：这种方法是我唯一的选择吗？我可以在不处理大量嵌套的情况下对我的 AST 进行模式匹配吗？我可以以一致且通用的方式（可能是 Zippers、Traversable 或其他方式）遍历树吗？这里通常采用什么方法？
整个文件如下：
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Prelude hiding (repeat)
import Control.Monad.Free
import Control.Monad (forM_)
import Data.Maybe (catMaybes, isJust)
main :: IO ()
main = execute prog
prog :: Free Command r
prog =
do displayChar 'A'
displayString "abc"
repeat 5 $
displayChar 'Z'
displayChar '\n'
done
optimize c@(Free (Repeat n block next)) =
if all isJust charsToDisplay then
let chars = catMaybes charsToDisplay
in
displayString (concat $ replicate n chars) >> optimize next
else
c >> optimize next
where
charsToDisplay = project getDisplayChar block
optimize (Free (DisplayChar ch next)) = displayChar ch >> optimize next
optimize (Free (DisplayString str next)) = displayString str >> optimize next
optimize (Free Done) = done
optimize c@(Pure r) = c
getDisplayChar (Free (DisplayChar ch _)) = Just ch
getDisplayChar _ = Nothing
project :: (Free Command a -> Maybe u) -> Free Command a -> [Maybe u]
project f = maybes
where
maybes (Pure a) = []
maybes c@(Free cmd) =
let build next = f c : maybes next
in
case cmd of
DisplayChar _ next -> build next
DisplayString _ next -> build next
Repeat _ _ next -> build next
Done -> []
execute :: Free Command r -> IO ()
execute (Free (DisplayChar ch next)) = putChar ch >> execute next
execute (Free (DisplayString str next)) = putStr str >> execute next
execute (Free (Repeat n block next)) = forM_ [1 .. n] (\_ -> execute block) >> execute next
execute (Free Done) = return ()
execute (Pure r) = return ()
data Command next
= DisplayChar Char next
| DisplayString String next
| Repeat Int (Free Command ()) next
| Done
deriving (Eq, Show, Functor)
displayChar :: Char -> Free Command ()
displayChar ch = liftF (DisplayChar ch ())
displayString :: String -> Free Command ()
displayString str = liftF (DisplayString str ())
repeat :: Int -> Free Command () -> Free Command ()
repeat times block = liftF (Repeat times block ())
done :: Free Command r
done = liftF Done