4

因此，我正在尝试执行标准的“为自己编写类似方案的语言的解析器”练习来找出 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*表达式的第三个参数 via 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*表达式。我需要一种方法来使这个可变状态成为相关计算的本地化，这是我不知道该怎么做的。是否有来自for的local命令的类似物？我使用了错误的单子变压器堆栈吗？我的方法有根本缺陷吗？ReaderState

我尝试过的天真的（回想起来）解决方案是通过向以下位置添加语句来重置每个let*表达式的可变状态：put Map.emptyletStarExpr

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。

有任何想法吗？

4

1 回答 1

3

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

但是，为了解决当前的问题，可以在此处以惯用的方式在解析时进行评估。关键点如下：没有任何上下文相关规则的词法作用域只需要一个Readermonad，用于范围/类型检查和评估。原因在于“词法”属性：纯嵌套作用域对作用域结构的其他分支没有副作用，因此在状态中不应该携带任何东西。所以最好只是摆脱State.

有趣的部分是letStarExpr。在那里，我们不能再使用many了，因为它不允许我们处理每个键值对上新绑定的名称。相反，我们可以编写一个自定义版本，many用于local在每个递归步骤上绑定一个新名称。在代码示例中，我只是使用fix.

另一个注意事项：lift不应该与mtl;一起使用。的重点mtl是消除大多数升降机。megaparsec出口已经泛化了MonadParsec。下面是megaparsec7.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))"
于 2018-12-20T23:02:10.593 回答