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

Question

因此，我试图做一个标准的“为类似于方案的语言编写解析器”的练习，以找出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表达式的第三个参数。

我构建了我的单变压器堆栈，如下所示：

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 用于该计算，这就是我无法解决的问题。local命令中的Reader用于State？是我使用错误的monad转换器堆栈吗?是否存在根本缺陷？

我尝试过的朴素(回溯)解决方案是通过向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

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

然而，为了解决当前的问题，这里可以用惯用的方式在解析过程中进行评估。关键是:在没有任何上下文敏感规则的情况下，词法作用域只需要一个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))"