packages feed

vector 0.1 → 0.2

raw patch · 15 files changed

+1390/−739 lines, 15 files

Files

Data/Vector.hs view
@@ -5,7 +5,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- 
+ Data/Vector/Fusion/Stream.hs view
@@ -0,0 +1,383 @@+{-# LANGUAGE ExistentialQuantification, FlexibleInstances #-}++-- |+-- Module      : Data.Vector.Fusion.Stream+-- Copyright   : (c) Roman Leshchinskiy 2008+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Streams for stream fusion+--++#include "phases.h"++module Data.Vector.Fusion.Stream (+  -- * Types+  Step(..), Stream, MStream, Id(..),++  -- * Size hints+  size, sized,++  -- * Length information+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, (++),++  -- * Accessing individual elements+  head, last, (!!),++  -- * Substreams+  extract, init, tail, take, drop,++  -- * Mapping and zipping+  map, zipWith,++  -- * Filtering+  filter, takeWhile, dropWhile,++  -- * Searching+  elem, notElem, find, findIndex,++  -- * Folding+  foldl, foldl1, foldl', foldl1', foldr, foldr1,++  -- * Unfolding+  unfold,++  -- * Scans+  prescanl, prescanl',++  -- * Conversions+  toList, fromList, liftStream,++  -- * Monadic combinators+  mapM_, foldM+) where++import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Stream.Monadic ( Step(..) )+import qualified Data.Vector.Fusion.Stream.Monadic as M++import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last, (!!),+                        init, tail, take, drop,+                        map, zipWith,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        mapM_ )+++-- | Identity monad+newtype Id a = Id { unId :: a }++instance Functor Id where+  fmap f (Id x) = Id (f x)++instance Monad Id where+  return     = Id+  Id x >>= f = f x++-- | The type of pure streams +type Stream = M.Stream Id++-- | Alternative name for monadic streams+type MStream = M.Stream++-- | Convert a pure stream to a monadic stream+liftStream :: Monad m => Stream a -> M.Stream m a+{-# INLINE_STREAM liftStream #-}+liftStream (M.Stream step s sz) = M.Stream (return . unId . step) s sz++-- | 'Size' hint of a 'Stream'+size :: Stream a -> Size+{-# INLINE size #-}+size = M.size++-- | Attach a 'Size' hint to a 'Stream'+sized :: Stream a -> Size -> Stream a+{-# INLINE sized #-}+sized = M.sized++-- Length+-- ------++-- | Length of a 'Stream'+length :: Stream a -> Int+{-# INLINE length #-}+length = unId . M.length++-- | Check if a 'Stream' is empty+null :: Stream a -> Bool+{-# INLINE null #-}+null = unId . M.null++-- Construction+-- ------------++-- | Empty 'Stream'+empty :: Stream a+{-# INLINE empty #-}+empty = M.empty++-- | Singleton 'Stream'+singleton :: a -> Stream a+{-# INLINE singleton #-}+singleton = M.singleton++-- | Replicate a value to a given length+replicate :: Int -> a -> Stream a+{-# INLINE_STREAM replicate #-}+replicate = M.replicate++-- | Prepend an element+cons :: a -> Stream a -> Stream a+{-# INLINE cons #-}+cons = M.cons++-- | Append an element+snoc :: Stream a -> a -> Stream a+{-# INLINE snoc #-}+snoc = M.snoc++infixr 5 +++-- | Concatenate two 'Stream's+(++) :: Stream a -> Stream a -> Stream a+{-# INLINE (++) #-}+(++) = (M.++)++-- Accessing elements+-- ------------------++-- | First element of the 'Stream' or error if empty+head :: Stream a -> a+{-# INLINE head #-}+head = unId . M.head++-- | Last element of the 'Stream' or error if empty+last :: Stream a -> a+{-# INLINE last #-}+last = unId . M.last++-- | Element at the given position+(!!) :: Stream a -> Int -> a+{-# INLINE (!!) #-}+s !! i = unId (s M.!! i)++-- Substreams+-- ----------++-- | Extract a substream of the given length starting at the given position.+extract :: Stream a -> Int   -- ^ starting index+                    -> Int   -- ^ length+                    -> Stream a+{-# INLINE extract #-}+extract = M.extract++-- | All but the last element+init :: Stream a -> Stream a+{-# INLINE init #-}+init = M.init++-- | All but the first element+tail :: Stream a -> Stream a+{-# INLINE tail #-}+tail = M.tail++-- | The first @n@ elements+take :: Int -> Stream a -> Stream a+{-# INLINE take #-}+take = M.take++-- | All but the first @n@ elements+drop :: Int -> Stream a -> Stream a+{-# INLINE drop #-}+drop = M.drop++-- Mapping/zipping+-- ---------------++-- | Map a function over a 'Stream'+map :: (a -> b) -> Stream a -> Stream b+{-# INLINE map #-}+map = M.map++-- | Zip two 'Stream's with the given function+zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+{-# INLINE zipWith #-}+zipWith = M.zipWith++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE filter #-}+filter = M.filter++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE takeWhile #-}+takeWhile = M.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE dropWhile #-}+dropWhile = M.dropWhile++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Stream' contains an element+elem :: Eq a => a -> Stream a -> Bool+{-# INLINE elem #-}+elem x = unId . M.elem x++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: Eq a => a -> Stream a -> Bool+{-# INLINE notElem #-}+notElem x = unId . M.notElem x++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: (a -> Bool) -> Stream a -> Maybe a+{-# INLINE find #-}+find f = unId . M.find f++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: (a -> Bool) -> Stream a -> Maybe Int+{-# INLINE findIndex #-}+findIndex f = unId . M.findIndex f++-- Folding+-- -------++-- | Left fold+foldl :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE foldl #-}+foldl f z = unId . M.foldl f z++-- | Left fold on non-empty 'Stream's+foldl1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldl1 #-}+foldl1 f = unId . M.foldl1 f++-- | Left fold with strict accumulator+foldl' :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE foldl' #-}+foldl' f z = unId . M.foldl' f z++-- | Left fold on non-empty 'Stream's with strict accumulator+foldl1' :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldl1' #-}+foldl1' f = unId . M.foldl1' f++-- | Right fold+foldr :: (a -> b -> b) -> b -> Stream a -> b+{-# INLINE foldr #-}+foldr f z = unId . M.foldr f z++-- | Right fold on non-empty 'Stream's+foldr1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldr1 #-}+foldr1 f = unId . M.foldr1 f++-- Unfolding+-- ---------++-- | Unfold+unfold :: (s -> Maybe (a, s)) -> s -> Stream a+{-# INLINE unfold #-}+unfold = M.unfold++-- Scans+-- -----++-- | Prefix scan+prescanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE prescanl #-}+prescanl = M.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE prescanl' #-}+prescanl' = M.prescanl'++-- Comparisons+-- -----------++-- | Check if two 'Stream's are equal+eq :: Eq a => Stream a -> Stream a -> Bool+{-# INLINE_STREAM eq #-}+eq (M.Stream step1 s1 _) (M.Stream step2 s2 _) = eq_loop0 s1 s2+  where+    eq_loop0 s1 s2 = case unId (step1 s1) of+                       Yield x s1' -> eq_loop1 x s1' s2+                       Skip    s1' -> eq_loop0   s1' s2+                       Done        -> null (M.Stream step2 s2 Unknown)++    eq_loop1 x s1 s2 = case unId (step2 s2) of+                         Yield y s2' -> x == y && eq_loop0   s1 s2'+                         Skip    s2' ->           eq_loop1 x s1 s2'+                         Done        -> False++-- | Lexicographically compare two 'Stream's+cmp :: Ord a => Stream a -> Stream a -> Ordering+{-# INLINE_STREAM cmp #-}+cmp (M.Stream step1 s1 _) (M.Stream step2 s2 _) = cmp_loop0 s1 s2+  where+    cmp_loop0 s1 s2 = case unId (step1 s1) of+                        Yield x s1' -> cmp_loop1 x s1' s2+                        Skip    s1' -> cmp_loop0   s1' s2+                        Done        -> if null (M.Stream step2 s2 Unknown)+                                         then EQ else LT++    cmp_loop1 x s1 s2 = case unId (step2 s2) of+                          Yield y s2' -> case x `compare` y of+                                           EQ -> cmp_loop0 s1 s2'+                                           c  -> c+                          Skip    s2' -> cmp_loop1 x s1 s2'+                          Done        -> GT++instance Eq a => Eq (M.Stream Id a) where+  {-# INLINE (==) #-}+  (==) = eq++instance Ord a => Ord (M.Stream Id a) where+  {-# INLINE compare #-}+  compare = cmp++-- Monadic combinators+-- -------------------++-- | Apply a monadic action to each element of the stream+mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()+{-# INLINE_STREAM mapM_ #-}+mapM_ f = M.mapM_ f . liftStream++-- | Monadic fold+foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a+{-# INLINE_STREAM foldM #-}+foldM m z = M.foldM m z . liftStream++-- Conversions+-- -----------++-- | Convert a 'Stream' to a list+toList :: Stream a -> [a]+{-# INLINE toList #-}+toList s = unId (M.toList s)++-- | Create a 'Stream' from a list+fromList :: [a] -> Stream a+{-# INLINE fromList #-}+fromList = M.fromList+
+ Data/Vector/Fusion/Stream/Monadic.hs view
@@ -0,0 +1,701 @@+{-# LANGUAGE ExistentialQuantification #-}++-- |+-- Module      : Data.Vector.Fusion.Stream.Monadic+-- Copyright   : (c) Roman Leshchinskiy 2008+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+--+-- Monadic streams+--++#include "phases.h"++module Data.Vector.Fusion.Stream.Monadic (+  Stream(..), Step(..),++  -- * Size hints+  size, sized,++  -- * Length+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, (++),++  -- * Accessing elements+  head, last, (!!),++  -- * Substreams+  extract, init, tail, take, drop,++  -- * Mapping and zipping+  map, mapM, mapM_, zipWith, zipWithM,++  -- * Filtering+  filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,++  -- * Searching+  elem, notElem, find, findM, findIndex, findIndexM,++  -- * Folding+  foldl, foldlM, foldM, foldl1, foldl1M,+  foldl', foldlM', foldl1', foldl1M',+  foldr, foldrM, foldr1, foldr1M,++  -- * Unfolding+  unfold, unfoldM,++  -- * Scans+  prescanl, prescanlM, prescanl', prescanlM',++  -- * Conversions+  toList, fromList+) where++import Data.Vector.Fusion.Stream.Size++import Control.Monad  ( liftM )+import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last, (!!),+                        init, tail, take, drop,+                        map, mapM, mapM_, zipWith,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1 )+import qualified Prelude++-- | 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++-- | Monadic streams+data Stream m a = forall s. Stream (s -> m (Step s a)) s Size++-- | 'Size' hint of a 'Stream'+size :: Stream m a -> Size+{-# INLINE size #-}+size (Stream _ _ sz) = sz++-- | 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++-- 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+++-- Construction+-- ------------++-- | Empty 'Stream'+empty :: Monad m => Stream m a+{-# INLINE_STREAM empty #-}+empty = Stream (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)+  where+    {-# INLINE 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))+  where+    {-# INLINE step #-}+    step i | i > 0     = Yield x (i-1)+           | otherwise = Done++-- | Prepend an element+cons :: Monad m => a -> Stream m a -> Stream m a+{-# INLINE cons #-}+cons x s = singleton x ++ s++-- | Append an element+snoc :: Monad m => Stream m a -> a -> Stream m a+{-# INLINE snoc #-}+snoc s x = s ++ singleton x++infixr 5 +++-- | Concatenate two 'Stream's+(++) :: Monad m => Stream m a -> Stream m a -> Stream m a+{-# INLINE_STREAM (++) #-}+Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)+  where+    step (Left  sa) = do+                        r <- stepa sa+                        case r of+                          Yield x sa' -> return $ Yield x (Left  sa')+                          Skip    sa' -> return $ Skip    (Left  sa')+                          Done        -> return $ Skip    (Right sb)+    step (Right sb) = do+                        r <- stepb sb+                        case r of+                          Yield x sb' -> return $ Yield x (Right sb')+                          Skip    sb' -> return $ Skip    (Right sb')+                          Done        -> return $ Done++-- Accessing elements+-- ------------------++-- | First element of the 'Stream' or error if empty+head :: Monad m => Stream m a -> m a+{-# INLINE_STREAM head #-}+head (Stream step s _) = head_loop s+  where+    head_loop s = do+                    r <- step s+                    case r of+                      Yield x _  -> return x+                      Skip    s' -> head_loop s'+                      Done       -> errorEmptyStream "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++-- | Element at the given position+(!!) :: Monad m => Stream m a -> Int -> m a+{-# INLINE (!!) #-}+s !! i = head (drop i s)++-- 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)++-- | 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' #-}+    step' (Nothing, s) = liftM (\r ->+                           case r of+                             Yield x s' -> Skip (Just x,  s')+                             Skip    s' -> Skip (Nothing, s')+                             Done       -> Done  -- FIXME: should be an error+                         ) (step s)++    step' (Just x,  s) = liftM (\r -> +                           case r of+                             Yield y s' -> Yield x (Just y, s')+                             Skip    s' -> Skip    (Just x, s')+                             Done       -> Done+                         ) (step s)++-- | All but the first element+tail :: Monad m => Stream m a -> Stream m a+{-# INLINE_STREAM tail #-}+tail (Stream step s sz) = Stream step' (Left s) (sz - 1)+  where+    {-# INLINE step' #-}+    step' (Left  s) = liftM (\r ->+                        case r of+                          Yield x s' -> Skip (Right s')+                          Skip    s' -> Skip (Left  s')+                          Done       -> Done    -- FIXME: should be error?+                      ) (step s)++    step' (Right s) = liftM (\r ->+                        case r of+                          Yield x s' -> Yield x (Right s')+                          Skip    s' -> Skip    (Right s')+                          Done       -> Done+                      ) (step s)++-- | The first @n@ elements+take :: Monad m => Int -> Stream m a -> Stream m a+{-# INLINE_STREAM take #-}+take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)+  where+    {-# INLINE step' #-}+    step' (s, i) | i < n = liftM (\r ->+                             case r of+                               Yield x s' -> Yield x (s', i+1)+                               Skip    s' -> Skip    (s', i)+                               Done       -> Done+                           ) (step s)+    step' (s, i) = return Done++-- | All but the first @n@ elements+drop :: Monad m => Int -> Stream m a -> Stream m a+{-# INLINE_STREAM drop #-}+drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)+  where+    {-# INLINE step' #-}+    step' (s, Just i) | i > 0 = liftM (\r ->+                                case r of+                                   Yield x s' -> Skip (s', Just (i-1))+                                   Skip    s' -> Skip (s', Just i)+                                   Done       -> Done+                                ) (step s)+                      | otherwise = return $ Skip (s, Nothing)++    step' (s, Nothing) = liftM (\r ->+                           case r of+                             Yield x s' -> Yield x (s', Nothing)+                             Skip    s' -> Skip    (s', Nothing)+                             Done       -> Done+                           ) (step s)+                     ++-- Mapping/zipping+-- ---------------++instance Monad m => Functor (Stream m) where+  {-# INLINE fmap #-}+  fmap = map++-- | Map a function over a 'Stream'+map :: Monad m => (a -> b) -> Stream m a -> Stream m b+{-# INLINE map #-}+map f = mapM (return . f)++-- | Map a monadic function over a 'Stream'+mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+{-# INLINE_STREAM mapM #-}+mapM f (Stream step s n) = Stream step' s n+  where+    {-# INLINE step' #-}+    step' s = do+                r <- step s+                case r of+                  Yield x s' -> liftM  (`Yield` s') (f x)+                  Skip    s' -> return (Skip    s')+                  Done       -> return Done++-- | 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+  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 ()++-- | 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))++-- | 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)+  where+    {-# INLINE step #-}+    step (sa, sb, Nothing) = liftM (\r ->+                               case r of+                                 Yield x sa' -> Skip (sa', sb, Just x)+                                 Skip    sa' -> Skip (sa', sb, Nothing)+                                 Done        -> Done+                             ) (stepa sa)++    step (sa, sb, Just x)  = do+                               r <- stepb sb+                               case r of+                                 Yield y sb' ->+                                   do+                                     z <- f x y+                                     return $ Yield z (sa, sb', Nothing)+                                 Skip    sb' -> return $ Skip (sa, sb', Just x)+                                 Done        -> return $ Done++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+{-# INLINE filter #-}+filter f = filterM (return . f)++-- | Drop elements which do not satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+{-# INLINE_STREAM filterM #-}+filterM f (Stream step s n) = Stream step' s (toMax n)+  where+    {-# INLINE step' #-}+    step' s = do+                r <- step s+                case r of+                  Yield x s' -> do+                                  b <- f x+                                  return $ if b then Yield x s'+                                                else Skip    s'+                  Skip    s' -> return $ Skip s'+                  Done       -> return $ Done++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+{-# INLINE takeWhile #-}+takeWhile f = takeWhileM (return . f)++-- | Longest prefix of elements that satisfy the monadic predicate+takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+{-# INLINE_STREAM takeWhileM #-}+takeWhileM f (Stream step s n) = Stream step' s (toMax n)+  where+    {-# INLINE step' #-}+    step' s = do+                r <- step s+                case r of+                  Yield x s' -> do+                                  b <- f x+                                  return $ if b then Yield x s' else Done+                  Skip    s' -> return $ Skip s'+                  Done       -> return $ Done++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+{-# INLINE dropWhile #-}+dropWhile f = dropWhileM (return . f)++data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s++-- | Drop the longest prefix of elements that satisfy the monadic predicate+dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+{-# INLINE_STREAM dropWhileM #-}+dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)+  where+    -- NOTE: we jump through hoops here to have only one Yield; local data+    -- declarations would be nice!++    {-# INLINE step' #-}+    step' (DropWhile_Drop s)+      = do+          r <- step s+          case r of+            Yield x s' -> do+                            b <- f x+                            return $ if b then Skip (DropWhile_Drop    s')+                                          else Skip (DropWhile_Yield x s')+            Skip    s' -> return $ Skip (DropWhile_Drop    s')+            Done       -> return $ Done++    step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)++    step' (DropWhile_Next s)+      = liftM (\r ->+          case r of+            Yield x s' -> Skip    (DropWhile_Yield x s')+            Skip    s' -> Skip    (DropWhile_Next    s')+            Done       -> Done+        ) (step s)++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Stream' contains an element+elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+{-# INLINE_STREAM elem #-}+elem x (Stream step s _) = elem_loop 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++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+{-# INLINE notElem #-}+notElem x s = liftM not (elem x s)++-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'+-- if no such element exists.+find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+{-# INLINE find #-}+find f = findM (return . f)++-- | Yield 'Just' the first element that satisfies the monadic predicate or+-- 'Nothing' if no such element exists.+findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+{-# INLINE_STREAM findM #-}+findM f (Stream step s _) = find_loop 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++-- | 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 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 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++-- Folding+-- -------++-- | Left fold+foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a+{-# INLINE foldl #-}+foldl f = foldlM (\a b -> return (f a b))++-- | Left fold with a monadic operator+foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a+{-# INLINE_STREAM foldlM #-}+foldlM m z (Stream step s _) = foldlM_go 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++-- | Same as 'foldlM'+foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a+{-# INLINE foldM #-}+foldM = foldlM++-- | Left fold over a non-empty 'Stream'+foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a+{-# INLINE foldl1 #-}+foldl1 f = foldl1M (\a b -> return (f a b))++-- | Left fold over a non-empty 'Stream' with a monadic operator+foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a+{-# INLINE_STREAM foldl1M #-}+foldl1M f (Stream step s sz) = foldl1M_go 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"++-- | Left fold with a strict accumulator+foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a+{-# INLINE foldl' #-}+foldl' f = foldlM' (\a b -> return (f a b))++-- | Left fold with a strict accumulator and a monadic operator+foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a+{-# INLINE_STREAM foldlM' #-}+foldlM' m z (Stream step s _) = foldlM'_go 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++-- | Left fold over a non-empty 'Stream' with a strict accumulator+foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a+{-# INLINE foldl1' #-}+foldl1' f = foldl1M' (\a b -> return (f a b))++-- | Left fold over a non-empty 'Stream' with a strict accumulator and a+-- monadic operator+foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a+{-# INLINE_STREAM foldl1M' #-}+foldl1M' f (Stream step s sz) = foldl1M'_go 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'"++-- | Right fold+foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+{-# INLINE foldr #-}+foldr f = foldrM (\a b -> return (f a b))++-- | Right fold with a monadic operator+foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b+{-# INLINE_STREAM foldrM #-}+foldrM f z (Stream step s _) = foldrM_go 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++-- | Right fold over a non-empty stream+foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a+{-# INLINE foldr1 #-}+foldr1 f = foldr1M (\a b -> return (f a b))++-- | Right fold over a non-empty stream with a monadic operator+foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a+{-# INLINE_STREAM foldr1M #-}+foldr1M f (Stream step s _) = foldr1M_go0 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_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++-- Unfolding+-- ---------++-- | Unfold+unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+{-# INLINE_STREAM unfold #-}+unfold f = unfoldM (return . f)++-- | Unfold with a monadic function+unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+{-# INLINE_STREAM unfoldM #-}+unfoldM f s = Stream step s Unknown+  where+    {-# INLINE step #-}+    step s = liftM (\r ->+               case r of+                 Just (x, s') -> Yield x s'+                 Nothing      -> Done+             ) (f s)++-- Scans+-- -----++-- | Prefix scan+prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE prescanl #-}+prescanl f = prescanlM (\a b -> return (f a b))++-- | Prefix scan with a monadic operator+prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE_STREAM prescanlM #-}+prescanlM f z (Stream step s sz) = Stream step' (s,z) sz+  where+    {-# INLINE step' #-}+    step' (s,x) = do+                    r <- step s+                    case r of+                      Yield y s' -> do+                                      z <- f x y+                                      return $ Yield x (s', z)+                      Skip    s' -> return $ Skip (s', x)+                      Done       -> return Done++-- | Prefix scan with strict accumulator+prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE prescanl' #-}+prescanl' f = prescanlM' (\a b -> return (f a b))++-- | Prefix scan with strict accumulator and a monadic operator+prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE_STREAM prescanlM' #-}+prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz+  where+    {-# INLINE step' #-}+    step' (s,x) = x `seq`+                  do+                    r <- step s+                    case r of+                      Yield y s' -> do+                                      z <- f x y+                                      return $ Yield x (s', z)+                      Skip    s' -> return $ Skip (s', x)+                      Done       -> return Done++-- Conversions+-- -----------++-- | Convert a 'Stream' to a list+toList :: Monad m => Stream m a -> m [a]+{-# INLINE toList #-}+toList = foldr (:) []++-- | Convert a list to a 'Stream'+fromList :: Monad m => [a] -> Stream m a+{-# INLINE_STREAM fromList #-}+fromList xs = Stream step xs Unknown+  where+    step (x:xs) = return (Yield x xs)+    step []     = return Done+++errorEmptyStream :: String -> a+errorEmptyStream s = error $ "Data.Vector.Fusion.Stream.Monadic."+                        Prelude.++ s Prelude.++ ": empty stream"+
+ Data/Vector/Fusion/Stream/Size.hs view
@@ -0,0 +1,83 @@+-- |+-- Module      : Data.Vector.Fusion.Stream.Size+-- Copyright   : (c) Roman Leshchinskiy 2008+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : portable+-- +-- Size hints+--++module Data.Vector.Fusion.Stream.Size (+  Size(..), smaller, larger, toMax, upperBound+) where++-- | Size hint+data Size = Exact Int          -- ^ Exact size+          | Max   Int          -- ^ Upper bound on the size+          | Unknown            -- ^ Unknown size+        deriving( Eq, Show )++instance Num Size where+  Exact m + Exact n = Exact (m+n)+  Exact m + Max   n = Max   (m+n)++  Max   m + Exact n = Max   (m+n)+  Max   m + Max   n = Max   (m+n)++  _       + _       = Unknown+++  Exact m - Exact n = Exact (m-n)+  Exact m - Max   n = Max   m++  Max   m - Exact n = Max   (m-n)+  Max   m - Max   n = Max   m+  Max   m - Unknown = Max   m++  _       - _       = Unknown+++  fromInteger n     = Exact (fromInteger n)++-- | Minimum of two size hints+smaller :: Size -> Size -> Size+smaller (Exact m) (Exact n) = Exact (m `min` n)+smaller (Exact m) (Max   n) = Max   (m `min` n)+smaller (Exact m) Unknown   = Max   m+smaller (Max   m) (Exact n) = Max   (m `min` n)+smaller (Max   m) (Max   n) = Max   (m `min` n)+smaller (Max   m) Unknown   = Max   m+smaller Unknown   (Exact n) = Max   n+smaller Unknown   (Max   n) = Max   n+smaller Unknown   Unknown   = Unknown++-- | Maximum of two size hints+larger :: Size -> Size -> Size+larger (Exact m) (Exact n)             = Exact (m `max` n)+larger (Exact m) (Max   n) | m >= n    = Exact m+                           | otherwise = Max   n+larger (Max   m) (Exact n) | n >= m    = Exact n+                           | otherwise = Max   m+larger (Max   m) (Max   n)             = Max   (m `max` n)+larger _         _                     = Unknown++-- | Convert a size hint to an upper bound+toMax :: Size -> Size+toMax (Exact n) = Max n+toMax (Max   n) = Max n+toMax Unknown   = Unknown++-- | Compute the minimum size from a size hint+lowerBound :: Size -> Int+lowerBound (Exact n) = n+lowerBound _         = 0++-- | Compute the maximum size from a size hint if possible+upperBound :: Size -> Maybe Int+upperBound (Exact n) = Just n+upperBound (Max   n) = Just n+upperBound Unknown   = Nothing+
Data/Vector/IVector.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,+             ScopedTypeVariables #-} -- | -- Module      : Data.Vector.IVector -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- @@ -30,10 +31,10 @@   slice, extract, takeSlice, take, dropSlice, drop,    -- * Permutations-  (//),+  (//), update, bpermute,    -- * Mapping and zipping-  map, zipWith,+  map, zipWith, zip,    -- * Comparisons   eq, cmp,@@ -47,6 +48,9 @@   -- * Folding   foldl, foldl1, foldl', foldl1', foldr, foldr1, +  -- * Scans+  prescanl, prescanl',+   -- * Conversion to/from lists   toList, fromList, @@ -66,12 +70,13 @@ import qualified Data.Vector.MVector as MVector import           Data.Vector.MVector ( MVector ) -import qualified Data.Vector.MVector.Mut as Mut-import           Data.Vector.MVector.Mut ( Mut )+import qualified Data.Vector.MVector.New as New+import           Data.Vector.MVector.New ( New ) -import qualified Data.Vector.Stream as Stream-import           Data.Vector.Stream ( Stream )-import           Data.Vector.Stream.Size+import qualified Data.Vector.Fusion.Stream as Stream+import           Data.Vector.Fusion.Stream ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import           Data.Vector.Fusion.Stream.Size  import Control.Exception ( assert ) @@ -79,7 +84,7 @@                         replicate, (++),                         head, last,                         init, tail, take, drop,-                        map, zipWith,+                        map, zipWith, zip,                         filter, takeWhile, dropWhile,                         elem, notElem,                         foldl, foldl1, foldr, foldr1 )@@ -121,10 +126,18 @@ -- ------  -- | Construct a pure vector from a monadic initialiser -new :: IVector v a => Mut a -> v a-{-# INLINE_STREAM new #-}-new m = vnew (Mut.run m)+new :: IVector v a => New a -> v a+{-# INLINE new #-}+new m = new' undefined m +-- | Same as 'new' but with a dummy argument necessary for correctly typing+-- the rule @uninplace@.+--+-- See http://hackage.haskell.org/trac/ghc/ticket/2600+new' :: IVector v a => v a -> New a -> v a+{-# INLINE_STREAM new' #-}+new' _ m = vnew (New.run m)+ -- | Convert a vector to a 'Stream' stream :: IVector v a => v a -> Stream a {-# INLINE_STREAM stream #-}@@ -139,18 +152,41 @@ -- | Create a vector from a 'Stream' unstream :: IVector v a => Stream a -> v a {-# INLINE unstream #-}-unstream s = new (Mut.unstream s)+unstream s = new (New.unstream s)  {-# RULES -"stream/unstream [IVector]" forall s.-  stream (new (Mut.unstream s)) = s+"stream/unstream [IVector]" forall v s.+  stream (new' v (New.unstream s)) = s -"Mut.unstream/stream/new [IVector]" forall p.-  Mut.unstream (stream (new p)) = p+"New.unstream/stream/new [IVector]" forall v p.+  New.unstream (stream (new' v p)) = p   #-} +inplace :: (forall m. Monad m => MStream m a -> MStream m a)+        -> Stream a -> Stream a+{-# INLINE_STREAM inplace #-}+inplace f s = f s++{-# RULES++"inplace [IVector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.+  New.unstream (inplace f (stream (new' v m))) = New.transform f m++"uninplace [IVector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.+  stream (new' v (New.transform f m)) = inplace f (stream (new' v m))++"inplace/inplace [IVector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a)+         (g :: forall m. Monad m => MStream m a -> MStream m a)+         s.+  inplace f (inplace g s) = inplace (f . g) s++ #-}+ -- Length -- ------ @@ -160,8 +196,8 @@  {-# RULES -"length/unstream [IVector]" forall s.-  length (new (Mut.unstream s)) = Stream.length s+"length/unstream [IVector]" forall v s.+  length (new' v (New.unstream s)) = Stream.length s    #-} @@ -220,26 +256,28 @@  {-# RULES -"(!)/unstream [IVector]" forall i s.-  new (Mut.unstream s) ! i = s Stream.!! i+"(!)/unstream [IVector]" forall v i s.+  new' v (New.unstream s) ! i = s Stream.!! i -"head/unstream [IVector]" forall s.-  head (new (Mut.unstream s)) = Stream.head s+"head/unstream [IVector]" forall v s.+  head (new' v (New.unstream s)) = Stream.head s -"last/unstream [IVector]" forall s.-  last (new (Mut.unstream s)) = Stream.last s+"last/unstream [IVector]" forall v s.+  last (new' v (New.unstream s)) = Stream.last s   #-}  -- Subarrays -- --------- +-- FIXME: slicing doesn't work with the inplace stuff at the moment+ -- | Yield a part of the vector without copying it. Safer version of -- 'unsafeSlice'. slice :: IVector v a => v a -> Int   -- ^ starting index                             -> Int   -- ^ length                             -> v a-{-# INLINE slice #-}+{-# INLINE_STREAM slice #-} slice v i n = assert (i >= 0 && n >= 0  && i+n <= length v)             $ unsafeSlice v i n @@ -272,14 +310,8 @@  {-# RULES -"slice/extract [IVector]" forall i n s.-  slice (new (Mut.unstream s)) i n = extract (new (Mut.unstream s)) i n--"takeSlice/unstream [IVector]" forall n s.-  takeSlice n (new (Mut.unstream s)) = take n (new (Mut.unstream s))--"dropSlice/unstream [IVector]" forall n s.-  dropSlice n (new (Mut.unstream s)) = drop n (new (Mut.unstream s))+"slice/unstream [IVector]" forall v i n s.+  slice (new' v (New.unstream s)) i n = extract (new' v (New.unstream s)) i n    #-} @@ -288,9 +320,17 @@  (//) :: IVector v a => v a -> [(Int, a)] -> v a {-# INLINE (//) #-}-v // us = new (Mut.update (Mut.unstream (stream v))+v // us = new (New.update (New.unstream (stream v))                           (Stream.fromList us)) +update :: (IVector v a, IVector v (Int, a)) => v a -> v (Int, a) -> v a+{-# INLINE update #-}+update v w = new (New.update (New.unstream (stream v)) (stream w))++bpermute :: (IVector v a, IVector v Int) => v a -> v Int -> v a+{-# INLINE bpermute #-}+bpermute v is = v `seq` map (v!) is+ -- Mapping/zipping -- --------------- @@ -299,18 +339,25 @@ {-# INLINE map #-} map f = unstream . Stream.map f . stream +inplace_map :: IVector v a => (a -> a) -> v a -> v a+{-# INLINE inplace_map #-}+inplace_map f = unstream . inplace (MStream.map f) . stream+ {-# RULES -"in-place map [IVector]" forall f m.-  Mut.unstream (Stream.map f (stream (new m))) = Mut.map f m+"map->inplace_map [IVector]" map = inplace_map -  #-}+ #-}  -- | Zip two vectors with the given function. zipWith :: (IVector v a, IVector v b, IVector v c) => (a -> b -> c) -> v a -> v b -> v c {-# INLINE zipWith #-} zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) +zip :: (IVector v a, IVector v b, IVector v (a,b)) => v a -> v b -> v (a, b)+{-# INLINE zip #-}+zip = zipWith (,)+ -- Comparisons -- ----------- @@ -328,12 +375,12 @@ -- | Drop elements which do not satisfy the predicate filter :: IVector v a => (a -> Bool) -> v a -> v a {-# INLINE filter #-}-filter f = unstream . Stream.filter f . stream+filter f = unstream . inplace (MStream.filter f) . stream  -- | Yield the longest prefix of elements satisfying the predicate without -- copying. takeWhileSlice :: IVector v a => (a -> Bool) -> v a -> v a-{-# INLINE takeWhileSlice #-}+{-# INLINE_STREAM takeWhileSlice #-} takeWhileSlice f v = case findIndex (not . f) v of                        Just n  -> takeSlice n v                        Nothing -> v@@ -347,7 +394,7 @@ -- | Drop the longest prefix of elements that satisfy the predicate without -- copying dropWhileSlice :: IVector v a => (a -> Bool) -> v a -> v a-{-# INLINE dropWhileSlice #-}+{-# INLINE_STREAM dropWhileSlice #-} dropWhileSlice f v = case findIndex (not . f) v of                        Just n  -> dropSlice n v                        Nothing -> v@@ -360,11 +407,11 @@  {-# RULES -"takeWhileSlice/unstream" forall f s.-  takeWhileSlice f (new (Mut.unstream s)) = takeWhile f (new (Mut.unstream s))+"takeWhileSlice/unstream" forall v f s.+  takeWhileSlice f (new' v (New.unstream s)) = takeWhile f (new' v (New.unstream s)) -"dropWhileSlice/unstream" forall f s.-  dropWhileSlice f (new (Mut.unstream s)) = dropWhile f (new (Mut.unstream s))+"dropWhileSlice/unstream" forall v f s.+  dropWhileSlice f (new' v (New.unstream s)) = dropWhile f (new' v (New.unstream s))   #-} @@ -427,6 +474,40 @@ foldr1 :: IVector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1 #-} foldr1 f = Stream.foldr1 f . stream++-- Scans+-- -----++-- | Prefix scan+prescanl :: (IVector v a, IVector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE prescanl #-}+prescanl f z = unstream . Stream.prescanl f z . stream++inplace_prescanl :: IVector v a => (a -> a -> a) -> a -> v a -> v a+{-# INLINE inplace_prescanl #-}+inplace_prescanl f z = unstream . inplace (MStream.prescanl f z) . stream++{-# RULES++"prescanl -> inplace_prescanl [IVector]" prescanl = inplace_prescanl++ #-}++-- | Prefix scan with strict accumulator+prescanl' :: (IVector v a, IVector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE prescanl' #-}+prescanl' f z = unstream . Stream.prescanl' f z . stream++inplace_prescanl' :: IVector v a => (a -> a -> a) -> a -> v a -> v a+{-# INLINE inplace_prescanl' #-}+inplace_prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream++{-# RULES++"prescanl' -> inplace_prescanl' [IVector]" prescanl' = inplace_prescanl'++ #-}+  -- | Convert a vector to a list toList :: IVector v a => v a -> [a]
Data/Vector/MVector.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- @@ -16,12 +16,15 @@ module Data.Vector.MVector (   MVectorPure(..), MVector(..), -  slice, new, newWith, read, write, copy, grow, unstream, update, reverse, map+  slice, new, newWith, read, write, copy, grow,+  unstream, transform,+  update, reverse ) where -import qualified Data.Vector.Stream      as Stream-import           Data.Vector.Stream      ( Stream )-import           Data.Vector.Stream.Size+import qualified Data.Vector.Fusion.Stream      as Stream+import           Data.Vector.Fusion.Stream      ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import           Data.Vector.Fusion.Stream.Size  import Control.Monad.ST ( ST ) import Control.Exception ( assert )@@ -164,7 +167,29 @@ grow v by = assert (by >= 0)           $ unsafeGrow v by +mstream :: MVector v m a => v a -> MStream m a+{-# INLINE mstream #-}+mstream v = v `seq` (MStream.unfoldM get 0 `MStream.sized` Exact n)+  where+    n = length v +    {-# INLINE get #-}+    get i | i < n     = do x <- unsafeRead v i+                           return $ Just (x, i+1)+          | otherwise = return $ Nothing++munstream :: MVector v m a => v a -> MStream m a -> m (v a)+{-# INLINE munstream #-}+munstream v s = v `seq` do+                          n' <- MStream.foldM put 0 s+                          return $ slice v 0 n'+  where+    put i x = do { write v i x; return (i+1) }++transform :: MVector v m a => (MStream m a -> MStream m a) -> v a -> m (v a)+{-# INLINE_STREAM transform #-}+transform f v = munstream v (f (mstream v))+ -- | Create a new mutable vector and fill it with elements from the 'Stream'. -- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is -- inexact.@@ -221,16 +246,4 @@                                  unsafeWrite v i y                                  unsafeWrite v j x     reverse_loop _ _ = return ()---map :: MVector v m a => (a -> a) -> v a -> m ()-{-# INLINE map #-}-map f v = map_loop 0-  where-    n = length v--    map_loop i | i <= n    = do-                               x <- read v i-                               write v i (f x)-               | otherwise = return () 
− Data/Vector/MVector/Mut.hs
@@ -1,41 +0,0 @@-{-# LANGUAGE Rank2Types #-}--#include "phases.h"--module Data.Vector.MVector.Mut (-  Mut(..), run, unstream, update, reverse, map-) where--import qualified Data.Vector.MVector as MVector-import           Data.Vector.MVector ( MVector )--import           Data.Vector.Stream ( Stream )--import Prelude hiding ( reverse, map )--data Mut a = Mut (forall m mv. MVector mv m a => m (mv a))--run :: MVector mv m a => Mut a -> m (mv a)-{-# INLINE run #-}-run (Mut p) = p--trans :: Mut a -> (forall m mv. MVector mv m a => mv a -> m ()) -> Mut a-{-# INLINE trans #-}-trans (Mut p) q = Mut (do { v <- p; q v; return v })--unstream :: Stream a -> Mut a-{-# INLINE_STREAM unstream #-}-unstream s = Mut (MVector.unstream s)--update :: Mut a -> Stream (Int, a) -> Mut a-{-# INLINE_STREAM update #-}-update m s = trans m (\v -> MVector.update v s)--reverse :: Mut a -> Mut a-{-# INLINE_STREAM reverse #-}-reverse m = trans m (MVector.reverse)--map :: (a -> a) -> Mut a -> Mut a-{-# INLINE_STREAM map #-}-map f m = trans m (MVector.map f)-
+ Data/Vector/MVector/New.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}++#include "phases.h"++module Data.Vector.MVector.New (+  New(..), run, unstream, transform, update, reverse+) where++import qualified Data.Vector.MVector as MVector+import           Data.Vector.MVector ( MVector )++import           Data.Vector.Fusion.Stream ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream as Stream++import qualified Data.Vector.Fusion.Stream.Monadic as MStream++import Control.Monad  ( liftM )+import Prelude hiding ( reverse, map, filter )++newtype New a = New (forall m mv. MVector mv m a => m (mv a))++run :: MVector mv m a => New a -> m (mv a)+{-# INLINE run #-}+run (New p) = p++modify :: New a -> (forall m mv. MVector mv m a => mv a -> m ()) -> New a+{-# INLINE modify #-}+modify (New p) q = New (do { v <- p; q v; return v })++unstream :: Stream a -> New a+{-# INLINE_STREAM unstream #-}+unstream s = New (MVector.unstream s)++transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a+{-# INLINE_STREAM transform #-}+transform f (New p) = New (MVector.transform f =<< p)++{-# RULES++"transform/transform [New]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a)+         (g :: forall m. Monad m => MStream m a -> MStream m a)+         p .+  transform f (transform g p) = transform (f . g) p++ #-}++update :: New a -> Stream (Int, a) -> New a+{-# INLINE_STREAM update #-}+update m s = modify m (\v -> MVector.update v s)++reverse :: New a -> New a+{-# INLINE_STREAM reverse #-}+reverse m = modify m (MVector.reverse)+
Data/Vector/Mutable.hs view
@@ -5,7 +5,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- 
− Data/Vector/Stream.hs
@@ -1,543 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}---- |--- Module      : Data.Vector.Stream.Size--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : rl@cse.unsw.edu.au--- Stability   : experimental--- Portability : non-portable--- --- Fusible streams-----#include "phases.h"--module Data.Vector.Stream (-  -- * Types-  Step(..), Stream(..),--  -- * Size hints-  size, sized,--  -- * Length information-  length, null,--  -- * Construction-  empty, singleton, cons, snoc, replicate, (++),--  -- * Accessing individual elements-  head, last, (!!),--  -- * Substreams-  extract, init, tail, take, drop,--  -- * Mapping and zipping-  map, zipWith,--  -- * Filtering-  filter, takeWhile, dropWhile,--  -- * Searching-  elem, notElem, find, findIndex,--  -- * Folding-  foldl, foldl1, foldl', foldl1', foldr, foldr1,--  -- * Unfolding-  unfold,--  -- * Conversion to/from lists-  toList, fromList,--  -- * Monadic combinators-  mapM_, foldM-) where--import Data.Vector.Stream.Size--import Prelude hiding ( length, null,-                        replicate, (++),-                        head, last, (!!),-                        init, tail, take, drop,-                        map, zipWith,-                        filter, takeWhile, dropWhile,-                        elem, notElem,-                        foldl, foldl1, foldr, foldr1,-                        mapM_ )--data Step s a = Yield a s-              | Skip    s-              | Done---- | The type of fusible streams-data Stream a = forall s. Stream (s -> Step s a) s Size---- | 'Size' hint of a 'Stream'-size :: Stream a -> Size-{-# INLINE size #-}-size (Stream _ _ sz) = sz---- | Attach a 'Size' hint to a 'Stream'-sized :: Stream a -> Size -> Stream a-{-# INLINE_STREAM sized #-}-sized (Stream step s _) sz = Stream step s sz---- | Unfold-unfold :: (s -> Maybe (a, s)) -> s -> Stream a-{-# INLINE_STREAM unfold #-}-unfold f s = Stream step s Unknown-  where-    {-# INLINE step #-}-    step s = case f s of-               Just (x, s') -> Yield x s'-               Nothing      -> Done---- | Convert a 'Stream' to a list-toList :: Stream a -> [a]-{-# INLINE toList #-}-toList s = foldr (:) [] s---- | Create a 'Stream' from a list-fromList :: [a] -> Stream a-{-# INLINE_STREAM fromList #-}-fromList xs = Stream step xs Unknown-  where-    step (x:xs) = Yield x xs-    step []     = Done---- Length--- ---------- | Length of a 'Stream'-length :: Stream a -> Int-{-# INLINE_STREAM length #-}-length s = foldl' (\n _ -> n+1) 0 s---- | Check if a 'Stream' is empty-null :: Stream a -> Bool-{-# INLINE_STREAM null #-}-null s = foldr (\_ _ -> False) True s---- Construction--- ---------------- | Empty 'Stream'-empty :: Stream a-{-# INLINE_STREAM empty #-}-empty = Stream (const Done) () (Exact 0)---- | Singleton 'Stream'-singleton :: a -> Stream a-{-# INLINE_STREAM singleton #-}-singleton x = Stream step True (Exact 1)-  where-    {-# INLINE step #-}-    step True  = Yield x False-    step False = Done---- | Replicate a value to a given length-replicate :: Int -> a -> Stream a-{-# INLINE_STREAM replicate #-}-replicate n x = Stream step n (Exact (max n 0))-  where-    {-# INLINE step #-}-    step i | i > 0     = Yield x (i-1)-           | otherwise = Done---- | Prepend an element-cons :: a -> Stream a -> Stream a-{-# INLINE cons #-}-cons x s = singleton x ++ s---- | Append an element-snoc :: Stream a -> a -> Stream a-{-# INLINE snoc #-}-snoc s x = s ++ singleton x--infixr 5 ++--- | Concatenate two 'Stream's-(++) :: Stream a -> Stream a -> Stream a-{-# INLINE_STREAM (++) #-}-Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)-  where-    step (Left  sa) = case stepa sa of-                        Yield x sa' -> Yield x (Left  sa')-                        Skip    sa' -> Skip    (Left  sa')-                        Done        -> Skip    (Right sb)-    step (Right sb) = case stepb sb of-                        Yield x sb' -> Yield x (Right sb')-                        Skip    sb' -> Skip    (Right sb')-                        Done        -> Done---- Accessing elements--- ---------------------- | First element of the 'Stream' or error if empty-head :: Stream a -> a-{-# INLINE_STREAM head #-}-head (Stream step s _) = head_loop s-  where-    head_loop s = case step s of-                    Yield x _  -> x-                    Skip    s' -> head_loop s'-                    Done       -> error "Data.Vector.Stream.head: empty stream"---- | Last element of the 'Stream' or error if empty-last :: Stream a -> a-{-# INLINE_STREAM last #-}-last (Stream step s _) = last_loop0 s-  where-    last_loop0 s = case step s of-                     Yield x s' -> last_loop1 x s'-                     Skip    s' -> last_loop0   s'-                     Done       -> error "Data.Vector.Stream.last: empty stream"--    last_loop1 x s = case step s of-                       Yield y s' -> last_loop1 y s'-                       Skip    s' -> last_loop1 x s'-                       Done       -> x---- | Element at the given position-(!!) :: Stream a -> Int -> a-{-# INLINE (!!) #-}-s !! i = head (drop i s)---- Substreams--- -------------- | Extract a substream of the given length starting at the given position.-extract :: Stream a -> Int   -- ^ starting index-                    -> Int   -- ^ length-                    -> Stream a-{-# INLINE extract #-}-extract s i n = take n (drop i s)---- | All but the last element-init :: Stream a -> Stream a-{-# INLINE_STREAM init #-}-init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)-  where-    {-# INLINE step' #-}-    step' (Nothing, s) = case step s of-                           Yield x s' -> Skip (Just x,  s')-                           Skip    s' -> Skip (Nothing, s')-                           Done       -> Done  -- FIXME: should be an error--    step' (Just x,  s) = case step s of-                           Yield y s' -> Yield x (Just y, s')-                           Skip    s' -> Skip    (Just x, s')-                           Done       -> Done---- | All but the first element-tail :: Stream a -> Stream a-{-# INLINE_STREAM tail #-}-tail (Stream step s sz) = Stream step' (Left s) (sz - 1)-  where-    {-# INLINE step' #-}-    step' (Left  s) = case step s of-                        Yield x s' -> Skip (Right s')-                        Skip    s' -> Skip (Left  s')-                        Done       -> Done    -- FIXME: should be error?--    step' (Right s) = case step s of-                        Yield x s' -> Yield x (Right s')-                        Skip    s' -> Skip    (Right s')-                        Done       -> Done---- | The first @n@ elements-take :: Int -> Stream a -> Stream a-{-# INLINE_STREAM take #-}-take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)-  where-    {-# INLINE step' #-}-    step' (s, i) | i < n = case step s of-                             Yield x s' -> Yield x (s', i+1)-                             Skip    s' -> Skip    (s', i)-                             Done       -> Done-    step' (s, i) = Done--data Drop s = Drop_Drop s Int | Drop_Keep s---- | All but the first @n@ elements-drop :: Int -> Stream a -> Stream a-{-# INLINE_STREAM drop #-}-drop n (Stream step s sz) = Stream step' (Drop_Drop s 0) (sz - Exact n)-  where-    {-# INLINE step' #-}-    step' (Drop_Drop s i) | i < n = case step s of-                                      Yield x s' -> Skip (Drop_Drop s' (i+1))-                                      Skip    s' -> Skip (Drop_Drop s' i)-                                      Done       -> Done-                          | otherwise = Skip (Drop_Keep s)--    step' (Drop_Keep s) = case step s of-                            Yield x s' -> Yield x (Drop_Keep s')-                            Skip    s' -> Skip    (Drop_Keep s')-                            Done       -> Done-                     ---- Mapping/zipping--- -----------------instance Functor Stream where-  {-# INLINE_STREAM fmap #-}-  fmap = map---- | Map a function over a 'Stream'-map :: (a -> b) -> Stream a -> Stream b-{-# INLINE_STREAM map #-}-map f (Stream step s n) = Stream step' s n-  where-    {-# INLINE step' #-}-    step' s = case step s of-                Yield x s' -> Yield (f x) s'-                Skip    s' -> Skip        s'-                Done       -> Done---- | Zip two 'Stream's with the given function-zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c-{-# INLINE_STREAM zipWith #-}-zipWith f (Stream stepa sa na) (Stream stepb sb nb)-  = Stream step (sa, sb, Nothing) (smaller na nb)-  where-    {-# INLINE step #-}-    step (sa, sb, Nothing) = case stepa sa of-                               Yield x sa' -> Skip (sa', sb, Just x)-                               Skip    sa' -> Skip (sa', sb, Nothing)-                               Done        -> Done--    step (sa, sb, Just x)  = case stepb sb of-                               Yield y sb' -> Yield (f x y) (sa, sb', Nothing)-                               Skip    sb' -> Skip          (sa, sb', Just x)-                               Done        -> Done---- Filtering--- ------------- | Drop elements which do not satisfy the predicate-filter :: (a -> Bool) -> Stream a -> Stream a-{-# INLINE_STREAM filter #-}-filter f (Stream step s n) = Stream step' s (toMax n)-  where-    {-# INLINE step' #-}-    step' s = case step s of-                Yield x s' | f x       -> Yield x s'-                           | otherwise -> Skip    s'-                Skip    s'             -> Skip    s'-                Done                   -> Done---- | Longest prefix of elements that satisfy the predicate-takeWhile :: (a -> Bool) -> Stream a -> Stream a-{-# INLINE_STREAM takeWhile #-}-takeWhile f (Stream step s n) = Stream step' s (toMax n)-  where-    {-# INLINE step' #-}-    step' s = case step s of-                Yield x s' | f x       -> Yield x s'-                           | otherwise -> Done-                Skip    s'             -> Skip s'-                Done                   -> Done---data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s---- | Drop the longest prefix of elements that satisfy the predicate-dropWhile :: (a -> Bool) -> Stream a -> Stream a-{-# INLINE_STREAM dropWhile #-}-dropWhile f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)-  where-    -- NOTE: we jump through hoops here to have only one Yield; local data-    -- declarations would be nice!--    {-# INLINE step' #-}-    step' (DropWhile_Drop s)-      = case step s of-          Yield x s' | f x       -> Skip    (DropWhile_Drop    s')-                     | otherwise -> Skip    (DropWhile_Yield x s')-          Skip    s'             -> Skip    (DropWhile_Drop    s')-          Done                   -> Done--    step' (DropWhile_Yield x s) = Yield x (DropWhile_Next s)--    step' (DropWhile_Next s) = case step s of-                                 Yield x s' -> Skip    (DropWhile_Yield x s')-                                 Skip    s' -> Skip    (DropWhile_Next    s')-                                 Done       -> Done---- Searching--- -----------infix 4 `elem`--- | Check whether the 'Stream' contains an element-elem :: Eq a => a -> Stream a -> Bool-{-# INLINE_STREAM elem #-}-elem x (Stream step s _) = elem_loop s-  where-    elem_loop s = case step s of-                    Yield y s' | x == y    -> True-                               | otherwise -> elem_loop s'-                    Skip    s'             -> elem_loop s'-                    Done                   -> False--infix 4 `notElem`--- | Inverse of `elem`-notElem :: Eq a => a -> Stream a -> Bool-{-# INLINE notElem #-}-notElem x = not . elem x---- | Yield 'Just' the first element matching the predicate or 'Nothing' if no--- such element exists.-find :: (a -> Bool) -> Stream a -> Maybe a-{-# INLINE_STREAM find #-}-find f (Stream step s _) = find_loop s-  where-    find_loop s = case step s of-                    Yield x s' | f x       -> Just x-                               | otherwise -> find_loop s'-                    Skip    s'             -> find_loop s'-                    Done                   -> Nothing---- | Yield 'Just' the index of the first element matching the predicate or--- 'Nothing' if no such element exists.-findIndex :: (a -> Bool) -> Stream a -> Maybe Int-{-# INLINE_STREAM findIndex #-}-findIndex f (Stream step s _) = findIndex_loop s 0-  where-    findIndex_loop s i = case step s of-                           Yield x s' | f x       -> Just i-                                      | otherwise -> findIndex_loop s' (i+1)-                           Skip    s'             -> findIndex_loop s' i-                           Done                   -> Nothing---- Folding--- ----------- | Left fold-foldl :: (a -> b -> a) -> a -> Stream b -> a-{-# INLINE_STREAM foldl #-}-foldl f z (Stream step s _) = foldl_go z s-  where-    foldl_go z s = case step s of-                     Yield x s' -> foldl_go (f z x) s'-                     Skip    s' -> foldl_go z       s'-                     Done       -> z---- | Left fold on non-empty 'Stream's-foldl1 :: (a -> a -> a) -> Stream a -> a-{-# INLINE_STREAM foldl1 #-}-foldl1 f (Stream step s sz) = foldl1_loop s-  where-    foldl1_loop s = case step s of-                      Yield x s' -> foldl f x (Stream step s' (sz - 1))-                      Skip    s' -> foldl1_loop s'-                      Done       -> error "Data.Vector.Stream.foldl1: empty stream"---- | Left fold with strict accumulator-foldl' :: (a -> b -> a) -> a -> Stream b -> a-{-# INLINE_STREAM foldl' #-}-foldl' f z (Stream step s _) = foldl_go z s-  where-    foldl_go z s = z `seq`-                   case step s of-                     Yield x s' -> foldl_go (f z x) s'-                     Skip    s' -> foldl_go z       s'-                     Done       -> z---- | Left fold on non-empty 'Stream's with strict accumulator-foldl1' :: (a -> a -> a) -> Stream a -> a-{-# INLINE_STREAM foldl1' #-}-foldl1' f (Stream step s sz) = foldl1'_loop s-  where-    foldl1'_loop s = case step s of-                      Yield x s' -> foldl' f x (Stream step s' (sz - 1))-                      Skip    s' -> foldl1'_loop s'-                      Done       -> error "Data.Vector.Stream.foldl1': empty stream"---- | Right fold-foldr :: (a -> b -> b) -> b -> Stream a -> b-{-# INLINE_STREAM foldr #-}-foldr f z (Stream step s _) = foldr_go s-  where-    foldr_go s = case step s of-                   Yield x s' -> f x (foldr_go s')-                   Skip    s' -> foldr_go s'-                   Done       -> z---- | Right fold on non-empty 'Stream's-foldr1 :: (a -> a -> a) -> Stream a -> a-{-# INLINE_STREAM foldr1 #-}-foldr1 f (Stream step s sz) = foldr1_loop s-  where-    foldr1_loop s = case step s of-                      Yield x s' -> foldr f x (Stream step s' (sz - 1))-                      Skip    s' -> foldr1_loop s'-                      Done       -> error "Data.Vector.Stream.foldr1: empty stream"---- Comparisons--- -------------eq :: Eq a => Stream a -> Stream a -> Bool-{-# INLINE_STREAM eq #-}-eq (Stream step1 s1 _) (Stream step2 s2 _) = eq_loop0 s1 s2-  where-    eq_loop0 s1 s2 = case step1 s1 of-                       Yield x s1' -> eq_loop1 x s1' s2-                       Skip    s1' -> eq_loop0   s1' s2-                       Done        -> null (Stream step2 s2 Unknown)--    eq_loop1 x s1 s2 = case step2 s2 of-                         Yield y s2' -> x == y && eq_loop0   s1 s2'-                         Skip    s2' ->           eq_loop1 x s1 s2'-                         Done        -> False--cmp :: Ord a => Stream a -> Stream a -> Ordering-{-# INLINE_STREAM cmp #-}-cmp (Stream step1 s1 _) (Stream step2 s2 _) = cmp_loop0 s1 s2-  where-    cmp_loop0 s1 s2 = case step1 s1 of-                        Yield x s1' -> cmp_loop1 x s1' s2-                        Skip    s1' -> cmp_loop0   s1' s2-                        Done        -> if null (Stream step2 s2 Unknown)-                                         then EQ else LT--    cmp_loop1 x s1 s2 = case step2 s2 of-                          Yield y s2' -> case x `compare` y of-                                           EQ -> cmp_loop0 s1 s2'-                                           c  -> c-                          Skip    s2' -> cmp_loop1 x s1 s2'-                          Done        -> GT--instance Eq a => Eq (Stream a) where-  {-# INLINE (==) #-}-  (==) = eq--instance Ord a => Ord (Stream a) where-  {-# INLINE compare #-}-  compare = cmp---- Monadic combinators--- ----------------------- | Apply a monadic action to each element of the stream-mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()-{-# INLINE_STREAM mapM_ #-}-mapM_ m (Stream step s _) = mapM_go s-   where-     mapM_go s = case step s of-                   Yield x s' -> do { m x; mapM_go s' }-                   Skip    s' -> mapM_go s'-                   Done       -> return ()---- | Monadic fold-foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a-{-# INLINE_STREAM foldM #-}-foldM m z (Stream step s _) = foldM_go z s-  where-    foldM_go z s = case step s of-                     Yield x s' -> do { z' <- m z x; foldM_go z' s' }-                     Skip    s' -> foldM_go z s'-                     Done       -> return z--
− Data/Vector/Stream/Size.hs
@@ -1,83 +0,0 @@--- |--- Module      : Data.Vector.Stream.Size--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : rl@cse.unsw.edu.au--- Stability   : experimental--- Portability : portable--- --- Size hints-----module Data.Vector.Stream.Size (-  Size(..), smaller, larger, toMax, upperBound-) where---- | Size hint-data Size = Exact Int          -- ^ Exact size-          | Max   Int          -- ^ Upper bound on the size-          | Unknown            -- ^ Unknown size-        deriving( Eq, Show )--instance Num Size where-  Exact m + Exact n = Exact (m+n)-  Exact m + Max   n = Max   (m+n)--  Max   m + Exact n = Max   (m+n)-  Max   m + Max   n = Max   (m+n)--  _       + _       = Unknown---  Exact m - Exact n = Exact (m-n)-  Exact m - Max   n = Max   m--  Max   m - Exact n = Max   (m-n)-  Max   m - Max   n = Max   m-  Max   m - Unknown = Max   m--  _       - _       = Unknown---  fromInteger n     = Exact (fromInteger n)---- | Minimum of two size hints-smaller :: Size -> Size -> Size-smaller (Exact m) (Exact n) = Exact (m `min` n)-smaller (Exact m) (Max   n) = Max   (m `min` n)-smaller (Exact m) Unknown   = Max   m-smaller (Max   m) (Exact n) = Max   (m `min` n)-smaller (Max   m) (Max   n) = Max   (m `min` n)-smaller (Max   m) Unknown   = Max   m-smaller Unknown   (Exact n) = Max   n-smaller Unknown   (Max   n) = Max   n-smaller Unknown   Unknown   = Unknown---- | Maximum of two size hints-larger :: Size -> Size -> Size-larger (Exact m) (Exact n)             = Exact (m `max` n)-larger (Exact m) (Max   n) | m >= n    = Exact m-                           | otherwise = Max   n-larger (Max   m) (Exact n) | n >= m    = Exact n-                           | otherwise = Max   m-larger (Max   m) (Max   n)             = Max   (m `max` n)-larger _         _                     = Unknown---- | Convert a size hint to an upper bound-toMax :: Size -> Size-toMax (Exact n) = Max n-toMax (Max   n) = Max n-toMax Unknown   = Unknown---- | Compute the minimum size from a size hint-lowerBound :: Size -> Int-lowerBound (Exact n) = n-lowerBound _         = 0---- | Compute the maximum size from a size hint if possible-upperBound :: Size -> Maybe Int-upperBound (Exact n) = Just n-upperBound (Max   n) = Just n-upperBound Unknown   = Nothing-
Data/Vector/Unboxed.hs view
@@ -5,7 +5,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- @@ -26,6 +26,7 @@ import GHC.Prim ( ByteArray#, unsafeFreezeByteArray#, (+#) ) import GHC.Base ( Int(..) ) +-- | Unboxed vectors data Vector a = Vector {-# UNPACK #-} !Int                        {-# UNPACK #-} !Int                                       ByteArray#
Data/Vector/Unboxed/Mutable.hs view
@@ -5,7 +5,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- 
Data/Vector/Unboxed/Unbox.hs view
@@ -5,7 +5,7 @@ -- Copyright   : (c) Roman Leshchinskiy 2008 -- License     : BSD-style ----- Maintainer  : rl@cse.unsw.edu.au+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- 
vector.cabal view
@@ -1,5 +1,5 @@ Name:           vector-Version:        0.1+Version:        0.2 License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy@@ -22,11 +22,12 @@ Library   Extensions: CPP   Exposed-Modules:-        Data.Vector.Stream.Size-        Data.Vector.Stream+        Data.Vector.Fusion.Stream.Size+        Data.Vector.Fusion.Stream.Monadic+        Data.Vector.Fusion.Stream          Data.Vector.MVector-        Data.Vector.MVector.Mut+        Data.Vector.MVector.New         Data.Vector.IVector          Data.Vector.Unboxed.Unbox