Trim imports
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
index c3fafe1..efa6b21 100644 (file)
@@ -1,19 +1,17 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
 
 -- |
 -- Module      : Data.Vector.Fusion.Stream.Monadic
--- Copyright   : (c) Roman Leshchinskiy 2008
+-- Copyright   : (c) Roman Leshchinskiy 2008-2009
 -- License     : BSD-style
 --
 -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
 -- Stability   : experimental
 -- Portability : non-portable
 --
--- Monadic streams
+-- Monadic stream combinators.
 --
 
-#include "phases.h"
-
 module Data.Vector.Fusion.Stream.Monadic (
   Stream(..), Step(..),
 
@@ -24,16 +22,22 @@ module Data.Vector.Fusion.Stream.Monadic (
   length, null,
 
   -- * Construction
-  empty, singleton, cons, snoc, replicate, (++),
+  empty, singleton, cons, snoc, replicate, generate, generateM, (++),
 
   -- * Accessing elements
   head, last, (!!),
 
   -- * Substreams
-  extract, init, tail, take, drop,
+  slice, init, tail, take, drop,
 
-  -- * Mapping and zipping
-  map, mapM, mapM_, zipWith, zipWithM,
+  -- * Mapping
+  map, mapM, mapM_, trans, unbox, concatMap,
+  
+  -- * Zipping
+  indexed, indexedR,
+  zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,
+  zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
+  zip, zip3, zip4, zip5, zip6,
 
   -- * Filtering
   filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
@@ -42,32 +46,63 @@ module Data.Vector.Fusion.Stream.Monadic (
   elem, notElem, find, findM, findIndex, findIndexM,
 
   -- * Folding
-  foldl, foldlM, foldM, foldl1, foldl1M,
-  foldl', foldlM', foldl1', foldl1M',
+  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,
 
   -- * Scans
   prescanl, prescanlM, prescanl', prescanlM',
+  postscanl, postscanlM, postscanl', postscanlM',
+  scanl, scanlM, scanl', scanlM',
+  scanl1, scanl1M, scanl1', scanl1M',
+
+  -- * Enumerations
+  enumFromStepN, enumFromTo, enumFromThenTo,
 
   -- * Conversions
-  toList, fromList
+  toList, fromList, fromListN
 ) where
 
 import Data.Vector.Fusion.Stream.Size
+import Data.Vector.Fusion.Util ( Box(..), delay_inline )
 
+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_, zipWith,
+                        map, mapM, mapM_, concatMap,
+                        zipWith, zipWith3, zip, zip3,
                         filter, takeWhile, dropWhile,
                         elem, notElem,
-                        foldl, foldl1, foldr, foldr1 )
-import qualified Prelude
+                        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__ >= 613
+import SpecConstr ( SpecConstrAnnotation(..) )
+#endif
+
+#include "vector.h"
+
+data SPEC = SPEC | SPEC2
+#if __GLASGOW_HASKELL__ >= 613
+{-# ANN type SPEC ForceSpecConstr #-}
+#endif
+
 
 -- | Result of taking a single step in a stream
 data Step s a = Yield a s  -- ^ a new element and a new seed
@@ -114,18 +149,35 @@ singleton :: Monad m => a -> Stream m a
 {-# INLINE_STREAM singleton #-}
 singleton x = Stream (return . step) True (Exact 1)
   where
-    {-# INLINE step #-}
+    {-# 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 n x = Stream (return . step) n (Exact (max n 0))
+-- 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))
   where
-    {-# INLINE step #-}
-    step i | i > 0     = Yield x (i-1)
-           | otherwise = Done
+    {-# INLINE_INNER step #-}
+    step i | i <= 0    = Done
+           | otherwise = 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_STREAM generateM #-}
+generateM n f = n `seq` Stream 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
 
 -- | Prepend an element
 cons :: Monad m => a -> Stream m a -> Stream m a
@@ -143,6 +195,7 @@ infixr 5 ++
 {-# INLINE_STREAM (++) #-}
 Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
   where
+    {-# INLINE_INNER step #-}
     step (Left  sa) = do
                         r <- stepa sa
                         case r of
@@ -162,70 +215,77 @@ Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
 -- | 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 s
+head (Stream step s _) = head_loop SPEC s
   where
-    head_loop s = do
-                    r <- step s
-                    case r of
-                      Yield x _  -> return x
-                      Skip    s' -> head_loop s'
-                      Done       -> errorEmptyStream "head"
+    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"
+
+
 
 -- | 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 s
-  where
-    last_loop0 s = do
-                     r <- step s
-                     case r of
-                       Yield x s' -> last_loop1 x s'
-                       Skip    s' -> last_loop0   s'
-                       Done       -> errorEmptyStream "last"
-
-    last_loop1 x s = do
-                       r <- step s
-                       case r of
-                         Yield y s' -> last_loop1 y s'
-                         Skip    s' -> last_loop1 x s'
-                         Done       -> return x
+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       -> BOUNDS_ERROR(emptyStream) "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
 
 -- | Element at the given position
 (!!) :: Monad m => Stream m a -> Int -> m a
 {-# INLINE (!!) #-}
-Stream step s _ !! i | i < 0     = errorNegativeIndex "!!"
-                     | otherwise = loop s i
-  where
-    loop s i = i `seq`
-               do
-                 r <- step s
-                 case r of
-                   Yield x s' | i == 0    -> return x
-                              | otherwise -> loop s' (i-1)
-                   Skip    s'             -> loop s' i
-                   Done                   -> errorIndexOutOfRange "!!"
+Stream step s _ !! i | i < 0     = BOUNDS_ERROR(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                   -> BOUNDS_ERROR(emptyStream) "!!"
 
 -- 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
+                 -> 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_STREAM init #-}
 init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (Nothing, s) = liftM (\r ->
                            case r of
                              Yield x s' -> Skip (Just x,  s')
                              Skip    s' -> Skip (Nothing, s')
-                             Done       -> errorEmptyStream "init"
+                             Done       -> BOUNDS_ERROR(emptyStream) "init"
                          ) (step s)
 
     step' (Just x,  s) = liftM (\r -> 
@@ -240,12 +300,12 @@ tail :: Monad m => Stream m a -> Stream m a
 {-# INLINE_STREAM tail #-}
 tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (Left  s) = liftM (\r ->
                         case r of
                           Yield x s' -> Skip (Right s')
                           Skip    s' -> Skip (Left  s')
-                          Done       -> errorEmptyStream "tail"
+                          Done       -> BOUNDS_ERROR(emptyStream) "tail"
                       ) (step s)
 
     step' (Right s) = liftM (\r ->
@@ -260,7 +320,7 @@ 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)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s, i) | i < n = liftM (\r ->
                              case r of
                                Yield x s' -> Yield x (s', i+1)
@@ -274,7 +334,7 @@ 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)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s, Just i) | i > 0 = liftM (\r ->
                                 case r of
                                    Yield x s' -> Skip (s', Just (i-1))
@@ -291,8 +351,8 @@ drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
                            ) (step s)
                      
 
--- Mapping/zipping
--- ---------------
+-- Mapping
+-- -------
 
 instance Monad m => Functor (Stream m) where
   {-# INLINE fmap #-}
@@ -303,12 +363,13 @@ 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_STREAM mapM #-}
 mapM f (Stream step s n) = Stream step' s n
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' s = do
                 r <- step s
                 case r of
@@ -319,19 +380,67 @@ mapM f (Stream step s n) = Stream step' s n
 -- | 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_go s
+mapM_ m (Stream step s _) = mapM_loop SPEC s
   where
-    mapM_go s = do
-                  r <- step s
-                  case r of
-                    Yield x s' -> do { m x; mapM_go s' }
-                    Skip    s' -> mapM_go s'
-                    Done       -> return ()
+    mapM_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'
+            Done       -> return ()
+
+-- | 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_STREAM trans #-}
+trans f (Stream step s n) = Stream (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
+  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
 
--- | Zip two 'Stream's with the given function
-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))
+-- 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
+  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_STREAM indexedR #-}
+indexedR m (Stream step s n) = Stream 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 'Stream's with the given monadic function
 zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
