Applicative parser stuck in infinite loop

Question

I'm trying to implement my own Applicative parser, here's the code I use:

{-# LANGUAGE ApplicativeDo, LambdaCase #-}

module Parser where

-- Implementation of an Applicative Parser

import Data.Char
import Control.Applicative (some, many, empty, (<*>), (<$>), (<|>), Alternative)

data Parser a = Parser { runParser :: String -> [(a, String)] }

instance Functor Parser where
  -- fmap :: (a -> b) -> (Parser a -> Parser b)
  fmap f (Parser p) = Parser (\s -> [(f a, s') | (a,s') <- p s])

instance Applicative Parser where
  -- pure :: a -> Parser a
  -- <*> :: Parser (a -> b) -> Parser a -> Parser b
  pure x = Parser $ \s -> [(x, s)]
  (Parser pf) <*> (Parser p) = Parser $ \s -> 
               [(f a, s'') | (f, s') <- pf s, (a, s'') <- p s']

instance Alternative Parser where
  -- empty :: Parser a
  -- <|> :: Parser a -> Parser a -> Parser a
  empty = Parser $ \_s -> []
  (Parser p1) <|> (Parser p2) = Parser $ \s ->
      case p1 s of [] -> p2 s
                   xs -> xs

char :: Char -> Parser Char
char c = Parser $ \case (c':cs) | c == c' -> [(c,cs)] ; _ -> []

main = print $ runParser (some $ char 'A') "AAA"

When I run it, it gets stuck and never returns. After digging into the problem I pinpointed the root cause to be my implementation of the <|> method. If I use the following implementation then everything goes as expected:

instance Alternative Parser where
  empty = Parser $ \_s -> []
  p1 <|> p2 = Parser $ \s ->
    case runParser p1 s of [] -> runParser p2 s
                           xs -> xs

These two implementations are, in my understanding, quite equivalent. What I guess is that this may have something to do with Haskell's lazy evaluation scheme. Can someone explain what's going on?

Answer 1

Fact "star": in your implementation of (<*>):

Parser p1 <*> Parser p2 = ...

...we must compute enough to know that both arguments are actually applications of the Parser constructor to something before we may proceed to the right-hand side of the equation.

Fact "pipe strict": in this implementation:

Parser p1 <|> Parser p2 = ...

...we must compute enough to know that both parsers are actually applications of the Parser constructor to something before we may proceed to the right-hand side of the equals sign.

Fact "pipe lazy": in this implementation:

p1 <|> p2 = Parser $ ...

...we may proceed to the right-hand side of the equals sign without doing any computation on p1 or p2.

This is important, because:

some v = some_v where
    some_v = pure (:) <*> v <*> (some_v <|> pure [])

Let's take your first implementation, the one about which we know the "pipe strict" fact. We want to know if some_v is an application of Parser to something. Thanks to fact "star", we must therefore know whether pure (:), v, and some_v <|> pure [] are applications of Parser to something. To know this last one, by fact "pipe strict", we must know whether some_v and pure [] are applications of Parser to something. Whoops! We just showed that to know whether some_v is an application of Parser to something, we need to know whether some_v is an application of Parser to something -- an infinite loop!

On the other hand, with your second implementation, to check whether some_v is a Parser _, we still must check pure (:), v, and some_v <|> pure [], but thanks to fact "pipe lazy", that's all we need to check -- we can be confident that some_v <|> pure [] is a Parser _ without first checking recursively that some_v and pure [] are.

(And next, you will learn about newtype -- and be confused yet again when changing from data to newtype makes both implementation work!)