public
Created

Space-efficient, composable list transformers

  • Download Gist
gistfile1.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 77 78 79 80
 
{-----------------------------------------------------------------------------
Re: Space-efficient, composable list transformers
A version of ListTo
that can handle lazy results and sequential compositon.
See http://article.gmane.org/gmane.comp.lang.haskell.cafe/95027
and follow-up discussion.
------------------------------------------------------------------------------}
{-# LANGUAGE GADTs #-}
 
import Control.Applicative
import Control.Arrow (first,second)
 
-- representation of functions [a] -> b
data ListTo a b where
CaseOf :: b -> (a -> ListTo a b) -> ListTo a b
Fmap :: (b -> c) -> ListTo a b -> ListTo a c
FmapCons :: b -> ListTo a [b] -> ListTo a [b]
 
caseOf = CaseOf
 
-- from Control.Monad.Instances
-- instance Functor ((->) a) where fmap = (.)
 
-- interpreter homomorphism
interpret :: ListTo a b -> ([a] -> b)
interpret (Fmap f g) = fmap f (interpret g)
interpret (FmapCons x g) = fmap (x:) (interpret g)
interpret (CaseOf nil cons) = \ys -> case ys of
[] -> nil
(x:xs) -> interpret (cons x) xs
 
-- functor instance
instance Functor (ListTo a) where
fmap f = normalize . Fmap f
 
normalize :: ListTo a b -> ListTo a b
normalize (Fmap a (Fmap b c)) = normalize $ Fmap (a . b) c
normalize x = x
 
-- sequential composition
-- interpret (a <. b) = interpret $ interpret a <$> b
(<.) :: ListTo b c -> ListTo a [b] -> ListTo a c
(CaseOf _ cons) <. (FmapCons y b) = cons y <. b
(Fmap f a) <. (FmapCons y b) = Fmap f $ a <. (FmapCons y b)
(FmapCons x a) <. (FmapCons y b) = FmapCons x $ a <. (FmapCons y b)
a <. (CaseOf nil cons) = CaseOf (interpret a nil) ((a <.) . cons)
a <. (Fmap f b) = fmap (interpret a . f) b
 
-- applicative instance, lock-step evaluation
instance Applicative (ListTo a) where
pure b = fmap (const b) $ caseOf b (const $ pure b)
f <*> x = fmap (uncurry ($)) $ pair f x
 
pair :: ListTo a b -> ListTo a c -> ListTo a (b,c)
pair (CaseOf a1 b1) (CaseOf a2 b2) = CaseOf (a1,a2) (\x -> pair (b1 x) (b2 x))
pair (Fmap f b) c = fmap (first f) (pair b c)
pair b (Fmap f c) = fmap (second f) (pair b c)
pair (FmapCons x b) c = pair (Fmap (x:) b) c
pair b (FmapCons x c) = pair b (Fmap (x:) c)
 
-- examples
idL :: ListTo a [a]
idL = caseOf [] $ \x -> FmapCons x idL
 
takeL :: Int -> ListTo a [a]
takeL 0 = pure []
takeL n = caseOf [] $ \x -> FmapCons x $ takeL (n-1)
 
andL :: ListTo Bool Bool
andL = caseOf True $ \b -> (\c -> if b then c else False) <$> andL
 
testId = interpret idL [1..]
testTake = interpret (takeL 20) [1..]
testAnd = interpret andL (True:False:undefined)
testTwoAnd = interpret $ liftA2 (,) (andL <. takeL 3) (andL <. idL)
 
-- > testTwoAnd [True,True,True,False]
-- (True,False)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.