Разбор с 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))"