Readd Fusion.Stream.Monadic and use it Bundle.Monadic
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 7 Oct 2012 12:09:50 +0000 (12:09 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 7 Oct 2012 12:09:50 +0000 (12:09 +0000)
Data/Vector/Fusion/Bundle.hs
Data/Vector/Fusion/Bundle/Monadic.hs
Data/Vector/Fusion/Stream/Monadic.hs [new file with mode: 0644]
Data/Vector/Generic/Mutable.hs
vector.cabal

index 0197c4c..a648ee7 100644 (file)
@@ -79,7 +79,8 @@ module Data.Vector.Fusion.Bundle (
 import Data.Vector.Generic.Base ( Vector )
 import Data.Vector.Fusion.Bundle.Size
 import Data.Vector.Fusion.Util
-import Data.Vector.Fusion.Bundle.Monadic ( Step(..), Chunk(..), SPEC(..) )
+import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..) )
+import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) )
 import qualified Data.Vector.Fusion.Bundle.Monadic as M
 
 import Prelude hiding ( length, null,
@@ -124,9 +125,9 @@ inplace f s = s `seq` f s
 -- | Convert a pure stream to a monadic stream
 lift :: Monad m => Bundle v a -> M.Bundle m v a
 {-# INLINE_FUSED lift #-}
-lift (M.Bundle (M.Unf step s) (M.Unf vstep t) v sz)
-    = M.Bundle (M.Unf (return . unId . step) s)
-               (M.Unf (return . unId . vstep) t) v sz
+lift (M.Bundle (Stream step s) (Stream vstep t) v sz)
+    = M.Bundle (Stream (return . unId . step) s)
+               (Stream (return . unId . vstep) t) v sz
 
 -- | 'Size' hint of a 'Bundle'
 size :: Bundle v a -> Size
@@ -583,7 +584,7 @@ toList s = build (\c n -> toListFB c n s)
 -- This supports foldr/build list fusion that GHC implements
 toListFB :: (a -> b -> b) -> b -> Bundle v a -> b
 {-# INLINE [0] toListFB #-}
-toListFB c n M.Bundle{M.sElems = M.Unf step s} = go s
+toListFB c n M.Bundle{M.sElems = Stream step s} = go s
   where
     go s = case unId (step s) of
              Yield x s' -> x `c` go s'
index a487d7f..ad2215d 100644 (file)
@@ -9,13 +9,11 @@
 -- Stability   : experimental
 -- Portability : non-portable
 --
--- Monadic stream combinators.
+-- Monadic bundles.
 --
 
 module Data.Vector.Fusion.Bundle.Monadic (
-  Bundle(..), Unf(..), Step(..), Chunk(..), SPEC(..),
-
-  simple,
+  Bundle(..), Chunk(..),
 
   -- * Size hints
   size, sized,
@@ -55,8 +53,6 @@ module Data.Vector.Fusion.Bundle.Monadic (
   foldl', foldlM', foldl1', foldl1M', foldM', fold1M',
   foldr, foldrM, foldr1, foldr1M,
 
-  vfoldlM, vfoldlM',
-
   -- * Specialised folds
   and, or, concatMapM,
 
@@ -76,13 +72,16 @@ module Data.Vector.Fusion.Bundle.Monadic (
 
   -- * Conversions
   toList, fromList, fromListN, unsafeFromList,
-  fromVector, reVector, fromVectors, concatVectors
+  fromVector, reVector, fromVectors, concatVectors,
+  fromStream, chunks
 ) where
 
 import Data.Vector.Generic.Base
 import qualified Data.Vector.Generic.Mutable.Base as M
 import Data.Vector.Fusion.Bundle.Size
 import Data.Vector.Fusion.Util ( Box(..), delay_inline )
+import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..) )
+import qualified Data.Vector.Fusion.Stream.Monadic as S
 import Control.Monad.Primitive
 
 import qualified Data.List as List
@@ -105,59 +104,28 @@ import Prelude hiding ( length, null,
 import Data.Int  ( Int8, Int16, Int32, Int64 )
 import Data.Word ( Word8, Word16, Word32, Word, Word64 )
 
-#if __GLASGOW_HASKELL__ >= 700
-import GHC.Exts ( SpecConstrAnnotation(..) )
-#endif
-
 #include "vector.h"
 
-data SPEC = SPEC | SPEC2
-#if __GLASGOW_HASKELL__ >= 700
-{-# ANN type SPEC ForceSpecConstr #-}
-#endif
-
-emptyBundle :: String
-{-# NOINLINE emptyBundle #-}
-emptyBundle = "empty stream"
-
-#define EMPTY_STREAM (\s -> ERROR s emptyBundle)
-
--- | Result of taking a single step in a stream
-data Step s a where
-  Yield :: a -> s -> Step s a
-  Skip  :: s -> Step s a
-  Done  :: Step s a
-
-instance Functor (Step s) where
-  {-# INLINE fmap #-}
-  fmap f (Yield x s) = Yield (f x) s
-  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
-  {-# INLINE fmap #-}
-  fmap f (Unf step s) = Unf step' s
-    where
-      step' s = do r <- step s ; return (fmap f r)
-
 -- | Monadic streams
-data Bundle m v a = Bundle { sElems  :: Unf m a
-                           , sChunks :: Unf m (Chunk v a)
+data Bundle m v a = Bundle { sElems  :: Stream m a
+                           , sChunks :: Stream m (Chunk v a)
                            , sVector :: Maybe (v a)
                            , sSize   :: Size
                            }
 
-simple :: Monad m => (s -> m (Step s a)) -> s -> Size -> Bundle m v a
-{-# INLINE simple #-}
-simple step s sz = Bundle (Unf step s) (Unf step' s) Nothing sz
+fromStream :: Monad m => Stream m a -> Size -> Bundle m v a
+{-# INLINE fromStream #-}
+fromStream (Stream step s) sz = Bundle (Stream step s) (Stream step' s) Nothing sz
   where
     step' s = do r <- step s
                  return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r
 
+chunks :: Bundle m v a -> Stream m (Chunk v a)
+{-# INLINE chunks #-}
+chunks = sChunks
+
 -- | 'Size' hint of a 'Bundle'
 size :: Bundle m v a -> Size
 {-# INLINE size #-}
@@ -175,22 +143,13 @@ sized s sz = s { sSize = sz }
 length :: Monad m => Bundle m v a -> m Int
 {-# INLINE_FUSED length #-}
 length Bundle{sSize = Exact n}  = return n
-length s = vfoldl' (\n (Chunk k _) -> n+k) 0 s
+length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s
 
 -- | Check if a 'Bundle' is empty
 null :: Monad m => Bundle m v a -> m Bool
 {-# INLINE_FUSED null #-}
 null Bundle{sSize = Exact n} = return (n == 0)
-null Bundle{sChunks = Unf step s} = null_loop s
-  where
-    null_loop s = do
-      r <- step s
-      case r of
-        Yield (Chunk n _) s'
-          | n /= 0    -> return False
-          | otherwise -> null_loop s'
-        Skip s'       -> null_loop s'
-        Done          -> return True
+null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s
 
 -- Construction
 -- ------------
@@ -198,45 +157,30 @@ null Bundle{sChunks = Unf step s} = null_loop s
 -- | Empty 'Bundle'
 empty :: Monad m => Bundle m v a
 {-# INLINE_FUSED empty #-}
-empty = simple (const (return Done)) () (Exact 0)
+empty = fromStream S.empty (Exact 0)
 
 -- | Singleton 'Bundle'
 singleton :: Monad m => a -> Bundle m v a
 {-# INLINE_FUSED singleton #-}
-singleton x = simple (return . step) True (Exact 1)
-  where
-    {-# INLINE_INNER step #-}
-    step True  = Yield x False
-    step False = Done
+singleton x = fromStream (S.singleton x) (Exact 1)
 
 -- | Replicate a value to a given length
 replicate :: Monad m => Int -> a -> Bundle m v a
 {-# INLINE_FUSED replicate #-}
-replicate n x = Bundle (Unf pstep n) (Unf vstep True) Nothing (Exact len)
+replicate n x = Bundle (S.replicate n x)
+                       (S.singleton $ Chunk len (\v -> M.basicSet v x))
+                       Nothing
+                       (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 'Bundle' of values obtained by performing the monadic action the
 -- given number of times
 replicateM :: Monad m => Int -> m a -> Bundle m v a
 {-# INLINE_FUSED replicateM #-}
 -- NOTE: We delay inlining max here because GHC will create a join point for
 -- the call to newArray# otherwise which is not really nice.
-replicateM n p = simple step n (Exact (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step i | i <= 0    = return Done
-           | otherwise = do { x <- p; return $ Yield x (i-1) }
+replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0))
 
 generate :: Monad m => Int -> (Int -> a) -> Bundle m v a
 {-# INLINE generate #-}
@@ -245,13 +189,7 @@ generate n f = generateM n (return . f)
 -- | Generate a stream from its indices
 generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a
 {-# INLINE_FUSED generateM #-}
-generateM n f = n `seq` simple step 0 (Exact (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step i | i < n     = do
-                           x <- f i
-                           return $ Yield x (i+1)
-           | otherwise = return Done
+generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0))
 
 -- | Prepend an element
 cons :: Monad m => a -> Bundle m v a -> Bundle m v a
@@ -267,37 +205,7 @@ infixr 5 ++
 -- | Concatenate two 'Bundle's
 (++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED (++) #-}
-Bundle{sElems = Unf stepa sa, sChunks = Unf vstepa vsa, sSize = na}
-  ++ Bundle{sElems = Unf stepb sb, sChunks = Unf vstepb vsb, sSize = nb}
-    = Bundle (Unf step (Left sa)) (Unf vstep (Left vsa)) Nothing (na + nb)
-  where
-    {-# INLINE_INNER step #-}
-    step (Left  sa) = do
-                        r <- stepa sa
-                        case r of
-                          Yield x sa' -> return $ Yield x (Left  sa')
-                          Skip    sa' -> return $ Skip    (Left  sa')
-                          Done        -> return $ Skip    (Right sb)
-    step (Right sb) = do
-                        r <- stepb sb
-                        case r of
-                          Yield x sb' -> return $ Yield x (Right sb')
-                          Skip    sb' -> return $ Skip    (Right sb')
-                          Done        -> return $ Done
-
-    {-# INLINE_INNER vstep #-}
-    vstep (Left  vsa) = do
-                          r <- vstepa vsa
-                          case r of
-                            Yield x vsa' -> return $ Yield x (Left  vsa')
-                            Skip    vsa' -> return $ Skip    (Left  vsa')
-                            Done         -> return $ Skip    (Right vsb)
-    vstep (Right vsb) = do
-                        r <- vstepb vsb
-                        case r of
-                          Yield x vsb' -> return $ Yield x (Right vsb')
-                          Skip    vsb' -> return $ Skip    (Right vsb')
-                          Done         -> return $ Done
+Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb)
 
 -- Accessing elements
 -- ------------------
@@ -305,71 +213,24 @@ Bundle{sElems = Unf stepa sa, sChunks = Unf vstepa vsa, sSize = na}
 -- | First element of the 'Bundle' or error if empty
 head :: Monad m => Bundle m v a -> m a
 {-# INLINE_FUSED head #-}
-head Bundle{sElems = Unf step s} = head_loop SPEC s
-  where
-    head_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x _  -> return x
-            Skip    s' -> head_loop SPEC s'
-            Done       -> EMPTY_STREAM "head"
-
-
+head = S.head . sElems
 
 -- | Last element of the 'Bundle' or error if empty
 last :: Monad m => Bundle m v a -> m a
 {-# INLINE_FUSED last #-}
-last Bundle{sElems = Unf step s} = last_loop0 SPEC s
-  where
-    last_loop0 !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> last_loop1 SPEC x s'
-            Skip    s' -> last_loop0 SPEC   s'
-            Done       -> EMPTY_STREAM "last"
-
-    last_loop1 !sPEC x s
-      = do
-          r <- step s
-          case r of
-            Yield y s' -> last_loop1 SPEC y s'
-            Skip    s' -> last_loop1 SPEC x s'
-            Done       -> return x
+last = S.last . sElems
 
 infixl 9 !!
 -- | Element at the given position
 (!!) :: Monad m => Bundle m v a -> Int -> m a
 {-# INLINE (!!) #-}
-Bundle{sElems = Unf step s} !! i | i < 0     = ERROR "!!" "negative index"
-                                 | otherwise = index_loop SPEC s i
-  where
-    index_loop !sPEC s i
-      = i `seq`
-        do
-          r <- step s
-          case r of
-            Yield x s' | i == 0    -> return x
-                       | otherwise -> index_loop SPEC s' (i-1)
-            Skip    s'             -> index_loop SPEC s' i
-            Done                   -> EMPTY_STREAM "!!"
+b !! i = sElems b S.!! i
 
 infixl 9 !?
 -- | Element at the given position or 'Nothing' if out of bounds
 (!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a)
 {-# INLINE (!?) #-}
-Bundle{sElems = Unf step s} !? i = index_loop SPEC s i
-  where
-    index_loop !sPEC s i
-      = i `seq`
-        do
-          r <- step s
-          case r of
-            Yield x s' | i == 0    -> return (Just x)
-                       | otherwise -> index_loop SPEC s' (i-1)
-            Skip    s'             -> index_loop SPEC s' i
-            Done                   -> return Nothing
+b !? i = sElems b S.!? i
 
 -- Substreams
 -- ----------
@@ -385,80 +246,23 @@ slice i n s = take n (drop i s)
 -- | All but the last element
 init :: Monad m => Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED init #-}
-init Bundle{sElems = Unf step s, sSize = sz} = simple step' (Nothing, s) (sz - 1)
-  where
-    {-# INLINE_INNER step' #-}
-    step' (Nothing, s) = liftM (\r ->
-                           case r of
-                             Yield x s' -> Skip (Just x,  s')
-                             Skip    s' -> Skip (Nothing, s')
-                             Done       -> EMPTY_STREAM "init"
-                         ) (step s)
-
-    step' (Just x,  s) = liftM (\r -> 
-                           case r of
-                             Yield y s' -> Yield x (Just y, s')
-                             Skip    s' -> Skip    (Just x, s')
-                             Done       -> Done
-                         ) (step s)
+init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1)
 
 -- | All but the first element
 tail :: Monad m => Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED tail #-}
-tail Bundle{sElems = Unf step s, sSize = sz} = simple step' (Left s) (sz - 1)
-  where
-    {-# INLINE_INNER step' #-}
-    step' (Left  s) = liftM (\r ->
-                        case r of
-                          Yield x s' -> Skip (Right s')
-                          Skip    s' -> Skip (Left  s')
-                          Done       -> EMPTY_STREAM "tail"
-                      ) (step s)
-
-    step' (Right s) = liftM (\r ->
-                        case r of
-                          Yield x s' -> Yield x (Right s')
-                          Skip    s' -> Skip    (Right s')
-                          Done       -> Done
-                      ) (step s)
+tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1)
 
 -- | The first @n@ elements
 take :: Monad m => Int -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED take #-}
-take n Bundle{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 ->
-                             case r of
-                               Yield x s' -> Yield x (s', i+1)
-                               Skip    s' -> Skip    (s', i)
-                               Done       -> Done
-                           ) (step s)
-    step' (s, i) = return Done
+take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz)
 
 -- | All but the first @n@ elements
 drop :: Monad m => Int -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED drop #-}
-drop n Bundle{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 ->
-                                case r of
-                                   Yield x s' -> Skip (s', Just (i-1))
-                                   Skip    s' -> Skip (s', Just i)
-                                   Done       -> Done
-                                ) (step s)
-                      | otherwise = return $ Skip (s, Nothing)
-
-    step' (s, Nothing) = liftM (\r ->
-                           case r of
-                             Yield x s' -> Yield x (s', Nothing)
-                             Skip    s' -> Skip    (s', Nothing)
-                             Done       -> Done
-                           ) (step s)
-                     
+drop n Bundle{sElems = s, sSize = sz} = fromStream (S.drop n s) (sz - Exact n)
+
 -- Mapping
 -- -------
 
@@ -471,54 +275,26 @@ map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b
 {-# INLINE map #-}
 map f = mapM (return . f)
 
-
 -- | Map a monadic function over a 'Bundle'
 mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b
 {-# INLINE_FUSED mapM #-}
-mapM f Bundle{sElems = Unf step s, sSize = n} = simple step' s n
-  where
-    {-# INLINE_INNER step' #-}
-    step' s = do
-                r <- step s
-                case r of
-                  Yield x s' -> liftM  (`Yield` s') (f x)
-                  Skip    s' -> return (Skip    s')
-                  Done       -> return Done
-
-consume :: Monad m => Bundle m v a -> m ()
-{-# INLINE_FUSED consume #-}
-consume Bundle {sChunks = Unf step s} = consume_loop SPEC s
-  where
-    consume_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield _ s' -> consume_loop SPEC s'
-            Skip    s' -> consume_loop SPEC s'
-            Done       -> return ()
+mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n
 
 -- | Execute a monadic action for each element of the 'Bundle'
 mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m ()
 {-# INLINE_FUSED mapM_ #-}
-mapM_ m = consume . mapM m
+mapM_ m = S.mapM_ m . sElems
 
 -- | Transform a 'Bundle' to use a different monad
 trans :: (Monad m, Monad m') => (forall a. m a -> m' a)
                              -> Bundle m v a -> Bundle m' v a
 {-# INLINE_FUSED trans #-}
-trans f Bundle{sElems = Unf step s, sSize = n} = simple (f . step) s n
+trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n}
+  = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n }
 
 unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a
 {-# INLINE_FUSED unbox #-}
-unbox Bundle{sElems = Unf step s, sSize = n} = simple step' s n
-  where
-    {-# INLINE_INNER step' #-}
-    step' s = do
-                r <- step s
-                case r of
-                  Yield (Box x) s' -> return $ Yield x s'
-                  Skip          s' -> return $ Skip    s'
-                  Done             -> return $ Done
+unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n
 
 -- Zipping
 -- -------
@@ -526,58 +302,19 @@ unbox Bundle{sElems = Unf step s, sSize = n} = simple step' s n
 -- | Pair each element in a 'Bundle' with its index
 indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a)
 {-# INLINE_FUSED indexed #-}
-indexed Bundle{sElems = Unf step s, sSize = n} = simple step' (s,0) n
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,i) = i `seq`
-                  do
-                    r <- step s
-                    case r of
-                      Yield x s' -> return $ Yield (i,x) (s', i+1)
-                      Skip    s' -> return $ Skip        (s', i)
-                      Done       -> return Done
+indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n
 
 -- | Pair each element in a 'Bundle' with its index, starting from the right
 -- and counting down
 indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a)
 {-# INLINE_FUSED indexedR #-}
-indexedR m Bundle{sElems = Unf step s, sSize = n} = simple step' (s,m) n
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,i) = i `seq`
-                  do
-                    r <- step s
-                    case r of
-                      Yield x s' -> let i' = i-1
-                                    in
-                                    return $ Yield (i',x) (s', i')
-                      Skip    s' -> return $ Skip         (s', i)
-                      Done       -> return Done
+indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n
 
 -- | Zip two 'Bundle's with the given monadic function
 zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
 {-# INLINE_FUSED zipWithM #-}
-zipWithM f Bundle{sElems = Unf stepa sa, sSize = na}
-           Bundle{sElems = Unf stepb sb, sSize = nb}
-  = simple step (sa, sb, Nothing) (smaller na nb)
-  where
-    {-# INLINE_INNER step #-}
-    step (sa, sb, Nothing) = liftM (\r ->
-                               case r of
-                                 Yield x sa' -> Skip (sa', sb, Just x)
-                                 Skip    sa' -> Skip (sa', sb, Nothing)
-                                 Done        -> Done
-                             ) (stepa sa)
-
-    step (sa, sb, Just x)  = do
-                               r <- stepb sb
-                               case r of
-                                 Yield y sb' ->
-                                   do
-                                     z <- f x y
-                                     return $ Yield z (sa, sb', Nothing)
-                                 Skip    sb' -> return $ Skip (sa, sb', Just x)
-                                 Done        -> return $ Done
+zipWithM f Bundle{sElems = sa, sSize = na}
+           Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb)
 
 -- FIXME: This might expose an opportunity for inplace execution.
 {-# RULES
@@ -589,36 +326,14 @@ zipWithM f Bundle{sElems = Unf stepa sa, sSize = na}
 
 zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m ()
 {-# INLINE zipWithM_ #-}
-zipWithM_ f sa sb = consume (zipWithM f sa sb)
+zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb)
 
 zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d
 {-# INLINE_FUSED zipWith3M #-}
-zipWith3M f Bundle{sElems = Unf stepa sa, sSize = na}
-            Bundle{sElems = Unf stepb sb, sSize = nb}
-            Bundle{sElems = Unf stepc sc, sSize = nc}
-  = simple step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
-  where
-    {-# INLINE_INNER step #-}
-    step (sa, sb, sc, Nothing) = do
-        r <- stepa sa
-        return $ case r of
-            Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing))
-            Skip    sa' -> Skip (sa', sb, sc, Nothing)
-            Done        -> Done
-
-    step (sa, sb, sc, Just (x, Nothing)) = do
-        r <- stepb sb
-        return $ case r of
-            Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y))
-            Skip    sb' -> Skip (sa, sb', sc, Just (x, Nothing))
-            Done        -> Done
-
-    step (sa, sb, sc, Just (x, Just y)) = do
-        r <- stepc sc
-        case r of
-            Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing))
-            Skip    sc' -> return $ Skip (sa, sb, sc', Just (x, Just y))
-            Done        -> return $ Done
+zipWith3M f Bundle{sElems = sa, sSize = na}
+            Bundle{sElems = sb, sSize = nb}
+            Bundle{sElems = sc, sSize = nc}
+  = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc))
 
 zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
                      -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d
