public
Created

  • Download Gist
ChurchList.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
{-# LANGUAGE RankNTypes #-}
module ChurchList where
 
import Data.Monoid
import Prelude hiding (zipWith)
 
-- church encoding for pairs
newtype ChurchPair a b = CP { runCP :: forall c. (a -> b -> c) -> c }
 
comma :: a -> b -> ChurchPair a b
comma a b = CP $ \c -> c a b
 
toPair :: ChurchPair a b -> (a,b)
toPair (CP cuncurry) = cuncurry (,)
 
fromPair :: (a,b) -> ChurchPair a b
fromPair = uncurry comma
 
instance Functor (ChurchPair a) where
fmap f (CP cuncurry) = CP $ \c -> cuncurry $ \a -> c a . f
 
instance Monoid a => Monad (ChurchPair a) where
return = comma mempty
(CP cuncurry) >>= f = CP $ \c -> cuncurry $ \a b -> f b `runCP` (c . mappend a)
 
-- church encoding for maybe
newtype ChurchMaybe a = CM { runCM :: forall b. b -> (a -> b) -> b }
 
nothing :: ChurchMaybe a
nothing = CM $ \n j -> n
 
just :: a -> ChurchMaybe a
just a = CM $ \n j -> j a
 
toMaybe :: ChurchMaybe a -> Maybe a
toMaybe (CM cmaybe) = cmaybe Nothing Just
 
fromMaybe :: Maybe a -> ChurchMaybe a
fromMaybe = maybe nothing just
 
instance Functor ChurchMaybe where
fmap f (CM cmaybe) = CM $ \n j -> cmaybe n (j.f)
 
instance Monad ChurchMaybe where
return = just
(CM cmaybe) >>= f = CM $ \n j -> cmaybe n $ \a -> runCM (f a) n j
 
-- church encoding for list
newtype ChurchList a = CL { runCL :: forall b. (a -> b -> b) -> b -> b }
 
nil :: ChurchList a
nil = CL $ \c n -> n
 
cons :: a -> ChurchList a -> ChurchList a
cons a (CL cfoldr) = CL $ \c n -> c a $ cfoldr c n
 
toList :: ChurchList a -> [a]
toList (CL cfoldr) = cfoldr (:) []
 
fromList :: [a] -> ChurchList a
fromList = foldr cons nil
 
instance Functor ChurchList where
fmap f (CL cfoldr) = CL $ \c n -> cfoldr (c.f) n
 
instance Monad ChurchList where
return a = cons a nil
(CL cfoldr) >>= f = CL $ \c n -> cfoldr (\a b -> runCL (f a) c b) n
 
uncons :: ChurchList a -> ChurchMaybe (ChurchPair a (ChurchList a))
uncons (CL cfoldr) = cfoldr (\a (CM cmaybe) -> just . comma a . cmaybe nil $ \(CP cuncurry) -> cuncurry cons) nothing
 
zipWith :: (a -> b -> c) -> ChurchList a -> ChurchList b -> ChurchList c
zipWith f as bs = runCM (uncons as) nil . flip runCP $ \a as' ->
runCM (uncons bs) nil . flip runCP $ \b bs' ->
f a b `cons` zipWith f as' bs'

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.