@@ -339,7 +448,7 @@ zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
 zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
   = Stream step (sa, sb, Nothing) (smaller na nb)
   where
-    {-# INLINE step #-}
+    {-# INLINE_INNER step #-}
     step (sa, sb, Nothing) = liftM (\r ->
                                case r of
                                  Yield x sa' -> Skip (sa', sb, Just x)
@@ -357,6 +466,113 @@ zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
                                  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
+
+  #-}
+
+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))
+  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 (,,,,,)
+
 -- Filtering
 -- ---------
 
@@ -370,7 +586,7 @@ 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)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' s = do
                 r <- step s
                 case r of
@@ -391,7 +607,7 @@ 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)
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' s = do
                 r <- step s
                 case r of
@@ -416,7 +632,7 @@ dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
     -- NOTE: we jump through hoops here to have only one Yield; local data
     -- declarations would be nice!
 
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (DropWhile_Drop s)
       = do
           r <- step s
@@ -445,15 +661,16 @@ 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 s
+elem x (Stream step s _) = elem_loop SPEC s
   where
-    elem_loop s = do
-                    r <- step s
-                    case r of
-                      Yield y s' | x == y    -> return True
-                                 | otherwise -> elem_loop s'
-                      Skip    s'             -> elem_loop s'
-                      Done                   -> return False
+    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`
@@ -471,17 +688,18 @@ find f = findM (return . f)
 -- '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 s
+findM f (Stream step s _) = find_loop SPEC s
   where
-    find_loop s = do
-                    r <- step s
-                    case r of
-                      Yield x s' -> do
-                                      b <- f x
-                                      if b then return $ Just x
-                                           else find_loop s'
-                      Skip    s' -> find_loop s'
-                      Done       -> return Nothing
+    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.
@@ -493,17 +711,18 @@ findIndex f = findIndexM (return . f)
 -- 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 s 0
+findIndexM f (Stream step s _) = findIndex_loop SPEC s 0
   where
-    findIndex_loop 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 s' (i+1)
-                             Skip    s' -> findIndex_loop s' i
-                             Done       -> return Nothing
+    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
 -- -------
@@ -516,14 +735,15 @@ 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_go z s
+foldlM m z (Stream step s _) = foldlM_loop SPEC z s
   where
-    foldlM_go z s = do
-                      r <- step s
-                      case r of
-                        Yield x s' -> do { z' <- m z x; foldlM_go z' s' }
-                        Skip    s' -> foldlM_go z s'
-                        Done       -> return z
+    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
@@ -538,14 +758,20 @@ 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_go s
+foldl1M f (Stream step s sz) = foldl1M_loop SPEC s
   where
-    foldl1M_go s = do
-                     r <- step s
-                     case r of
-                       Yield x s' -> foldlM f x (Stream step s' (sz - 1))
-                       Skip    s' -> foldl1M_go s'
-                       Done       -> errorEmptyStream "foldl1M"
+    foldl1M_loop SPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> foldlM f x (Stream step s' (sz - 1))
+            Skip    s' -> foldl1M_loop SPEC s'
+            Done       -> BOUNDS_ERROR(emptyStream) "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
@@ -555,15 +781,21 @@ 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_STREAM foldlM' #-}
-foldlM' m z (Stream step s _) = foldlM'_go z s
+foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s
   where
-    foldlM'_go z s = z `seq`
-                     do
-                       r <- step s
-                       case r of
-                         Yield x s' -> do { z' <- m z x; foldlM'_go z' s' }
-                         Skip    s' -> foldlM'_go z s'
-                         Done       -> return z
+    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
@@ -574,14 +806,20 @@ foldl1' f = foldl1M' (\a b -> return (f a b))
 -- monadic operator
 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
 {-# INLINE_STREAM foldl1M' #-}
-foldl1M' f (Stream step s sz) = foldl1M'_go s
+foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s
   where
-    foldl1M'_go s = do
-                      r <- step s
-                      case r of
-                        Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
-                        Skip    s' -> foldl1M'_go s'
-                        Done       -> errorEmptyStream "foldl1M'"
+    foldl1M'_loop SPEC s
+      = do
+          r <- step s
+          case r of
+            Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
+            Skip    s' -> foldl1M'_loop SPEC s'
+            Done       -> BOUNDS_ERROR(emptyStream) "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
@@ -591,14 +829,15 @@ 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_go s
+foldrM f z (Stream step s _) = foldrM_loop SPEC s
   where
-    foldrM_go s = do
-                    r <- step s
-                    case r of
-                      Yield x s' -> f x =<< foldrM_go s'
-                      Skip    s' -> foldrM_go s'
-                      Done       -> return z
+    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
@@ -608,21 +847,75 @@ 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_go0 s
+foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
   where
-    foldr1M_go0 s = do
-                      r <- step s
-                      case r of
-                        Yield x s' -> foldr1M_go1 x s'
-                        Skip    s' -> foldr1M_go0   s'
-                        Done       -> errorEmptyStream "foldr1M"
+    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"
 
-    foldr1M_go1 x s = do
-                        r <- step s
-                        case r of
-                          Yield y s' -> f x =<< foldr1M_go1 y s'
-                          Skip    s' -> foldr1M_go1 x s'
-                          Done       -> return x
+    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_STREAM 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_STREAM 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_STREAM concatMapM #-}
+concatMapM f (Stream step s _) = Stream 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 (Stream inner_step inner_s 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))
+            Done             -> return $ Skip (Left s)
 
 -- Unfolding
 -- ---------
@@ -637,13 +930,31 @@ unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
 {-# INLINE_STREAM unfoldrM #-}
 unfoldrM f s = Stream step s Unknown
   where
-    {-# INLINE step #-}
+    {-# INLINE_INNER step #-}
     step s = liftM (\r ->
                case r of
                  Just (x, s') -> Yield x s'
                  Nothing      -> Done
              ) (f s)
 
+-- | Unfold at most @n@ elements
+unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a
+{-# INLINE_STREAM 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_STREAM unfoldrNM #-}
+unfoldrNM n f s = Stream 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)
+
 -- Scans
 -- -----
 
@@ -657,7 +968,7 @@ 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
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s,x) = do
                     r <- step s
                     case r of
@@ -677,7 +988,7 @@ 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
   where
-    {-# INLINE step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
                   do
                     r <- step s
@@ -688,6 +999,371 @@ prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
                       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_STREAM postscanlM #-}
+postscanlM f z (Stream step s sz) = Stream 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
+
+-- | 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_STREAM postscanlM' #-}
+postscanlM' f z (Stream step s sz) = z `seq` Stream 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
+
+-- | 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_STREAM scanl1M #-}
+scanl1M f (Stream step s sz) = Stream 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       -> BOUNDS_ERROR(emptyStream) "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_STREAM scanl1M' #-}
+scanl1M' f (Stream step s sz) = Stream 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       -> BOUNDS_ERROR(emptyStream) "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_STREAM enumFromStepN #-}
+enumFromStepN x y n = n `seq` Stream 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
+--
+-- /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_STREAM 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)
+  where
+    n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0
+
+    {-# 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 :: (Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_STREAM enumFromTo_int #-}
+enumFromTo_int x y = Stream 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)
+           | 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_int :: Monad m => Int64 -> Int64 -> Stream m Int64
+
+#else
+
+"enumFromTo<Int32> [Stream]"
+  enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32
+
+#endif
+
+  #-}
+
+enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_STREAM enumFromTo_big_word #-}
+enumFromTo_big_word x y = Stream 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> [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_STREAM enumFromTo_big_int #-}
+enumFromTo_big_int x y = Stream 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> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64
+
+  #-}
+
+#endif
+
+enumFromTo_char :: Monad m => Char -> Char -> Stream m Char
+{-# INLINE_STREAM enumFromTo_char #-}
+enumFromTo_char x y = Stream step xn (Exact n)
+  where
+    xn = ord x
+    yn = ord y
+
+    n = delay_inline max 0 (yn - xn + 1)
+
+    {-# 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_STREAM enumFromTo_double #-}
+enumFromTo_double n m = Stream 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> [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_STREAM enumFromThenTo #-}
+enumFromThenTo x y z = fromList [x, y .. z]
+
+-- FIXME: Specialise enumFromThenTo.
+
 -- Conversions
 -- -----------
 
@@ -704,17 +1380,13 @@ fromList xs = Stream step xs Unknown
     step (x:xs) = return (Yield x xs)
     step []     = return Done
 
-
-streamError :: String -> String -> a
-streamError fn msg = error $ "Data.Vector.Fusion.Stream.Monadic."
-                             Prelude.++ fn Prelude.++ ": " Prelude.++ msg
-
-errorEmptyStream :: String -> a
-errorEmptyStream fn = streamError fn "empty stream"
-
-errorNegativeIndex :: String -> a
-errorNegativeIndex fn = streamError fn "negative index"
-
-errorIndexOutOfRange :: String -> a
-errorIndexOutOfRange fn = streamError fn "index out of range"
+-- | Convert the first @n@ elements of a list to a 'Stream'
+fromListN :: Monad m => Int -> [a] -> Stream m a
+{-# INLINE_STREAM fromListN #-}
+fromListN n xs = Stream 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