在Haskell Arrow解析器中實現「零個或多個」時的無限循環

Question

我正在學習如何使用Haskell中的箭頭並實現了以下解析器。

所有測試正常工作除了最後兩項測試：

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

這些測試會卡在一個無限循環。問題是爲什麼？據我所見，它應該可以正常工作？

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

您的pZeroOrMore函數沒有停止條件。即使沒有解析，行pIf p (arr (\b -> [b])) (pConst [])總是返回Right ...。這意味着遞歸調用first (pZeroOrMore p)總是執行，因此是無限循環。