递归到 Haskell 中尚不存在的函数

如何解决递归到 Haskell 中尚不存在的函数

我在用 Haskell 编写解析器时遇到了问题，希望有人能帮忙解决！

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

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

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

语言定义可能定义一种语言由三个顺序的关键字和括号中的可选递归组成。

A B C ($RECURSE)

将被解析为 AST 如下：

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

Many 在这个例子中并不是真正需要的，但在我的实际项目中，可选块可以有多个语法元素，所以 Optional 将包含一个带有 Many >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",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

处的无限循环问题（整合了以下答案中的优秀建议）

解决方法

我相信你可以在这里使用懒惰。将 final 解析器作为参数传递给 transformSyntaxExprToParser，当您看到 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)

这应该产生与您直接编写的完全相同的递归解析器。 Parser 最终只是一种数据结构，您可以使用其 Monad、Applicative、Alternative 和 c 的实例来构造。

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

你的想法几乎是正确的：

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

问题是您正在为每个 Recurse 构建一个 新 解析器，来自相同的输入，其中包含一个 Recurse，从而构建一个新的解析器……等等在。我上面的代码所做的只是传入相同解析器。

如果您在构造解析器时需要执行 monadic 副作用，例如日志记录，那么您可以使用递归 do，例如，带有一些假设的 MonadLog插图类：

{-# Language RecursiveDo #-}

transformSyntaxExprToParser :: (MonadLog m) => Parser [Text] -> SyntaxAst -> m (Parser [Text])
transformSyntaxExprToParser self = go
  where
    go (Keyword text) = do
      logMessage "Got ‘Keyword’"
      pure $ dbg "Keyword" (pure <$> lexeme (string' text))
    go (Optional inner) = do
      logMessage "Got ‘Optional’"
      inner' <- go inner
      pure $ dbg "Optional" (option [] (try (inParens inner')))
    go Recurse = do
      logMessage "Got ‘Recurse’"
      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 块引入了一个递归绑定，您可以使用副作用构造它。一般来说，需要注意确保像这样的递归定义足够懒惰，也就是说，您不会比预期更快地强制结果，但这里的递归模式非常简单，您从不检查 {{1} } 解析器，只把它当成一个黑盒子来挂接其他解析器。

此方法还明确了 self 的作用域是什么，并开启了引入本地递归解析器的可能性，使用新的本地 Recurse 对 transformSyntaxExprToParser 进行新调用论证。