4

我被困在用 Haskell 编写解析器的问题上，希望有人能提供帮助！

它比我通常的解析器要复杂一些，因为有两层解析。首先将语言定义解析为 AST，然后将该 AST 转换为解析实际语言的另一个解析器。

到目前为止，我已经取得了不错的进展，但我坚持在语言定义中实现递归。由于语言定义从 AST 转换为递归函数中的解析器，因此如果它还不存在，我无法弄清楚它如何调用自身。

我发现解释我的问题有点困难，所以也许举个例子会有所帮助。

语言定义可能定义一种语言由三个按顺序排列的关键字组成，然后是括号中的可选递归。

A B C ($RECURSE)

这将被解析为 AST，如：

[Keyword "A", Keyword "B", Keyword "C", Optional (Many [Recurse])]

这个Many例子并不是真正需要的，但在我的实际项目中，可选块中可以有多个语法元素，因此 anOptional将包含 aMany和n 个元素。

然后我希望它被转换为解析字符串的解析器，例如：

A B C
A B C (A B C)
A B C (A B C (A B C))

我已将我的项目简化为最简单的示例。您可以看到我的 TODO 评论，我在尝试实现递归时遇到了困难。

{-# LANGUAGE OverloadedStrings #-}

module Example
  ( runExample,
  )
where

import Control.Applicative hiding (many, some)
import Data.Text (Text)
import Data.Void
import System.IO as SIO
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char (space1, string')
import qualified Text.Megaparsec.Char.Lexer as L
import Text.Megaparsec.Debug
import Text.Pretty.Simple (pPrint)

-- Types

type Parser = Parsec Void Text

data SyntaxAst = Keyword Text | Recurse | Optional SyntaxAst | Many [SyntaxAst]

--  Megaparsec Base Parsers

-- Space consumer - used by other parsers to ignore whitespace
sc :: Parser ()
sc =
  L.space
    space1
    (L.skipLineComment "--")
    (L.skipBlockComment "/*" "*/")

-- Runs a parser, then consumes any left over space with sc
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc

-- Parses a string, then consumes any left over space with sc
symbol :: Text -> Parser Text
symbol = L.symbol sc

-- Parses something between parentheses
inParens :: Parser a -> Parser a
inParens =
  between
    (symbol "(")
    (symbol ")")

-- Transforms the AST into a parser
transformSyntaxExprToParser :: SyntaxAst -> Parser [Text]
transformSyntaxExprToParser (Many exprs) = dbg "Many" (createParser exprs)
transformSyntaxExprToParser (Keyword text) = dbg "Keyword" (pure <$> lexeme (string' text))
transformSyntaxExprToParser (Optional inner) = dbg "Optional" (option [] (try (inParens (transformSyntaxExprToParser inner))))
transformSyntaxExprToParser Recurse = dbg "Recurse" (pure ["TODO"]) -- TODO: How do I recurse here?
-- transformSyntaxExprToParser s Recurse = dbg "Recurse" (createParser s) -- Seems to work in the example, but in my actual application creates an infinite loop and freezes

-- Walks over the parser AST and convert it to a parser
createParser :: [SyntaxAst] -> Parser [Text]
createParser expressions =
  do
    foldr1 (liftA2 (<>)) (fmap transformSyntaxExprToParser expressions)

runExample :: IO ()
runExample = do
  -- To make the example simple, lets cut out the language definition parsing and just define
  -- it literally.
  let languageParser = createParser [Keyword "A", Keyword "B", Keyword "C", Optional (Many [Recurse])]
  let run p = runParser p "" "A B C (A B C (A B C))"
  let result = run languageParser
  case result of
    Left bundle -> SIO.putStrLn (errorBundlePretty bundle)
    Right xs -> pPrint xs

我尝试过的几件事：

  1. 将原始 AST 传递给transformSyntaxExprToParser函数并createParser在Recurse遇到令牌时调用。由于无限循环，这不起作用。
  2. 使用可变引用（如 IORef/STRef）传入一个引用，该引用在转换完成后更新为引用最终解析器。我不知道如何将 IO/ST monad 线程化到解析器转换函数中。
  3. 状态单子。我不知道如何通过 state monad 传递引用。

我希望这是有道理的，如果我需要详细说明，请告诉我。如果有帮助，我也可以推进我的整个项目。

谢谢阅读！

编辑：我对我的原始示例进行了更改，以在https://pastebin.com/DN0JJ9BA上演示无限循环问题（整合下面答案中的优秀建议）

4

1 回答 1

2

我相信你可以在这里使用懒惰。将最终解析器作为参数传递给transformSyntaxExprToParser，当您看到 a 时Recurse，返回该解析器。

transformSyntaxExprToParser :: Parser [Text] -> SyntaxAst -> Parser [Text]
transformSyntaxExprToParser self = go
  where
    go (Keyword text) = dbg "Keyword" (pure <$> lexeme (string' text))
    go (Optional inner) = dbg "Optional" (option [] (try (inParens (go inner))))
    go Recurse = dbg "Recurse" self

createParser :: [SyntaxAst] -> Parser [Text]
createParser expressions = parser
  where
    parser = foldr1 (liftA2 (<>))
      (fmap (transformSyntaxExprToParser parser) expressions)

这应该会产生与您直接编写的完全相同的递归解析器。AParser最终只是一个数据结构，您可以使用它的Monad, Applicative, Alternative, &c 的实例来构建它。

您使用诸如 an 之类的可变引用执行此操作的想法IORef本质上是在构造和评估 thunk 时发生的事情。

您的想法几乎是正确的：

将原始 AST 传递给transformSyntaxExprToParser函数并createParser在Recurse遇到令牌时调用。由于无限循环，这不起作用。

问题是您正在为每个 构造一个新的解析器Recurse，来自相同的输入，其中包含 a Recurse，因此构造了一个新的解析器......等等。我上面的代码所做的只是传递同一个解析器。

如果您需要在构造解析器时执行单子副作用，例如日志记录，那么您可以使用递归do，例如，使用一些假设MonadLog类进行说明：

{-# Language RecursiveDo #-}

transformSyntaxExprToParser :: (MonadLog m) => Parser [Text] -> SyntaxAst -> m (Parser [Text])
transformSyntaxExprToParser self = go
  where
    go (Keyword text) = do
      logMessage "Got ‘Keyword’&quot;
      pure $ dbg "Keyword" (pure <$> lexeme (string' text))
    go (Optional inner) = do
      logMessage "Got ‘Optional’&quot;
      inner' <- go inner
      pure $ dbg "Optional" (option [] (try (inParens inner')))
    go Recurse = do
      logMessage "Got ‘Recurse’&quot;
      pure $ dbg "Recurse" self

createParser :: (MonadFix m, MonadLog m) => [SyntaxAst] -> m (Parser [Text])
createParser expressions = do
  rec
    parser <- fmap (foldr1 (liftA2 (<>)))
      (traverse (transformSyntaxExprToParser parser) expressions)
  pure parser

该rec块引入了一个递归绑定，您可以使用副作用构建它。一般来说，需要注意确保像这样的递归定义足够懒惰，也就是说，你不会比预期更早地强制结果，但这里的递归模式非常简单，你从不检查self解析器，只处理它作为一个黑匣子连接到其他解析器。

此方法还明确了 a 的范围Recurse，并打开了引入本地递归解析器的可能性，新调用transformSyntaxExprToParser带有新的本地self参数。

于 2021-06-10T18:48:08.177 回答