Faster concatMap
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
index 135360e..eb31806 100644 (file)
@@ -13,7 +13,7 @@
 --
 
 module Data.Vector.Fusion.Stream.Monadic (
-  Stream(..), Unf(..), Step(..), SPEC(..),
+  Stream(..), Unf(..), Step(..), Chunk(..), SPEC(..),
 
   simple,
 
@@ -73,13 +73,16 @@ module Data.Vector.Fusion.Stream.Monadic (
 
   -- * Conversions
   toList, fromList, fromListN, unsafeFromList,
-  fromVector, reVector
+  fromVector, reVector, fromVectors, fromVectorStream
 ) where
 
 import Data.Vector.Generic.Base
+import qualified Data.Vector.Generic.Mutable.Base as M
 import Data.Vector.Fusion.Stream.Size
 import Data.Vector.Fusion.Util ( Box(..), delay_inline )
+import Control.Monad.Primitive
 
+import qualified Data.List as List
 import Data.Char      ( ord )
 import GHC.Base       ( unsafeChr )
 import Control.Monad  ( liftM )
@@ -128,6 +131,8 @@ instance Functor (Step s) where
   fmap f (Skip s) = Skip s
   fmap f Done = Done
 
+data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ())
+
 data Unf m a = forall s. Unf (s -> m (Step s a)) s
 
 instance Monad m => Functor (Unf m) where
@@ -137,23 +142,27 @@ instance Monad m => Functor (Unf m) where
       step' s = do r <- step s ; return (fmap f r)
 
 -- | Monadic streams
