Переполнение стека двумя функциями, вызывающими друг друга в анализаторе Applicative

Question

Я делаю курс 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)

Это работаетхорошо. Сопоставление с образцом здесь является проблемой. Я не понимаю этого ... Пожалуйста, помогите!

Answer 1

Если я использую сопоставление с ленивым шаблоном P f <*> ~(P a) = ..., то оно работает нормально. Почему?

Этот вопрос обсуждался недавно . Вы также можете исправить это, используя newtype вместо data: newtype Parser a = P (Input -> ParseResult a). (*)

Определение list1 хочет знать оба аргумента синтаксического анализатора для <*> но на самом деле, когда первое не удастся (когда ввод исчерпан), нам не нужно знать второе! Но так как мы навязываем его, он навязывает свой второй аргумент, и тот навязывает свой второй синтаксический анализатор до бесконечности. (**) То есть p потерпит неудачу при исчерпании ввода, но мыиметь list1 p = (:.) <$> p <*> list p, что заставляет list p, даже если он не будет работать, если предыдущий p не удастся. Вот причина бесконечного зацикливания, и почему ваше исправление с ленивым шаблоном работает.

В чем разница между data и newtype с точки зрения лени?

(*) newtype Тип d всегда имеет только один конструктор данных, и сопоставление с образцом для него не на самом деле вызывает значение, поэтому оно неявно похоже на ленивоешаблон. Попробуйте newtype P = P Int, let foo (P i) = 42 in foo undefined и убедитесь, что это работает.

(**) Это происходит, когда синтаксический анализатор еще готов, скомпонован;до того, как комбинированный, составной синтаксический анализатор даже запустится на фактическом вводе. Это означает, что есть еще один, третий способ решения проблемы: определить

list1 p = (:.) <$> p <*> P (\s -> parse (list p) s)

Это должно работать независимо от лени <*> и от того, использовались ли data или newtype.

Интересно, что приведенное выше определение означает, что синтаксический анализатор будет фактически создан во время выполнения, в зависимости от входных данных, которые являются определяющей характеристикой Monad, а не Applicative, которая должна быть заранее известна статически. Но разница здесь в том, что Applicative зависит от скрытого состояния ввода, а не от «возвращаемого» значения.