0

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

1 回答 1

4

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

于 2014-06-16T15:48:44.783 回答