实现"零或更多"时的无限循环在Haskell箭头解析器中

时间:2014-06-16 15:03:13

标签: parsing haskell arrows

我正在学习如何在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"

1 个答案:

答案 0 :(得分:4)

pZeroOrMore功能没有停止条件。即使没有解析,行pIf p (arr (\b -> [b])) (pConst [])始终会返回Right ...。这意味着总是执行递归调用first (pZeroOrMore p),因此无限循环。