@@ -698,60 +413,12 @@ zip6 = zipWith6 (,,,,,)
 -- | Check if two 'Bundle's are equal
 eq :: (Monad m, Eq a) => Bundle m v a -> Bundle m v a -> m Bool
 {-# INLINE_FUSED eq #-}
-eq Bundle{sElems = Unf step1 s1}
-   Bundle{sElems = Unf step2 s2} = eq_loop0 SPEC s1 s2
-  where
-    eq_loop0 !sPEC s1 s2 = do
-      r <- step1 s1
-      case r of
-        Yield x s1' -> eq_loop1 SPEC x s1' s2
-        Skip    s1' -> eq_loop0 SPEC   s1' s2
-        Done        -> eq_null s2
-
-    eq_loop1 !sPEC x s1 s2 = do
-      r <- step2 s2
-      case r of
-        Yield y s2'
-          | x == y    -> eq_loop0 SPEC   s1 s2'
-          | otherwise -> return False
-        Skip    s2'   -> eq_loop1 SPEC x s1 s2'
-        Done          -> return False
-
-    eq_null s2 = do
-      r <- step2 s2
-      case r of
-        Yield _ _ -> return False
-        Skip s2'  -> eq_null s2'
-        Done      -> return True
+eq x y = sElems x `S.eq` sElems y
 
 -- | Lexicographically compare two 'Bundle's
 cmp :: (Monad m, Ord a) => Bundle m v a -> Bundle m v a -> m Ordering
 {-# INLINE_FUSED cmp #-}
-cmp Bundle{sElems = Unf step1 s1}
-    Bundle{sElems = Unf step2 s2} = cmp_loop0 SPEC s1 s2
-  where
-    cmp_loop0 !sPEC s1 s2 = do
-      r <- step1 s1
-      case r of
-        Yield x s1' -> cmp_loop1 SPEC x s1' s2
-        Skip    s1' -> cmp_loop0 SPEC   s1' s2
-        Done        -> cmp_null s2
-
-    cmp_loop1 !sPEC x s1 s2 = do
-      r <- step2 s2
-      case r of
-        Yield y s2' -> case x `compare` y of
-                         EQ -> cmp_loop0 SPEC s1 s2'
-                         c  -> return c
-        Skip    s2' -> cmp_loop1 SPEC x s1 s2'
-        Done        -> return GT
-
-    cmp_null s2 = do
-      r <- step2 s2
-      case r of
-        Yield _ _ -> return LT
-        Skip s2'  -> cmp_null s2'
-        Done      -> return EQ
+cmp x y = sElems x `S.cmp` sElems y
 
 -- Filtering
 -- ---------
@@ -764,18 +431,7 @@ filter f = filterM (return . f)
 -- | Drop elements which do not satisfy the monadic predicate
 filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED filterM #-}
-filterM f Bundle{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
-  where
-    {-# INLINE_INNER step' #-}
-    step' s = do
-                r <- step s
-                case r of
-                  Yield x s' -> do
-                                  b <- f x
-                                  return $ if b then Yield x s'
-                                                else Skip    s'
-                  Skip    s' -> return $ Skip s'
-                  Done       -> return $ Done
+filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n)
 
 -- | Longest prefix of elements that satisfy the predicate
 takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a
@@ -785,55 +441,17 @@ takeWhile f = takeWhileM (return . f)
 -- | Longest prefix of elements that satisfy the monadic predicate
 takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED takeWhileM #-}
-takeWhileM f Bundle{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
-  where
-    {-# INLINE_INNER step' #-}
-    step' s = do
-                r <- step s
-                case r of
-                  Yield x s' -> do
-                                  b <- f x
-                                  return $ if b then Yield x s' else Done
-                  Skip    s' -> return $ Skip s'
-                  Done       -> return $ Done
+takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n)
 
 -- | Drop the longest prefix of elements that satisfy the predicate
 dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a
 {-# INLINE dropWhile #-}
 dropWhile f = dropWhileM (return . f)
 
-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) -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED dropWhileM #-}
-dropWhileM f Bundle{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!
-
-    {-# INLINE_INNER step' #-}
-    step' (DropWhile_Drop s)
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> do
-                            b <- f x
-                            return $ if b then Skip (DropWhile_Drop    s')
-                                          else Skip (DropWhile_Yield x s')
-            Skip    s' -> return $ Skip (DropWhile_Drop    s')
-            Done       -> return $ Done
-
-    step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
-
-    step' (DropWhile_Next s)
-      = liftM (\r ->
-          case r of
-            Yield x s' -> Skip    (DropWhile_Yield x s')
-            Skip    s' -> Skip    (DropWhile_Next    s')
-            Done       -> Done
-        ) (step s)
+dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n)
 
 -- Searching
 -- ---------
@@ -842,22 +460,13 @@ infix 4 `elem`
 -- | Check whether the 'Bundle' contains an element
 elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool
 {-# INLINE_FUSED elem #-}
-elem x Bundle{sElems = Unf step s} = elem_loop SPEC s
-  where
-    elem_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield y s' | x == y    -> return True
-                       | otherwise -> elem_loop SPEC s'
-            Skip    s'             -> elem_loop SPEC s'
-            Done                   -> return False
+elem x = S.elem x . sElems
 
 infix 4 `notElem`
 -- | Inverse of `elem`
 notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool
 {-# INLINE notElem #-}
-notElem x s = liftM not (elem x s)
+notElem x = S.notElem x . sElems
 
 -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
 -- if no such element exists.
@@ -869,18 +478,7 @@ find f = findM (return . f)
 -- 'Nothing' if no such element exists.
 findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a)
 {-# INLINE_FUSED findM #-}
-findM f Bundle{sElems = Unf step s} = find_loop SPEC s
-  where
-    find_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> do
-                            b <- f x
-                            if b then return $ Just x
-                                 else find_loop SPEC s'
-            Skip    s' -> find_loop SPEC s'
-            Done       -> return Nothing
+findM f = S.findM f . sElems
 
 -- | Yield 'Just' the index of the first element that satisfies the predicate
 -- or 'Nothing' if no such element exists.
@@ -892,18 +490,7 @@ findIndex f = findIndexM (return . f)
 -- predicate or 'Nothing' if no such element exists.
 findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int)
 {-# INLINE_FUSED findIndexM #-}
-findIndexM f Bundle{sElems = Unf step s} = findIndex_loop SPEC s 0
-  where
-    findIndex_loop !sPEC s i
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> do
-                            b <- f x
-                            if b then return $ Just i
-                                 else findIndex_loop SPEC s' (i+1)
-            Skip    s' -> findIndex_loop SPEC s' i
-            Done       -> return Nothing
+findIndexM f = S.findIndexM f . sElems
 
 -- Folding
 -- -------
@@ -916,33 +503,13 @@ foldl f = foldlM (\a b -> return (f a b))
 -- | Left fold with a monadic operator
 foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a
 {-# INLINE_FUSED foldlM #-}
-foldlM m z Bundle{sElems = Unf step s} = foldlM_loop SPEC z s
-  where
-    foldlM_loop !sPEC z s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' }
-            Skip    s' -> foldlM_loop SPEC z s'
-            Done       -> return z
+foldlM m z = S.foldlM m z . sElems
 
 -- | Same as 'foldlM'
 foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a
 {-# INLINE foldM #-}
 foldM = foldlM
 
-vfoldlM :: Monad m => (a -> Chunk v b -> m a) -> a -> Bundle m v b -> m a
-{-# INLINE_FUSED vfoldlM #-}
-vfoldlM f z Bundle{sChunks = Unf step s} = vfoldlM_loop SPEC z s
-  where
-    vfoldlM_loop !sPEC z s
-      = do
-          r <- step s
-          case r of
-            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 'Bundle'
 foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a
 {-# INLINE foldl1 #-}
@@ -951,15 +518,7 @@ foldl1 f = foldl1M (\a b -> return (f a b))
 -- | Left fold over a non-empty 'Bundle' with a monadic operator
 foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a
 {-# INLINE_FUSED foldl1M #-}
-foldl1M f Bundle{sElems = Unf step s, sSize = sz} = foldl1M_loop SPEC s
-  where
-    foldl1M_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> foldlM f x (simple step s' (sz - 1))
-            Skip    s' -> foldl1M_loop SPEC s'
-            Done       -> EMPTY_STREAM "foldl1M"
+foldl1M f = S.foldl1M f . sElems
 
 -- | Same as 'foldl1M'
 fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a
@@ -971,41 +530,16 @@ foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a
 {-# INLINE foldl' #-}
 foldl' f = foldlM' (\a b -> return (f a b))
 
-vfoldl' :: Monad m => (a -> Chunk v b -> a) -> a -> Bundle m v b -> m a
-{-# INLINE vfoldl' #-}
-vfoldl' f = vfoldlM' (\a b -> return (f a b))
-
 -- | Left fold with a strict accumulator and a monadic operator
 foldlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a
 {-# INLINE_FUSED foldlM' #-}
-foldlM' m z Bundle{sElems = Unf step s} = foldlM'_loop SPEC z s
-  where
-    foldlM'_loop !sPEC z s
-      = z `seq`
-        do
-          r <- step s
-          case r of
-            Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
-            Skip    s' -> foldlM'_loop SPEC z s'
-            Done       -> return z
+foldlM' m z = S.foldlM' m z . sElems
 
 -- | Same as 'foldlM''
 foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a
 {-# INLINE foldM' #-}
 foldM' = foldlM'
 
-vfoldlM' :: Monad m => (a -> Chunk v b -> m a) -> a -> Bundle m v b -> m a
-{-# INLINE_FUSED vfoldlM' #-}
-vfoldlM' f z Bundle{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 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 'Bundle' with a strict accumulator
 foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a
 {-# INLINE foldl1' #-}
@@ -1015,15 +549,7 @@ foldl1' f = foldl1M' (\a b -> return (f a b))
 -- monadic operator
 foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a
 {-# INLINE_FUSED foldl1M' #-}
-foldl1M' f Bundle{sElems = Unf step s, sSize = sz} = foldl1M'_loop SPEC s
-  where
-    foldl1M'_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> foldlM' f x (simple step s' (sz - 1))
-            Skip    s' -> foldl1M'_loop SPEC s'
-            Done       -> EMPTY_STREAM "foldl1M'"
+foldl1M' f = S.foldl1M' f . sElems
 
 -- | Same as 'foldl1M''
 fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a
@@ -1038,15 +564,7 @@ foldr f = foldrM (\a b -> return (f a b))
 -- | Right fold with a monadic operator
 foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b
 {-# INLINE_FUSED foldrM #-}
-foldrM f z Bundle{sElems = Unf step s} = foldrM_loop SPEC s
-  where
-    foldrM_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> f x =<< foldrM_loop SPEC s'
-            Skip    s' -> foldrM_loop SPEC s'
-            Done       -> return z
+foldrM f z = S.foldrM f z . sElems
 
 -- | Right fold over a non-empty stream
 foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a
@@ -1056,52 +574,18 @@ 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) -> Bundle m v a -> m a
 {-# INLINE_FUSED foldr1M #-}
-foldr1M f Bundle{sElems = Unf step s} = foldr1M_loop0 SPEC s
-  where
-    foldr1M_loop0 !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield x s' -> foldr1M_loop1 SPEC x s'
-            Skip    s' -> foldr1M_loop0 SPEC   s'
-            Done       -> EMPTY_STREAM "foldr1M"
-
-    foldr1M_loop1 !sPEC x s
-      = do
-          r <- step s
-          case r of
-            Yield y s' -> f x =<< foldr1M_loop1 SPEC y s'
-            Skip    s' -> foldr1M_loop1 SPEC x s'
-            Done       -> return x
+foldr1M f = S.foldr1M f . sElems
 
 -- Specialised folds
 -- -----------------
 
 and :: Monad m => Bundle m v Bool -> m Bool
 {-# INLINE_FUSED and #-}
-and Bundle{sElems = Unf step s} = and_loop SPEC s
-  where
-    and_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield False _  -> return False
-            Yield True  s' -> and_loop SPEC s'
-            Skip        s' -> and_loop SPEC s'
-            Done           -> return True
+and = S.and . sElems
 
 or :: Monad m => Bundle m v Bool -> m Bool
 {-# INLINE_FUSED or #-}
-or Bundle{sElems = Unf step s} = or_loop SPEC s
-  where
-    or_loop !sPEC s
-      = do
-          r <- step s
-          case r of
-            Yield False s' -> or_loop SPEC s'
-            Yield True  _  -> return True
-            Skip        s' -> or_loop SPEC s'
-            Done           -> return False
+or = S.or . sElems
 
 concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b
 {-# INLINE concatMap #-}
@@ -1109,46 +593,13 @@ concatMap f = concatMapM (return . f)
 
 concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b
 {-# INLINE_FUSED concatMapM #-}
-concatMapM f Bundle{sElems = Unf step s} = simple concatMap_go (Left s) Unknown
-  where
-    concatMap_go (Left s) = do
-        r <- step s
-        case r of
-            Yield a s' -> do
-                b_stream <- f a
-                return $ Skip (Right (b_stream, s'))
-            Skip    s' -> return $ Skip (Left s')
-            Done       -> return Done
-    concatMap_go (Right (Bundle{sElems = Unf inner_step inner_s, sSize = sz}, s)) = do
-        r <- inner_step inner_s
-        case r of
-            Yield b inner_s' -> return $ Yield b (Right (simple inner_step inner_s' sz, s))
-            Skip    inner_s' -> return $ Skip (Right (simple inner_step inner_s' sz, s))
-            Done             -> return $ Skip (Left s)
+concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown
 
 -- | Create a 'Bundle' of values from a 'Bundle' of streamable things
 flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size
                    -> Bundle m v a -> Bundle m v b
 {-# INLINE_FUSED flatten #-}
-flatten mk istep sz Bundle{sElems = Unf ostep t} = simple step (Left t) sz
-  where
-    {-# INLINE_INNER step #-}
-    step (Left t) = do
-                      r <- ostep t
-                      case r of
-                        Yield a t' -> do
-                                        s <- mk a
-                                        s `seq` return (Skip (Right (s,t')))
-                        Skip    t' -> return $ Skip (Left t')
-                        Done       -> return $ Done
-
-    
-    step (Right (s,t)) = do
-                           r <- istep s
-                           case r of
-                             Yield x s' -> return $ Yield x (Right (s',t))
-                             Skip    s' -> return $ Skip    (Right (s',t))
-                             Done       -> return $ Skip    (Left t)
+flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz
 
 -- Unfolding
 -- ---------
@@ -1161,14 +612,7 @@ unfoldr f = unfoldrM (return . f)
 -- | Unfold with a monadic function
 unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a
 {-# INLINE_FUSED unfoldrM #-}
-unfoldrM f s = simple step s Unknown
-  where
-    {-# INLINE_INNER step #-}
-    step s = liftM (\r ->
-               case r of
-                 Just (x, s') -> Yield x s'
-                 Nothing      -> Done
-             ) (f s)
+unfoldrM f s = fromStream (S.unfoldrM f s) Unknown
 
 -- | Unfold at most @n@ elements
 unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a
@@ -1178,26 +622,12 @@ unfoldrN n f = unfoldrNM n (return . f)
 -- | Unfold at most @n@ elements with a monadic functions
 unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a
 {-# INLINE_FUSED unfoldrNM #-}
-unfoldrNM n f s = simple step (s,n) (Max (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step (s,n) | n <= 0    = return Done
-               | otherwise = liftM (\r ->
-                               case r of
-                                 Just (x,s') -> Yield x (s',n-1)
-                                 Nothing     -> Done
-                             ) (f s)
+unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0))
 
 -- | Apply monadic function n times to value. Zeroth element is original value.
 iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a
 {-# INLINE_FUSED iterateNM #-}
-iterateNM n f x0 = simple step (x0,n) (Exact (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step (x,i) | i <= 0    = return Done
-               | i == n    = return $ Yield x (x,i-1)
-               | otherwise = do a <- f x
-                                return $ Yield a (a,i-1)
+iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0))
 
 -- | Apply function n times to value. Zeroth element is original value.
 iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a
@@ -1215,17 +645,7 @@ prescanl f = prescanlM (\a b -> return (f a b))
 -- | Prefix scan with a monadic operator
 prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a
 {-# INLINE_FUSED prescanlM #-}
-prescanlM f z Bundle{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,x) = do
-                    r <- step s
-                    case r of
-                      Yield y s' -> do
-                                      z <- f x y
-                                      return $ Yield x (s', z)
-                      Skip    s' -> return $ Skip (s', x)
-                      Done       -> return Done
+prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz
 
 -- | Prefix scan with strict accumulator
 prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a
@@ -1235,18 +655,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 -> Bundle m v b -> Bundle m v a
 {-# INLINE_FUSED prescanlM' #-}
-prescanlM' f z Bundle{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,x) = x `seq`
-                  do
-                    r <- step s
-                    case r of
-                      Yield y s' -> do
-                                      z <- f x y
-                                      return $ Yield x (s', z)
-                      Skip    s' -> return $ Skip (s', x)
-                      Done       -> return Done
+prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz
 
 -- | Suffix scan
 postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a
@@ -1256,17 +665,7 @@ postscanl f = postscanlM (\a b -> return (f a b))
 -- | Suffix scan with a monadic operator
 postscanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a
 {-# INLINE_FUSED postscanlM #-}
-postscanlM f z Bundle{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,x) = do
-                    r <- step s
-                    case r of
-                      Yield y s' -> do
-                                      z <- f x y
-                                      return $ Yield z (s',z)
-                      Skip    s' -> return $ Skip (s',x)
-                      Done       -> return Done
+postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz
 
 -- | Suffix scan with strict accumulator
 postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a
@@ -1276,19 +675,7 @@ 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 -> Bundle m v b -> Bundle m v a
 {-# INLINE_FUSED postscanlM' #-}
-postscanlM' f z Bundle{sElems = Unf step s, sSize = sz}
-  = z `seq` simple step' (s,z) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s,x) = x `seq`
-                  do
-                    r <- step s
-                    case r of
-                      Yield y s' -> do
-                                      z <- f x y
-                                      z `seq` return (Yield z (s',z))
-                      Skip    s' -> return $ Skip (s',x)
-                      Done       -> return Done
+postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz
 
 -- | Haskell-style scan
 scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a
@@ -1318,24 +705,7 @@ scanl1 f = scanl1M (\x y -> return (f x y))
 -- | Scan over a non-empty 'Bundle' with a monadic operator
 scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED scanl1M #-}
-scanl1M f Bundle{sElems = Unf step s, sSize = sz} = simple step' (s, Nothing) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s, Nothing) = do
-                           r <- step s
-                           case r of
-                             Yield x s' -> return $ Yield x (s', Just x)
-                             Skip    s' -> return $ Skip (s', Nothing)
-                             Done       -> EMPTY_STREAM "scanl1M"
-
-    step' (s, Just x) = do
-                          r <- step s
-                          case r of
-                            Yield y s' -> do
-                                            z <- f x y
-                                            return $ Yield z (s', Just z)
-                            Skip    s' -> return $ Skip (s', Just x)
-                            Done       -> return Done
+scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz
 
 -- | Scan over a non-empty 'Bundle' with a strict accumulator
 scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a
@@ -1346,26 +716,7 @@ scanl1' f = scanl1M' (\x y -> return (f x y))
 -- operator
 scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a
 {-# INLINE_FUSED scanl1M' #-}
-scanl1M' f Bundle{sElems = Unf step s, sSize = sz}
-  = simple step' (s, Nothing) sz
-  where
-    {-# INLINE_INNER step' #-}
-    step' (s, Nothing) = do
-                           r <- step s
-                           case r of
-                             Yield x s' -> x `seq` return (Yield x (s', Just x))
-                             Skip    s' -> return $ Skip (s', Nothing)
-                             Done       -> EMPTY_STREAM "scanl1M"
-
-    step' (s, Just x) = x `seq`
-                        do
-                          r <- step s
-                          case r of
-                            Yield y s' -> do
-                                            z <- f x y
-                                            z `seq` return (Yield z (s', Just z))
-                            Skip    s' -> return $ Skip (s', Just x)
-                            Done       -> return Done
+scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz
 
 -- Enumerations
 -- ------------
@@ -1378,12 +729,7 @@ scanl1M' f Bundle{sElems = Unf step s, sSize = sz}
 -- @x+y+y@ etc.
 enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a
 {-# INLINE_FUSED enumFromStepN #-}
-enumFromStepN x y n = x `seq` y `seq` n `seq`
-                      simple step (x,n) (Exact (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step (x,n) | n > 0     = return $ Yield x (x+y,n-1)
-               | otherwise = return $ Done
+enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0))
 
 -- | Enumerate values
 --
@@ -1399,7 +745,7 @@ enumFromTo x y = fromList [x .. y]
 -- FIXME: add "too large" test for Int
 enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a
 {-# INLINE_FUSED enumFromTo_small #-}
-enumFromTo_small x y = x `seq` y `seq` simple step x (Exact n)
+enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n)
   where
     n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0
 
@@ -1451,7 +797,7 @@ enumFromTo_small x y = x `seq` y `seq` simple step x (Exact n)
 
 enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int
 {-# INLINE_FUSED enumFromTo_int #-}
-enumFromTo_int x y = x `seq` y `seq` simple step x (Exact (len x y))
+enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))
   where
     {-# INLINE [0] len #-}
     len :: Int -> Int -> Int
@@ -1468,7 +814,7 @@ enumFromTo_int x y = x `seq` y `seq` simple step x (Exact (len x y))
 
 enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a
 {-# INLINE_FUSED enumFromTo_intlike #-}
-enumFromTo_intlike x y = x `seq` y `seq` simple step x (Exact (len x y))
+enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))
   where
     {-# INLINE [0] len #-}
     len x y | x > y     = 0
@@ -1503,7 +849,7 @@ enumFromTo_intlike x y = x `seq` y `seq` simple step x (Exact (len x y))
 
 enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a
 {-# INLINE_FUSED enumFromTo_big_word #-}
-enumFromTo_big_word x y = x `seq` y `seq` simple step x (Exact (len x y))
+enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))
   where
     {-# INLINE [0] len #-}
     len x y | x > y     = 0
@@ -1543,7 +889,7 @@ enumFromTo_big_word x y = x `seq` y `seq` simple step x (Exact (len x y))
 -- FIXME: the "too large" test is totally wrong
 enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a
 {-# INLINE_FUSED enumFromTo_big_int #-}
-enumFromTo_big_int x y = x `seq` y `seq` simple step x (Exact (len x y))
+enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))
   where
     {-# INLINE [0] len #-}
     len x y | x > y     = 0
@@ -1570,7 +916,7 @@ enumFromTo_big_int x y = x `seq` y `seq` simple step x (Exact (len x y))
 
 enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char
 {-# INLINE_FUSED enumFromTo_char #-}
-enumFromTo_char x y = x `seq` y `seq` simple step xn (Exact n)
+enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)
   where
     xn = ord x
     yn = ord y
@@ -1595,7 +941,7 @@ enumFromTo_char x y = x `seq` y `seq` simple step xn (Exact n)
 
 enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a
 {-# INLINE_FUSED enumFromTo_double #-}
-enumFromTo_double n m = n `seq` m `seq` simple step n (Max (len n m))
+enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n m))
   where
     lim = m + 1/2 -- important to float out
 
@@ -1649,25 +995,17 @@ fromList xs = unsafeFromList Unknown xs
 -- | Convert the first @n@ elements of a list to a 'Bundle'
 fromListN :: Monad m => Int -> [a] -> Bundle m v a
 {-# INLINE_FUSED fromListN #-}
-fromListN n xs = simple step (xs,n) (Max (delay_inline max n 0))
-  where
-    {-# INLINE_INNER step #-}
-    step (xs,n) | n <= 0 = return Done
-    step (x:xs,n)        = return (Yield x (xs,n-1))
-    step ([],n)          = return Done
+fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0))
 
 -- | Convert a list to a 'Bundle' with the given 'Size' hint. 
 unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a
 {-# INLINE_FUSED unsafeFromList #-}
-unsafeFromList sz xs = simple step xs sz
-  where
-    step (x:xs) = return (Yield x xs)
-    step []     = return Done
+unsafeFromList sz xs = fromStream (S.fromList xs) sz
 
 fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a
 {-# INLINE_FUSED fromVector #-}
-fromVector v = v `seq` n `seq` Bundle (Unf step 0)
-                                      (Unf vstep True)
+fromVector v = v `seq` n `seq` Bundle (Stream step 0)
+                                      (Stream vstep True)
                                       (Just v)
                                       (Exact n)
   where
@@ -1685,8 +1023,8 @@ fromVector v = v `seq` n `seq` Bundle (Unf step 0)
 
 fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a
 {-# INLINE_FUSED fromVectors #-}
-fromVectors vs = Bundle (Unf pstep (Left vs))
-                        (Unf vstep vs)
+fromVectors vs = Bundle (Stream pstep (Left vs))
+                        (Stream vstep vs)
                         Nothing
                         (Exact n) 
   where
@@ -1711,9 +1049,9 @@ fromVectors vs = Bundle (Unf pstep (Left vs))
 
 concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a
 {-# INLINE_FUSED concatVectors #-}
-concatVectors Bundle{sElems = Unf step s}
-  = Bundle (Unf pstep (Left s))
-           (Unf vstep s)
+concatVectors Bundle{sElems = Stream step s}
+  = Bundle (Stream pstep (Left s))
+           (Stream vstep s)
            Nothing
            Unknown
   where
@@ -1742,7 +1080,7 @@ concatVectors Bundle{sElems = Unf step s}
 
 reVector :: Monad m => Bundle m u a -> Bundle m v a
 {-# INLINE_FUSED reVector #-}
-reVector Bundle{sElems = Unf step s, sSize = n} = simple step s n
+reVector Bundle{sElems = s, sSize = n} = fromStream s n
 
 {-# RULES
 
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
new file mode 100644 (file)
index 0000000..2b0a043
--- /dev/null
@@ -0,0 +1,1599 @@
+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}
+
+-- |
+-- Module      : Data.Vector.Fusion.Stream.Monadic
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Monadic stream combinators.
+--
+
+module Data.Vector.Fusion.Stream.Monadic (
+  Stream(..), Step(..), SPEC(..),
+
+  -- * Length
+  length, null,
+
+  -- * Construction
+  empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),
+
+  -- * Accessing elements
+  head, last, (!!), (!?),
+
+  -- * Substreams
+  slice, init, tail, take, drop,
+
+  -- * Mapping
+  map, mapM, mapM_, trans, unbox, concatMap, flatten,
+  
+  -- * Zipping
+  indexed, indexedR, zipWithM_,
+  zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,
+  zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
+  zip, zip3, zip4, zip5, zip6,
+
+  -- * Comparisons
+  eq, cmp,
+
+  -- * Filtering
+  filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
+
+  -- * Searching
+  elem, notElem, find, findM, findIndex, findIndexM,
+
+  -- * Folding
+  foldl, foldlM, foldl1, foldl1M, foldM, fold1M,
+  foldl', foldlM', foldl1', foldl1M', foldM', fold1M',
+  foldr, foldrM, foldr1, foldr1M,
+
+  -- * Specialised folds
+  and, or, concatMapM,
+
+  -- * Unfolding
+  unfoldr, unfoldrM,
+  unfoldrN, unfoldrNM,
+  iterateN, iterateNM,
+
+  -- * Scans
+  prescanl, prescanlM, prescanl', prescanlM',
+  postscanl, postscanlM, postscanl', postscanlM',
+  scanl, scanlM, scanl', scanlM',
+  scanl1, scanl1M, scanl1', scanl1M',
+
+  -- * Enumerations
+  enumFromStepN, enumFromTo, enumFromThenTo,
+
+  -- * Conversions
+  toList, fromList, fromListN
+) where
+
+import Data.Vector.Fusion.Util ( Box(..) )
+
+import qualified Data.List as List
+import Data.Char      ( ord )
+import GHC.Base       ( unsafeChr )
+import Control.Monad  ( liftM )
+import Prelude hiding ( length, null,
+                        replicate, (++),
+                        head, last, (!!),
+                        init, tail, take, drop,
+                        map, mapM, mapM_, concatMap,
+                        zipWith, zipWith3, zip, zip3,
+                        filter, takeWhile, dropWhile,
+                        elem, notElem,
+                        foldl, foldl1, foldr, foldr1,
+                        and, or,
+                        scanl, scanl1,
+                        enumFromTo, enumFromThenTo )
+
+import Data.Int  ( Int8, Int16, Int32, Int64 )
+import Data.Word ( Word8, Word16, Word32, Word, Word64 )
+
+#if __GLASGOW_HASKELL__ >= 700
+import GHC.Exts ( SpecConstrAnnotation(..) )
+#endif
+
+#include "vector.h"
+
+data SPEC = SPEC | SPEC2
+#if __GLASGOW_HASKELL__ >= 700
+{-# ANN type SPEC ForceSpecConstr #-}
+#endif
+
+emptyStream :: String
+{-# NOINLINE emptyStream #-}
+emptyStream = "empty stream"
+
+#define EMPTY_STREAM (\s -> ERROR s emptyStream)
+
+-- | Result of taking a single step in a stream
+data Step s a where
+  Yield :: a -> s -> Step s a
+  Skip  :: s -> Step s a
+  Done  :: Step s a
+
+instance Functor (Step s) where
+  {-# INLINE fmap #-}
+  fmap f (Yield x s) = Yield (f x) s
+  fmap f (Skip s) = Skip s
+  fmap f Done = Done
+
+-- | Monadic streams
+data Stream m a = forall s. Stream (s -> m (Step s a)) s
+
+-- Length
+-- ------
+
+-- | Length of a 'Stream'
+length :: Monad m => Stream m a -> m Int
+{-# INLINE_FUSED length #-}
+length = foldl' (\n _ -> n+1) 0
+
+-- | Check if a 'Stream' is empty
+null :: Monad m => Stream m a -> m Bool
+{-# INLINE_FUSED null #-}
+null (Stream step s) = null_loop s
+  where
+    null_loop s = do
+      r <- step s
+      case r of
+        Yield _ _ -> return False
+        Skip s'   -> null_loop s'
+        Done      -> return True
+
+-- Construction
+-- ------------
+
+-- | Empty 'Stream'
+empty :: Monad m => Stream m a
+{-# INLINE_FUSED empty #-}
+empty = Stream (const (return Done)) ()
+
+-- | Singleton 'Stream'
+singleton :: Monad m => a -> Stream m a
+{-# INLINE_FUSED singleton #-}
+singleton x = Stream (return . step) True
+  where
+    {-# INLINE_INNER step #-}
+    step True  = Yield x False
+    step False = Done
+
+-- | Replicate a value to a given length
+replicate :: Monad m => Int -> a -> Stream m a
+{-# INLINE_FUSED replicate #-}
+replicate n x = replicateM n (return x)
+
+-- | Yield a 'Stream' of values obtained by performing the monadic action the
+-- given number of times
+replicateM :: Monad m => Int -> m a -> Stream m a
+{-# INLINE_FUSED replicateM #-}
+replicateM n p = Stream step n
+  where
+    {-# INLINE_INNER step #-}
+    step i | i <= 0    = return Done
+           | otherwise = do { x <- p; return $ Yield x (i-1) }
+
+generate :: Monad m => Int -> (Int -> a) -> Stream m a
+{-# INLINE generate #-}
+generate n f = generateM n (return . f)
+
+-- | Generate a stream from its indices
+generateM :: Monad m => Int -> (Int -> m a) -> Stream m a
+{-# INLINE_FUSED generateM #-}
+generateM n f = n `seq` Stream step 0
+  where
+    {-# INLINE_INNER step #-}
+    step i | i < n     = do
+                           x <- f i
+                           return $ Yield x (i+1)
+           | otherwise = return Done
+
+-- | Prepend an element
+cons :: Monad m => a -> Stream m a -> Stream m a
+{-# INLINE cons #-}
+cons x s = singleton x ++ s
+
+-- | Append an element
+snoc :: Monad m => Stream m a -> a -> Stream m a
+{-# INLINE snoc #-}
+snoc s x = s ++ singleton x
+
+infixr 5 ++
+-- | Concatenate two 'Stream's
+(++) :: Monad m => Stream m a -> Stream m a -> Stream m a
+{-# INLINE_FUSED (++) #-}
+Stream stepa sa ++ Stream stepb sb = Stream step (Left sa)
+  where
+    {-# INLINE_INNER step #-}
+    step (Left  sa) = do
+                        r <- stepa sa
+                        case r of
+                          Yield x sa' -> return $ Yield x (Left  sa')
+                          Skip    sa' -> return $ Skip    (Left  sa')
+                          Done        -> return $ Skip    (Right sb)
+    step (Right sb) = do
+                        r <- stepb sb
+                        case r of
+                          Yield x sb' -> return $ Yield x (Right sb')
+                          Skip    sb' -> return $ Skip    (Right sb')
+                          Done        -> return $ Done
+
+-- Accessing elements
+-- ------------------
+
+-- | First element of the 'Stream' or error if empty
+head :: Monad m => Stream m a -> m a
+{-# INLINE_FUSED head #-}
+head (Stream step s) = head_loop SPEC s
+  where
+    head_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x _  -> return x
+            Skip    s' -> head_loop SPEC s'
+            Done       -> EMPTY_STREAM "head"
+
+
+
+-- | Last element of the 'Stream' or error if empty
+last :: Monad m => Stream m a -> m a
+{-# INLINE_FUSED last #-}
+last (Stream step s) = last_loop0 SPEC s
+  where
+    last_loop0 !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> last_loop1 SPEC x s'
+            Skip    s' -> last_loop0 SPEC   s'
+            Done       -> EMPTY_STREAM "last"
+
+    last_loop1 !sPEC x s
+      = do
+          r <- step s
+          case r of
+            Yield y s' -> last_loop1 SPEC y s'
+            Skip    s' -> last_loop1 SPEC x s'
+            Done       -> return x
+
+infixl 9 !!
+-- | Element at the given position
+(!!) :: Monad m => Stream m a -> Int -> m a
+{-# INLINE (!!) #-}
+Stream step s !! i | i < 0     = ERROR "!!" "negative index"
+                   | otherwise = index_loop SPEC s i
+  where
+    index_loop !sPEC s i
+      = i `seq`
+        do
+          r <- step s
+          case r of
+            Yield x s' | i == 0    -> return x
+                       | otherwise -> index_loop SPEC s' (i-1)
+            Skip    s'             -> index_loop SPEC s' i
+            Done                   -> EMPTY_STREAM "!!"
+
+infixl 9 !?
+-- | Element at the given position or 'Nothing' if out of bounds
+(!?) :: Monad m => Stream m a -> Int -> m (Maybe a)
+{-# INLINE (!?) #-}
+Stream step s !? i = index_loop SPEC s i
+  where
+    index_loop !sPEC s i
+      = i `seq`
+        do
+          r <- step s
+          case r of
+            Yield x s' | i == 0    -> return (Just x)
+                       | otherwise -> index_loop SPEC s' (i-1)
+            Skip    s'             -> index_loop SPEC s' i
+            Done                   -> return Nothing
+
+-- Substreams
+-- ----------
+
+-- | Extract a substream of the given length starting at the given position.
+slice :: Monad m => Int   -- ^ starting index
+                 -> Int   -- ^ length
+                 -> Stream m a
+                 -> Stream m a
+{-# INLINE slice #-}
+slice i n s = take n (drop i s)
+
+-- | All but the last element
+init :: Monad m => Stream m a -> Stream m a
+{-# INLINE_FUSED init #-}
+init (Stream step s) = Stream step' (Nothing, s)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (Nothing, s) = liftM (\r ->
+                           case r of
+                             Yield x s' -> Skip (Just x,  s')
+                             Skip    s' -> Skip (Nothing, s')
+                             Done       -> EMPTY_STREAM "init"
+                         ) (step s)
+
+    step' (Just x,  s) = liftM (\r -> 
+                           case r of
+                             Yield y s' -> Yield x (Just y, s')
+                             Skip    s' -> Skip    (Just x, s')
+                             Done       -> Done
+                         ) (step s)
+
+-- | All but the first element
+tail :: Monad m => Stream m a -> Stream m a
+{-# INLINE_FUSED tail #-}
+tail (Stream step s) = Stream step' (Left s)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (Left  s) = liftM (\r ->
+                        case r of
+                          Yield x s' -> Skip (Right s')
+                          Skip    s' -> Skip (Left  s')
+                          Done       -> EMPTY_STREAM "tail"
+                      ) (step s)
+
+    step' (Right s) = liftM (\r ->
+                        case r of
+                          Yield x s' -> Yield x (Right s')
+                          Skip    s' -> Skip    (Right s')
+                          Done       -> Done
+                      ) (step s)
+
+-- | The first @n@ elements
+take :: Monad m => Int -> Stream m a -> Stream m a
+{-# INLINE_FUSED take #-}
+take n (Stream step s) = n `seq` Stream step' (s, 0)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s, i) | i < n = liftM (\r ->
+                             case r of
+                               Yield x s' -> Yield x (s', i+1)
+                               Skip    s' -> Skip    (s', i)
+                               Done       -> Done
+                           ) (step s)
+    step' (s, i) = return Done
+
+-- | All but the first @n@ elements
+drop :: Monad m => Int -> Stream m a -> Stream m a
+{-# INLINE_FUSED drop #-}
+drop n (Stream step s) = Stream step' (s, Just n)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s, Just i) | i > 0 = liftM (\r ->
+                                case r of
+                                   Yield x s' -> Skip (s', Just (i-1))
+                                   Skip    s' -> Skip (s', Just i)
+                                   Done       -> Done
+                                ) (step s)
+                      | otherwise = return $ Skip (s, Nothing)
+
+    step' (s, Nothing) = liftM (\r ->
+                           case r of
+                             Yield x s' -> Yield x (s', Nothing)
+                             Skip    s' -> Skip    (s', Nothing)
+                             Done       -> Done
+                           ) (step s)
+                     
+-- Mapping
+-- -------
+
+instance Monad m => Functor (Stream m) where
+  {-# INLINE fmap #-}
+  fmap = map
+
+-- | Map a function over a 'Stream'
+map :: Monad m => (a -> b) -> Stream m a -> Stream m b
+{-# INLINE map #-}
+map f = mapM (return . f)
+
+
+-- | Map a monadic function over a 'Stream'
+mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
+{-# INLINE_FUSED mapM #-}
+mapM f (Stream step s) = Stream step' s
+  where
+    {-# INLINE_INNER step' #-}
+    step' s = do
+                r <- step s
+                case r of
+                  Yield x s' -> liftM  (`Yield` s') (f x)
+                  Skip    s' -> return (Skip    s')
+                  Done       -> return Done
+
+consume :: Monad m => Stream m a -> m ()
+{-# INLINE_FUSED consume #-}
+consume (Stream step s) = consume_loop SPEC s
+  where
+    consume_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield _ s' -> consume_loop SPEC s'
+            Skip    s' -> consume_loop SPEC s'
+            Done       -> return ()
+
+-- | Execute a monadic action for each element of the 'Stream'
+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
+{-# INLINE_FUSED mapM_ #-}
+mapM_ m = consume . mapM m
+
+-- | Transform a 'Stream' to use a different monad
+trans :: (Monad m, Monad m')
+      => (forall a. m a -> m' a) -> Stream m a -> Stream m' a
+{-# INLINE_FUSED trans #-}
+trans f (Stream step s) = Stream (f . step) s
+
+unbox :: Monad m => Stream m (Box a) -> Stream m a
+{-# INLINE_FUSED unbox #-}
+unbox (Stream step s) = Stream step' s
+  where
+    {-# INLINE_INNER step' #-}
+    step' s = do
+                r <- step s
+                case r of
+                  Yield (Box x) s' -> return $ Yield x s'
+                  Skip          s' -> return $ Skip    s'
+                  Done             -> return $ Done
+
+-- Zipping
+-- -------
+
+-- | Pair each element in a 'Stream' with its index
+indexed :: Monad m => Stream m a -> Stream m (Int,a)
+{-# INLINE_FUSED indexed #-}
+indexed (Stream step s) = Stream step' (s,0)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,i) = i `seq`
+                  do
+                    r <- step s
+                    case r of
+                      Yield x s' -> return $ Yield (i,x) (s', i+1)
+                      Skip    s' -> return $ Skip        (s', i)
+                      Done       -> return Done
+
+-- | Pair each element in a 'Stream' with its index, starting from the right
+-- and counting down
+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a)
+{-# INLINE_FUSED indexedR #-}
+indexedR m (Stream step s) = Stream step' (s,m)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,i) = i `seq`
+                  do
+                    r <- step s
+                    case r of
+                      Yield x s' -> let i' = i-1
+                                    in
+                                    return $ Yield (i',x) (s', i')
+                      Skip    s' -> return $ Skip         (s', i)
+                      Done       -> return Done
+
+-- | Zip two 'Stream's with the given monadic function
+zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
+{-# INLINE_FUSED zipWithM #-}
+zipWithM f (Stream stepa sa) (Stream stepb sb) = Stream step (sa, sb, Nothing)
+  where
+    {-# INLINE_INNER step #-}
+    step (sa, sb, Nothing) = liftM (\r ->
+                               case r of
+                                 Yield x sa' -> Skip (sa', sb, Just x)
+                                 Skip    sa' -> Skip (sa', sb, Nothing)
+                                 Done        -> Done
+                             ) (stepa sa)
+
+    step (sa, sb, Just x)  = do
+                               r <- stepb sb
+                               case r of
+                                 Yield y sb' ->
+                                   do
+                                     z <- f x y
+                                     return $ Yield z (sa, sb', Nothing)
+                                 Skip    sb' -> return $ Skip (sa, sb', Just x)
+                                 Done        -> return $ Done
+
+-- FIXME: This might expose an opportunity for inplace execution.
+{-# RULES
+
+"zipWithM xs xs [Vector.Stream]" forall f xs.
+  zipWithM f xs xs = mapM (\x -> f x x) xs
+
+  #-}
+
+zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m ()
+{-# INLINE zipWithM_ #-}
+zipWithM_ f sa sb = consume (zipWithM f sa sb)
+
+zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+{-# INLINE_FUSED zipWith3M #-}
+zipWith3M f (Stream stepa sa)
+            (Stream stepb sb)
+            (Stream stepc sc) = Stream step (sa, sb, sc, Nothing)
+  where
+    {-# INLINE_INNER step #-}
+    step (sa, sb, sc, Nothing) = do
+        r <- stepa sa
+        return $ case r of
+            Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing))
+            Skip    sa' -> Skip (sa', sb, sc, Nothing)
+            Done        -> Done
+
+    step (sa, sb, sc, Just (x, Nothing)) = do
+        r <- stepb sb
+        return $ case r of
+            Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y))
+            Skip    sb' -> Skip (sa, sb', sc, Just (x, Nothing))
+            Done        -> Done
+
+    step (sa, sb, sc, Just (x, Just y)) = do
+        r <- stepc sc
+        case r of
+            Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing))
+            Skip    sc' -> return $ Skip (sa, sb, sc', Just (x, Just y))
+            Done        -> return $ Done
+
+zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
+                     -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                     -> Stream m e
+{-# INLINE zipWith4M #-}
+zipWith4M f sa sb sc sd
+  = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)
+
+zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)
+                     -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                     -> Stream m e -> Stream m f
+{-# INLINE zipWith5M #-}
+zipWith5M f sa sb sc sd se
+  = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)
+
+zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)
+                     -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                     -> Stream m e -> Stream m f -> Stream m g
+{-# INLINE zipWith6M #-}
+zipWith6M fn sa sb sc sd se sf
+  = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)
+                                                  (zip3 sd se sf)
+
+zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
+{-# INLINE zipWith #-}
+zipWith f = zipWithM (\a b -> return (f a b))
+
+zipWith3 :: Monad m => (a -> b -> c -> d)
+                    -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+{-# INLINE zipWith3 #-}
+zipWith3 f = zipWith3M (\a b c -> return (f a b c))
+
+zipWith4 :: Monad m => (a -> b -> c -> d -> e)
+                    -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                    -> Stream m e
+{-# INLINE zipWith4 #-}
+zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))
+
+zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)
+                    -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                    -> Stream m e -> Stream m f
+{-# INLINE zipWith5 #-}
+zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))
+
+zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)
+                    -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+                    -> Stream m e -> Stream m f -> Stream m g
+{-# INLINE zipWith6 #-}
+zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))
+
+zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b)
+{-# INLINE zip #-}
+zip = zipWith (,)
+
+zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c)
+{-# INLINE zip3 #-}
+zip3 = zipWith3 (,,)
+
+zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
+                -> Stream m (a,b,c,d)
+{-# INLINE zip4 #-}
+zip4 = zipWith4 (,,,)
+
+zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
+                -> Stream m e -> Stream m (a,b,c,d,e)
+{-# INLINE zip5 #-}
+zip5 = zipWith5 (,,,,)
+
+zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
+                -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f)
+{-# INLINE zip6 #-}
+zip6 = zipWith6 (,,,,,)
+
+-- Comparisons
+-- -----------
+
+-- | Check if two 'Stream's are equal
+eq :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool
+{-# INLINE_FUSED eq #-}
+eq (Stream step1 s1) (Stream step2 s2) = eq_loop0 SPEC s1 s2
+  where
+    eq_loop0 !sPEC s1 s2 = do
+      r <- step1 s1
+      case r of
+        Yield x s1' -> eq_loop1 SPEC x s1' s2
+        Skip    s1' -> eq_loop0 SPEC   s1' s2
+        Done        -> eq_null s2
+
+    eq_loop1 !sPEC x s1 s2 = do
+      r <- step2 s2
+      case r of
+        Yield y s2'
+          | x == y    -> eq_loop0 SPEC   s1 s2'
+          | otherwise -> return False
+        Skip    s2'   -> eq_loop1 SPEC x s1 s2'
+        Done          -> return False
+
+    eq_null s2 = do
+      r <- step2 s2
+      case r of
+        Yield _ _ -> return False
+        Skip s2'  -> eq_null s2'
+        Done      -> return True
+
+-- | Lexicographically compare two 'Stream's
+cmp :: (Monad m, Ord a) => Stream m a -> Stream m a -> m Ordering
+{-# INLINE_FUSED cmp #-}
+cmp (Stream step1 s1) (Stream step2 s2) = cmp_loop0 SPEC s1 s2
+  where
+    cmp_loop0 !sPEC s1 s2 = do
+      r <- step1 s1
+      case r of
+        Yield x s1' -> cmp_loop1 SPEC x s1' s2
+        Skip    s1' -> cmp_loop0 SPEC   s1' s2
+        Done        -> cmp_null s2
+
+    cmp_loop1 !sPEC x s1 s2 = do
+      r <- step2 s2
+      case r of
+        Yield y s2' -> case x `compare` y of
+                         EQ -> cmp_loop0 SPEC s1 s2'
+                         c  -> return c
+        Skip    s2' -> cmp_loop1 SPEC x s1 s2'
+        Done        -> return GT
+
+    cmp_null s2 = do
+      r <- step2 s2
+      case r of
+        Yield _ _ -> return LT
+        Skip s2'  -> cmp_null s2'
+        Done      -> return EQ
+
+-- Filtering
+-- ---------
+
+-- | Drop elements which do not satisfy the predicate
+filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+{-# INLINE filter #-}
+filter f = filterM (return . f)
+
+-- | Drop elements which do not satisfy the monadic predicate
+filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
+{-# INLINE_FUSED filterM #-}
+filterM f (Stream step s) = Stream step' s
+  where
+    {-# INLINE_INNER step' #-}
+    step' s = do
+                r <- step s
+                case r of
+                  Yield x s' -> do
+                                  b <- f x
+                                  return $ if b then Yield x s'
+                                                else Skip    s'
+                  Skip    s' -> return $ Skip s'
+                  Done       -> return $ Done
+
+-- | Longest prefix of elements that satisfy the predicate
+takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+{-# INLINE takeWhile #-}
+takeWhile f = takeWhileM (return . f)
+
+-- | Longest prefix of elements that satisfy the monadic predicate
+takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
+{-# INLINE_FUSED takeWhileM #-}
+takeWhileM f (Stream step s) = Stream step' s
+  where
+    {-# INLINE_INNER step' #-}
+    step' s = do
+                r <- step s
+                case r of
+                  Yield x s' -> do
+                                  b <- f x
+                                  return $ if b then Yield x s' else Done
+                  Skip    s' -> return $ Skip s'
+                  Done       -> return $ Done
+
+-- | Drop the longest prefix of elements that satisfy the predicate
+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+{-# INLINE dropWhile #-}
+dropWhile f = dropWhileM (return . f)
+
+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 a -> Stream m a
+{-# INLINE_FUSED dropWhileM #-}
+dropWhileM f (Stream step s) = Stream step' (DropWhile_Drop s)
+  where
+    -- NOTE: we jump through hoops here to have only one Yield; local data
+    -- declarations would be nice!
+
+    {-# INLINE_INNER step' #-}
+    step' (DropWhile_Drop s)
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> do
+                            b <- f x
+                            return $ if b then Skip (DropWhile_Drop    s')
+                                          else Skip (DropWhile_Yield x s')
+            Skip    s' -> return $ Skip (DropWhile_Drop    s')
+            Done       -> return $ Done
+
+    step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
+
+    step' (DropWhile_Next s)
+      = liftM (\r ->
+          case r of
+            Yield x s' -> Skip    (DropWhile_Yield x s')
+            Skip    s' -> Skip    (DropWhile_Next    s')
+            Done       -> Done
+        ) (step s)
+
+-- Searching
+-- ---------
+
+infix 4 `elem`
+-- | Check whether the 'Stream' contains an element
+elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
+{-# INLINE_FUSED elem #-}
+elem x (Stream step s) = elem_loop SPEC s
+  where
+    elem_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield y s' | x == y    -> return True
+                       | otherwise -> elem_loop SPEC s'
+            Skip    s'             -> elem_loop SPEC s'
+            Done                   -> return False
+
+infix 4 `notElem`
+-- | Inverse of `elem`
+notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
+{-# INLINE notElem #-}
+notElem x s = liftM not (elem x s)
+
+-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
+-- if no such element exists.
+find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
+{-# INLINE find #-}
+find f = findM (return . f)
+
+-- | Yield 'Just' the first element that satisfies the monadic predicate or
+-- 'Nothing' if no such element exists.
+findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
+{-# INLINE_FUSED findM #-}
+findM f (Stream step s) = find_loop SPEC s
+  where
+    find_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> do
+                            b <- f x
+                            if b then return $ Just x
+                                 else find_loop SPEC s'
+            Skip    s' -> find_loop SPEC s'
+            Done       -> return Nothing
+
+-- | Yield 'Just' the index of the first element that satisfies the predicate
+-- or 'Nothing' if no such element exists.
+findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
+{-# INLINE_FUSED findIndex #-}
+findIndex f = findIndexM (return . f)
+
+-- | Yield 'Just' the index of the first element that satisfies the monadic
+-- predicate or 'Nothing' if no such element exists.
+findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
+{-# INLINE_FUSED findIndexM #-}
+findIndexM f (Stream step s) = findIndex_loop SPEC s 0
+  where
+    findIndex_loop !sPEC s i
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> do
+                            b <- f x
+                            if b then return $ Just i
+                                 else findIndex_loop SPEC s' (i+1)
+            Skip    s' -> findIndex_loop SPEC s' i
+            Done       -> return Nothing
+
+-- Folding
+-- -------
+
+-- | Left fold
+foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
+{-# INLINE foldl #-}
+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 b -> m a
+{-# INLINE_FUSED foldlM #-}
+foldlM m z (Stream step s) = foldlM_loop SPEC z s
+  where
+    foldlM_loop !sPEC z s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' }
+            Skip    s' -> foldlM_loop SPEC z s'
+            Done       -> return z
+
+-- | Same as 'foldlM'
+foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
+{-# INLINE foldM #-}
+foldM = foldlM
+
+-- | Left fold over a non-empty 'Stream'
+foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
+{-# INLINE foldl1 #-}
+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 a -> m a
+{-# INLINE_FUSED foldl1M #-}
+foldl1M f (Stream step s) = foldl1M_loop SPEC s
+  where
+    foldl1M_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> foldlM f x (Stream step s')
+            Skip    s' -> foldl1M_loop SPEC s'
+            Done       -> EMPTY_STREAM "foldl1M"
+
+-- | Same as 'foldl1M'
+fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+{-# INLINE fold1M #-}
+fold1M = foldl1M
+
+-- | Left fold with a strict accumulator
+foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
+{-# INLINE foldl' #-}
+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 b -> m a
+{-# INLINE_FUSED foldlM' #-}
+foldlM' m z (Stream step s) = foldlM'_loop SPEC z s
+  where
+    foldlM'_loop !sPEC z s
+      = z `seq`
+        do
+          r <- step s
+          case r of
+            Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
+            Skip    s' -> foldlM'_loop SPEC z s'
+            Done       -> return z
+
+-- | Same as 'foldlM''
+foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
+{-# INLINE foldM' #-}
+foldM' = foldlM'
+
+-- | Left fold over a non-empty 'Stream' with a strict accumulator
+foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
+{-# INLINE foldl1' #-}
+foldl1' f = foldl1M' (\a b -> return (f a b))
+
+-- | Left fold over a non-empty 'Stream' with a strict accumulator and a
+-- monadic operator
+foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+{-# INLINE_FUSED foldl1M' #-}
+foldl1M' f (Stream step s) = foldl1M'_loop SPEC s
+  where
+    foldl1M'_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> foldlM' f x (Stream step s')
+            Skip    s' -> foldl1M'_loop SPEC s'
+            Done       -> EMPTY_STREAM "foldl1M'"
+
+-- | Same as 'foldl1M''
+fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+{-# INLINE fold1M' #-}
+fold1M' = foldl1M'
+
+-- | Right fold
+foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
+{-# INLINE foldr #-}
+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 a -> m b
+{-# INLINE_FUSED foldrM #-}
+foldrM f z (Stream step s) = foldrM_loop SPEC s
+  where
+    foldrM_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> f x =<< foldrM_loop SPEC s'
+            Skip    s' -> foldrM_loop SPEC s'
+            Done       -> return z
+
+-- | Right fold over a non-empty stream
+foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
+{-# INLINE foldr1 #-}
+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 a -> m a
+{-# INLINE_FUSED foldr1M #-}
+foldr1M f (Stream step s) = foldr1M_loop0 SPEC s
+  where
+    foldr1M_loop0 !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> foldr1M_loop1 SPEC x s'
+            Skip    s' -> foldr1M_loop0 SPEC   s'
+            Done       -> EMPTY_STREAM "foldr1M"
+
+    foldr1M_loop1 !sPEC x s
+      = do
+          r <- step s
+          case r of
+            Yield y s' -> f x =<< foldr1M_loop1 SPEC y s'
+            Skip    s' -> foldr1M_loop1 SPEC x s'
+            Done       -> return x
+
+-- Specialised folds
+-- -----------------
+
+and :: Monad m => Stream m Bool -> m Bool
+{-# INLINE_FUSED and #-}
+and (Stream step s) = and_loop SPEC s
+  where
+    and_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield False _  -> return False
+            Yield True  s' -> and_loop SPEC s'
+            Skip        s' -> and_loop SPEC s'
+            Done           -> return True
+
+or :: Monad m => Stream m Bool -> m Bool
+{-# INLINE_FUSED or #-}
+or (Stream step s) = or_loop SPEC s
+  where
+    or_loop !sPEC s
+      = do
+          r <- step s
+          case r of
+            Yield False s' -> or_loop SPEC s'
+            Yield True  _  -> return True
+            Skip        s' -> or_loop SPEC s'
+            Done           -> return False
+
+concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
+{-# INLINE concatMap #-}
+concatMap f = concatMapM (return . f)
+
+concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b
+{-# INLINE_FUSED concatMapM #-}
+concatMapM f (Stream step s) = Stream concatMap_go (Left s)
+  where
+    concatMap_go (Left s) = do
+        r <- step s
+        case r of
+            Yield a s' -> do
+                b_stream <- f a
+                return $ Skip (Right (b_stream, s'))
+            Skip    s' -> return $ Skip (Left s')
+            Done       -> return Done
+    concatMap_go (Right (Stream inner_step inner_s, s)) = do
+        r <- inner_step inner_s
+        case r of
+            Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s))
+            Skip    inner_s' -> return $ Skip (Right (Stream inner_step inner_s', s))
+            Done             -> return $ Skip (Left s)
+
+-- | Create a 'Stream' of values from a 'Stream' of streamable things
+flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
+{-# INLINE_FUSED flatten #-}
+flatten mk istep (Stream ostep t) = Stream step (Left t)
+  where
+    {-# INLINE_INNER step #-}
+    step (Left t) = do
+                      r <- ostep t
+                      case r of
+                        Yield a t' -> do
+                                        s <- mk a
+                                        s `seq` return (Skip (Right (s,t')))
+                        Skip    t' -> return $ Skip (Left t')
+                        Done       -> return $ Done
+
+    
+    step (Right (s,t)) = do
+                           r <- istep s
+                           case r of
+                             Yield x s' -> return $ Yield x (Right (s',t))
+                             Skip    s' -> return $ Skip    (Right (s',t))
+                             Done       -> return $ Skip    (Left t)
+
+-- Unfolding
+-- ---------
+
+-- | Unfold
+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
+{-# INLINE_FUSED unfoldr #-}
+unfoldr f = unfoldrM (return . f)
+
+-- | Unfold with a monadic function
+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
+{-# INLINE_FUSED unfoldrM #-}
+unfoldrM f s = Stream step s
+  where
+    {-# INLINE_INNER step #-}
+    step s = liftM (\r ->
+               case r of
+                 Just (x, s') -> Yield x s'
+                 Nothing      -> Done
+             ) (f s)
+
+unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a
+{-# INLINE_FUSED unfoldrN #-}
+unfoldrN n f = unfoldrNM n (return . f)
+
+-- | Unfold at most @n@ elements with a monadic functions
+unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a
+{-# INLINE_FUSED unfoldrNM #-}
+unfoldrNM n f s = Stream step (s,n)
+  where
+    {-# INLINE_INNER step #-}
+    step (s,n) | n <= 0    = return Done
+               | otherwise = liftM (\r ->
+                               case r of
+                                 Just (x,s') -> Yield x (s',n-1)
+                                 Nothing     -> Done
+                             ) (f s)
+
+-- | Apply monadic function n times to value. Zeroth element is original value.
+iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a
+{-# INLINE_FUSED iterateNM #-}
+iterateNM n f x0 = Stream step (x0,n)
+  where
+    {-# INLINE_INNER step #-}
+    step (x,i) | i <= 0    = return Done
+               | i == n    = return $ Yield x (x,i-1)
+               | otherwise = do a <- f x
+                                return $ Yield a (a,i-1)
+
+-- | Apply function n times to value. Zeroth element is original value.
+iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a
+{-# INLINE_FUSED iterateN #-}
+iterateN n f x0 = iterateNM n (return . f) x0
+
+-- Scans
+-- -----
+
+-- | Prefix scan
+prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE prescanl #-}
+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 b -> Stream m a
+{-# INLINE_FUSED prescanlM #-}
+prescanlM f z (Stream step s) = Stream step' (s,z)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,x) = do
+                    r <- step s
+                    case r of
+                      Yield y s' -> do
+                                      z <- f x y
+                                      return $ Yield x (s', z)
+                      Skip    s' -> return $ Skip (s', x)
+                      Done       -> return Done
+
+-- | Prefix scan with strict accumulator
+prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE prescanl' #-}
+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 b -> Stream m a
+{-# INLINE_FUSED prescanlM' #-}
+prescanlM' f z (Stream step s) = Stream step' (s,z)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,x) = x `seq`
+                  do
+                    r <- step s
+                    case r of
+                      Yield y s' -> do
+                                      z <- f x y
+                                      return $ Yield x (s', z)
+                      Skip    s' -> return $ Skip (s', x)
+                      Done       -> return Done
+
+-- | Suffix scan
+postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE postscanl #-}
+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 b -> Stream m a
+{-# INLINE_FUSED postscanlM #-}
+postscanlM f z (Stream step s) = Stream step' (s,z)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,x) = do
+                    r <- step s
+                    case r of
+                      Yield y s' -> do
+                                      z <- f x y
+                                      return $ Yield z (s',z)
+                      Skip    s' -> return $ Skip (s',x)
+                      Done       -> return Done
+
+-- | Suffix scan with strict accumulator
+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE postscanl' #-}
+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 b -> Stream m a
+{-# INLINE_FUSED postscanlM' #-}
+postscanlM' f z (Stream step s) = z `seq` Stream step' (s,z)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s,x) = x `seq`
+                  do
+                    r <- step s
+                    case r of
+                      Yield y s' -> do
+                                      z <- f x y
+                                      z `seq` return (Yield z (s',z))
+                      Skip    s' -> return $ Skip (s',x)
+                      Done       -> return Done
+
+-- | Haskell-style scan
+scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE scanl #-}
+scanl f = scanlM (\a b -> return (f a b))
+
+-- | Haskell-style scan with a monadic operator
+scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
+{-# INLINE scanlM #-}
+scanlM f z s = z `cons` postscanlM f z s
+
+-- | Haskell-style scan with strict accumulator
+scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+{-# INLINE scanl' #-}
+scanl' f = scanlM' (\a b -> return (f a b))
+
+-- | Haskell-style scan with strict accumulator and a monadic operator
+scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
+{-# INLINE scanlM' #-}
+scanlM' f z s = z `seq` (z `cons` postscanlM f z s)
+
+-- | Scan over a non-empty 'Stream'
+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
+{-# INLINE scanl1 #-}
+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 a -> Stream m a
+{-# INLINE_FUSED scanl1M #-}
+scanl1M f (Stream step s) = Stream step' (s, Nothing)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s, Nothing) = do
+                           r <- step s
+                           case r of
+                             Yield x s' -> return $ Yield x (s', Just x)
+                             Skip    s' -> return $ Skip (s', Nothing)
+                             Done       -> EMPTY_STREAM "scanl1M"
+
+    step' (s, Just x) = do
+                          r <- step s
+                          case r of
+                            Yield y s' -> do
+                                            z <- f x y
+                                            return $ Yield z (s', Just z)
+                            Skip    s' -> return $ Skip (s', Just x)
+                            Done       -> return Done
+
+-- | Scan over a non-empty 'Stream' with a strict accumulator
+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
+{-# INLINE scanl1' #-}
+scanl1' f = scanl1M' (\x y -> return (f x y))
+
+-- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic
+-- operator
+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
+{-# INLINE_FUSED scanl1M' #-}
+scanl1M' f (Stream step s) = Stream step' (s, Nothing)
+  where
+    {-# INLINE_INNER step' #-}
+    step' (s, Nothing) = do
+                           r <- step s
+                           case r of
+                             Yield x s' -> x `seq` return (Yield x (s', Just x))
+                             Skip    s' -> return $ Skip (s', Nothing)
+                             Done       -> EMPTY_STREAM "scanl1M"
+
+    step' (s, Just x) = x `seq`
+                        do
+                          r <- step s
+                          case r of
+                            Yield y s' -> do
+                                            z <- f x y
+                                            z `seq` return (Yield z (s', Just z))
+                            Skip    s' -> return $ Skip (s', Just x)
+                            Done       -> return Done
+
+-- Enumerations
+-- ------------
+
+-- The Enum class is broken for this, there just doesn't seem to be a
+-- way to implement this generically. We have to specialise for as many types
+-- as we can but this doesn't help in polymorphic loops.
+
+-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,
+-- @x+y+y@ etc.
+enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a
+{-# INLINE_FUSED enumFromStepN #-}
+enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n)
+  where
+    {-# INLINE_INNER step #-}
+    step (x,n) | n > 0     = return $ Yield x (x+y,n-1)
+               | otherwise = return $ Done
+
+-- | Enumerate values
+--
+-- /WARNING:/ This operation can be very inefficient. If at all possible, use
+-- 'enumFromStepN' instead.
+enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a
+{-# INLINE_FUSED enumFromTo #-}
+enumFromTo x y = fromList [x .. y]
+
+-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for
+-- overflow which can't happen here.
+
+-- FIXME: add "too large" test for Int
+enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_FUSED enumFromTo_small #-}
+enumFromTo_small x y = x `seq` y `seq` Stream step x
+  where
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Int8> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8
+
+"enumFromTo<Int16> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16
+
+"enumFromTo<Word8> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8
+
+"enumFromTo<Word16> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16
+
+  #-}
+
+#if WORD_SIZE_IN_BITS > 32
+
+{-# RULES
+
+"enumFromTo<Int32> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32
+
+"enumFromTo<Word32> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32
+
+  #-}
+
+#endif
+
+-- NOTE: We could implement a generic "too large" test:
+--
+-- len x y | x > y = 0
+--         | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n
+--         | otherwise = error
+--   where
+--     n = y-x+1
+--
+-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for
+-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744
+--
+
+enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int
+{-# INLINE_FUSED enumFromTo_int #-}
+enumFromTo_int x y = x `seq` y `seq` Stream step x
+  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 a
+{-# INLINE_FUSED enumFromTo_intlike #-}
+enumFromTo_intlike x y = x `seq` y `seq` Stream step x
+  where
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Int> [Stream]"
+  enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int
+
+#if WORD_SIZE_IN_BITS > 32
+
+"enumFromTo<Int64> [Stream]"
+  enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64
+
+#else
+
+"enumFromTo<Int32> [Stream]"
+  enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32
+
+#endif
+
+  #-}
+
+enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_FUSED enumFromTo_big_word #-}
+enumFromTo_big_word x y = x `seq` y `seq` Stream step x
+  where
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Word> [Stream]"
+  enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word
+
+"enumFromTo<Word64> [Stream]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Word64 -> Word64 -> Stream m Word64
+
+#if WORD_SIZE_IN_BITS == 32
+
+"enumFromTo<Word32> [Stream]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Word32 -> Word32 -> Stream m Word32
+
+#endif
+
+"enumFromTo<Integer> [Stream]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Integer -> Integer -> Stream m Integer
+
+  #-}
+
+-- FIXME: the "too large" test is totally wrong
+enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_FUSED enumFromTo_big_int #-}
+enumFromTo_big_int x y = x `seq` y `seq` Stream step x
+  where
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+#if WORD_SIZE_IN_BITS > 32
+
+{-# RULES
+
+"enumFromTo<Int64> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64
+
+  #-}
+
+#endif
+
+enumFromTo_char :: Monad m => Char -> Char -> Stream m Char
+{-# INLINE_FUSED enumFromTo_char #-}
+enumFromTo_char x y = x `seq` y `seq` Stream step xn
+  where
+    xn = ord x
+    yn = ord y
+
+    {-# INLINE_INNER step #-}
+    step xn | xn <= yn  = return $ Yield (unsafeChr xn) (xn+1)
+            | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Char> [Stream]"
+  enumFromTo = enumFromTo_char
+
+  #-}
+
+------------------------------------------------------------------------
+
+-- Specialise enumFromTo for Float and Double.
+-- Also, try to do something about pairs?
+
+enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a
+{-# INLINE_FUSED enumFromTo_double #-}
+enumFromTo_double n m = n `seq` m `seq` Stream step n
+  where
+    lim = m + 1/2 -- important to float out
+
+    {-# INLINE_INNER step #-}
+    step x | x <= lim  = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Double> [Stream]"
+  enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double
+
+"enumFromTo<Float> [Stream]"
+  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float
+
+  #-}
+
+------------------------------------------------------------------------
+
+-- | Enumerate values with a given step.
+--
+-- /WARNING:/ This operation is very inefficient. If at all possible, use
+-- 'enumFromStepN' instead.
+enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a
+{-# INLINE_FUSED enumFromThenTo #-}
+enumFromThenTo x y z = fromList [x, y .. z]
+
+-- FIXME: Specialise enumFromThenTo.
+
+-- Conversions
+-- -----------
+
+-- | Convert a 'Stream' to a list
+toList :: Monad m => Stream m a -> m [a]
+{-# INLINE toList #-}
+toList = foldr (:) []
+
+-- | Convert a list to a 'Stream'
+fromList :: Monad m => [a] -> Stream m a
+{-# INLINE fromList #-}
+fromList xs = Stream step xs
+  where
+    step (x:xs) = return (Yield x xs)
+    step []     = return Done
+
+-- | Convert the first @n@ elements of a list to a 'Bundle'
+fromListN :: Monad m => Int -> [a] -> Stream m a
+{-# INLINE_FUSED fromListN #-}
+fromListN n xs = Stream step (xs,n)
+  where
+    {-# INLINE_INNER step #-}
+    step (xs,n) | n <= 0 = return Done
+    step (x:xs,n)        = return (Yield x (xs,n-1))
+    step ([],n)          = return Done
+
+{-
+fromVector :: (Monad m, Vector v a) => v a -> Stream m a
+{-# INLINE_FUSED fromVector #-}
+fromVector v = v `seq` n `seq` Stream (Unf step 0)
+                                      (Unf vstep True)
+                                      (Just v)
+                                      (Exact n)
+  where
+    n = basicLength v
+
+    {-# INLINE step #-}
+    step i | i >= n = return Done
+           | otherwise = case basicUnsafeIndexM v i of
+                           Box x -> return $ Yield x (i+1)
+
+    
+    {-# INLINE vstep #-}
+    vstep True  = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)
+    vstep False = return Done
+
+fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a
+{-# INLINE_FUSED fromVectors #-}
+fromVectors vs = Stream (Unf pstep (Left vs))
+                        (Unf vstep vs)
+                        Nothing
+                        (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))
+
+    -- FIXME: work around bug in GHC 7.6.1
+    vstep :: [v a] -> m (Step [v a] (Chunk v a))
+    vstep [] = return Done
+    vstep (v:vs) = return $ Yield (Chunk (basicLength v)
+                                         (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+                                                                       (M.basicLength mv == basicLength v)
+                                                 $ basicUnsafeCopy mv v)) vs
+
+
+concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a
+{-# INLINE_FUSED concatVectors #-}
+concatVectors (Stream step s}
+  = Stream (Unf pstep (Left s))
+           (Unf vstep s)
+           Nothing
+           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 -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+                                                                          (M.basicLength mv == basicLength v)
+                                                   $ basicUnsafeCopy mv v)) s')
+        Skip    s' -> return (Skip s')
+        Done       -> return Done
+
+reVector :: Monad m => Stream m a -> Stream m a
+{-# INLINE_FUSED reVector #-}
+reVector (Stream step s, sSize = n} = Stream step s n
+
+{-# RULES
+
+"reVector [Vector]"
+  reVector = id
+
+"reVector/reVector [Vector]" forall s.
+  reVector (reVector s) = s
+
+  #-}
+-}
+
index 12d9143..3cbebf1 100644 (file)
@@ -63,6 +63,7 @@ import qualified Data.Vector.Generic.Base as V
 import qualified Data.Vector.Fusion.Bundle      as Bundle
 import           Data.Vector.Fusion.Bundle      ( Bundle, MBundle, Chunk(..) )
 import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle
+import qualified Data.Vector.Fusion.Stream.Monadic as MStream
 import           Data.Vector.Fusion.Bundle.Size
 import           Data.Vector.Fusion.Util        ( delay_inline )
 
@@ -418,7 +419,7 @@ vmunstreamMax s n
               f (basicUnsafeSlice i n v)
               return (i+n)
 
-      n' <- MBundle.vfoldlM' copy 0 s
+      n' <- MStream.foldlM' copy 0 (MBundle.chunks s)
       return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n
              $ unsafeSlice 0 n' v
 
@@ -428,7 +429,7 @@ vmunstreamUnknown :: (PrimMonad m, V.Vector v a)
 vmunstreamUnknown s
   = do
       v <- unsafeNew 0
-      (v', n) <- MBundle.vfoldlM copy (v, 0) s
+      (v', n) <- MStream.foldlM copy (v,0) (MBundle.chunks s)
       return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v')
              $ unsafeSlice 0 n v'
   where
index 4cdb762..f66078c 100644 (file)
@@ -99,6 +99,7 @@ Library
         Data.Vector.Internal.Check
 
         Data.Vector.Fusion.Util
+        Data.Vector.Fusion.Stream.Monadic
         Data.Vector.Fusion.Bundle.Size
         Data.Vector.Fusion.Bundle.Monadic
         Data.Vector.Fusion.Bundle