phases.h -> vector.h
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
index 955da6c..c94c238 100644 (file)
@@ -2,7 +2,7 @@
 
 -- |
 -- 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>
@@ -12,7 +12,7 @@
 -- Monadic streams
 --
 
-#include "phases.h"
+#include "vector.h"
 
 module Data.Vector.Fusion.Stream.Monadic (
   Stream(..), Step(..),
@@ -33,7 +33,7 @@ module Data.Vector.Fusion.Stream.Monadic (
   extract, init, tail, take, drop,
 
   -- * Mapping
-  map, mapM, mapM_, trans, concatMap,
+  map, mapM, mapM_, trans, unbox, concatMap,
   
   -- * Zipping
   zipWith, zipWithM, zipWith3, zipWith3M,
@@ -45,8 +45,8 @@ 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
@@ -61,11 +61,15 @@ module Data.Vector.Fusion.Stream.Monadic (
   scanl, scanlM, scanl', scanlM',
   scanl1, scanl1M, scanl1', scanl1M',
 
+  -- * Enumerations
+  enumFromTo,
+
   -- * Conversions
   toList, fromList
 ) where
 
 import Data.Vector.Fusion.Stream.Size
+import Data.Vector.Fusion.Util ( Box(..) )
 
 import Control.Monad  ( liftM )
 import Prelude hiding ( length, null,
@@ -78,9 +82,13 @@ import Prelude hiding ( length, null,
                         elem, notElem,
                         foldl, foldl1, foldr, foldr1,
                         and, or,
-                        scanl, scanl1 )
+                        scanl, scanl1,
+                        enumFromTo, enumFromThenTo )
 import qualified Prelude
 
+import Data.Int  ( Int8, Int16, Int32, Int64 )
+import Data.Word ( Word8, Word16, Word32, Word, Word64 )
+
 -- | 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
@@ -126,7 +134,7 @@ 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
 
@@ -135,7 +143,7 @@ replicate :: Monad m => Int -> a -> Stream m a
 {-# INLINE_STREAM replicate #-}
 replicate n x = Stream (return . step) n (Exact (max n 0))
   where
-    {-# INLINE step #-}
+    {-# INLINE_INNER step #-}
     step i | i > 0     = Yield x (i-1)
            | otherwise = Done
 
@@ -155,6 +163,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
@@ -232,7 +241,7 @@ 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')
@@ -252,7 +261,7 @@ 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')
@@ -272,7 +281,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)
@@ -286,7 +295,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))
@@ -320,7 +329,7 @@ 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
@@ -346,6 +355,18 @@ trans :: (Monad m, Monad m') => (forall a. m a -> 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
+
 -- Zipping
 -- -------
 
@@ -360,7 +381,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)
@@ -389,7 +410,7 @@ zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stre
 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 step #-}
+    {-# INLINE_INNER step #-}
     step (sa, sb, sc, Nothing) = do
         r <- stepa sa
         return $ case r of
@@ -424,7 +445,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
@@ -445,7 +466,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
@@ -470,7 +491,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
@@ -601,6 +622,11 @@ foldl1M f (Stream step s sz) = foldl1M_go s
                        Skip    s' -> foldl1M_go s'
                        Done       -> errorEmptyStream "foldl1M"
 
+-- | Same as 'foldl1M'
+fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+{-# INLINE fold1M #-}
+fold1M = foldl1M
+
 -- | Left fold with a strict accumulator
 foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
 {-# INLINE foldl' #-}
@@ -619,6 +645,11 @@ foldlM' m z (Stream step s _) = foldlM'_go z s
                          Skip    s' -> foldlM'_go z s'
                          Done       -> return z
 
+-- | Same as 'foldlM''
+foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
+{-# INLINE foldM' #-}
+foldM' = foldlM'
+
 -- | Left fold over a non-empty 'Stream' with a strict accumulator
 foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
 {-# INLINE foldl1' #-}
@@ -637,6 +668,11 @@ foldl1M' f (Stream step s sz) = foldl1M'_go s
                         Skip    s' -> foldl1M'_go s'
                         Done       -> errorEmptyStream "foldl1M'"
 
+-- | Same as 'foldl1M''
+fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
+{-# INLINE fold1M' #-}
+fold1M' = foldl1M'
+
 -- | Right fold
 foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
 {-# INLINE foldr #-}
@@ -741,7 +777,7 @@ 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'
@@ -761,7 +797,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
@@ -781,7 +817,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
@@ -802,7 +838,7 @@ 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 step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s,x) = do
                     r <- step s
                     case r of
@@ -822,7 +858,7 @@ 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 step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s,x) = x `seq`
                   do
                     r <- step s
@@ -863,7 +899,7 @@ 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 step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
                            r <- step s
                            case r of
@@ -891,7 +927,7 @@ 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 step' #-}
+    {-# INLINE_INNER step' #-}
     step' (s, Nothing) = do
                            r <- step s
                            case r of
@@ -909,6 +945,80 @@ scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
                             Skip    s' -> return $ Skip (s', Just x)
                             Done       -> return Done
 
+-- Enumerations
+-- ------------
+
+-- | Enumerate values from @x@ to @y@
+enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a
+{-# INLINE_STREAM enumFromTo #-}
+enumFromTo x y = fromList [x .. y]
+
+enumFromTo_small :: (Enum a, Ord a, Monad m) => a -> a -> Stream m a
+{-# INLINE_STREAM enumFromTo_small #-}
+enumFromTo_small x y = Stream step x (Exact n)
+  where
+    n = max (fromEnum y - fromEnum x + 1) 0
+
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (succ x)
+           | otherwise = return $ Done
+
+{-# RULES
+
+"enumFromTo<Int> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Int -> Int -> Stream m Int
+
+"enumFromTo<Char> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Char -> Char -> Stream m Char
+
+"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<Int32> [Stream]"
+  enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32
+
+"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
+
+  #-}
+
+enumFromTo_big :: (Enum a, Integral a, Monad m) => a -> a -> Stream m a
+{-# INLINE_STREAM enumFromTo_big #-}
+enumFromTo_big x y = Stream step x (Exact n)
+  where
+    n | x > y = 0
+      | y - x < fromIntegral (maxBound :: Int) = fromIntegral (y-x+1)
+      | otherwise = error $ "vector.enumFromTo_big: Array too large"
+
+    {-# INLINE_INNER step #-}
+    step x | x <= y    = return $ Yield x (succ x)
+           | otherwise = return $ Done
+
+{-# RULES
+
+
+"enumFromTo<Int64> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64
+
+"enumFromTo<Word32> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Word32 -> Word32 -> Stream m Word32
+
+"enumFromTo<Word64> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Word64 -> Word64 -> Stream m Word64
+
+"enumFromTo<Integer> [Stream]"
+  enumFromTo = enumFromTo_big :: Monad m => Integer -> Integer -> Stream m Integer
+
+  #-}
+
+
+
 -- Conversions
 -- -----------