Я пытаюсь структурировать AST, используя Free monad, основываясь на некоторой полезной литературе, которую я читал в Интернете.
У меня есть некоторые вопросы о работе с этими типами АСТ на практике, которые я рассмотрел в следующем примере.
Предположим, что мой язык допускает следующие команды:
{-# 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
Хорошо. Это все хорошо, но теперь я хочу узнать о моем АСТ и выполнить на нем преобразования. Подумайте, как оптимизация в компиляторе.
Здесь простой: если блок Repeat содержит только команды DisplayChar, то я хотел бы заменить все это на DisplayString. Другими словами,
Я хотел бы преобразовать repeat 2 (displayChar 'A' >> displayChar 'B') с помощью displayString "ABAB".
Здесь моя попытка:
optimize [email protected](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 [email protected](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 [email protected](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 показывает, что это работает правильно, и действительно
λ> optimize $ repeat 3 (displayChar 'A' >> displayChar 'B')
Free (DisplayString "ABABAB" (Pure ()))
λ> execute . optimize $ prog
AabcZZZZZ
λ> execute prog
AabcZZZZZ
Но я не доволен. На мой взгляд, этот код повторяется. Я должен определить, как проходить через мой AST каждый раз, когда я хочу его изучить, или определить такие функции, как my project, которые дают мне представление о нем. Я должен сделать то же самое, когда хочу изменить дерево.
Итак, мой вопрос: этот подход мой единственный вариант? Могу ли я сопоставлять шаблоны с моим АСТ, не имея дело с тоннами гнездования? Могу ли я перемещаться по дереву последовательным и общим образом (возможно, молния, или траверс, или что-то еще)? Какие подходы обычно принимаются здесь?
Весь файл находится ниже:
{-# 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 [email protected](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 [email protected](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 [email protected](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