Récursion vers une fonction qui n'existe pas encore en Haskell

Question

Je suis bloqué sur un problème d'écriture d'un analyseur syntaxique en Haskell et j'espère que quelqu'un pourra m'aider !

Il est un peu plus compliqué que mon analyseur habituel car il y a deux niveaux d'analyse. D'abord, la définition du langage est analysée dans un AST, puis cet AST est transformé en un autre analyseur qui analyse le langage réel.

J'ai bien avancé jusqu'à présent mais je suis bloqué sur l'implémentation de la récursion dans la définition du langage. Comme la définition du langage est transformée de l'AST en un analyseur syntaxique dans une fonction récursive, je n'arrive pas à comprendre comment elle peut s'appeler elle-même si elle n'existe pas encore.

J'ai un peu de mal à expliquer mon problème, alors peut-être qu'un exemple m'aidera.

La définition du langage peut indiquer qu'un langage se compose de trois mots-clés en séquence, puis d'une récursion optionnelle entre parenthèses.

A B C ($RECURSE)

Ce qui serait analysé dans un AST comme :

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

Le site Many n'est pas vraiment nécessaire pour cet exemple, mais dans mon projet actuel, les blocs optionnels peuvent contenir plusieurs éléments de syntaxe, donc un fichier Optional contiendrait un Many con n éléments.

Je voudrais ensuite qu'il soit transformé en un analyseur syntaxique qui analyse des chaînes de caractères comme :

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

J'ai réduit mon projet à l'exemple le plus simple possible. Vous pouvez voir mon commentaire TODO où je suis coincé en essayant d'implémenter la récursion.

{-# 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

J'ai essayé quelques trucs :

1. Transmettez l'AST original à l transformSyntaxExprToParser et appeler la fonction createParser lorsque le Recurse est rencontré. Cela n'a pas fonctionné à cause des boucles infinies.
2. Utilisation de références mutables comme IORef/STRef pour passer une référence qui est mise à jour pour référencer le parseur final une fois la transformation terminée. Je n'ai pas réussi à trouver comment enfiler les monades IO/ST dans la fonction de transformation du parseur.
3. Monades d'état. Je n'ai pas réussi à trouver comment faire passer une référence par la monade d'état.

J'espère que cela a du sens, faites-moi savoir si j'ai besoin d'en dire plus. Je peux aussi mettre en avant mon projet complet si cela peut aider.

Merci de nous lire !

Edit : J'ai apporté des modifications à mon exemple original pour démontrer le problème de la boucle infinie (en intégrant les excellentes suggestions de la réponse ci-dessous) à l'adresse suivante https://pastebin.com/DN0JJ9BA

Answer 1

Je crois que vous pouvez utiliser la paresse ici. Passez le final en tant que paramètre pour transformSyntaxExprToParser et quand vous voyez un Recurse retourne ce parseur.

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)

Cela devrait produire exactement le même type d'analyseur récursif que si vous l'aviez écrit directement. A Parser n'est finalement qu'une structure de données que vous pouvez construire en utilisant ses instances de Monad , Applicative , Alternative , &c.

Votre idée de faire cela avec une référence mutable telle qu'une IORef est essentiellement ce qui se passe sous le capot de toute façon lors de la construction et l'évaluation d'un thunk.

Votre idée ici était presque correcte :

Transmettez l'AST original à l transformSyntaxExprToParser et appeler la fonction createParser lorsque le Recurse est rencontré. Cela n'a pas fonctionné à cause des boucles infinies.

Le problème est que vous construisiez un nouveau pour chaque Recurse à partir de la même entrée, qui contient un Recurse et construire ainsi un nouveau parseur et ainsi de suite. Ce que mon code ci-dessus fait, c'est de passer dans le fichier même parser.

Si vous devez effectuer des effets secondaires monadiques alors que construire l'analyseur syntaxique, comme la journalisation, alors vous pouvez utiliser une fonction récursive do par exemple, avec une hypothétique MonadLog à titre d'illustration :

{-# 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

Le site rec introduit une liaison récursive que vous pouvez construire en utilisant des effets secondaires. En général, il est nécessaire de s'assurer que les définitions récursives de ce type sont suffisamment paresseuses, c'est-à-dire que vous ne forcez pas le résultat plus tôt que prévu, mais ici le modèle de récursion est très simple, et vous n'examinez jamais le bloc self parser, ne le traitez que comme une boîte noire à connecter à d'autres parseurs.

Cette méthode rend également explicite le champ d'application d'un Recurse est, et ouvre la possibilité d'introduire des analyseurs récursifs locaux, avec un nouvel appel à transformSyntaxExprToParser avec un nouveau local self argument.