使用 Haskell/Megaparsec: StateT 进行解析以构建本地词法范围？

Question

所以我正在尝试做标准的 "write yourself a parser for a scheme-like language" 练习来找出 MegaParsec 和 monad 转换器。根据许多教程和博客文章的建议，我使用 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.

我按如下方式构建我的 monad 转换器堆栈：

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

上面的第一个测试成功，但第二个失败。它失败了，因为在第一个 let* 表达式中持有 x 绑定的可变状态被转移到第二个 let* 表达式。 我需要一种方法使这个可变状态 local 到有问题的计算，这是我不知道该怎么做。是否有来自 Reader 用于 State 的 local 命令的模拟？我使用了错误的 monad 转换器堆栈吗？我的方法是否存在根本性缺陷？

我尝试过的天真的（回想起来）解决方案是通过向 letStarExpr:

添加 put Map.empty 语句来重置每个 let* 表达式的可变状态

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

正如 Alexis King 在评论中指出的那样，将解析与求值分开是标准做法。

但是，为了解决当前的问题，可以在此处以惯用的方式在解析时进行评估。关键点如下：没有任何上下文相关规则的词法范围只需要一个 Reader monad，也用于 scope/type 检查和评估。原因在"lexical" 属性：纯嵌套作用域对作用域结构的其他分支没有副作用，因此状态中不应该携带任何东西。所以最好去掉 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))"

使用 Haskell/Megaparsec: StateT 进行解析以构建本地词法范围？

Parsing with Haskell/Megaparsec: StateT for building up local, lexical scope?

parsing

state

haskell

monad-transformers

megaparsec