与Haskell/Megaparsec解析:建立本地词汇范围的股份

Question

因此，我正在尝试执行标准"为自己的方案语言写解析器"练习，以找出Megaparsec和Monad Transformers。按照许多教程和博客文章的建议，我正在使用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来说，这似乎是一个很好的用例；允许我一次建立本地范围。然后，解析了所有新绑定后，我可以通过local。

我构建我的单声ad变压器堆栈如下：

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的 CC_16的绑定被带到第二个let*表达式中。我需要一种方法，使该可变状态 local 纳入所讨论的计算，这就是我无法弄清楚该怎么做的。是否有一个类似物local Reader的命令用于State？我使用错误的单声ad变压器堆栈吗？我的方法根本存在缺陷吗？

我尝试过的幼稚（回顾）解决方案是通过向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单元，以进行范围/类型检查和评估。原因在于"词汇"属性：纯粹的嵌套范围对范围结构的其他分支没有副作用，因此在一个状态下不应携带任何东西。因此，最好摆脱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))"