Boucle infinie lors de l'implémentation de "zéro ou plus" dans l'analyseur Haskell Arrow

Question

J'apprends à utiliser les flèches dans Haskell et j'ai implémenté l'analyseur suivant.

Tous les tests fonctionnent très bien, sauf pour les deux derniers essais:

test (pZeroOrMore pDigit) "x123abc" 
test (pZeroOrMore pDigit) "123abc" 

Ces tests se coincer dans une boucle infinie. La question est pourquoi? Pour autant que je puisse voir, cela devrait fonctionner?

{-# LANGUAGE Arrows #-} 

module Code.ArrowParser where 

import Control.Arrow 
import Control.Category 

import Data.Char 

import Prelude hiding (id,(.)) 

--------------------------------------------------------------------- 

data Parser a b = Parser { runParser :: (a,String) -> Either (String,String) (b,String) } 

--------------------------------------------------------------------- 

instance Category Parser where 
    id = Parser Right 

    (Parser bc) . (Parser ab) = Parser $ \a -> 
     case ab a of 
      Left es -> Left es 
      Right b -> bc b 

--------------------------------------------------------------------- 

instance Arrow Parser where 
    arr ab = Parser $ \(a,s) -> Right (ab a,s) 

    first (Parser ab) = Parser $ \((a,c),as) -> 
     case ab (a,as) of 
      Left es  -> Left  es 
      Right (b,bs) -> Right ((b,c),bs) 

--------------------------------------------------------------------- 

pChar :: Char -> Parser a Char 

pChar c = 
    pMatch (== c) ("'" ++ [c] ++ "' expected") 

--------------------------------------------------------------------- 

pConst :: a -> Parser x a 

pConst a = arr (\_ -> a) 

--------------------------------------------------------------------- 

pDigit :: Parser a Int 

pDigit = 
    pMatch isDigit ("Digit expected") >>> arr (\c -> ord c - ord '0') 

--------------------------------------------------------------------- 

pError :: String -> Parser a() 

pError e = Parser $ \(_,s) -> Left (e,s) 

--------------------------------------------------------------------- 

pIf :: Parser a b -> Parser b c -> Parser a c -> Parser a c 

pIf (Parser pc) (Parser pt) (Parser pf) = Parser $ \(a,as) -> 
    case pc (a,as) of 
     Right (b,bs) -> pt (b,bs) 
     Left _  -> pf (a,as) 

--------------------------------------------------------------------- 

pMatch :: (Char -> Bool) -> String -> Parser a Char 

pMatch f e = Parser $ \(_,s) -> 
    if s /= [] && f (head s) then 
     Right (head s,tail s) 
    else 
     Left (e, s) 

--------------------------------------------------------------------- 

pMaybe :: (Char -> Maybe b) -> String -> Parser a b 

pMaybe f e = Parser $ \(_,s) -> 
    if s == [] then 
     Left (e, s) 
    else 
     case f (head s) of 
      Nothing -> Left (e,s) 
      Just b -> Right (b,tail s) 

--------------------------------------------------------------------- 

pZeroOrMore :: Parser() b -> Parser() [b] 

pZeroOrMore p = 
     pIf p (arr (\b -> [b])) (pConst []) 
    >>> arr ((,)()) 
    >>> first (pZeroOrMore p) 
    >>> arr (\(b1,b0) -> b0 ++ b1) 

--------------------------------------------------------------------- 

test :: Show a => Parser() a -> String -> IO() 

test p s = 
    print $ runParser p ((),s) 

--------------------------------------------------------------------- 

arMain :: IO() 

arMain = do 
    test (pChar 'a') "abcdef" 
    test (pChar 'b') "abcdef" 
    test pDigit "54321" 
    test (pIf (pChar 'a') (pChar 'b') (pChar 'c')) "abc" 
    test (pIf (pChar 'a') (pChar 'b') (pChar 'c')) "bc" 
    test (pIf (pChar 'a') (pChar 'b') (pChar 'c')) "c" 
    test (pError "Error!" >>> pChar 'a') "abc" 
    test (pZeroOrMore pDigit) "x123abc" 
    test (pZeroOrMore pDigit) "123abc" 

Answer 1

Il n'y a pas de condition d'arrêt sur votre fonction pZeroOrMore. La ligne pIf p (arr (\b -> [b])) (pConst []) renvoie toujours Right ... même s'il n'y a pas d'analyse. Ce qui signifie que l'appel récursif first (pZeroOrMore p) est toujours exécuté, donc la boucle infinie.