-- Church-encoded lists. Used in Twee.CP to make sure that fusion happens.
{-# LANGUAGE Rank2Types, BangPatterns #-}
module Data.ChurchList where

import Prelude(Functor(..), Applicative(..), Monad(..), Bool(..), Maybe(..), (.), ($), id)
import qualified Prelude
import GHC.Magic(oneShot)
import GHC.Exts(build)
import Control.Monad(MonadPlus(..), liftM2)
import Control.Applicative(Alternative(..))

newtype ChurchList a =
  ChurchList (forall b. (a -> b -> b) -> b -> b)

{-# INLINE foldr #-}
foldr :: (a -> b -> b) -> b -> ChurchList a -> b
foldr :: (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
op b
e (ChurchList forall b. (a -> b -> b) -> b -> b
f) = b -> b
forall a. a -> a
eta ((a -> b -> b) -> b -> b
forall b. (a -> b -> b) -> b -> b
f a -> b -> b
op (b -> b
forall a. a -> a
eta b
e))
  -- Using eta here seems to help with eta-expanding foldl'

{-# INLINE[0] eta #-}
eta :: a -> a
eta :: a -> a
eta a
x = a
x
{-# RULES "eta" forall f. eta f = \x -> f x #-}

{-# INLINE nil #-}
nil :: ChurchList a
nil :: ChurchList a
nil = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
_ b
n -> b
n)

{-# INLINE unit #-}
unit :: a -> ChurchList a
unit :: a -> ChurchList a
unit a
x = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
c b
n -> a -> b -> b
c a
x b
n)

{-# INLINE cons #-}
cons :: a -> ChurchList a -> ChurchList a
cons :: a -> ChurchList a -> ChurchList a
cons a
x ChurchList a
xs = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
c b
n -> a -> b -> b
c a
x ((a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
c b
n ChurchList a
xs))

{-# INLINE append #-}
append :: ChurchList a -> ChurchList a -> ChurchList a
append :: ChurchList a -> ChurchList a -> ChurchList a
append ChurchList a
xs ChurchList a
ys = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
c b
n -> (a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
c ((a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
c b
n ChurchList a
ys) ChurchList a
xs)

{-# INLINE join #-}
join :: ChurchList (ChurchList a) -> ChurchList a
join :: ChurchList (ChurchList a) -> ChurchList a
join ChurchList (ChurchList a)
xss = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
c b
n -> (ChurchList a -> b -> b) -> b -> ChurchList (ChurchList a) -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr (\ChurchList a
xs b
ys -> (a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
c b
ys ChurchList a
xs) b
n ChurchList (ChurchList a)
xss)

instance Functor ChurchList where
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> ChurchList a -> ChurchList b
fmap a -> b
f ChurchList a
xs = (forall b. (b -> b -> b) -> b -> b) -> ChurchList b
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\b -> b -> b
c b
n -> (a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr (b -> b -> b
c (b -> b -> b) -> (a -> b) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b
n ChurchList a
xs)

instance Applicative ChurchList where
  {-# INLINE pure #-}
  pure :: a -> ChurchList a
pure = a -> ChurchList a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE (<*>) #-}
  <*> :: ChurchList (a -> b) -> ChurchList a -> ChurchList b
(<*>) = ((a -> b) -> a -> b)
-> ChurchList (a -> b) -> ChurchList a -> ChurchList b
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)

instance Monad ChurchList where
  {-# INLINE return #-}
  return :: a -> ChurchList a
return = a -> ChurchList a
forall a. a -> ChurchList a
unit
  {-# INLINE (>>=) #-}
  ChurchList a
xs >>= :: ChurchList a -> (a -> ChurchList b) -> ChurchList b
>>= a -> ChurchList b
f = ChurchList (ChurchList b) -> ChurchList b
forall a. ChurchList (ChurchList a) -> ChurchList a
join ((a -> ChurchList b) -> ChurchList a -> ChurchList (ChurchList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ChurchList b
f ChurchList a
xs)

instance Alternative ChurchList where
  {-# INLINE empty #-}
  empty :: ChurchList a
empty = ChurchList a
forall a. ChurchList a
nil
  {-# INLINE (<|>) #-}
  <|> :: ChurchList a -> ChurchList a -> ChurchList a
(<|>) = ChurchList a -> ChurchList a -> ChurchList a
forall a. ChurchList a -> ChurchList a -> ChurchList a
append

instance MonadPlus ChurchList where
  {-# INLINE mzero #-}
  mzero :: ChurchList a
mzero = ChurchList a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE mplus #-}
  mplus :: ChurchList a -> ChurchList a -> ChurchList a
mplus = ChurchList a -> ChurchList a -> ChurchList a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

{-# INLINE fromList #-}
fromList :: [a] -> ChurchList a
fromList :: [a] -> ChurchList a
fromList [a]
xs = (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList (\a -> b -> b
c b
n -> (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr a -> b -> b
c b
n [a]
xs)

{-# INLINE toList #-}
toList :: ChurchList a -> [a]
toList :: ChurchList a -> [a]
toList (ChurchList forall b. (a -> b -> b) -> b -> b
f) = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build forall b. (a -> b -> b) -> b -> b
f

{-# INLINE foldl' #-}
foldl' :: (b -> a -> b) -> b -> ChurchList a -> b
foldl' :: (b -> a -> b) -> b -> ChurchList a -> b
foldl' b -> a -> b
op b
e ChurchList a
xs =
  (a -> (b -> b) -> b -> b) -> (b -> b) -> ChurchList a -> b -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr (\a
x b -> b
f -> (b -> b) -> b -> b
oneShot (\ (!b
acc) -> b -> b
f (b -> a -> b
op b
acc a
x))) b -> b
forall a. a -> a
id ChurchList a
xs b
e

{-# INLINE filter #-}
filter :: (a -> Bool) -> ChurchList a -> ChurchList a
filter :: (a -> Bool) -> ChurchList a -> ChurchList a
filter a -> Bool
p ChurchList a
xs =
  (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
ChurchList ((forall b. (a -> b -> b) -> b -> b) -> ChurchList a)
-> (forall b. (a -> b -> b) -> b -> b) -> ChurchList a
forall a b. (a -> b) -> a -> b
$ \a -> b -> b
c b
n ->
    let            
      {-# INLINE op #-}
      op :: a -> b -> b
op a
x b
xs = if a -> Bool
p a
x then a -> b -> b
c a
x b
xs else b
xs
    in
      (a -> b -> b) -> b -> ChurchList a -> b
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr a -> b -> b
op b
n ChurchList a
xs

{-# INLINE fromMaybe #-}
fromMaybe :: Maybe a -> ChurchList a
fromMaybe :: Maybe a -> ChurchList a
fromMaybe Maybe a
Nothing = ChurchList a
forall a. ChurchList a
nil
fromMaybe (Just a
x) = a -> ChurchList a
forall a. a -> ChurchList a
unit a
x

{-# INLINE null #-}
null :: ChurchList a -> Bool
null :: ChurchList a -> Bool
null = (a -> Bool -> Bool) -> Bool -> ChurchList a -> Bool
forall a b. (a -> b -> b) -> b -> ChurchList a -> b
foldr (\a
_ Bool
_ -> Bool
False) Bool
True