我正在上data61的课程：https://github.com/data61/fp-course。在解析器一中，以下实现将导致parse (list1 (character *> valueParser 'v')) "abc"堆栈溢出。

现有代码：

data List t =
  Nil
  | t :. List t
  deriving (Eq,Ord)

-- Right-associative
infixr 5 :.

type Input = Chars

data ParseResult a =
    UnexpectedEof
  | ExpectedEof Input
  | UnexpectedChar Char
  | UnexpectedString Chars
  | Result Input a
  deriving Eq

instance Show a => Show (ParseResult a) where
  show UnexpectedEof =
    "Unexpected end of stream"
  show (ExpectedEof i) =
    stringconcat ["Expected end of stream,but got >",show i,"<"]
  show (UnexpectedChar c) =
    stringconcat ["Unexpected character: ",show [c]]
  show (UnexpectedString s) =
    stringconcat ["Unexpected string: ",show s]
  show (Result i a) =
    stringconcat ["Result >",hlist i,"< ",show a]

instance Functor ParseResult where
  _ <$> UnexpectedEof =
    UnexpectedEof
  _ <$> ExpectedEof i =
    ExpectedEof i
  _ <$> UnexpectedChar c =
    UnexpectedChar c
  _ <$> UnexpectedString s =
    UnexpectedString s
  f <$> Result i a =
    Result i (f a)

-- Function to determine is a parse result is an error.
isErrorResult ::
  ParseResult a
  -> Bool
isErrorResult (Result _ _) =
  False
isErrorResult UnexpectedEof =
  True
isErrorResult (ExpectedEof _) =
  True
isErrorResult (UnexpectedChar _) =
  True
isErrorResult (UnexpectedString _) =
  True

-- | Runs the given function on a successful parse result. Otherwise return the same failing parse result.
onResult ::
  ParseResult a
  -> (Input -> a -> ParseResult b)
  -> ParseResult b
onResult UnexpectedEof _ = 
  UnexpectedEof
onResult (ExpectedEof i) _ = 
  ExpectedEof i
onResult (UnexpectedChar c) _ = 
  UnexpectedChar c
onResult (UnexpectedString s)  _ = 
  UnexpectedString s
onResult (Result i a) k = 
  k i a

data Parser a = P (Input -> ParseResult a)

parse ::
  Parser a
  -> Input
  -> ParseResult a
parse (P p) =
  p

-- | Produces a parser that always fails with @UnexpectedChar@ using the given character.
unexpectedCharParser ::
  Char
  -> Parser a
unexpectedCharParser c =
  P (\_ -> UnexpectedChar c)

--- | Return a parser that always returns the given parse result.
---
--- >>> isErrorResult (parse (constantParser UnexpectedEof) "abc")
--- True
constantParser ::
  ParseResult a
  -> Parser a
constantParser =
  P . const

-- | Return a parser that succeeds with a character off the input or fails with an error if the input is empty.
--
-- >>> parse character "abc"
-- Result >bc< 'a'
--
-- >>> isErrorResult (parse character "")
-- True
character ::
  Parser Char
character = P p
  where p Nil = UnexpectedString Nil
        p (a :. as) = Result as a

-- | Parsers can map.
-- Write a Functor instance for a @Parser@.
--
-- >>> parse (toUpper <$> character) "amz"
-- Result >mz< 'A'
instance Functor Parser where
  (<$>) ::
    (a -> b)
    -> Parser a
    -> Parser b
  f <$> P p = P p'
    where p' input = f <$> p input 

-- | Return a parser that always succeeds with the given value and consumes no input.
--
-- >>> parse (valueParser 3) "abc"
-- Result >abc< 3
valueParser ::
  a
  -> Parser a
valueParser a = P p
  where p input = Result input a

-- | Return a parser that tries the first parser for a successful value.
--
--   * If the first parser succeeds then use this parser.
--
--   * If the first parser fails,try the second parser.
--
-- >>> parse (character ||| valueParser 'v') ""
-- Result >< 'v'
--
-- >>> parse (constantParser UnexpectedEof ||| valueParser 'v') ""
-- Result >< 'v'
--
-- >>> parse (character ||| valueParser 'v') "abc"
-- Result >bc< 'a'
--
-- >>> parse (constantParser UnexpectedEof ||| valueParser 'v') "abc"
-- Result >abc< 'v'
(|||) ::
  Parser a
  -> Parser a
  -> Parser a
P a ||| P b = P c
  where c input
          | isErrorResult resultA = b input
          | otherwise = resultA
            where resultA = a input

infixl 3 |||

我的代码：

instance Monad Parser where
  (=<<) ::
    (a -> Parser b)
    -> Parser a
    -> Parser b
  f =<< P a = P p
    where p input = onResult (a input) (\i r -> parse (f r) i)

instance Applicative Parser where
  (<*>) ::
    Parser (a -> b)
    -> Parser a
    -> Parser b
  P f <*> P a = P b
    where b input = onResult (f input) (\i f' -> f' <$> a i)

list ::
  Parser a
  -> Parser (List a)
list p = list1 p ||| pure Nil

list1 ::
  Parser a
  -> Parser (List a)
list1 p = (:.) <$> p <*> list p

但是，如果我将list更改为不使用list1，或在=<<中使用list1，则效果很好。如果<*>使用=<<，它也可以工作。我觉得这可能与尾递归有关。

更新：

如果我在这里使用惰性模式匹配

  P f <*> ~(P a) = P b
    where b input = onResult (f input) (\i f' -> f' <$> a i)

工作正常。问题是这里的模式匹配。我不明白...请帮助！