Разбор с Haskell/Megaparsec: StateT для создания локальной, лексической области видимости?

Question

Поэтому я пытаюсь выполнить стандартное упражнение "напиши себе синтаксический анализатор для языка, похожего на схему", чтобы выяснить преобразователи MegaParsec и монад. Следуя предложениям многих уроков и постов в блоге, я использую ReaderT а также local реализовать лексическую сферу.

Я столкнулся с проблемой, пытаясь реализовать let*, И то и другое let а также let* использовать тот же синтаксис, связывая переменные для использования в последующем выражении. Разница между ними заключается в том, что let* позволяет использовать привязку в последующих, тогда как let нет:

(let ((x 1) (y 2)) (+ x y))       ; 3
(let* ((x 1) (y (+ x x)) (+ x y)) ; 3
(let ((x 1) (y (+ x x)) (+ x y))  ; Error unbound symbol "x"

Моя проблема в том, что при разборе let* В выражении мне нужно добавить привязки к текущей области видимости один за другим, чтобы каждая привязка была доступна для использования в последующих. Это похоже на хороший пример использования StateT; что позволяет мне создавать локальную область видимости по одной привязке за раз. Затем, проанализировав все новые привязки, я могу передать их вместе с наследованными от родительской области видимости третьему аргументу let* выражение, через local,

Я строю свой монадный стек трансформаторов следующим образом:

type Parser = Parsec Void String
type Env = Map.Map String Float
type RSParser = ReaderT Env (StateT Env Parser)

А вот синтаксический анализатор, упрощенный настолько, насколько я мог, все еще делая свою точку зрения. Особенно, Float это единственный тип данных и +, *, а также let* единственные команды.

data Op = Plus | Times

spaceConsumer :: Parser ()
spaceConsumer = Lexer.space space1
                            (Lexer.skipLineComment ";")
                            (Lexer.skipBlockComment "#|" "|#")
lexeme :: Parser a -> RSParser a
lexeme = lift . lift . Lexer.lexeme spaceConsumer

lParen, rParen :: RSParser Char
lParen = lexeme $ char '('
rParen = lexeme $ char ')'

plus, times :: RSParser Op
plus = lexeme $ char '+' $> Plus
times = lexeme $ char '*' $> Times

keyValuePair :: RSParser ()
keyValuePair = between lParen rParen $ do
    state <- get
    name  <- lift . lift $ Lexer.lexeme spaceConsumer (some letterChar)
    x     <- num
    modify (union (fromList [(name, x)]))

keyValuePairs :: RSParser ()
keyValuePairs = between lParen rParen (many keyValuePair) $> ()

num :: RSParser Float
num = lexeme $ Lexer.signed (return ()) Lexer.float

expr, var :: RSParser Float
expr = num <|> var <|> between lParen rParen (arithExpr <|> letStarExpr)
var = do
    env <- ask
    lift . lift $ do
        name <- Lexer.lexeme spaceConsumer (some letterChar)
        case Map.lookup name env of
            Nothing -> mzero
            Just x  -> return x
arithExpr = do
    op   <- (plus <|> times) <?> "operation"
    args <- many (expr <?> "argument")
    return $ case op of
        Plus  -> sum args
        Times -> product args
letStarExpr = lexeme (string "let*") *> do
    keyValuePairs
    bindings <- get
    local (Map.union bindings) expr

main :: IO ()
main = do
    parseTest (runStateT (runReaderT expr (fromList [("x", 1)])) Map.empty)
              "(+ (let* ((x 666.0)) x) x)"
        -- (667.0,fromList [("x",666.0)]) Ok
    parseTest (runStateT (runReaderT expr (fromList [("x", 1)])) Map.empty)
              "(+ (let* ((x 666.0)) x) (let* ((w 0.0)) x))"
        -- (1332.0,fromList [("x",666.0)]) Wrong

Первый тест, приведенный выше, успешен, а второй - неудачен. Это терпит неудачу, потому что изменяемое состояние держит xобязателен в первом let* выражение переносится на второе let* выражение. Мне нужен способ сделать это изменчивое состояние локальным для рассматриваемого вычисления, и это то, что я не могу понять, как это сделать. Есть ли аналог local команда от Reader за State? Я использую неправильный стек монадного трансформатора? Мой подход в корне ошибочный?

Наивное (ретроспективно) решение, которое я пробовал, заключается в сбросе изменяемого состояния на каждом let* выражение путем добавления put Map.empty заявление к letStarExpr:

letStarExpr = lexeme (string "let*") *> do
    keyValuePairs
    bindings <- get
    put Map.empty
    local (Map.union bindings) expr

Но это несовместимо с вложенным let* выражения:

parseTest (runStateT (runReaderT expr (fromList [("x", 1)])) Map.empty)
    (let* ( (x 666.0) (y (let* ((z 3.0)) z)) ) x)

дает 1,0 вместо 666,0.

Есть идеи?

Answer 1

Как отметил в комментариях Алексис Кинг, стандартная практика - отделять анализ от оценки.

Тем не менее, для решения текущего вопроса, здесь можно оценить, анализируя идиоматическим способом. Ключевым моментом является следующее: лексическое определение без каких-либо контекстно-зависимых правил требует только Reader монада, для проверки и оценки объема / типа. Причина кроется в "лексическом" свойстве: чисто вложенные области не имеют побочных эффектов на другие ветви структуры области видимости, поэтому в состоянии не нужно ничего переносить. Так что лучше всего избавиться от State,

Интересная часть letStarExpr, Там мы не можем использовать many больше, потому что это не позволяет нам обрабатывать вновь связанные имена в каждой паре ключ-значение. Вместо этого мы можем написать собственную версию many который использует local связывать новое имя на каждом рекурсивном шаге. В примере кода я просто встроил эту функцию, используя fix,

Еще одна заметка: lift не должны использоваться с mtl; точка mtl это устранить большинство подъемников. megaparsec экспорт уже обобщен MonadParsec, Ниже приведен пример кода с megaparsec 7.0.4, я сделал упомянутые изменения и несколько дальнейших стилистических.

import Control.Monad.Reader
import Data.Map as Map
import Data.Void

import Text.Megaparsec
import qualified Text.Megaparsec.Char as Char
import qualified Text.Megaparsec.Char.Lexer as Lexer

type Env    = Map String Double
type Parser = ReaderT Env (Parsec Void String)

spaceConsumer :: Parser ()
spaceConsumer = Lexer.space Char.space1
                            (Lexer.skipLineComment ";")
                            (Lexer.skipBlockComment "#|" "|#")

lexeme = Lexer.lexeme spaceConsumer
symbol = Lexer.symbol spaceConsumer
char   = lexeme . Char.char

parens :: Parser a -> Parser a
parens = between (char '(') (char ')')

num :: Parser Double
num = lexeme $ Lexer.signed (pure ()) Lexer.float

identifier :: Parser String
identifier = try $ lexeme (some Char.letterChar)

keyValuePair :: Parser (String, Double)
keyValuePair = parens ((,) <$> identifier <*> num)

expr :: Parser Double
expr = num <|> var <|> parens (arithExpr <|> letStarExpr)

var :: Parser Double
var = do
  env  <- ask
  name <- identifier
  maybe mzero pure (Map.lookup name env)

arithExpr :: Parser Double
arithExpr =
      (((sum <$ char '+') <|> (product <$ char '*')) <?> "operation")
  <*> many (expr <?> "argument")

letStarExpr :: Parser Double
letStarExpr = do
  symbol "let*"
  char '('
  fix $ \go ->
        (char ')' *> expr)
    <|> do {(x, n) <- keyValuePair; local (insert x n) go}

main :: IO ()
main = do
    parseTest (runReaderT expr (fromList [("x", 1)]))
              "(+ (let* ((x 666.0)) x) x)"
    parseTest (runReaderT expr (fromList [("x", 1)]))
              "(+ (let* ((x 666.0)) x) (let* ((w 0.0)) x))"