INLINE_STREAM -> INLINE_FUSED
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
index d8ec6d8..c77bceb 100644 (file)
@@ -1,19 +1,21 @@
-{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}
 
 -- |
 -- Module      : Data.Vector.Fusion.Stream.Monadic
--- Copyright   : (c) Roman Leshchinskiy 2008-2009
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
 -- License     : BSD-style
 --
 -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
 -- Stability   : experimental
 -- Portability : non-portable
 --
--- Monadic streams
+-- Monadic stream combinators.
 --
 
 module Data.Vector.Fusion.Stream.Monadic (
-  Stream(..), Step(..),
+  Facets(..), Unf(..), Step(..), Chunk(..), SPEC(..),
+
+  simple,
 
   -- * Size hints
   size, sized,
@@ -22,23 +24,26 @@ module Data.Vector.Fusion.Stream.Monadic (
   length, null,
 
   -- * Construction
-  empty, singleton, cons, snoc, replicate, generate, generateM, (++),
+  empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),
 
   -- * Accessing elements
-  head, last, (!!),
+  head, last, (!!), (!?),
 
   -- * Substreams
-  extract, init, tail, take, drop,
+  slice, init, tail, take, drop,
 
   -- * Mapping
-  map, mapM, mapM_, trans, unbox, concatMap,
+  map, mapM, mapM_, trans, unbox, concatMap, flatten,
   
   -- * Zipping
-  indexed,
+  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,
 
@@ -50,11 +55,15 @@ module Data.Vector.Fusion.Stream.Monadic (
   foldl', foldlM', foldl1', foldl1M', foldM', fold1M',
   foldr, foldrM, foldr1, foldr1M,
 
+  vfoldlM, vfoldlM',
+
   -- * Specialised folds
   and, or, concatMapM,
 
   -- * Unfolding
   unfoldr, unfoldrM,
+  unfoldrN, unfoldrNM,
+  iterateN, iterateNM,
 
   -- * Scans
   prescanl, prescanlM, prescanl', prescanlM',
@@ -63,15 +72,20 @@ module Data.Vector.Fusion.Stream.Monadic (
   scanl1, scanl1M, scanl1', scanl1M',
 
   -- * Enumerations
-  enumFromTo, enumFromThenTo,
+  enumFromStepN, enumFromTo, enumFromThenTo,
 
   -- * Conversions
-  toList, fromList
+  toList, fromList, fromListN, unsafeFromList,
+  fromVector, reVector, fromVectors, concatVectors
 ) where
 
+import Data.Vector.Generic.Base
+import qualified Data.Vector.Generic.Mutable.Base as M
 import Data.Vector.Fusion.Stream.Size
 import Data.Vector.Fusion.Util ( Box(..), delay_inline )
+import Control.Monad.Primitive
 
+import qualified Data.List as List
 import Data.Char      ( ord )
 import GHC.Base       ( unsafeChr )
 import Control.Monad  ( liftM )
@@ -87,91 +101,151 @@ import Prelude hiding ( length, null,
                         and, or,
                         scanl, scanl1,
                         enumFromTo, enumFromThenTo )
-import qualified Prelude
 
 import Data.Int  ( Int8, Int16, Int32, Int64 )
 import Data.Word ( Word8, Word16, Word32, Word, Word64 )
 
-#if __GLASGOW_HASKELL__ >= 613
-import SpecConstr ( SpecConstrAnnotation(..) )
+#if __GLASGOW_HASKELL__ >= 700
+import GHC.Exts ( SpecConstrAnnotation(..) )
 #endif
 
 #include "vector.h"
 
 data SPEC = SPEC | SPEC2
-#if __GLASGOW_HASKELL__ >= 613
+#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 = Yield a s  -- ^ a new element and a new seed
-              | Skip    s  -- ^ just a new seed
-              | Done       -- ^ end of 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 Stream m a = forall s. Stream (s -> m (Step s a)) s Size
+data Facets m v a = Facets { sElems  :: Unf m a
+                           , sChunks :: Unf m (Chunk v a)
+                           , sVector :: Maybe (v a)
+                           , sSize   :: Size
+                           }
+
+simple :: Monad m => (s -> m (Step s a)) -> s -> Size -> Facets m v a
+{-# INLINE simple #-}
+simple step s sz = Facets (Unf step s) (Unf step' s) Nothing sz
+  where
+    step' s = do r <- step s
+                 return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r
 
--- | 'Size' hint of a 'Stream'
-size :: Stream m a -> Size
+-- | 'Size' hint of a 'Facets'
+size :: Facets m v a -> Size
 {-# INLINE size #-}
-size (Stream _ _ sz) = sz
+size = sSize
 
--- | Attach a 'Size' hint to a 'Stream'
-sized :: Stream m a -> Size -> Stream m a
-{-# INLINE_STREAM sized #-}
-sized (Stream step s _) sz = Stream step s sz
+-- | Attach a 'Size' hint to a 'Facets'
+sized :: Facets m v a -> Size -> Facets m v a
+{-# INLINE_FUSED sized #-}
+sized s sz = s { sSize = sz }
 
 -- Length
 -- ------
 
--- | Length of a 'Stream'
-length :: Monad m => Stream m a -> m Int
-{-# INLINE_STREAM length #-}
-length s = foldl' (\n _ -> n+1) 0 s
-
--- | Check if a 'Stream' is empty
-null :: Monad m => Stream m a -> m Bool
-{-# INLINE_STREAM null #-}
-null s = foldr (\_ _ -> False) True s
-
+-- | Length of a 'Facets'
+length :: Monad m => Facets m v a -> m Int
+{-# INLINE_FUSED length #-}
+length Facets{sSize = Exact n}  = return n
+length s = vfoldl' (\n (Chunk k _) -> n+k) 0 s
+
+-- | Check if a 'Facets' is empty
+null :: Monad m => Facets m v a -> m Bool
+{-# INLINE_FUSED null #-}
+null Facets{sSize = Exact n} = return (n == 0)
+null Facets{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
 
 -- Construction
 -- ------------
 
--- | Empty 'Stream'
-empty :: Monad m => Stream m a
-{-# INLINE_STREAM empty #-}
-empty = Stream (const (return Done)) () (Exact 0)
+-- | Empty 'Facets'
+empty :: Monad m => Facets m v a
+{-# INLINE_FUSED empty #-}
+empty = simple (const (return Done)) () (Exact 0)
 
--- | Singleton 'Stream'
-singleton :: Monad m => a -> Stream m a
-{-# INLINE_STREAM singleton #-}
-singleton x = Stream (return . step) True (Exact 1)
+-- | Singleton 'Facets'
+singleton :: Monad m => a -> Facets 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
 
 -- | Replicate a value to a given length
-replicate :: Monad m => Int -> a -> Stream m a
-{-# INLINE_STREAM replicate #-}
+replicate :: Monad m => Int -> a -> Facets m v a
+{-# INLINE_FUSED replicate #-}
+replicate n x = Facets (Unf pstep n) (Unf vstep True) 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 'Facets' of values obtained by performing the monadic action the
+-- given number of times
+replicateM :: Monad m => Int -> m a -> Facets 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.
-replicate n x = Stream (return . step) n (Exact (delay_inline max n 0))
+replicateM n p = simple step n (Exact (delay_inline max n 0))
   where
     {-# INLINE_INNER step #-}
-    step i | i > 0     = Yield x (i-1)
-           | otherwise = Done
+    step i | i <= 0    = return Done
+           | otherwise = do { x <- p; return $ Yield x (i-1) }
 
-generate :: Monad m => Int -> (Int -> a) -> Stream m a
+generate :: Monad m => Int -> (Int -> a) -> Facets m v 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_STREAM generateM #-}
-generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0))
+generateM :: Monad m => Int -> (Int -> m a) -> Facets 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
@@ -180,20 +254,22 @@ generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0))
            | otherwise = return Done
 
 -- | Prepend an element
-cons :: Monad m => a -> Stream m a -> Stream m a
+cons :: Monad m => a -> Facets m v a -> Facets m v a
 {-# INLINE cons #-}
 cons x s = singleton x ++ s
 
 -- | Append an element
-snoc :: Monad m => Stream m a -> a -> Stream m a
+snoc :: Monad m => Facets m v a -> a -> Facets m v 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_STREAM (++) #-}
-Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
+-- | Concatenate two 'Facets's
+(++) :: Monad m => Facets m v a -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED (++) #-}
+Facets{sElems = Unf stepa sa, sChunks = Unf vstepa vsa, sSize = na}
+  ++ Facets{sElems = Unf stepb sb, sChunks = Unf vstepb vsb, sSize = nb}
+    = Facets (Unf step (Left sa)) (Unf vstep (Left vsa)) Nothing (na + nb)
   where
     {-# INLINE_INNER step #-}
     step (Left  sa) = do
@@ -209,38 +285,52 @@ Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
                           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
+
 -- Accessing elements
 -- ------------------
 
--- | First element of the 'Stream' or error if empty
-head :: Monad m => Stream m a -> m a
-{-# INLINE_STREAM head #-}
-head (Stream step s _) = head_loop SPEC s
+-- | First element of the 'Facets' or error if empty
+head :: Monad m => Facets m v a -> m a
+{-# INLINE_FUSED head #-}
+head Facets{sElems = Unf step s} = head_loop SPEC s
   where
-    head_loop SPEC s
+    head_loop !sPEC s
       = do
           r <- step s
           case r of
             Yield x _  -> return x
             Skip    s' -> head_loop SPEC s'
-            Done       -> BOUNDS_ERROR(emptyStream) "head"
+            Done       -> EMPTY_STREAM "head"
 
 
 
--- | Last element of the 'Stream' or error if empty
-last :: Monad m => Stream m a -> m a
-{-# INLINE_STREAM last #-}
-last (Stream step s _) = last_loop0 SPEC s
+-- | Last element of the 'Facets' or error if empty
+last :: Monad m => Facets m v a -> m a
+{-# INLINE_FUSED last #-}
+last Facets{sElems = Unf step s} = last_loop0 SPEC s
   where
-    last_loop0 SPEC s
+    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       -> BOUNDS_ERROR(emptyStream) "last"
+            Done       -> EMPTY_STREAM "last"
 
-    last_loop1 SPEC x s
+    last_loop1 !sPEC x s
       = do
           r <- step s
           case r of
@@ -248,13 +338,14 @@ last (Stream step s _) = last_loop0 SPEC 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
+(!!) :: Monad m => Facets m v a -> Int -> m a
 {-# INLINE (!!) #-}
-Stream step s _ !! i | i < 0     = BOUNDS_ERROR(error) "!!" "negative index"
-                     | otherwise = index_loop SPEC s i
+Facets{sElems = Unf step s} !! i | i < 0     = ERROR "!!" "negative index"
+                                 | otherwise = index_loop SPEC s i
   where
-    index_loop SPEC s i
+    index_loop !sPEC s i
       = i `seq`
         do
           r <- step s
@@ -262,29 +353,46 @@ Stream step s _ !! i | i < 0     = BOUNDS_ERROR(error) "!!" "negative index"
             Yield x s' | i == 0    -> return x
                        | otherwise -> index_loop SPEC s' (i-1)
             Skip    s'             -> index_loop SPEC s' i
-            Done                   -> BOUNDS_ERROR(emptyStream) "!!"
+            Done                   -> EMPTY_STREAM "!!"
+
+infixl 9 !?
+-- | Element at the given position or 'Nothing' if out of bounds
+(!?) :: Monad m => Facets m v a -> Int -> m (Maybe a)
+{-# INLINE (!?) #-}
+Facets{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
 
 -- Substreams
 -- ----------
 
 -- | Extract a substream of the given length starting at the given position.
-extract :: Monad m => Stream m a -> Int   -- ^ starting index
-                                 -> Int   -- ^ length
-                                 -> Stream m a
-{-# INLINE extract #-}
-extract s i n = take n (drop i s)
+slice :: Monad m => Int   -- ^ starting index
+                 -> Int   -- ^ length
+                 -> Facets m v a
+                 -> Facets m v 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_STREAM init #-}
-init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
+init :: Monad m => Facets m v a -> Facets m v a
+{-# INLINE_FUSED init #-}
+init Facets{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       -> BOUNDS_ERROR(emptyStream) "init"
+                             Done       -> EMPTY_STREAM "init"
                          ) (step s)
 
     step' (Just x,  s) = liftM (\r -> 
@@ -295,16 +403,16 @@ init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
                          ) (step s)
 
 -- | All but the first element
-tail :: Monad m => Stream m a -> Stream m a
-{-# INLINE_STREAM tail #-}
-tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
+tail :: Monad m => Facets m v a -> Facets m v a
+{-# INLINE_FUSED tail #-}
+tail Facets{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       -> BOUNDS_ERROR(emptyStream) "tail"
+                          Done       -> EMPTY_STREAM "tail"
                       ) (step s)
 
     step' (Right s) = liftM (\r ->
@@ -315,9 +423,10 @@ tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
                       ) (step s)
 
 -- | The first @n@ elements
-take :: Monad m => Int -> Stream m a -> Stream m a
-{-# INLINE_STREAM take #-}
-take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
+take :: Monad m => Int -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED take #-}
+take n Facets{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 ->
@@ -329,9 +438,10 @@ take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
     step' (s, i) = return Done
 
 -- | All but the first @n@ elements
-drop :: Monad m => Int -> Stream m a -> Stream m a
-{-# INLINE_STREAM drop #-}
-drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
+drop :: Monad m => Int -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED drop #-}
+drop n Facets{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 ->
@@ -349,24 +459,23 @@ drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
                              Done       -> Done
                            ) (step s)
                      
-
 -- Mapping
 -- -------
 
-instance Monad m => Functor (Stream m) where
+instance Monad m => Functor (Facets m v) where
   {-# INLINE fmap #-}
   fmap = map
 
--- | Map a function over a 'Stream'
-map :: Monad m => (a -> b) -> Stream m a -> Stream m b
+-- | Map a function over a 'Facets'
+map :: Monad m => (a -> b) -> Facets m v a -> Facets m v 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_STREAM mapM #-}
-mapM f (Stream step s n) = Stream step' s n
+-- | Map a monadic function over a 'Facets'
+mapM :: Monad m => (a -> m b) -> Facets m v a -> Facets m v b
+{-# INLINE_FUSED mapM #-}
+mapM f Facets{sElems = Unf step s, sSize = n} = simple step' s n
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -376,28 +485,32 @@ mapM f (Stream step s n) = Stream step' s n
                   Skip    s' -> return (Skip    s')
                   Done       -> return Done
 
--- | Execute a monadic action for each element of the 'Stream'
-mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
-{-# INLINE_STREAM mapM_ #-}
-mapM_ m (Stream step s _) = mapM_loop SPEC s
+consume :: Monad m => Facets m v a -> m ()
+{-# INLINE_FUSED consume #-}
+consume Facets {sChunks = Unf step s} = consume_loop SPEC s
   where
-    mapM_loop SPEC s
+    consume_loop !sPEC s
       = do
           r <- step s
           case r of
-            Yield x s' -> do { m x; mapM_loop SPEC s' }
-            Skip    s' -> mapM_loop SPEC s'
+            Yield _ s' -> consume_loop SPEC s'
+            Skip    s' -> consume_loop SPEC s'
             Done       -> return ()
 
--- | Transform a 'Stream' to use a different monad
+-- | Execute a monadic action for each element of the 'Facets'
+mapM_ :: Monad m => (a -> m b) -> Facets m v a -> m ()
+{-# INLINE_FUSED mapM_ #-}
+mapM_ m = consume . mapM m
+
+-- | Transform a 'Facets' to use a different monad
 trans :: (Monad m, Monad m') => (forall a. m a -> m' a)
-                             -> Stream m a -> Stream m' a
-{-# INLINE_STREAM trans #-}
-trans f (Stream step s n) = Stream (f . step) s n
+                             -> Facets m v a -> Facets m' v a
+{-# INLINE_FUSED trans #-}
+trans f Facets{sElems = Unf step s, sSize = n} = simple (f . step) s n
 
-unbox :: Monad m => Stream m (Box a) -> Stream m a
-{-# INLINE_STREAM unbox #-}
-unbox (Stream step s n) = Stream step' s n
+unbox :: Monad m => Facets m v (Box a) -> Facets m v a
+{-# INLINE_FUSED unbox #-}
+unbox Facets{sElems = Unf step s, sSize = n} = simple step' s n
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -410,10 +523,10 @@ unbox (Stream step s n) = Stream step' s n
 -- Zipping
 -- -------
 
--- | Pair each element in a 'Stream' with its index
-indexed :: Monad m => Stream m a -> Stream m (Int,a)
-{-# INLINE_STREAM indexed #-}
-indexed (Stream step s n) = Stream step' (s,0) n
+-- | Pair each element in a 'Facets' with its index
+indexed :: Monad m => Facets m v a -> Facets m v (Int,a)
+{-# INLINE_FUSED indexed #-}
+indexed Facets{sElems = Unf step s, sSize = n} = simple step' (s,0) n
   where
     {-# INLINE_INNER step' #-}
     step' (s,i) = i `seq`
@@ -424,11 +537,29 @@ indexed (Stream step s n) = Stream step' (s,0) n
                       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_STREAM zipWithM #-}
-zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
-  = Stream step (sa, sb, Nothing) (smaller na nb)
+-- | Pair each element in a 'Facets' with its index, starting from the right
+-- and counting down
+indexedR :: Monad m => Int -> Facets m v a -> Facets m v (Int,a)
+{-# INLINE_FUSED indexedR #-}
+indexedR m Facets{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
+
+-- | Zip two 'Facets's with the given monadic function
+zipWithM :: Monad m => (a -> b -> m c) -> Facets m v a -> Facets m v b -> Facets m v c
+{-# INLINE_FUSED zipWithM #-}
+zipWithM f Facets{sElems = Unf stepa sa, sSize = na}
+           Facets{sElems = Unf stepb sb, sSize = nb}
+  = simple step (sa, sb, Nothing) (smaller na nb)
   where
     {-# INLINE_INNER step #-}
     step (sa, sb, Nothing) = liftM (\r ->
@@ -451,15 +582,21 @@ zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
 -- FIXME: This might expose an opportunity for inplace execution.
 {-# RULES
 
-"zipWithM xs xs [Vector.Stream]" forall f xs.
+"zipWithM xs xs [Vector.Facets]" forall f xs.
   zipWithM f xs xs = mapM (\x -> f x x) xs
 
   #-}
 
-zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
-{-# INLINE_STREAM zipWith3M #-}
-zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)
-  = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
+zipWithM_ :: Monad m => (a -> b -> m c) -> Facets m v a -> Facets m v b -> m ()
+{-# INLINE zipWithM_ #-}
+zipWithM_ f sa sb = consume (zipWithM f sa sb)
+
+zipWith3M :: Monad m => (a -> b -> c -> m d) -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+{-# INLINE_FUSED zipWith3M #-}
+zipWith3M f Facets{sElems = Unf stepa sa, sSize = na}
+            Facets{sElems = Unf stepb sb, sSize = nb}
+            Facets{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
@@ -484,89 +621,150 @@ zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)
             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
+                     -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                     -> Facets m v 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
+                     -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                     -> Facets m v e -> Facets m v 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
+                     -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                     -> Facets m v e -> Facets m v f -> Facets m v 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
+zipWith :: Monad m => (a -> b -> c) -> Facets m v a -> Facets m v b -> Facets m v 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
+                    -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v 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
+                    -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                    -> Facets m v 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
+                    -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                    -> Facets m v e -> Facets m v 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
+                    -> Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                    -> Facets m v e -> Facets m v f -> Facets m v 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)
+zip :: Monad m => Facets m v a -> Facets m v b -> Facets m v (a,b)
 {-# INLINE zip #-}
 zip = zipWith (,)
 
-zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c)
+zip3 :: Monad m => Facets m v a -> Facets m v b -> Facets m v c -> Facets m v (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)
+zip4 :: Monad m => Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                -> Facets m v (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)
+zip5 :: Monad m => Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                -> Facets m v e -> Facets m v (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)
+zip6 :: Monad m => Facets m v a -> Facets m v b -> Facets m v c -> Facets m v d
+                -> Facets m v e -> Facets m v f -> Facets m v (a,b,c,d,e,f)
 {-# INLINE zip6 #-}
 zip6 = zipWith6 (,,,,,)
 
+-- Comparisons
+-- -----------
+
+-- | Check if two 'Facets's are equal
+eq :: (Monad m, Eq a) => Facets m v a -> Facets m v a -> m Bool
+{-# INLINE_FUSED eq #-}
+eq Facets{sElems = Unf step1 s1}
+   Facets{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
+
+-- | Lexicographically compare two 'Facets's
+cmp :: (Monad m, Ord a) => Facets m v a -> Facets m v a -> m Ordering
+{-# INLINE_FUSED cmp #-}
+cmp Facets{sElems = Unf step1 s1}
+    Facets{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
+
 -- Filtering
 -- ---------
 
 -- | Drop elements which do not satisfy the predicate
-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+filter :: Monad m => (a -> Bool) -> Facets m v a -> Facets m v 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_STREAM filterM #-}
-filterM f (Stream step s n) = Stream step' s (toMax n)
+filterM :: Monad m => (a -> m Bool) -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED filterM #-}
+filterM f Facets{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -580,14 +778,14 @@ filterM f (Stream step s n) = Stream step' s (toMax n)
                   Done       -> return $ Done
 
 -- | Longest prefix of elements that satisfy the predicate
-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+takeWhile :: Monad m => (a -> Bool) -> Facets m v a -> Facets m v 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_STREAM takeWhileM #-}
-takeWhileM f (Stream step s n) = Stream step' s (toMax n)
+takeWhileM :: Monad m => (a -> m Bool) -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED takeWhileM #-}
+takeWhileM f Facets{sElems = Unf step s, sSize = n} = simple step' s (toMax n)
   where
     {-# INLINE_INNER step' #-}
     step' s = do
@@ -600,16 +798,17 @@ takeWhileM f (Stream step s n) = Stream step' s (toMax n)
                   Done       -> return $ Done
 
 -- | Drop the longest prefix of elements that satisfy the predicate
-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
+dropWhile :: Monad m => (a -> Bool) -> Facets m v a -> Facets 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) -> Stream m a -> Stream m a
-{-# INLINE_STREAM dropWhileM #-}
-dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
+dropWhileM :: Monad m => (a -> m Bool) -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED dropWhileM #-}
+dropWhileM f Facets{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!
@@ -640,12 +839,12 @@ dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
 -- ---------
 
 infix 4 `elem`
--- | Check whether the 'Stream' contains an element
-elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
-{-# INLINE_STREAM elem #-}
-elem x (Stream step s _) = elem_loop SPEC s
+-- | Check whether the 'Facets' contains an element
+elem :: (Monad m, Eq a) => a -> Facets m v a -> m Bool
+{-# INLINE_FUSED elem #-}
+elem x Facets{sElems = Unf step s} = elem_loop SPEC s
   where
-    elem_loop SPEC s
+    elem_loop !sPEC s
       = do
           r <- step s
           case r of
@@ -656,23 +855,23 @@ elem x (Stream step s _) = elem_loop SPEC s
 
 infix 4 `notElem`
 -- | Inverse of `elem`
-notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
+notElem :: (Monad m, Eq a) => a -> Facets m v 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)
+find :: Monad m => (a -> Bool) -> Facets m v 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_STREAM findM #-}
-findM f (Stream step s _) = find_loop SPEC s
+findM :: Monad m => (a -> m Bool) -> Facets m v a -> m (Maybe a)
+{-# INLINE_FUSED findM #-}
+findM f Facets{sElems = Unf step s} = find_loop SPEC s
   where
-    find_loop SPEC s
+    find_loop !sPEC s
       = do
           r <- step s
           case r of
@@ -685,17 +884,17 @@ findM f (Stream step s _) = find_loop SPEC s
 
 -- | 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_STREAM findIndex #-}
+findIndex :: Monad m => (a -> Bool) -> Facets m v 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_STREAM findIndexM #-}
-findIndexM f (Stream step s _) = findIndex_loop SPEC s 0
+findIndexM :: Monad m => (a -> m Bool) -> Facets m v a -> m (Maybe Int)
+{-# INLINE_FUSED findIndexM #-}
+findIndexM f Facets{sElems = Unf step s} = findIndex_loop SPEC s 0
   where
-    findIndex_loop SPEC s i
+    findIndex_loop !sPEC s i
       = do
           r <- step s
           case r of
@@ -710,16 +909,16 @@ findIndexM f (Stream step s _) = findIndex_loop SPEC s 0
 -- -------
 
 -- | Left fold
-foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
+foldl :: Monad m => (a -> b -> a) -> a -> Facets m v 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_STREAM foldlM #-}
-foldlM m z (Stream step s _) = foldlM_loop SPEC z s
+foldlM :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> m a
+{-# INLINE_FUSED foldlM #-}
+foldlM m z Facets{sElems = Unf step s} = foldlM_loop SPEC z s
   where
-    foldlM_loop SPEC z s
+    foldlM_loop !sPEC z s
       = do
           r <- step s
           case r of
@@ -728,44 +927,60 @@ foldlM m z (Stream step 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
+foldM :: Monad m => (a -> b -> m a) -> a -> Facets m v 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
+vfoldlM :: Monad m => (a -> Chunk v b -> m a) -> a -> Facets m v b -> m a
+{-# INLINE_FUSED vfoldlM #-}
+vfoldlM f z Facets{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 'Facets'
+foldl1 :: Monad m => (a -> a -> a) -> Facets m v 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_STREAM foldl1M #-}
-foldl1M f (Stream step s sz) = foldl1M_loop SPEC s
+-- | Left fold over a non-empty 'Facets' with a monadic operator
+foldl1M :: Monad m => (a -> a -> m a) -> Facets m v a -> m a
+{-# INLINE_FUSED foldl1M #-}
+foldl1M f Facets{sElems = Unf step s, sSize = sz} = foldl1M_loop SPEC s
   where
-    foldl1M_loop SPEC s
+    foldl1M_loop !sPEC s
       = do
           r <- step s
           case r of
-            Yield x s' -> foldlM f x (Stream step s' (sz - 1))
+            Yield x s' -> foldlM f x (simple step s' (sz - 1))
             Skip    s' -> foldl1M_loop SPEC s'
-            Done       -> BOUNDS_ERROR(emptyStream) "foldl1M"
+            Done       -> EMPTY_STREAM "foldl1M"
 
 -- | Same as 'foldl1M'
-fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+fold1M :: Monad m => (a -> a -> m a) -> Facets m v 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
+foldl' :: Monad m => (a -> b -> a) -> a -> Facets 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 -> Facets 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 -> Stream m b -> m a
-{-# INLINE_STREAM foldlM' #-}
-foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s
+foldlM' :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> m a
+{-# INLINE_FUSED foldlM' #-}
+foldlM' m z Facets{sElems = Unf step s} = foldlM'_loop SPEC z s
   where
-    foldlM'_loop SPEC z s
+    foldlM'_loop !sPEC z s
       = z `seq`
         do
           r <- step s
@@ -775,45 +990,57 @@ foldlM' m z (Stream step 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
+foldM' :: Monad m => (a -> b -> m a) -> a -> Facets m v 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
+vfoldlM' :: Monad m => (a -> Chunk v b -> m a) -> a -> Facets m v b -> m a
+{-# INLINE_FUSED vfoldlM' #-}
+vfoldlM' f z Facets{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 'Facets' with a strict accumulator
+foldl1' :: Monad m => (a -> a -> a) -> Facets m v 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
+-- | Left fold over a non-empty 'Facets' with a strict accumulator and a
 -- monadic operator
-foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
-{-# INLINE_STREAM foldl1M' #-}
-foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s
+foldl1M' :: Monad m => (a -> a -> m a) -> Facets m v a -> m a
+{-# INLINE_FUSED foldl1M' #-}
+foldl1M' f Facets{sElems = Unf step s, sSize = sz} = foldl1M'_loop SPEC s
   where
-    foldl1M'_loop SPEC s
+    foldl1M'_loop !sPEC s
       = do
           r <- step s
           case r of
-            Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
+            Yield x s' -> foldlM' f x (simple step s' (sz - 1))
             Skip    s' -> foldl1M'_loop SPEC s'
-            Done       -> BOUNDS_ERROR(emptyStream) "foldl1M'"
+            Done       -> EMPTY_STREAM "foldl1M'"
 
 -- | Same as 'foldl1M''
-fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+fold1M' :: Monad m => (a -> a -> m a) -> Facets m v a -> m a
 {-# INLINE fold1M' #-}
 fold1M' = foldl1M'
 
 -- | Right fold
-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
+foldr :: Monad m => (a -> b -> b) -> b -> Facets m v 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_STREAM foldrM #-}
-foldrM f z (Stream step s _) = foldrM_loop SPEC s
+foldrM :: Monad m => (a -> b -> m b) -> b -> Facets m v a -> m b
+{-# INLINE_FUSED foldrM #-}
+foldrM f z Facets{sElems = Unf step s} = foldrM_loop SPEC s
   where
-    foldrM_loop SPEC s
+    foldrM_loop !sPEC s
       = do
           r <- step s
           case r of
@@ -822,24 +1049,24 @@ foldrM f z (Stream step 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
+foldr1 :: Monad m => (a -> a -> a) -> Facets m v 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_STREAM foldr1M #-}
-foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
+foldr1M :: Monad m => (a -> a -> m a) -> Facets m v a -> m a
+{-# INLINE_FUSED foldr1M #-}
+foldr1M f Facets{sElems = Unf step s} = foldr1M_loop0 SPEC s
   where
-    foldr1M_loop0 SPEC s
+    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       -> BOUNDS_ERROR(emptyStream) "foldr1M"
+            Done       -> EMPTY_STREAM "foldr1M"
 
-    foldr1M_loop1 SPEC x s
+    foldr1M_loop1 !sPEC x s
       = do
           r <- step s
           case r of
@@ -850,11 +1077,11 @@ foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
 -- Specialised folds
 -- -----------------
 
-and :: Monad m => Stream m Bool -> m Bool
-{-# INLINE_STREAM and #-}
-and (Stream step s _) = and_loop SPEC s
+and :: Monad m => Facets m v Bool -> m Bool
+{-# INLINE_FUSED and #-}
+and Facets{sElems = Unf step s} = and_loop SPEC s
   where
-    and_loop SPEC s
+    and_loop !sPEC s
       = do
           r <- step s
           case r of
@@ -863,11 +1090,11 @@ and (Stream step s _) = and_loop SPEC s
             Skip        s' -> and_loop SPEC s'
             Done           -> return True
 
-or :: Monad m => Stream m Bool -> m Bool
-{-# INLINE_STREAM or #-}
-or (Stream step s _) = or_loop SPEC s
+or :: Monad m => Facets m v Bool -> m Bool
+{-# INLINE_FUSED or #-}
+or Facets{sElems = Unf step s} = or_loop SPEC s
   where
-    or_loop SPEC s
+    or_loop !sPEC s
       = do
           r <- step s
           case r of
@@ -876,13 +1103,13 @@ or (Stream step s _) = or_loop SPEC s
             Skip        s' -> or_loop SPEC s'
             Done           -> return False
 
-concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
+concatMap :: Monad m => (a -> Facets m v b) -> Facets m v a -> Facets m v b
 {-# INLINE concatMap #-}
 concatMap f = concatMapM (return . f)
 
-concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b
-{-# INLINE_STREAM concatMapM #-}
-concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown
+concatMapM :: Monad m => (a -> m (Facets m v b)) -> Facets m v a -> Facets m v b
+{-# INLINE_FUSED concatMapM #-}
+concatMapM f Facets{sElems = Unf step s} = simple concatMap_go (Left s) Unknown
   where
     concatMap_go (Left s) = do
         r <- step s
@@ -892,25 +1119,49 @@ concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown
                 return $ Skip (Right (b_stream, s'))
             Skip    s' -> return $ Skip (Left s')
             Done       -> return Done
-    concatMap_go (Right (Stream inner_step inner_s sz, s)) = do
+    concatMap_go (Right (Facets{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 (Stream inner_step inner_s' sz, s))
-            Skip    inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s))
+            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)
 
+-- | Create a 'Facets' of values from a 'Facets' of streamable things
+flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size
+                   -> Facets m v a -> Facets m v b
+{-# INLINE_FUSED flatten #-}
+flatten mk istep sz Facets{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)
+
 -- Unfolding
 -- ---------
 
 -- | Unfold
-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
-{-# INLINE_STREAM unfoldr #-}
+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Facets m u 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_STREAM unfoldrM #-}
-unfoldrM f s = Stream step s Unknown
+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Facets m u a
+{-# INLINE_FUSED unfoldrM #-}
+unfoldrM f s = simple step s Unknown
   where
     {-# INLINE_INNER step #-}
     step s = liftM (\r ->
@@ -919,18 +1170,52 @@ unfoldrM f s = Stream step s Unknown
                  Nothing      -> Done
              ) (f s)
 
+-- | Unfold at most @n@ elements
+unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Facets m u 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 -> Facets 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)
+
+-- | Apply monadic function n times to value. Zeroth element is original value.
+iterateNM :: Monad m => Int -> (a -> m a) -> a -> Facets 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)
+
+-- | Apply function n times to value. Zeroth element is original value.
+iterateN :: Monad m => Int -> (a -> a) -> a -> Facets m u 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
+prescanl :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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_STREAM prescanlM #-}
-prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
+prescanlM :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v a
+{-# INLINE_FUSED prescanlM #-}
+prescanlM f z Facets{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = do
@@ -943,14 +1228,14 @@ prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
                       Done       -> return Done
 
 -- | Prefix scan with strict accumulator
-prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+prescanl' :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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_STREAM prescanlM' #-}
-prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
+prescanlM' :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v a
+{-# INLINE_FUSED prescanlM' #-}
+prescanlM' f z Facets{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
@@ -964,14 +1249,14 @@ prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
                       Done       -> return Done
 
 -- | Suffix scan
-postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+postscanl :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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_STREAM postscanlM #-}
-postscanlM f z (Stream step s sz) = Stream step' (s,z) sz
+postscanlM :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v a
+{-# INLINE_FUSED postscanlM #-}
+postscanlM f z Facets{sElems = Unf step s, sSize = sz} = simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = do
@@ -984,14 +1269,15 @@ postscanlM f z (Stream step s sz) = Stream step' (s,z) sz
                       Done       -> return Done
 
 -- | Suffix scan with strict accumulator
-postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+postscanl' :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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_STREAM postscanlM' #-}
-postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz
+postscanlM' :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v a
+{-# INLINE_FUSED postscanlM' #-}
+postscanlM' f z Facets{sElems = Unf step s, sSize = sz}
+  = z `seq` simple step' (s,z) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
@@ -1005,34 +1291,34 @@ postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz
                       Done       -> return Done
 
 -- | Haskell-style scan
-scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
+scanl :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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
+scanlM :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v 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
+scanl' :: Monad m => (a -> b -> a) -> a -> Facets m v b -> Facets m v 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
+scanlM' :: Monad m => (a -> b -> m a) -> a -> Facets m v b -> Facets m v 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
+-- | Scan over a non-empty 'Facets'
+scanl1 :: Monad m => (a -> a -> a) -> Facets m v a -> Facets m v 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_STREAM scanl1M #-}
-scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
+-- | Scan over a non-empty 'Facets' with a monadic operator
+scanl1M :: Monad m => (a -> a -> m a) -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED scanl1M #-}
+scanl1M f Facets{sElems = Unf step s, sSize = sz} = simple step' (s, Nothing) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
@@ -1040,7 +1326,7 @@ scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
                            case r of
                              Yield x s' -> return $ Yield x (s', Just x)
                              Skip    s' -> return $ Skip (s', Nothing)
-                             Done       -> BOUNDS_ERROR(emptyStream) "scanl1M"
+                             Done       -> EMPTY_STREAM "scanl1M"
 
     step' (s, Just x) = do
                           r <- step s
@@ -1051,16 +1337,17 @@ scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
                             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
+-- | Scan over a non-empty 'Facets' with a strict accumulator
+scanl1' :: Monad m => (a -> a -> a) -> Facets m v a -> Facets m v 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
+-- | Scan over a non-empty 'Facets' with a strict accumulator and a monadic
 -- operator
-scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
-{-# INLINE_STREAM scanl1M' #-}
-scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
+scanl1M' :: Monad m => (a -> a -> m a) -> Facets m v a -> Facets m v a
+{-# INLINE_FUSED scanl1M' #-}
+scanl1M' f Facets{sElems = Unf step s, sSize = sz}
+  = simple step' (s, Nothing) sz
   where
     {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
@@ -1068,7 +1355,7 @@ scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
                            case r of
                              Yield x s' -> x `seq` return (Yield x (s', Just x))
                              Skip    s' -> return $ Skip (s', Nothing)
-                             Done       -> BOUNDS_ERROR(emptyStream) "scanl1M"
+                             Done       -> EMPTY_STREAM "scanl1M"
 
     step' (s, Just x) = x `seq`
                         do
@@ -1084,23 +1371,37 @@ scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
 -- ------------
 
 -- The Enum class is broken for this, there just doesn't seem to be a
--- way to implement this generically. We have specialise for as many types as
--- we can but this doesn't help in polymorphic loops.
+-- 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 'Facets' of the given length containing the values @x@, @x+y@,
+-- @x+y+y@ etc.
+enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Facets 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
 
--- | Enumerate values from @x@ to @y@
-enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a
-{-# INLINE_STREAM enumFromTo #-}
+-- | Enumerate values
+--
+-- /WARNING:/ This operation can be very inefficient. If at all possible, use
+-- 'enumFromStepN' instead.
+enumFromTo :: (Enum a, Monad m) => a -> a -> Facets m v 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_STREAM enumFromTo_small #-}
-enumFromTo_small x y = Stream step x (Exact n)
+enumFromTo_small :: (Integral a, Monad m) => a -> a -> Facets m v a
+{-# INLINE_FUSED enumFromTo_small #-}
+enumFromTo_small x y = x `seq` y `seq` simple step x (Exact n)
   where
-    n = max (fromIntegral y - fromIntegral x + 1) 0
+    n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0
 
     {-# INLINE_INNER step #-}
     step x | x <= y    = return $ Yield x (x+1)
@@ -1108,34 +1409,74 @@ enumFromTo_small x y = Stream step x (Exact n)
 
 {-# RULES
 
-"enumFromTo<Int> [Stream]"
-  enumFromTo = enumFromTo_small :: Monad m => Int -> Int -> Stream m Int
+"enumFromTo<Int8> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Facets m v Int8
+
+"enumFromTo<Int16> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Facets m v Int16
+
+"enumFromTo<Word8> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Facets m v Word8
+
+"enumFromTo<Word16> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Facets m v Word16
 
-"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
+#if WORD_SIZE_IN_BITS > 32
 
-"enumFromTo<Int32> [Stream]"
-  enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32
+{-# RULES
 
-"enumFromTo<Word8> [Stream]"
-  enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8
+"enumFromTo<Int32> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Facets m v Int32
 
-"enumFromTo<Word16> [Stream]"
-  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16
+"enumFromTo<Word32> [Facets]"
+  enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Facets m v Word32
 
   #-}
 
--- FIXME: the "too large" test is totally wrong
-enumFromTo_big :: (Integral a, Monad m) => a -> a -> Stream m a
-{-# INLINE_STREAM enumFromTo_big #-}
-enumFromTo_big x y = Stream step x (Exact n)
+#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 v. Monad m => Int -> Int -> Facets m v Int
+{-# INLINE_FUSED enumFromTo_int #-}
+enumFromTo_int x y = x `seq` y `seq` simple step x (Exact (len x y))
   where
-    n | x > y = 0
-      | y - x < fromIntegral (maxBound :: Int) = fromIntegral (y-x+1)
-      | otherwise = error $ "vector.enumFromTo_big: Array too large"
+    {-# 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 -> Facets m v a
+{-# INLINE_FUSED enumFromTo_intlike #-}
+enumFromTo_intlike x y = x `seq` y `seq` simple step x (Exact (len x y))
+  where
+    {-# INLINE [0] len #-}
+    len x y | x > y     = 0
+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
+                          (n > 0)
+                        $ fromIntegral n
+      where
+        n = y-x+1
 
     {-# INLINE_INNER step #-}
     step x | x <= y    = return $ Yield x (x+1)
@@ -1143,29 +1484,98 @@ enumFromTo_big x y = Stream step x (Exact n)
 
 {-# RULES
 
-"enumFromTo<Int64> [Stream]"
-  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64
+"enumFromTo<Int> [Facets]"
+  enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Facets m v Int
+
+#if WORD_SIZE_IN_BITS > 32
 
-"enumFromTo<Word32> [Stream]"
-  enumFromTo = enumFromTo_big :: Monad m => Word32 -> Word32 -> Stream m Word32
+"enumFromTo<Int64> [Facets]"
+  enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Facets m v Int64
 
-"enumFromTo<Word64> [Stream]"
-  enumFromTo = enumFromTo_big :: Monad m => Word64 -> Word64 -> Stream m Word64
+#else
 
-"enumFromTo<Integer> [Stream]"
-  enumFromTo = enumFromTo_big :: Monad m => Integer -> Integer -> Stream m Integer
+"enumFromTo<Int32> [Facets]"
+  enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Facets m v Int32
+
+#endif
 
   #-}
 
-enumFromTo_char :: Monad m => Char -> Char -> Stream m Char
-{-# INLINE_STREAM enumFromTo_char #-}
-enumFromTo_char x y = Stream step xn (Exact n)
+enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Facets m v a
+{-# INLINE_FUSED enumFromTo_big_word #-}
+enumFromTo_big_word x y = x `seq` y `seq` simple step x (Exact (len x y))
+  where
+    {-# INLINE [0] len #-}
+    len x y | x > y     = 0
+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
+                          (n < fromIntegral (maxBound :: Int))
+                        $ fromIntegral (n+1)
+      where
+        n = y-x
+
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Word> [Facets]"
+  enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Facets m v Word
+
+"enumFromTo<Word64> [Facets]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Word64 -> Word64 -> Facets m v Word64
+
+#if WORD_SIZE_IN_BITS == 32
+
+"enumFromTo<Word32> [Facets]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Word32 -> Word32 -> Facets m v Word32
+
+#endif
+
+"enumFromTo<Integer> [Facets]"
+  enumFromTo = enumFromTo_big_word
+                        :: Monad m => Integer -> Integer -> Facets m v Integer
+
+  #-}
+
+-- FIXME: the "too large" test is totally wrong
+enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Facets m v a
+{-# INLINE_FUSED enumFromTo_big_int #-}
+enumFromTo_big_int x y = x `seq` y `seq` simple step x (Exact (len x y))
+  where
+    {-# INLINE [0] len #-}
+    len x y | x > y     = 0
+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
+                          (n > 0 && n <= fromIntegral (maxBound :: Int))
+                        $ fromIntegral n
+      where
+        n = y-x+1
+
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+#if WORD_SIZE_IN_BITS > 32
+
+{-# RULES
+
+"enumFromTo<Int64> [Facets]"
+  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Facets m v Int64
+
+  #-}
+
+#endif
+
+enumFromTo_char :: Monad m => Char -> Char -> Facets m v Char
+{-# INLINE_FUSED enumFromTo_char #-}
+enumFromTo_char x y = x `seq` y `seq` simple step xn (Exact n)
   where
     xn = ord x
     yn = ord y
 
-    n | xn > yn   = 0
-      | otherwise = yn - xn + 1
+    n = delay_inline max 0 (yn - xn + 1)
 
     {-# INLINE_INNER step #-}
     step xn | xn <= yn  = return $ Yield (unsafeChr xn) (xn+1)
@@ -1173,29 +1583,169 @@ enumFromTo_char x y = Stream step xn (Exact n)
 
 {-# RULES
 
-"enumFromTo<Char> [Stream]"
+"enumFromTo<Char> [Facets]"
   enumFromTo = enumFromTo_char
 
   #-}
 
--- | Enumerate values from @x@ to @y@
-enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a
-{-# INLINE_STREAM enumFromThenTo #-}
+------------------------------------------------------------------------
+
+-- Specialise enumFromTo for Float and Double.
+-- Also, try to do something about pairs?
+
+enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Facets m v a
+{-# INLINE_FUSED enumFromTo_double #-}
+enumFromTo_double n m = n `seq` m `seq` simple step n (Max (len n m))
+  where
+    lim = m + 1/2 -- important to float out
+
+    {-# INLINE [0] len #-}
+    len x y | x > y     = 0
+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
+                          (n > 0)
+                        $ fromIntegral n
+      where
+        n = truncate (y-x)+2
+
+    {-# INLINE_INNER step #-}
+    step x | x <= lim  = return $ Yield x (x+1)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Double> [Facets]"
+  enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Facets m v Double
+
+"enumFromTo<Float> [Facets]"
+  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Facets m v 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 -> Facets m v 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]
+-- | Convert a 'Facets' to a list
+toList :: Monad m => Facets m v a -> m [a]
 {-# INLINE toList #-}
 toList = foldr (:) []
 
--- | Convert a list to a 'Stream'
-fromList :: Monad m => [a] -> Stream m a
-{-# INLINE_STREAM fromList #-}
-fromList xs = Stream step xs Unknown
+-- | Convert a list to a 'Facets'
+fromList :: Monad m => [a] -> Facets m v a
+{-# INLINE fromList #-}
+fromList xs = unsafeFromList Unknown xs
+
+-- | Convert the first @n@ elements of a list to a 'Facets'
+fromListN :: Monad m => Int -> [a] -> Facets 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
+
+-- | Convert a list to a 'Facets' with the given 'Size' hint. 
+unsafeFromList :: Monad m => Size -> [a] -> Facets m v a
+{-# INLINE_FUSED unsafeFromList #-}
+unsafeFromList sz xs = simple step xs sz
   where
     step (x:xs) = return (Yield x xs)
     step []     = return Done
 
+fromVector :: (Monad m, Vector v a) => v a -> Facets m v a
+{-# INLINE_FUSED fromVector #-}
+fromVector v = v `seq` n `seq` Facets (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 :: (Monad m, Vector v a) => [v a] -> Facets m v a
+{-# INLINE_FUSED fromVectors #-}
+fromVectors vs = Facets (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))
+
+
+    vstep [] = return Done
+    vstep (v:vs) = return $ Yield (Chunk (basicLength v)
+                                         (\mv -> basicUnsafeCopy mv v)) vs
+
+
+concatVectors :: (Monad m, Vector v a) => Facets m u (v a) -> Facets m v a
+{-# INLINE_FUSED concatVectors #-}
+concatVectors Facets{sElems = Unf step s}
+  = Facets (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 -> basicUnsafeCopy mv v)) s')
+        Skip    s' -> return (Skip s')
+        Done       -> return Done
+
+reVector :: Monad m => Facets m u a -> Facets m v a
+{-# INLINE_FUSED reVector #-}
+reVector Facets{sElems = Unf step s, sSize = n} = simple step s n
+
+{-# RULES
+
+"reVector [Vector]"
+  reVector = id
+
+"reVector/reVector [Vector]" forall s.
+  reVector (reVector s) = s
+
+  #-}
+