-data Stream m v a = Stream (Unf m a) (Unf m (Either a (v a))) Size
+data Stream m v a = Stream { sElems  :: Unf m a
+                           , sChunks :: Unf m (Chunk v a)
+                           , sSize   :: Size
+                           }
 
 simple :: Monad m => (s -> m (Step s a)) -> s -> Size -> Stream m v a
 {-# INLINE simple #-}
 simple step s sz = Stream (Unf step s) (Unf step' s) sz
   where
-    step' s = do r <- step s ; return (fmap Left r)
+    step' s = do r <- step s
+                 return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r
 
 -- | 'Size' hint of a 'Stream'
 size :: Stream m v a -> Size
 {-# INLINE size #-}
-size (Stream _ _ sz) = sz
+size = sSize
 
 -- | Attach a 'Size' hint to a 'Stream'
 sized :: Stream m v a -> Size -> Stream m v a
 {-# INLINE_STREAM sized #-}
-sized (Stream p q _) sz = Stream p q sz
+sized s sz = s { sSize = sz }
 
 -- Length
 -- ------
@@ -188,8 +197,20 @@ singleton x = simple (return . step) True (Exact 1)
 
 -- | Replicate a value to a given length
 replicate :: Monad m => Int -> a -> Stream m v a
-{-# INLINE replicate #-}
-replicate n x = replicateM n (return x)
+{-# INLINE_STREAM replicate #-}
+replicate n x = Stream (Unf pstep n) (Unf vstep True) (Exact len)
+  where
+    len = delay_inline max n 0
+
+    {-# INLINE_INNER pstep #-}
+    pstep i | i <= 0    = return Done
+            | otherwise = return $ Yield x (i-1)
+
+    {-# INLINE_INNER vstep #-}
+    vstep True  = return $ Yield (Chunk len (\v -> M.basicSet v x)) False
+    vstep False = return Done
+
+--replicate n x = replicateM n (return x)
 
 -- | Yield a 'Stream' of values obtained by performing the monadic action the
 -- given number of times
@@ -270,7 +291,7 @@ Stream (Unf stepa sa) (Unf vstepa vsa) na
 -- | First element of the 'Stream' or error if empty
 head :: Monad m => Stream m v a -> m a
 {-# INLINE_STREAM head #-}
-head (Stream (Unf step s) _ _) = head_loop SPEC s
+head Stream{sElems = Unf step s} = head_loop SPEC s
   where
     head_loop !sPEC s
       = do
@@ -285,7 +306,7 @@ head (Stream (Unf step s) _ _) = head_loop SPEC s
 -- | Last element of the 'Stream' or error if empty
 last :: Monad m => Stream m v a -> m a
 {-# INLINE_STREAM last #-}
-last (Stream (Unf step s) _ _) = last_loop0 SPEC s
+last Stream{sElems = Unf step s} = last_loop0 SPEC s
   where
     last_loop0 !sPEC s
       = do
@@ -307,8 +328,8 @@ infixl 9 !!
 -- | Element at the given position
 (!!) :: Monad m => Stream m v a -> Int -> m a
 {-# INLINE (!!) #-}
-Stream (Unf step s) _ _ !! i | i < 0     = ERROR "!!" "negative index"
-                             | otherwise = index_loop SPEC s i
+Stream{sElems = Unf step s} !! i | i < 0     = ERROR "!!" "negative index"
+                                 | otherwise = index_loop SPEC s i
   where
     index_loop !sPEC s i
       = i `seq`
@@ -324,7 +345,7 @@ infixl 9 !?
 -- | Element at the given position or 'Nothing' if out of bounds
 (!?) :: Monad m => Stream m v a -> Int -> m (Maybe a)
 {-# INLINE (!?) #-}
-Stream (Unf step s) _ _ !? i = index_loop SPEC s i
+Stream{sElems = Unf step s} !? i = index_loop SPEC s i
   where
     index_loop !sPEC s i
       = i `seq`
@@ -350,7 +371,7 @@ slice i n s = take n (drop i s)
 -- | All but the last element
 init :: Monad m => Stream m v a -> Stream m v a
 {-# INLINE_STREAM init #-}
-init (Stream (Unf step s) _ sz) = simple step' (Nothing, s) (sz - 1)
+init Stream{sElems = Unf step s, sSize = sz} = simple step' (Nothing, s) (sz - 1)
   where
     {-# INLINE_INNER step' #-}
     step' (Nothing, s) = liftM (\r ->
@@ -370,7 +391,7 @@ init (Stream (Unf step s) _ sz) = simple step' (Nothing, s) (sz - 1)
 -- | All but the first element
 tail :: Monad m => Stream m v a -> Stream m v a
 {-# INLINE_STREAM tail #-}
-tail (Stream (Unf step s) _ sz) = simple step' (Left s) (sz - 1)
+tail Stream{sElems = Unf step s, sSize = sz} = simple step' (Left s) (sz - 1)
   where
     {-# INLINE_INNER step' #-}
     step' (Left  s) = liftM (\r ->
@@ -390,7 +411,8 @@ tail (Stream (Unf step s) _ sz) = simple step' (Left s) (sz - 1)
 -- | The first @n@ elements
 take :: Monad m => Int -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM take #-}
-take n (Stream (Unf step s) _ sz) = simple step' (s, 0) (smaller (Exact n) sz)
+take n Stream{sElems = Unf step s, sSize = sz}
+  = simple step' (s, 0) (smaller (Exact n) sz)
   where
     {-# INLINE_INNER step' #-}
     step' (s, i) | i < n = liftM (\r ->
@@ -404,7 +426,8 @@ take n (Stream (Unf step s) _ sz) = simple step' (s, 0) (smaller (Exact n) sz)
 -- | All but the first @n@ elements
 drop :: Monad m => Int -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM drop #-}
-drop n (Stream (Unf step s) _ sz) = simple step' (s, Just n) (sz - Exact n)
+drop n Stream{sElems = Unf step s, sSize = sz}
+  = simple step' (s, Just n) (sz - Exact n)
   where
     {-# INLINE_INNER step' #-}
     step' (s, Just i) | i > 0 = liftM (\r ->
@@ -438,7 +461,7 @@ map f = mapM (return . f)
 -- | Map a monadic function over a 'Stream'
 mapM :: Monad m => (a -> m b) -> Stream m v a -> Stream m v b
 {-# INLINE_STREAM mapM #-}
-mapM f (Stream (Unf step s) _ n) = simple step' s n
+mapM f Stream{sElems = Unf step s, sSize = n} = simple step' s n
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -450,7 +473,7 @@ mapM f (Stream (Unf step s) _ n) = simple step' s n
 
 consume :: Monad m => Stream m v a -> m ()
 {-# INLINE_STREAM consume #-}
-consume (Stream _ (Unf step s) _) = consume_loop SPEC s
+consume Stream {sChunks = Unf step s} = consume_loop SPEC s
   where
     consume_loop !sPEC s
       = do
@@ -469,11 +492,11 @@ mapM_ m = consume . mapM m
 trans :: (Monad m, Monad m') => (forall a. m a -> m' a)
                              -> Stream m v a -> Stream m' v a
 {-# INLINE_STREAM trans #-}
-trans f (Stream (Unf step s) _ n) = simple (f . step) s n
+trans f Stream{sElems = Unf step s, sSize = n} = simple (f . step) s n
 
 unbox :: Monad m => Stream m v (Box a) -> Stream m v a
 {-# INLINE_STREAM unbox #-}
-unbox (Stream (Unf step s) _ n) = simple step' s n
+unbox Stream{sElems = Unf step s, sSize = n} = simple step' s n
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -489,7 +512,7 @@ unbox (Stream (Unf step s) _ n) = simple step' s n
 -- | Pair each element in a 'Stream' with its index
 indexed :: Monad m => Stream m v a -> Stream m v (Int,a)
 {-# INLINE_STREAM indexed #-}
-indexed (Stream (Unf step s) _ n) = simple step' (s,0) n
+indexed Stream{sElems = Unf step s, sSize = n} = simple step' (s,0) n
   where
     {-# INLINE_INNER step' #-}
     step' (s,i) = i `seq`
@@ -504,7 +527,7 @@ indexed (Stream (Unf step s) _ n) = simple step' (s,0) n
 -- and counting down
 indexedR :: Monad m => Int -> Stream m v a -> Stream m v (Int,a)
 {-# INLINE_STREAM indexedR #-}
-indexedR m (Stream (Unf step s) _ n) = simple step' (s,m) n
+indexedR m Stream{sElems = Unf step s, sSize = n} = simple step' (s,m) n
   where
     {-# INLINE_INNER step' #-}
     step' (s,i) = i `seq`
@@ -520,7 +543,8 @@ indexedR m (Stream (Unf step s) _ n) = simple step' (s,m) n
 -- | Zip two 'Stream's with the given monadic function
 zipWithM :: Monad m => (a -> b -> m c) -> Stream m v a -> Stream m v b -> Stream m v c
 {-# INLINE_STREAM zipWithM #-}
-zipWithM f (Stream (Unf stepa sa) _ na) (Stream (Unf stepb sb) _ nb)
+zipWithM f Stream{sElems = Unf stepa sa, sSize = na}
+           Stream{sElems = Unf stepb sb, sSize = nb}
   = simple step (sa, sb, Nothing) (smaller na nb)
   where
     {-# INLINE_INNER step #-}
@@ -555,7 +579,9 @@ zipWithM_ f sa sb = consume (zipWithM f sa sb)
 
 zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m v a -> Stream m v b -> Stream m v c -> Stream m v d
 {-# INLINE_STREAM zipWith3M #-}
-zipWith3M f (Stream (Unf stepa sa) _ na) (Stream (Unf stepb sb) _ nb) (Stream (Unf stepc sc) _ nc)
+zipWith3M f Stream{sElems = Unf stepa sa, sSize = na}
+            Stream{sElems = Unf stepb sb, sSize = nb}
+            Stream{sElems = Unf stepc sc, sSize = nc}
   = simple step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
   where
     {-# INLINE_INNER step #-}
@@ -663,7 +689,7 @@ filter f = filterM (return . f)
 -- | Drop elements which do not satisfy the monadic predicate
 filterM :: Monad m => (a -> m Bool) -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM filterM #-}
-filterM f (Stream (Unf step s) _ n) = simple step' s (toMax n)
+filterM f Stream{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -684,7 +710,7 @@ takeWhile f = takeWhileM (return . f)
 -- | Longest prefix of elements that satisfy the monadic predicate
 takeWhileM :: Monad m => (a -> m Bool) -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM takeWhileM #-}
-takeWhileM f (Stream (Unf step s) _ n) = simple step' s (toMax n)
+takeWhileM f Stream{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -706,7 +732,8 @@ data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
 -- | Drop the longest prefix of elements that satisfy the monadic predicate
 dropWhileM :: Monad m => (a -> m Bool) -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM dropWhileM #-}
-dropWhileM f (Stream (Unf step s) _ n) = simple step' (DropWhile_Drop s) (toMax n)
+dropWhileM f Stream{sElems = Unf step s, sSize = n}
+  = simple step' (DropWhile_Drop s) (toMax n)
   where
     -- NOTE: we jump through hoops here to have only one Yield; local data
     -- declarations would be nice!
@@ -740,7 +767,7 @@ infix 4 `elem`
 -- | Check whether the 'Stream' contains an element
 elem :: (Monad m, Eq a) => a -> Stream m v a -> m Bool
 {-# INLINE_STREAM elem #-}
-elem x (Stream (Unf step s) _ _) = elem_loop SPEC s
+elem x Stream{sElems = Unf step s} = elem_loop SPEC s
   where
     elem_loop !sPEC s
       = do
@@ -767,7 +794,7 @@ find f = findM (return . f)
 -- 'Nothing' if no such element exists.
 findM :: Monad m => (a -> m Bool) -> Stream m v a -> m (Maybe a)
 {-# INLINE_STREAM findM #-}
-findM f (Stream (Unf step s) _ _) = find_loop SPEC s
+findM f Stream{sElems = Unf step s} = find_loop SPEC s
   where
     find_loop !sPEC s
       = do
@@ -790,7 +817,7 @@ findIndex f = findIndexM (return . f)
 -- predicate or 'Nothing' if no such element exists.
 findIndexM :: Monad m => (a -> m Bool) -> Stream m v a -> m (Maybe Int)
 {-# INLINE_STREAM findIndexM #-}
-findIndexM f (Stream (Unf step s) _ _) = findIndex_loop SPEC s 0
+findIndexM f Stream{sElems = Unf step s} = findIndex_loop SPEC s 0
   where
     findIndex_loop !sPEC s i
       = do
@@ -814,7 +841,7 @@ foldl f = foldlM (\a b -> return (f a b))
 -- | Left fold with a monadic operator
 foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE_STREAM foldlM #-}
-foldlM m z (Stream (Unf step s) _ _) = foldlM_loop SPEC z s
+foldlM m z Stream{sElems = Unf step s} = foldlM_loop SPEC z s
   where
     foldlM_loop !sPEC z s
       = do
@@ -829,18 +856,17 @@ foldM :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE foldM #-}
 foldM = foldlM
 
-vfoldlM :: Monad m => (a -> b -> m a) -> (a -> v b -> m a) -> a -> Stream m v b -> m a
+vfoldlM :: Monad m => (a -> Chunk v b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE_STREAM vfoldlM #-}
-vfoldlM p q z (Stream _ (Unf step s) _) = vfoldlM_loop SPEC z s
+vfoldlM f z Stream{sChunks = Unf step s} = vfoldlM_loop SPEC z s
   where
     vfoldlM_loop !sPEC z s
       = do
           r <- step s
           case r of
-            Yield (Left  x) s' -> do { z' <- p z x; vfoldlM_loop SPEC z' s' }
-            Yield (Right v) s' -> do { z' <- q z v; vfoldlM_loop SPEC z' s' }
-            Skip            s' -> vfoldlM_loop SPEC z s'
-            Done               -> return z
+            Yield x s' -> do { z' <- f z x; vfoldlM_loop SPEC z' s' }
+            Skip    s' -> vfoldlM_loop SPEC z s'
+            Done       -> return z
 
 -- | Left fold over a non-empty 'Stream'
 foldl1 :: Monad m => (a -> a -> a) -> Stream m v a -> m a
@@ -850,7 +876,7 @@ foldl1 f = foldl1M (\a b -> return (f a b))
 -- | Left fold over a non-empty 'Stream' with a monadic operator
 foldl1M :: Monad m => (a -> a -> m a) -> Stream m v a -> m a
 {-# INLINE_STREAM foldl1M #-}
-foldl1M f (Stream (Unf step s) _ sz) = foldl1M_loop SPEC s
+foldl1M f Stream{sElems = Unf step s, sSize = sz} = foldl1M_loop SPEC s
   where
     foldl1M_loop !sPEC s
       = do
@@ -873,7 +899,7 @@ foldl' f = foldlM' (\a b -> return (f a b))
 -- | Left fold with a strict accumulator and a monadic operator
 foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE_STREAM foldlM' #-}
-foldlM' m z (Stream (Unf step s) _ _) = foldlM'_loop SPEC z s
+foldlM' m z Stream{sElems = Unf step s} = foldlM'_loop SPEC z s
   where
     foldlM'_loop !sPEC z s
       = z `seq`
@@ -889,18 +915,17 @@ foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE foldM' #-}
 foldM' = foldlM'
 
-vfoldlM' :: Monad m => (a -> b -> m a) -> (a -> v b -> m a) -> a -> Stream m v b -> m a
+vfoldlM' :: Monad m => (a -> Chunk v b -> m a) -> a -> Stream m v b -> m a
 {-# INLINE_STREAM vfoldlM' #-}
-vfoldlM' p q z (Stream _ (Unf step s) _) = vfoldlM'_loop SPEC z s
+vfoldlM' f z Stream{sChunks = Unf step s} = vfoldlM'_loop SPEC z s
   where
     vfoldlM'_loop !sPEC z s
       = z `seq` do
           r <- step s
           case r of
-            Yield (Left  x) s' -> do { z' <- p z x; vfoldlM'_loop SPEC z' s' }
-            Yield (Right v) s' -> do { z' <- q z v; vfoldlM'_loop SPEC z' s' }
-            Skip            s' -> vfoldlM'_loop SPEC z s'
-            Done               -> return z
+            Yield x s' -> do { z' <- f z x; vfoldlM'_loop SPEC z' s' }
+            Skip    s' -> vfoldlM'_loop SPEC z s'
+            Done       -> return z
 
 -- | Left fold over a non-empty 'Stream' with a strict accumulator
 foldl1' :: Monad m => (a -> a -> a) -> Stream m v a -> m a
@@ -911,7 +936,7 @@ foldl1' f = foldl1M' (\a b -> return (f a b))
 -- monadic operator
 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m v a -> m a
 {-# INLINE_STREAM foldl1M' #-}
-foldl1M' f (Stream (Unf step s) _ sz) = foldl1M'_loop SPEC s
+foldl1M' f Stream{sElems = Unf step s, sSize = sz} = foldl1M'_loop SPEC s
   where
     foldl1M'_loop !sPEC s
       = do
@@ -934,7 +959,7 @@ foldr f = foldrM (\a b -> return (f a b))
 -- | Right fold with a monadic operator
 foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m v a -> m b
 {-# INLINE_STREAM foldrM #-}
-foldrM f z (Stream (Unf step s) _ _) = foldrM_loop SPEC s
+foldrM f z Stream{sElems = Unf step s} = foldrM_loop SPEC s
   where
     foldrM_loop !sPEC s
       = do
@@ -952,7 +977,7 @@ foldr1 f = foldr1M (\a b -> return (f a b))
 -- | Right fold over a non-empty stream with a monadic operator
 foldr1M :: Monad m => (a -> a -> m a) -> Stream m v a -> m a
 {-# INLINE_STREAM foldr1M #-}
-foldr1M f (Stream (Unf step s) _ _) = foldr1M_loop0 SPEC s
+foldr1M f Stream{sElems = Unf step s} = foldr1M_loop0 SPEC s
   where
     foldr1M_loop0 !sPEC s
       = do
@@ -975,7 +1000,7 @@ foldr1M f (Stream (Unf step s) _ _) = foldr1M_loop0 SPEC s
 
 and :: Monad m => Stream m v Bool -> m Bool
 {-# INLINE_STREAM and #-}
-and (Stream (Unf step s) _ _) = and_loop SPEC s
+and Stream{sElems = Unf step s} = and_loop SPEC s
   where
     and_loop !sPEC s
       = do
@@ -988,7 +1013,7 @@ and (Stream (Unf step s) _ _) = and_loop SPEC s
 
 or :: Monad m => Stream m v Bool -> m Bool
 {-# INLINE_STREAM or #-}
-or (Stream (Unf step s) _ _) = or_loop SPEC s
+or Stream{sElems = Unf step s} = or_loop SPEC s
   where
     or_loop !sPEC s
       = do
@@ -1005,7 +1030,7 @@ concatMap f = concatMapM (return . f)
 
 concatMapM :: Monad m => (a -> m (Stream m v b)) -> Stream m v a -> Stream m v b
 {-# INLINE_STREAM concatMapM #-}
-concatMapM f (Stream (Unf step s) _ _) = simple concatMap_go (Left s) Unknown
+concatMapM f Stream{sElems = Unf step s} = simple concatMap_go (Left s) Unknown
   where
     concatMap_go (Left s) = do
         r <- step s
@@ -1026,7 +1051,7 @@ concatMapM f (Stream (Unf step s) _ _) = simple concatMap_go (Left s) Unknown
 flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size
                    -> Stream m v a -> Stream m v b
 {-# INLINE_STREAM flatten #-}
-flatten mk istep sz (Stream (Unf ostep t) _ _) = simple step (Left t) sz
+flatten mk istep sz Stream{sElems = Unf ostep t} = simple step (Left t) sz
   where
     {-# INLINE_INNER step #-}
     step (Left t) = do
@@ -1111,7 +1136,7 @@ prescanl f = prescanlM (\a b -> return (f a b))
 -- | Prefix scan with a monadic operator
 prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> Stream m v a
 {-# INLINE_STREAM prescanlM #-}
-prescanlM f z (Stream (Unf step s) _ sz) = simple step' (s,z) sz
+prescanlM f z Stream{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = do
@@ -1131,7 +1156,7 @@ prescanl' f = prescanlM' (\a b -> return (f a b))
 -- | Prefix scan with strict accumulator and a monadic operator
 prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> Stream m v a
 {-# INLINE_STREAM prescanlM' #-}
-prescanlM' f z (Stream (Unf step s) _ sz) = simple step' (s,z) sz
+prescanlM' f z Stream{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
@@ -1152,7 +1177,7 @@ postscanl f = postscanlM (\a b -> return (f a b))
 -- | Suffix scan with a monadic operator
 postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> Stream m v a
 {-# INLINE_STREAM postscanlM #-}
-postscanlM f z (Stream (Unf step s) _ sz) = simple step' (s,z) sz
+postscanlM f z Stream{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = do
@@ -1172,7 +1197,8 @@ postscanl' f = postscanlM' (\a b -> return (f a b))
 -- | Suffix scan with strict acccumulator and a monadic operator
 postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m v b -> Stream m v a
 {-# INLINE_STREAM postscanlM' #-}
-postscanlM' f z (Stream (Unf step s) _ sz) = z `seq` simple step' (s,z) sz
+postscanlM' f z Stream{sElems = Unf step s, sSize = sz}
+  = z `seq` simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
@@ -1213,7 +1239,7 @@ scanl1 f = scanl1M (\x y -> return (f x y))
 -- | Scan over a non-empty 'Stream' with a monadic operator
 scanl1M :: Monad m => (a -> a -> m a) -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM scanl1M #-}
-scanl1M f (Stream (Unf step s) _ sz) = simple step' (s, Nothing) sz
+scanl1M f Stream{sElems = Unf step s, sSize = sz} = simple step' (s, Nothing) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
@@ -1241,7 +1267,8 @@ scanl1' f = scanl1M' (\x y -> return (f x y))
 -- operator
 scanl1M' :: Monad m => (a -> a -> m a) -> Stream m v a -> Stream m v a
 {-# INLINE_STREAM scanl1M' #-}
-scanl1M' f (Stream (Unf step s) _ sz) = simple step' (s, Nothing) sz
+scanl1M' f Stream{sElems = Unf step s, sSize = sz}
+  = simple step' (s, Nothing) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
@@ -1343,11 +1370,28 @@ enumFromTo_small x y = x `seq` y `seq` simple step x (Exact n)
 -- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744
 --
 
-enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m v a
+enumFromTo_int :: forall m v. Monad m => Int -> Int -> Stream m v Int
 {-# INLINE_STREAM enumFromTo_int #-}
 enumFromTo_int x y = x `seq` y `seq` simple step x (Exact (len x y))
   where
     {-# INLINE [0] len #-}
+    len :: Int -> Int -> Int
+    len x y | x > y     = 0
+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
+                          (n > 0)
+                        $ n
+      where
+        n = y-x+1
+
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m v a
+{-# INLINE_STREAM enumFromTo_intlike #-}
+enumFromTo_intlike x y = x `seq` y `seq` simple step x (Exact (len x y))
+  where
+    {-# INLINE [0] len #-}
     len x y | x > y     = 0
             | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
                           (n > 0)
@@ -1367,12 +1411,12 @@ enumFromTo_int x y = x `seq` y `seq` simple step x (Exact (len x y))
 #if WORD_SIZE_IN_BITS > 32
 
 "enumFromTo<Int64> [Stream]"
-  enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m v Int64
+  enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m v Int64
 
 #else
 
 "enumFromTo<Int32> [Stream]"
-  enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m v Int32
+  enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m v Int32
 
 #endif
 
@@ -1554,12 +1598,62 @@ fromVector v = v `seq` n `seq` Stream (Unf step 0) (Unf vstep True) (Exact n)
 
     
     {-# INLINE vstep #-}
-    vstep True  = return (Yield (Right v) False)
+    vstep True  = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)
     vstep False = return Done
 
+fromVectors :: (Monad m, Vector v a) => [v a] -> Stream m v a
+{-# INLINE_STREAM fromVectors #-}
+fromVectors vs = Stream (Unf pstep (Left vs))
+                        (Unf vstep vs)
+                        (Exact n) 
+  where
+    n = List.foldl' (\k v -> k + basicLength v) 0 vs
+
+    pstep (Left []) = return Done
+    pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs)))
+
+    pstep (Right (v,i,vs))
+      | i >= basicLength v = return $ Skip (Left vs)
+      | otherwise          = case basicUnsafeIndexM v i of
+                               Box x -> return $ Yield x (Right (v,i+1,vs))
+
+
+    vstep [] = return Done
+    vstep (v:vs) = return $ Yield (Chunk (basicLength v)
+                                         (\mv -> basicUnsafeCopy mv v)) vs
+
+
+fromVectorStream :: (Monad m, Vector v a) => Stream m u (v a) -> Stream m v a
+{-# INLINE_STREAM fromVectorStream #-}
+fromVectorStream Stream{sElems = Unf step s}
+  = Stream (Unf pstep (Left s))
+           (Unf vstep s)
+           Unknown
+  where
+    pstep (Left s) = do
+      r <- step s
+      case r of
+        Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s')))
+        Skip    s' -> return (Skip (Left s'))
+        Done       -> return Done
+
+    pstep (Right (v,i,s))
+      | i >= basicLength v = return (Skip (Left s))
+      | otherwise          = case basicUnsafeIndexM v i of
+                               Box x -> return (Yield x (Right (v,i+1,s)))
+
+
+    vstep s = do
+      r <- step s
+      case r of
+        Yield v s' -> return (Yield (Chunk (basicLength v)
+                                           (\mv -> basicUnsafeCopy mv v)) s')
+        Skip    s' -> return (Skip s')
+        Done       -> return Done
+
 reVector :: Monad m => Stream m u a -> Stream m v a
 {-# INLINE_STREAM reVector #-}
-reVector (Stream (Unf step s) _ n) = simple step s n
+reVector Stream{sElems = Unf step s, sSize = n} = simple step s n
 
 {-# RULES