[Haskell-cafe] Combining stream and list fusion

Bas van Dijk v.dijk.bas at gmail.com
Fri Oct 7 16:28:17 CEST 2011


Hello,

I'm trying to make the following faster:

Data.Vector.Generic.fromList list

where 'list' is some expression yielding a list.

(For example: map (+1) $ map (*2) [1..1000000])

Note that Data.Vector.Generic.fromList is defined as:

fromList :: Vector v a => [a] -> v a
{-# INLINE fromList #-}
fromList = unstream . Stream.fromList

where Stream.fromList is defined in Data.Vector.Fusion.Stream as:

fromList :: [a] -> Stream a
{-# INLINE fromList #-}
fromList = M.fromList

where M.fromList is defined in Data.Vector.Fusion.Stream.Monadic as:

fromList :: Monad m => [a] -> Stream m a
{-# INLINE fromList #-}
fromList xs = unsafeFromList Unknown xs

where unsafeFromList is defined as:

unsafeFromList :: Monad m => Size -> [a] -> Stream m a
{-# INLINE_STREAM unsafeFromList #-}
unsafeFromList sz xs = Stream step xs sz
  where
    step (x:xs) = return (Yield x xs)
    step []     = return Done

I would like to fuse the construction of the list with the
construction of the stream as in:

import GHC.Base ( build )

 {-# RULES
"unsafeFromList/build"
  forall sz (g :: forall b. (a -> b -> b) -> b -> b).
  unsafeFromList sz (build g) = unsafeFromListF sz g
  #-}

unsafeFromListF :: forall m a. Monad m
                => Size
                -> (forall b. (a -> b -> b) -> b -> b)
                -> Stream m a
{-# INLINE unsafeFromListF #-}
unsafeFromListF sz g = Stream step st sz
    where
      St step st = g c z

      c :: a -> St m a -> St m a
      c x st = St (\(St s st') -> s st')
                  (St (\s -> return (Yield x s)) st)

      z :: St m a
      z = St (\_ -> return Done) undefined -- Ouch!

data St m a = St ((St m a) -> m (Step (St m a) a)) (St m a)

Unfortunately, some initial experiments show that this doesn't make it
faster. Are there ways to improve this? (Bonus points for getting rid
of the undefined!)

Regards,

Bas



More information about the Haskell-Cafe mailing list