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表达式的第三个参数。

我按如下方式构建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

上面的第一个测试成功，但是第二个失败。之所以失败，是因为在第一个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 King）在评论中指出的那样，将解析与评估分开是一种标准做法。

但是，为了解决当前问题，在这里可以以惯用方式进行评估时进行评估。关键点如下：没有任何上下文相关规则的词法作用域只需要Reader monad，就可以进行范围/类型检查和评估。原因在于“词汇”属性：纯嵌套的作用域对作用域结构的其他分支没有副作用，因此，状态中不应携带任何东西。因此，最好摆脱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用于建立局部词汇范围吗？

1 个答案: