我正在学习如何在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"
答案 0 :(得分:4)
pZeroOrMore
功能没有停止条件。即使没有解析,行pIf p (arr (\b -> [b])) (pConst [])
始终会返回Right ...
。这意味着总是执行递归调用first (pZeroOrMore p)
,因此无限循环。