packages feed

vector 0.10.12.3 → 0.11.0.0

raw patch · 36 files changed

+3842/−1937 lines, 36 filesdep ~basedep ~ghc-prim

Dependency ranges changed: base, ghc-prim

Files

Data/Vector.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP+           , DeriveDataTypeable            , FlexibleInstances            , MultiParamTypeClasses            , TypeFamilies@@ -14,7 +15,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- A library for boxed vectors (that is, polymorphic arrays capable of -- holding any Haskell value). The vectors come in two flavours: --@@ -80,7 +81,7 @@   accum, accumulate, accumulate_,   unsafeAccum, unsafeAccumulate, unsafeAccumulate_, -  -- ** Permutations +  -- ** Permutations   reverse, backpermute, unsafeBackpermute,    -- ** Safe destructive updates@@ -95,7 +96,7 @@   map, imap, concatMap,    -- ** Monadic mapping-  mapM, mapM_, forM, forM_,+  mapM, imapM, mapM_, imapM_, forM, forM_,    -- ** Zipping   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,@@ -103,7 +104,7 @@   zip, zip3, zip4, zip5, zip6,    -- ** Monadic zipping-  zipWithM, zipWithM_,+  zipWithM, izipWithM, zipWithM_, izipWithM_,    -- ** Unzipping   unzip, unzip3, unzip4, unzip5, unzip6,@@ -131,8 +132,9 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- ** Monadic folds-  foldM, foldM', fold1M, fold1M',-  foldM_, foldM'_, fold1M_, fold1M'_,+  foldM, ifoldM, foldM', ifoldM',+  fold1M, fold1M',foldM_, ifoldM_,+  foldM'_, ifoldM'_, fold1M_, fold1M'_,    -- ** Monadic sequencing   sequence, sequence_,@@ -160,7 +162,7 @@ import qualified Data.Vector.Generic as G import           Data.Vector.Mutable  ( MVector(..) ) import           Data.Primitive.Array-import qualified Data.Vector.Fusion.Stream as Stream+import qualified Data.Vector.Fusion.Bundle as Bundle  import Control.DeepSeq ( NFData, rnf ) import Control.Monad ( MonadPlus(..), liftM, ap )@@ -181,8 +183,6 @@                         enumFromTo, enumFromThenTo,                         mapM, mapM_, sequence, sequence_ ) -import qualified Prelude- import Data.Typeable ( Typeable ) import Data.Data     ( Data(..) ) import Text.Read     ( Read(..), readListPrecDefault )@@ -193,9 +193,10 @@ import qualified Data.Traversable as Traversable  #if __GLASGOW_HASKELL__ >= 708-import qualified GHC.Exts as Exts+import qualified GHC.Exts as Exts (IsList(..)) #endif + -- | Boxed vectors, supporting efficient slicing. data Vector a = Vector {-# UNPACK #-} !Int                        {-# UNPACK #-} !Int@@ -203,9 +204,9 @@         deriving ( Typeable )  instance NFData a => NFData (Vector a) where-    rnf (Vector i n arr) = force i+    rnf (Vector i n arr) = rnfAll i         where-          force !ix | ix < n    = rnf (indexArray arr ix) `seq` force (ix+1)+          rnfAll ix | ix < n    = rnf (indexArray arr ix) `seq` rnfAll (ix+1)                     | otherwise = ()  instance Show a => Show (Vector a) where@@ -216,6 +217,7 @@   readListPrec = readListPrecDefault  #if __GLASGOW_HASKELL__ >= 708+ instance Exts.IsList (Vector a) where   type Item (Vector a) = a   fromList = fromList@@ -257,27 +259,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance Eq a => Eq (Vector a) where   {-# INLINE (==) #-}-  xs == ys = Stream.eq (G.stream xs) (G.stream ys)+  xs == ys = Bundle.eq (G.stream xs) (G.stream ys)    {-# INLINE (/=) #-}-  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))+  xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))  -- See http://trac.haskell.org/vector/ticket/12 instance Ord a => Ord (Vector a) where   {-# INLINE compare #-}-  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)+  compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)    {-# INLINE (<) #-}-  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT+  xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT    {-# INLINE (<=) #-}-  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT+  xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT    {-# INLINE (>) #-}-  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT+  xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT    {-# INLINE (>=) #-}-  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+  xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT  instance Monoid (Vector a) where   {-# INLINE mempty #-}@@ -300,6 +302,9 @@   {-# INLINE (>>=) #-}   (>>=) = flip concatMap +  {-# INLINE fail #-}+  fail _ = empty+ instance MonadPlus Vector where   {-# INLINE mzero #-}   mzero = empty@@ -327,7 +332,7 @@    {-# INLINE foldl #-}   foldl = foldl-  +   {-# INLINE foldr1 #-}   foldr1 = foldr1 @@ -710,7 +715,7 @@ -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Vector a   -- ^ initial vector (of length @m@)-                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) +                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@)                 -> Vector a {-# INLINE (//) #-} (//) = (G.//)@@ -893,12 +898,24 @@ {-# INLINE mapM #-} mapM = G.mapM +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, yielding a vector of results+imapM :: Monad m => (Int -> a -> m b) -> Vector a -> m (Vector b)+{-# INLINE imapM #-}+imapM = G.imapM+ -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: Monad m => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, ignoring the results+imapM_ :: Monad m => (Int -> a -> m b) -> Vector a -> m ()+{-# INLINE imapM_ #-}+imapM_ = G.imapM_+ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b)@@ -970,7 +987,7 @@ {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 --- | Elementwise pairing of array elements. +-- | Elementwise pairing of array elements. zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-} zip = G.zip@@ -1030,12 +1047,24 @@ {-# INLINE zipWithM #-} zipWithM = G.zipWithM +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and yield a vector of results+izipWithM :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE izipWithM #-}+izipWithM = G.izipWithM+ -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and ignore the results+izipWithM_ :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE izipWithM_ #-}+izipWithM_ = G.izipWithM_+ -- Filtering -- --------- @@ -1298,6 +1327,11 @@ {-# INLINE foldM #-} foldM = G.foldM +-- | /O(n)/ Monadic fold (action applied to each element and its index)+ifoldM :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a+{-# INLINE ifoldM #-}+ifoldM = G.ifoldM+ -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-}@@ -1308,6 +1342,12 @@ {-# INLINE foldM' #-} foldM' = G.foldM' +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each+-- element and its index)+ifoldM' :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a+{-# INLINE ifoldM' #-}+ifoldM' = G.ifoldM'+ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-}@@ -1318,6 +1358,12 @@ {-# INLINE foldM_ #-} foldM_ = G.foldM_ +-- | /O(n)/ Monadic fold that discards the result (action applied to each+-- element and its index)+ifoldM_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m ()+{-# INLINE ifoldM_ #-}+ifoldM_ = G.ifoldM_+ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-}@@ -1328,6 +1374,12 @@ {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ +-- | /O(n)/ Monadic fold with strict accumulator that discards the result+-- (action applied to each element and its index)+ifoldM'_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m ()+{-# INLINE ifoldM'_ #-}+ifoldM'_ = G.ifoldM'_+ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m ()@@ -1391,7 +1443,7 @@ -- >         yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@--- +-- scanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl@@ -1514,7 +1566,7 @@ unsafeCopy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy-           + -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m ()
+ Data/Vector/Fusion/Bundle.hs view
@@ -0,0 +1,633 @@+{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, BangPatterns #-}++-- |+-- Module      : Data.Vector.Fusion.Bundle+-- Copyright   : (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+--+-- Bundles for stream fusion+--++module Data.Vector.Fusion.Bundle (+  -- * Types+  Step(..), Chunk(..), Bundle, MBundle,++  -- * In-place markers+  inplace,++  -- * Size hints+  size, sized,++  -- * Length information+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, generate, (++),++  -- * Accessing individual elements+  head, last, (!!), (!?),++  -- * Substreams+  slice, init, tail, take, drop,++  -- * Mapping+  map, concatMap, flatten, unbox,++  -- * Zipping+  indexed, indexedR,+  zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+  zip, zip3, zip4, zip5, zip6,++  -- * Filtering+  filter, takeWhile, dropWhile,++  -- * Searching+  elem, notElem, find, findIndex,++  -- * Folding+  foldl, foldl1, foldl', foldl1', foldr, foldr1,++  -- * Specialised folds+  and, or,++  -- * Unfolding+  unfoldr, unfoldrN, iterateN,++  -- * Scans+  prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl',+  scanl1, scanl1',++  -- * Enumerations+  enumFromStepN, enumFromTo, enumFromThenTo,++  -- * Conversions+  toList, fromList, fromListN, unsafeFromList, lift,+  fromVector, reVector, fromVectors, concatVectors,++  -- * Monadic combinators+  mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',++  eq, cmp+) where++import Data.Vector.Generic.Base ( Vector )+import Data.Vector.Fusion.Bundle.Size+import Data.Vector.Fusion.Util+import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) )+import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) )+import qualified Data.Vector.Fusion.Bundle.Monadic as M+import qualified Data.Vector.Fusion.Stream.Monadic as S++import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last, (!!),+                        init, tail, take, drop,+                        map, concatMap,+                        zipWith, zipWith3, zip, zip3,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        and, or,+                        scanl, scanl1,+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ )++import GHC.Base ( build )++-- Data.Vector.Internal.Check is unused+#define NOT_VECTOR_MODULE+#include "vector.h"++-- | The type of pure streams+type Bundle = M.Bundle Id++-- | Alternative name for monadic streams+type MBundle = M.Bundle++inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b)+	-> (Size -> Size) -> Bundle v a -> Bundle v b+{-# INLINE_FUSED inplace #-}+inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b))++{-# RULES++"inplace/inplace [Vector]"+  forall (f1 :: forall m. Monad m => S.Stream m a -> S.Stream m a)+         (f2 :: forall m. Monad m => S.Stream m a -> S.Stream m a)+         g1 g2 s.+  inplace f1 g1 (inplace f2 g2 s) = inplace (f1 . f2) (g1 . g2) s   #-}++++-- | Convert a pure stream to a monadic stream+lift :: Monad m => Bundle v a -> M.Bundle m v a+{-# INLINE_FUSED lift #-}+lift (M.Bundle (Stream step s) (Stream vstep t) v sz)+    = M.Bundle (Stream (return . unId . step) s)+               (Stream (return . unId . vstep) t) v sz++-- | 'Size' hint of a 'Bundle'+size :: Bundle v a -> Size+{-# INLINE size #-}+size = M.size++-- | Attach a 'Size' hint to a 'Bundle'+sized :: Bundle v a -> Size -> Bundle v a+{-# INLINE sized #-}+sized = M.sized++-- Length+-- ------++-- | Length of a 'Bundle'+length :: Bundle v a -> Int+{-# INLINE length #-}+length = unId . M.length++-- | Check if a 'Bundle' is empty+null :: Bundle v a -> Bool+{-# INLINE null #-}+null = unId . M.null++-- Construction+-- ------------++-- | Empty 'Bundle'+empty :: Bundle v a+{-# INLINE empty #-}+empty = M.empty++-- | Singleton 'Bundle'+singleton :: a -> Bundle v a+{-# INLINE singleton #-}+singleton = M.singleton++-- | Replicate a value to a given length+replicate :: Int -> a -> Bundle v a+{-# INLINE replicate #-}+replicate = M.replicate++-- | Generate a stream from its indices+generate :: Int -> (Int -> a) -> Bundle v a+{-# INLINE generate #-}+generate = M.generate++-- | Prepend an element+cons :: a -> Bundle v a -> Bundle v a+{-# INLINE cons #-}+cons = M.cons++-- | Append an element+snoc :: Bundle v a -> a -> Bundle v a+{-# INLINE snoc #-}+snoc = M.snoc++infixr 5 +++-- | Concatenate two 'Bundle's+(++) :: Bundle v a -> Bundle v a -> Bundle v a+{-# INLINE (++) #-}+(++) = (M.++)++-- Accessing elements+-- ------------------++-- | First element of the 'Bundle' or error if empty+head :: Bundle v a -> a+{-# INLINE head #-}+head = unId . M.head++-- | Last element of the 'Bundle' or error if empty+last :: Bundle v a -> a+{-# INLINE last #-}+last = unId . M.last++infixl 9 !!+-- | Element at the given position+(!!) :: Bundle v a -> Int -> a+{-# INLINE (!!) #-}+s !! i = unId (s M.!! i)++infixl 9 !?+-- | Element at the given position or 'Nothing' if out of bounds+(!?) :: Bundle v a -> Int -> Maybe a+{-# INLINE (!?) #-}+s !? i = unId (s M.!? i)++-- Substreams+-- ----------++-- | Extract a substream of the given length starting at the given position.+slice :: Int   -- ^ starting index+      -> Int   -- ^ length+      -> Bundle v a+      -> Bundle v a+{-# INLINE slice #-}+slice = M.slice++-- | All but the last element+init :: Bundle v a -> Bundle v a+{-# INLINE init #-}+init = M.init++-- | All but the first element+tail :: Bundle v a -> Bundle v a+{-# INLINE tail #-}+tail = M.tail++-- | The first @n@ elements+take :: Int -> Bundle v a -> Bundle v a+{-# INLINE take #-}+take = M.take++-- | All but the first @n@ elements+drop :: Int -> Bundle v a -> Bundle v a+{-# INLINE drop #-}+drop = M.drop++-- Mapping+-- ---------------++-- | Map a function over a 'Bundle'+map :: (a -> b) -> Bundle v a -> Bundle v b+{-# INLINE map #-}+map = M.map++unbox :: Bundle v (Box a) -> Bundle v a+{-# INLINE unbox #-}+unbox = M.unbox++concatMap :: (a -> Bundle v b) -> Bundle v a -> Bundle v b+{-# INLINE concatMap #-}+concatMap = M.concatMap++-- Zipping+-- -------++-- | Pair each element in a 'Bundle' with its index+indexed :: Bundle v a -> Bundle v (Int,a)+{-# INLINE indexed #-}+indexed = M.indexed++-- | Pair each element in a 'Bundle' with its index, starting from the right+-- and counting down+indexedR :: Int -> Bundle v a -> Bundle v (Int,a)+{-# INLINE_FUSED indexedR #-}+indexedR = M.indexedR++-- | Zip two 'Bundle's with the given function+zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c+{-# INLINE zipWith #-}+zipWith = M.zipWith++-- | Zip three 'Bundle's with the given function+zipWith3 :: (a -> b -> c -> d) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+{-# INLINE zipWith3 #-}+zipWith3 = M.zipWith3++zipWith4 :: (a -> b -> c -> d -> e)+                    -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                    -> Bundle v e+{-# INLINE zipWith4 #-}+zipWith4 = M.zipWith4++zipWith5 :: (a -> b -> c -> d -> e -> f)+                    -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                    -> Bundle v e -> Bundle v f+{-# INLINE zipWith5 #-}+zipWith5 = M.zipWith5++zipWith6 :: (a -> b -> c -> d -> e -> f -> g)+                    -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                    -> Bundle v e -> Bundle v f -> Bundle v g+{-# INLINE zipWith6 #-}+zipWith6 = M.zipWith6++zip :: Bundle v a -> Bundle v b -> Bundle v (a,b)+{-# INLINE zip #-}+zip = M.zip++zip3 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v (a,b,c)+{-# INLINE zip3 #-}+zip3 = M.zip3++zip4 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                -> Bundle v (a,b,c,d)+{-# INLINE zip4 #-}+zip4 = M.zip4++zip5 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                -> Bundle v e -> Bundle v (a,b,c,d,e)+{-# INLINE zip5 #-}+zip5 = M.zip5++zip6 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d+                -> Bundle v e -> Bundle v f -> Bundle v (a,b,c,d,e,f)+{-# INLINE zip6 #-}+zip6 = M.zip6++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: (a -> Bool) -> Bundle v a -> Bundle v a+{-# INLINE filter #-}+filter = M.filter++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: (a -> Bool) -> Bundle v a -> Bundle v a+{-# INLINE takeWhile #-}+takeWhile = M.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: (a -> Bool) -> Bundle v a -> Bundle v a+{-# INLINE dropWhile #-}+dropWhile = M.dropWhile++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Bundle' contains an element+elem :: Eq a => a -> Bundle v a -> Bool+{-# INLINE elem #-}+elem x = unId . M.elem x++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: Eq a => a -> Bundle v 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) -> Bundle v 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) -> Bundle v a -> Maybe Int+{-# INLINE findIndex #-}+findIndex f = unId . M.findIndex f++-- Folding+-- -------++-- | Left fold+foldl :: (a -> b -> a) -> a -> Bundle v b -> a+{-# INLINE foldl #-}+foldl f z = unId . M.foldl f z++-- | Left fold on non-empty 'Bundle's+foldl1 :: (a -> a -> a) -> Bundle v a -> a+{-# INLINE foldl1 #-}+foldl1 f = unId . M.foldl1 f++-- | Left fold with strict accumulator+foldl' :: (a -> b -> a) -> a -> Bundle v b -> a+{-# INLINE foldl' #-}+foldl' f z = unId . M.foldl' f z++-- | Left fold on non-empty 'Bundle's with strict accumulator+foldl1' :: (a -> a -> a) -> Bundle v a -> a+{-# INLINE foldl1' #-}+foldl1' f = unId . M.foldl1' f++-- | Right fold+foldr :: (a -> b -> b) -> b -> Bundle v a -> b+{-# INLINE foldr #-}+foldr f z = unId . M.foldr f z++-- | Right fold on non-empty 'Bundle's+foldr1 :: (a -> a -> a) -> Bundle v a -> a+{-# INLINE foldr1 #-}+foldr1 f = unId . M.foldr1 f++-- Specialised folds+-- -----------------++and :: Bundle v Bool -> Bool+{-# INLINE and #-}+and = unId . M.and++or :: Bundle v Bool -> Bool+{-# INLINE or #-}+or = unId . M.or++-- Unfolding+-- ---------++-- | Unfold+unfoldr :: (s -> Maybe (a, s)) -> s -> Bundle v a+{-# INLINE unfoldr #-}+unfoldr = M.unfoldr++-- | Unfold at most @n@ elements+unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Bundle v a+{-# INLINE unfoldrN #-}+unfoldrN = M.unfoldrN++-- | Apply function n-1 times to value. Zeroth element is original value.+iterateN :: Int -> (a -> a) -> a -> Bundle v a+{-# INLINE iterateN #-}+iterateN = M.iterateN++-- Scans+-- -----++-- | Prefix scan+prescanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE prescanl #-}+prescanl = M.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE prescanl' #-}+prescanl' = M.prescanl'++-- | Suffix scan+postscanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE postscanl #-}+postscanl = M.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE postscanl' #-}+postscanl' = M.postscanl'++-- | Haskell-style scan+scanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE scanl #-}+scanl = M.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a+{-# INLINE scanl' #-}+scanl' = M.scanl'++-- | Scan over a non-empty 'Bundle'+scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a+{-# INLINE scanl1 #-}+scanl1 = M.scanl1++-- | Scan over a non-empty 'Bundle' with a strict accumulator+scanl1' :: (a -> a -> a) -> Bundle v a -> Bundle v a+{-# INLINE scanl1' #-}+scanl1' = M.scanl1'+++-- Comparisons+-- -----------++-- | Check if two 'Bundle's are equal+eq :: Eq a => Bundle v a -> Bundle v a -> Bool+{-# INLINE eq #-}+eq x y = unId (M.eq x y)++-- | Lexicographically compare two 'Bundle's+cmp :: Ord a => Bundle v a -> Bundle v a -> Ordering+{-# INLINE cmp #-}+cmp x y = unId (M.cmp x y)++instance Eq a => Eq (M.Bundle Id v a) where+  {-# INLINE (==) #-}+  (==) = eq++instance Ord a => Ord (M.Bundle Id v a) where+  {-# INLINE compare #-}+  compare = cmp++-- Monadic combinators+-- -------------------++-- | Apply a monadic action to each element of the stream, producing a monadic+-- stream of results+mapM :: Monad m => (a -> m b) -> Bundle v a -> M.Bundle m v b+{-# INLINE mapM #-}+mapM f = M.mapM f . lift++-- | Apply a monadic action to each element of the stream+mapM_ :: Monad m => (a -> m b) -> Bundle v a -> m ()+{-# INLINE mapM_ #-}+mapM_ f = M.mapM_ f . lift++zipWithM :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> M.Bundle m v c+{-# INLINE zipWithM #-}+zipWithM f as bs = M.zipWithM f (lift as) (lift bs)++zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f as bs = M.zipWithM_ f (lift as) (lift bs)++-- | Yield a monadic stream of elements that satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Bundle v a -> M.Bundle m v a+{-# INLINE filterM #-}+filterM f = M.filterM f . lift++-- | Monadic fold+foldM :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a+{-# INLINE foldM #-}+foldM m z = M.foldM m z . lift++-- | Monadic fold over non-empty stream+fold1M :: Monad m => (a -> a -> m a) -> Bundle v a -> m a+{-# INLINE fold1M #-}+fold1M m = M.fold1M m . lift++-- | Monadic fold with strict accumulator+foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a+{-# INLINE foldM' #-}+foldM' m z = M.foldM' m z . lift++-- | Monad fold over non-empty stream with strict accumulator+fold1M' :: Monad m => (a -> a -> m a) -> Bundle v a -> m a+{-# INLINE fold1M' #-}+fold1M' m = M.fold1M' m . lift++-- Enumerations+-- ------------++-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@,+-- @x+y+y@ etc.+enumFromStepN :: Num a => a -> a -> Int -> Bundle v a+{-# INLINE enumFromStepN #-}+enumFromStepN = M.enumFromStepN++-- | Enumerate values+--+-- /WARNING:/ This operations can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromTo :: Enum a => a -> a -> Bundle v a+{-# INLINE enumFromTo #-}+enumFromTo = M.enumFromTo++-- | Enumerate values with a given step.+--+-- /WARNING:/ This operations is very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: Enum a => a -> a -> a -> Bundle v a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = M.enumFromThenTo++-- Conversions+-- -----------++-- | Convert a 'Bundle' to a list+toList :: Bundle v a -> [a]+{-# INLINE toList #-}+-- toList s = unId (M.toList s)+toList s = build (\c n -> toListFB c n s)++-- This supports foldr/build list fusion that GHC implements+toListFB :: (a -> b -> b) -> b -> Bundle v a -> b+{-# INLINE [0] toListFB #-}+toListFB c n M.Bundle{M.sElems = Stream step t} = go t+  where+    go s = case unId (step s) of+             Yield x s' -> x `c` go s'+             Skip    s' -> go s'+             Done       -> n++-- | Create a 'Bundle' from a list+fromList :: [a] -> Bundle v a+{-# INLINE fromList #-}+fromList = M.fromList++-- | Create a 'Bundle' from the first @n@ elements of a list+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Int -> [a] -> Bundle v a+{-# INLINE fromListN #-}+fromListN = M.fromListN++unsafeFromList :: Size -> [a] -> Bundle v a+{-# INLINE unsafeFromList #-}+unsafeFromList = M.unsafeFromList++fromVector :: Vector v a => v a -> Bundle v a+{-# INLINE fromVector #-}+fromVector = M.fromVector++reVector :: Bundle u a -> Bundle v a+{-# INLINE reVector #-}+reVector = M.reVector++fromVectors :: Vector v a => [v a] -> Bundle v a+{-# INLINE fromVectors #-}+fromVectors = M.fromVectors++concatVectors :: Vector v a => Bundle u (v a) -> Bundle v a+{-# INLINE concatVectors #-}+concatVectors = M.concatVectors++-- | Create a 'Bundle' of values from a 'Bundle' of streamable things+flatten :: (a -> s) -> (s -> Step s b) -> Size -> Bundle v a -> Bundle v b+{-# INLINE_FUSED flatten #-}+flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . lift+
+ Data/Vector/Fusion/Bundle/Monadic.hs view
@@ -0,0 +1,1098 @@+{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}++-- |+-- Module      : Data.Vector.Fusion.Bundle.Monadic+-- Copyright   : (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+--+-- Monadic bundles.+--++module Data.Vector.Fusion.Bundle.Monadic (+  Bundle(..), Chunk(..),++  -- * Size hints+  size, sized,++  -- * Length+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),++  -- * Accessing elements+  head, last, (!!), (!?),++  -- * Substreams+  slice, init, tail, take, drop,++  -- * Mapping+  map, mapM, mapM_, trans, unbox, concatMap, flatten,++  -- * Zipping+  indexed, indexedR, zipWithM_,+  zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,+  zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+  zip, zip3, zip4, zip5, zip6,++  -- * Comparisons+  eq, cmp,++  -- * Filtering+  filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,++  -- * Searching+  elem, notElem, find, findM, findIndex, findIndexM,++  -- * Folding+  foldl, foldlM, foldl1, foldl1M, foldM, fold1M,+  foldl', foldlM', foldl1', foldl1M', foldM', fold1M',+  foldr, foldrM, foldr1, foldr1M,++  -- * Specialised folds+  and, or, concatMapM,++  -- * Unfolding+  unfoldr, unfoldrM,+  unfoldrN, unfoldrNM,+  iterateN, iterateNM,++  -- * Scans+  prescanl, prescanlM, prescanl', prescanlM',+  postscanl, postscanlM, postscanl', postscanlM',+  scanl, scanlM, scanl', scanlM',+  scanl1, scanl1M, scanl1', scanl1M',++  -- * Enumerations+  enumFromStepN, enumFromTo, enumFromThenTo,++  -- * Conversions+  toList, fromList, fromListN, unsafeFromList,+  fromVector, reVector, fromVectors, concatVectors,+  fromStream, chunks, elements+) where++import Data.Vector.Generic.Base+import qualified Data.Vector.Generic.Mutable.Base as M+import Data.Vector.Fusion.Bundle.Size+import Data.Vector.Fusion.Util ( Box(..), delay_inline )+import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) )+import qualified Data.Vector.Fusion.Stream.Monadic as S+import Control.Monad.Primitive++import qualified Data.List as List+import Data.Char      ( ord )+import GHC.Base       ( unsafeChr )+import Control.Monad  ( liftM )+import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last, (!!),+                        init, tail, take, drop,+                        map, mapM, mapM_, concatMap,+                        zipWith, zipWith3, zip, zip3,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        and, or,+                        scanl, scanl1,+                        enumFromTo, enumFromThenTo )++import Data.Int  ( Int8, Int16, Int32, Int64 )+import Data.Word ( Word8, Word16, Word32, Word, Word64 )++#include "vector.h"+#include "MachDeps.h"++data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ())++-- | Monadic streams+data Bundle m v a = Bundle { sElems  :: Stream m a+                           , sChunks :: Stream m (Chunk v a)+                           , sVector :: Maybe (v a)+                           , sSize   :: Size+                           }++fromStream :: Monad m => Stream m a -> Size -> Bundle m v a+{-# INLINE fromStream #-}+fromStream (Stream step t) sz = Bundle (Stream step t) (Stream step' t) Nothing sz+  where+    step' s = do r <- step s+                 return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r++chunks :: Bundle m v a -> Stream m (Chunk v a)+{-# INLINE chunks #-}+chunks = sChunks++elements :: Bundle m v a -> Stream m a+{-# INLINE elements #-}+elements = sElems++-- | 'Size' hint of a 'Bundle'+size :: Bundle m v a -> Size+{-# INLINE size #-}+size = sSize++-- | Attach a 'Size' hint to a 'Bundle'+sized :: Bundle m v a -> Size -> Bundle m v a+{-# INLINE_FUSED sized #-}+sized s sz = s { sSize = sz }++-- Length+-- ------++-- | Length of a 'Bundle'+length :: Monad m => Bundle m v a -> m Int+{-# INLINE_FUSED length #-}+length Bundle{sSize = Exact n}  = return n+length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s++-- | Check if a 'Bundle' is empty+null :: Monad m => Bundle m v a -> m Bool+{-# INLINE_FUSED null #-}+null Bundle{sSize = Exact n} = return (n == 0)+null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s++-- Construction+-- ------------++-- | Empty 'Bundle'+empty :: Monad m => Bundle m v a+{-# INLINE_FUSED empty #-}+empty = fromStream S.empty (Exact 0)++-- | Singleton 'Bundle'+singleton :: Monad m => a -> Bundle m v a+{-# INLINE_FUSED singleton #-}+singleton x = fromStream (S.singleton x) (Exact 1)++-- | Replicate a value to a given length+replicate :: Monad m => Int -> a -> Bundle m v a+{-# INLINE_FUSED replicate #-}+replicate n x = Bundle (S.replicate n x)+                       (S.singleton $ Chunk len (\v -> M.basicSet v x))+                       Nothing+                       (Exact len)+  where+    len = delay_inline max n 0++-- | Yield a 'Bundle' of values obtained by performing the monadic action the+-- given number of times+replicateM :: Monad m => Int -> m a -> Bundle m v a+{-# INLINE_FUSED replicateM #-}+-- NOTE: We delay inlining max here because GHC will create a join point for+-- the call to newArray# otherwise which is not really nice.+replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0))++generate :: Monad m => Int -> (Int -> a) -> Bundle m v a+{-# INLINE generate #-}+generate n f = generateM n (return . f)++-- | Generate a stream from its indices+generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a+{-# INLINE_FUSED generateM #-}+generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0))++-- | Prepend an element+cons :: Monad m => a -> Bundle m v a -> Bundle m v a+{-# INLINE cons #-}+cons x s = singleton x ++ s++-- | Append an element+snoc :: Monad m => Bundle m v a -> a -> Bundle m v a+{-# INLINE snoc #-}+snoc s x = s ++ singleton x++infixr 5 +++-- | Concatenate two 'Bundle's+(++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED (++) #-}+Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb)++-- Accessing elements+-- ------------------++-- | First element of the 'Bundle' or error if empty+head :: Monad m => Bundle m v a -> m a+{-# INLINE_FUSED head #-}+head = S.head . sElems++-- | Last element of the 'Bundle' or error if empty+last :: Monad m => Bundle m v a -> m a+{-# INLINE_FUSED last #-}+last = S.last . sElems++infixl 9 !!+-- | Element at the given position+(!!) :: Monad m => Bundle m v a -> Int -> m a+{-# INLINE (!!) #-}+b !! i = sElems b S.!! i++infixl 9 !?+-- | Element at the given position or 'Nothing' if out of bounds+(!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a)+{-# INLINE (!?) #-}+b !? i = sElems b S.!? i++-- Substreams+-- ----------++-- | Extract a substream of the given length starting at the given position.+slice :: Monad m => Int   -- ^ starting index+                 -> Int   -- ^ length+                 -> Bundle m v a+                 -> Bundle m v a+{-# INLINE slice #-}+slice i n s = take n (drop i s)++-- | All but the last element+init :: Monad m => Bundle m v a -> Bundle m v a+{-# INLINE_FUSED init #-}+init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1)++-- | All but the first element+tail :: Monad m => Bundle m v a -> Bundle m v a+{-# INLINE_FUSED tail #-}+tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1)++-- | The first @n@ elements+take :: Monad m => Int -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED take #-}+take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz)++-- | All but the first @n@ elements+drop :: Monad m => Int -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED drop #-}+drop n Bundle{sElems = s, sSize = sz} =+  fromStream (S.drop n s) (clampedSubtract sz (Exact n))++-- Mapping+-- -------++instance Monad m => Functor (Bundle m v) where+  {-# INLINE fmap #-}+  fmap = map++-- | Map a function over a 'Bundle'+map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b+{-# INLINE map #-}+map f = mapM (return . f)++-- | Map a monadic function over a 'Bundle'+mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b+{-# INLINE_FUSED mapM #-}+mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n++-- | Execute a monadic action for each element of the 'Bundle'+mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m ()+{-# INLINE_FUSED mapM_ #-}+mapM_ m = S.mapM_ m . sElems++-- | Transform a 'Bundle' to use a different monad+trans :: (Monad m, Monad m') => (forall z. m z -> m' z)+                             -> Bundle m v a -> Bundle m' v a+{-# INLINE_FUSED trans #-}+trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n}+  = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n }++unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a+{-# INLINE_FUSED unbox #-}+unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n++-- Zipping+-- -------++-- | Pair each element in a 'Bundle' with its index+indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a)+{-# INLINE_FUSED indexed #-}+indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n++-- | Pair each element in a 'Bundle' with its index, starting from the right+-- and counting down+indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a)+{-# INLINE_FUSED indexedR #-}+indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n++-- | Zip two 'Bundle's with the given monadic function+zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c+{-# INLINE_FUSED zipWithM #-}+zipWithM f Bundle{sElems = sa, sSize = na}+           Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb)++-- FIXME: This might expose an opportunity for inplace execution.+{-# RULES++"zipWithM xs xs [Vector.Bundle]" forall f xs.+  zipWithM f xs xs = mapM (\x -> f x x) xs   #-}+++zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb)++zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+{-# INLINE_FUSED zipWith3M #-}+zipWith3M f Bundle{sElems = sa, sSize = na}+            Bundle{sElems = sb, sSize = nb}+            Bundle{sElems = sc, sSize = nc}+  = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc))++zipWith4M :: Monad m => (a -> b -> c -> d -> m e)+                     -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                     -> Bundle m v e+{-# INLINE zipWith4M #-}+zipWith4M f sa sb sc sd+  = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)++zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)+                     -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                     -> Bundle m v e -> Bundle m v f+{-# INLINE zipWith5M #-}+zipWith5M f sa sb sc sd se+  = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)++zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)+                     -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                     -> Bundle m v e -> Bundle m v f -> Bundle m v g+{-# INLINE zipWith6M #-}+zipWith6M fn sa sb sc sd se sf+  = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)+                                                  (zip3 sd se sf)++zipWith :: Monad m => (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c+{-# INLINE zipWith #-}+zipWith f = zipWithM (\a b -> return (f a b))++zipWith3 :: Monad m => (a -> b -> c -> d)+                    -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+{-# INLINE zipWith3 #-}+zipWith3 f = zipWith3M (\a b c -> return (f a b c))++zipWith4 :: Monad m => (a -> b -> c -> d -> e)+                    -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                    -> Bundle m v e+{-# INLINE zipWith4 #-}+zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))++zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)+                    -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                    -> Bundle m v e -> Bundle m v f+{-# INLINE zipWith5 #-}+zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))++zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)+                    -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                    -> Bundle m v e -> Bundle m v f -> Bundle m v g+{-# INLINE zipWith6 #-}+zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))++zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b)+{-# INLINE zip #-}+zip = zipWith (,)++zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c)+{-# INLINE zip3 #-}+zip3 = zipWith3 (,,)++zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                -> Bundle m v (a,b,c,d)+{-# INLINE zip4 #-}+zip4 = zipWith4 (,,,)++zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                -> Bundle m v e -> Bundle m v (a,b,c,d,e)+{-# INLINE zip5 #-}+zip5 = zipWith5 (,,,,)++zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d+                -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f)+{-# INLINE zip6 #-}+zip6 = zipWith6 (,,,,,)++-- Comparisons+-- -----------++-- | Check if two 'Bundle's are equal+eq :: (Monad m, Eq a) => Bundle m v a -> Bundle m v a -> m Bool+{-# INLINE_FUSED eq #-}+eq x y = sElems x `S.eq` sElems y++-- | Lexicographically compare two 'Bundle's+cmp :: (Monad m, Ord a) => Bundle m v a -> Bundle m v a -> m Ordering+{-# INLINE_FUSED cmp #-}+cmp x y = sElems x `S.cmp` sElems y++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE filter #-}+filter f = filterM (return . f)++-- | Drop elements which do not satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED filterM #-}+filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n)++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE takeWhile #-}+takeWhile f = takeWhileM (return . f)++-- | Longest prefix of elements that satisfy the monadic predicate+takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED takeWhileM #-}+takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n)++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE dropWhile #-}+dropWhile f = dropWhileM (return . f)++-- | Drop the longest prefix of elements that satisfy the monadic predicate+dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED dropWhileM #-}+dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n)++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Bundle' contains an element+elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool+{-# INLINE_FUSED elem #-}+elem x = S.elem x . sElems++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool+{-# INLINE notElem #-}+notElem x = S.notElem x . sElems++-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'+-- if no such element exists.+find :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe a)+{-# INLINE find #-}+find f = findM (return . f)++-- | Yield 'Just' the first element that satisfies the monadic predicate or+-- 'Nothing' if no such element exists.+findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a)+{-# INLINE_FUSED findM #-}+findM f = S.findM f . sElems++-- | Yield 'Just' the index of the first element that satisfies the predicate+-- or 'Nothing' if no such element exists.+findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int)+{-# INLINE_FUSED findIndex #-}+findIndex f = findIndexM (return . f)++-- | Yield 'Just' the index of the first element that satisfies the monadic+-- predicate or 'Nothing' if no such element exists.+findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int)+{-# INLINE_FUSED findIndexM #-}+findIndexM f = S.findIndexM f . sElems++-- Folding+-- -------++-- | Left fold+foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a+{-# INLINE foldl #-}+foldl f = foldlM (\a b -> return (f a b))++-- | Left fold with a monadic operator+foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a+{-# INLINE_FUSED foldlM #-}+foldlM m z = S.foldlM m z . sElems++-- | Same as 'foldlM'+foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a+{-# INLINE foldM #-}+foldM = foldlM++-- | Left fold over a non-empty 'Bundle'+foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a+{-# INLINE foldl1 #-}+foldl1 f = foldl1M (\a b -> return (f a b))++-- | Left fold over a non-empty 'Bundle' with a monadic operator+foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a+{-# INLINE_FUSED foldl1M #-}+foldl1M f = S.foldl1M f . sElems++-- | Same as 'foldl1M'+fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a+{-# INLINE fold1M #-}+fold1M = foldl1M++-- | Left fold with a strict accumulator+foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v 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 -> Bundle m v b -> m a+{-# INLINE_FUSED foldlM' #-}+foldlM' m z = S.foldlM' m z . sElems++-- | Same as 'foldlM''+foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a+{-# INLINE foldM' #-}+foldM' = foldlM'++-- | Left fold over a non-empty 'Bundle' with a strict accumulator+foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a+{-# INLINE foldl1' #-}+foldl1' f = foldl1M' (\a b -> return (f a b))++-- | Left fold over a non-empty 'Bundle' with a strict accumulator and a+-- monadic operator+foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a+{-# INLINE_FUSED foldl1M' #-}+foldl1M' f = S.foldl1M' f . sElems++-- | Same as 'foldl1M''+fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a+{-# INLINE fold1M' #-}+fold1M' = foldl1M'++-- | Right fold+foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v a -> m b+{-# INLINE foldr #-}+foldr f = foldrM (\a b -> return (f a b))++-- | Right fold with a monadic operator+foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b+{-# INLINE_FUSED foldrM #-}+foldrM f z = S.foldrM f z . sElems++-- | Right fold over a non-empty stream+foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a+{-# 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) -> Bundle m v a -> m a+{-# INLINE_FUSED foldr1M #-}+foldr1M f = S.foldr1M f . sElems++-- Specialised folds+-- -----------------++and :: Monad m => Bundle m v Bool -> m Bool+{-# INLINE_FUSED and #-}+and = S.and . sElems++or :: Monad m => Bundle m v Bool -> m Bool+{-# INLINE_FUSED or #-}+or = S.or . sElems++concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b+{-# INLINE concatMap #-}+concatMap f = concatMapM (return . f)++concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b+{-# INLINE_FUSED concatMapM #-}+concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown++-- | Create a 'Bundle' of values from a 'Bundle' of streamable things+flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size+                   -> Bundle m v a -> Bundle m v b+{-# INLINE_FUSED flatten #-}+flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz++-- Unfolding+-- ---------++-- | Unfold+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a+{-# INLINE_FUSED unfoldr #-}+unfoldr f = unfoldrM (return . f)++-- | Unfold with a monadic function+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a+{-# INLINE_FUSED unfoldrM #-}+unfoldrM f s = fromStream (S.unfoldrM f s) Unknown++-- | Unfold at most @n@ elements+unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a+{-# INLINE_FUSED unfoldrN #-}+unfoldrN n f = unfoldrNM n (return . f)++-- | Unfold at most @n@ elements with a monadic functions+unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a+{-# INLINE_FUSED unfoldrNM #-}+unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0))++-- | Apply monadic function n times to value. Zeroth element is original value.+iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a+{-# INLINE_FUSED iterateNM #-}+iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0))++-- | Apply function n times to value. Zeroth element is original value.+iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a+{-# INLINE_FUSED iterateN #-}+iterateN n f x0 = iterateNM n (return . f) x0++-- Scans+-- -----++-- | Prefix scan+prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# INLINE prescanl #-}+prescanl f = prescanlM (\a b -> return (f a b))++-- | Prefix scan with a monadic operator+prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a+{-# INLINE_FUSED prescanlM #-}+prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz++-- | Prefix scan with strict accumulator+prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# 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 -> Bundle m v b -> Bundle m v a+{-# INLINE_FUSED prescanlM' #-}+prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz++-- | Suffix scan+postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# 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 -> Bundle m v b -> Bundle m v a+{-# INLINE_FUSED postscanlM #-}+postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz++-- | Suffix scan with strict accumulator+postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# 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 -> Bundle m v b -> Bundle m v a+{-# INLINE_FUSED postscanlM' #-}+postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz++-- | Haskell-style scan+scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# 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 -> Bundle m v b -> Bundle m v a+{-# INLINE scanlM #-}+scanlM f z s = z `cons` postscanlM f z s++-- | Haskell-style scan with strict accumulator+scanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a+{-# INLINE scanl' #-}+scanl' f = scanlM' (\a b -> return (f a b))++-- | Haskell-style scan with strict accumulator and a monadic operator+scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a+{-# INLINE scanlM' #-}+scanlM' f z s = z `seq` (z `cons` postscanlM f z s)++-- | Scan over a non-empty 'Bundle'+scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a+{-# INLINE scanl1 #-}+scanl1 f = scanl1M (\x y -> return (f x y))++-- | Scan over a non-empty 'Bundle' with a monadic operator+scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED scanl1M #-}+scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz++-- | Scan over a non-empty 'Bundle' with a strict accumulator+scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a+{-# INLINE scanl1' #-}+scanl1' f = scanl1M' (\x y -> return (f x y))++-- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic+-- operator+scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a+{-# INLINE_FUSED scanl1M' #-}+scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz++-- 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 'Bundle' of the given length containing the values @x@, @x+y@,+-- @x+y+y@ etc.+enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a+{-# INLINE_FUSED enumFromStepN #-}+enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0))++-- | Enumerate values+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromTo #-}+enumFromTo x y = fromList [x .. y]++-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for+-- overflow which can't happen here.++-- FIXME: add "too large" test for Int+enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromTo_small #-}+enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n)+  where+    n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0++    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done++{-# RULES++"enumFromTo<Int8> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8++"enumFromTo<Int16> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16++"enumFromTo<Word8> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8++"enumFromTo<Word16> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16   #-}++++#if WORD_SIZE_IN_BITS > 32++{-# RULES++"enumFromTo<Int32> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32++"enumFromTo<Word32> [Bundle]"+  enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32   #-}++#endif++-- NOTE: We could implement a generic "too large" test:+--+-- len x y | x > y = 0+--         | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n+--         | otherwise = error+--   where+--     n = y-x+1+--+-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for+-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744+--++enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int+{-# INLINE_FUSED enumFromTo_int #-}+enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+  where+    {-# INLINE [0] len #-}+    len :: Int -> Int -> Int+    len u v | u > v     = 0+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+                          (n > 0)+                        $ n+      where+        n = v-u+1++    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done++enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromTo_intlike #-}+enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+  where+    {-# INLINE [0] len #-}+    len u v | u > v     = 0+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+                          (n > 0)+                        $ fromIntegral n+      where+        n = v-u+1++    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done++{-# RULES++"enumFromTo<Int> [Bundle]"+  enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int++#if WORD_SIZE_IN_BITS > 32++"enumFromTo<Int64> [Bundle]"+  enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64    #-}++#else++"enumFromTo<Int32> [Bundle]"+  enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32    #-}++#endif++++enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromTo_big_word #-}+enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+  where+    {-# INLINE [0] len #-}+    len u v | u > v     = 0+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+                          (n < fromIntegral (maxBound :: Int))+                        $ fromIntegral (n+1)+      where+        n = v-u++    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done++{-# RULES++"enumFromTo<Word> [Bundle]"+  enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word++"enumFromTo<Word64> [Bundle]"+  enumFromTo = enumFromTo_big_word+                        :: Monad m => Word64 -> Word64 -> Bundle m v Word64++#if WORD_SIZE_IN_BITS == 32++"enumFromTo<Word32> [Bundle]"+  enumFromTo = enumFromTo_big_word+                        :: Monad m => Word32 -> Word32 -> Bundle m v Word32++#endif++"enumFromTo<Integer> [Bundle]"+  enumFromTo = enumFromTo_big_word+                        :: Monad m => Integer -> Integer -> Bundle m v Integer   #-}++++-- FIXME: the "too large" test is totally wrong+enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromTo_big_int #-}+enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+  where+    {-# INLINE [0] len #-}+    len u v | u > v     = 0+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+                          (n > 0 && n <= fromIntegral (maxBound :: Int))+                        $ fromIntegral n+      where+        n = v-u+1++    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done++#if WORD_SIZE_IN_BITS > 32++{-# RULES++"enumFromTo<Int64> [Bundle]"+  enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64   #-}++++#endif++enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char+{-# INLINE_FUSED enumFromTo_char #-}+enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)+  where+    xn = ord x+    yn = ord y++    n = delay_inline max 0 (yn - xn + 1)++    {-# INLINE_INNER step #-}+    step zn | zn <= yn  = return $ Yield (unsafeChr zn) (zn+1)+            | otherwise = return $ Done++{-# RULES++"enumFromTo<Char> [Bundle]"+  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 -> Bundle m v a+{-# INLINE_FUSED enumFromTo_double #-}+enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n lim))+  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"+                          (l > 0)+                        $ fromIntegral l+      where+        l :: Integer+        l = truncate (y-x)+2++    {-# INLINE_INNER step #-}+    step x | x <= lim  = return $ Yield x (x+1)+           | otherwise = return $ Done++{-# RULES++"enumFromTo<Double> [Bundle]"+  enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double++"enumFromTo<Float> [Bundle]"+  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float   #-}++++------------------------------------------------------------------------++-- | Enumerate values with a given step.+--+-- /WARNING:/ This operation is very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Bundle m v a+{-# INLINE_FUSED enumFromThenTo #-}+enumFromThenTo x y z = fromList [x, y .. z]++-- FIXME: Specialise enumFromThenTo.++-- Conversions+-- -----------++-- | Convert a 'Bundle' to a list+toList :: Monad m => Bundle m v a -> m [a]+{-# INLINE toList #-}+toList = foldr (:) []++-- | Convert a list to a 'Bundle'+fromList :: Monad m => [a] -> Bundle m v a+{-# INLINE fromList #-}+fromList xs = unsafeFromList Unknown xs++-- | Convert the first @n@ elements of a list to a 'Bundle'+fromListN :: Monad m => Int -> [a] -> Bundle m v a+{-# INLINE_FUSED fromListN #-}+fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0))++-- | Convert a list to a 'Bundle' with the given 'Size' hint.+unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a+{-# INLINE_FUSED unsafeFromList #-}+unsafeFromList sz xs = fromStream (S.fromList xs) sz++fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a+{-# INLINE_FUSED fromVector #-}+fromVector v = v `seq` n `seq` Bundle (Stream step 0)+                                      (Stream vstep True)+                                      (Just v)+                                      (Exact n)+  where+    n = basicLength v++    {-# INLINE step #-}+    step i | i >= n = return Done+           | otherwise = case basicUnsafeIndexM v i of+                           Box x -> return $ Yield x (i+1)+++    {-# INLINE vstep #-}+    vstep True  = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)+    vstep False = return Done++fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a+{-# INLINE_FUSED fromVectors #-}+fromVectors us = Bundle (Stream pstep (Left us))+                        (Stream vstep us)+                        Nothing+                        (Exact n)+  where+    n = List.foldl' (\k v -> k + basicLength v) 0 us++    pstep (Left []) = return Done+    pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs)))++    pstep (Right (v,i,vs))+      | i >= basicLength v = return $ Skip (Left vs)+      | otherwise          = case basicUnsafeIndexM v i of+                               Box x -> return $ Yield x (Right (v,i+1,vs))++    -- FIXME: work around bug in GHC 7.6.1+    vstep :: [v a] -> m (Step [v a] (Chunk v a))+    vstep [] = return Done+    vstep (v:vs) = return $ Yield (Chunk (basicLength v)+                                         (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"+                                                                       (M.basicLength mv == basicLength v)+                                                 $ basicUnsafeCopy mv v)) vs+++concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a+{-# INLINE_FUSED concatVectors #-}+concatVectors Bundle{sElems = Stream step t}+  = Bundle (Stream pstep (Left t))+           (Stream vstep t)+           Nothing+           Unknown+  where+    pstep (Left s) = do+      r <- step s+      case r of+        Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s')))+        Skip    s' -> return (Skip (Left s'))+        Done       -> return Done++    pstep (Right (v,i,s))+      | i >= basicLength v = return (Skip (Left s))+      | otherwise          = case basicUnsafeIndexM v i of+                               Box x -> return (Yield x (Right (v,i+1,s)))+++    vstep s = do+      r <- step s+      case r of+        Yield v s' -> return (Yield (Chunk (basicLength v)+                                           (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"+                                                                          (M.basicLength mv == basicLength v)+                                                   $ basicUnsafeCopy mv v)) s')+        Skip    s' -> return (Skip s')+        Done       -> return Done++reVector :: Monad m => Bundle m u a -> Bundle m v a+{-# INLINE_FUSED reVector #-}+reVector Bundle{sElems = s, sSize = n} = fromStream s n++{-# RULES++"reVector [Vector]"+  reVector = id++"reVector/reVector [Vector]" forall s.+  reVector (reVector s) = s   #-}+++
+ Data/Vector/Fusion/Bundle/Size.hs view
@@ -0,0 +1,121 @@+-- |+-- Module      : Data.Vector.Fusion.Bundle.Size+-- Copyright   : (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : portable+--+-- Size hints for streams.+--++module Data.Vector.Fusion.Bundle.Size (+  Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound+) where++import Data.Vector.Fusion.Util ( delay_inline )++-- | 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 = checkedAdd Exact m n+  Exact m + Max   n = checkedAdd Max m n++  Max   m + Exact n = checkedAdd Max m n+  Max   m + Max   n = checkedAdd Max m n++  _       + _       = Unknown+++  Exact m - Exact n = checkedSubtract Exact m n+  Exact m - Max   _ = Max   m++  Max   m - Exact n = checkedSubtract Max m n+  Max   m - Max   _ = Max   m+  Max   m - Unknown = Max   m++  _       - _       = Unknown+++  fromInteger n     = Exact (fromInteger n)++  (*)    = error "vector: internal error * for Bundle.size isn't defined"+  abs    = error "vector: internal error abs for Bundle.size isn't defined"+  signum = error "vector: internal error signum for Bundle.size isn't defined"++{-# INLINE checkedAdd #-}+checkedAdd :: (Int -> Size) -> Int -> Int -> Size+checkedAdd con m n+    -- Note: we assume m and n are >= 0.+  | r < m || r < n =+      error $ "Data.Vector.Fusion.Bundle.Size.checkedAdd: overflow: " ++ show r+  | otherwise = con r+  where+    r = m + n++{-# INLINE checkedSubtract #-}+checkedSubtract :: (Int -> Size) -> Int -> Int -> Size+checkedSubtract con m n+  | r < 0 =+      error $ "Data.Vector.Fusion.Bundle.Size.checkedSubtract: underflow: " ++ show r+  | otherwise = con r+  where+    r = m - n++-- | Subtract two sizes with clamping to 0, for drop-like things+{-# INLINE clampedSubtract #-}+clampedSubtract :: Size -> Size -> Size+clampedSubtract (Exact m) (Exact n) = Exact (max 0 (m - n))+clampedSubtract (Max   m) (Exact n)+  | m <= n = Exact 0+  | otherwise = Max (m - n)+clampedSubtract (Exact m) (Max   _) = Max m+clampedSubtract (Max   m) (Max   _) = Max m+clampedSubtract _         _ = Unknown++-- | Minimum of two size hints+smaller :: Size -> Size -> Size+{-# INLINE smaller #-}+smaller (Exact m) (Exact n) = Exact (delay_inline min m n)+smaller (Exact m) (Max   n) = Max   (delay_inline min m n)+smaller (Exact m) Unknown   = Max   m+smaller (Max   m) (Exact n) = Max   (delay_inline min m n)+smaller (Max   m) (Max   n) = Max   (delay_inline min m 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+{-# INLINE larger #-}+larger (Exact m) (Exact n)             = Exact (delay_inline max m 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   (delay_inline max m 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/Fusion/Stream.hs 
@@ -1,634 +0,0 @@-{-# LANGUAGE FlexibleInstances, Rank2Types, BangPatterns #-}---- |--- Module      : Data.Vector.Fusion.Stream--- Copyright   : (c) Roman Leshchinskiy 2008-2010--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Streams for stream fusion-----module Data.Vector.Fusion.Stream (-  -- * Types-  Step(..), Stream, MStream,--  -- * In-place markers-  inplace,--  -- * Size hints-  size, sized,--  -- * Length information-  length, null,--  -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++),--  -- * Accessing individual elements-  head, last, (!!), (!?),--  -- * Substreams-  slice, init, tail, take, drop,--  -- * Mapping-  map, concatMap, flatten, unbox,-  -  -- * Zipping-  indexed, indexedR,-  zipWith, zipWith3, zipWith4, zipWith5, zipWith6,-  zip, zip3, zip4, zip5, zip6,--  -- * Filtering-  filter, takeWhile, dropWhile,--  -- * Searching-  elem, notElem, find, findIndex,--  -- * Folding-  foldl, foldl1, foldl', foldl1', foldr, foldr1,--  -- * Specialised folds-  and, or,--  -- * Unfolding-  unfoldr, unfoldrN, iterateN,--  -- * Scans-  prescanl, prescanl',-  postscanl, postscanl',-  scanl, scanl',-  scanl1, scanl1',--  -- * Enumerations-  enumFromStepN, enumFromTo, enumFromThenTo,--  -- * Conversions-  toList, fromList, fromListN, unsafeFromList, liftStream,--  -- * Monadic combinators-  mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',--  eq, cmp-) where--import Data.Vector.Fusion.Stream.Size-import Data.Vector.Fusion.Util-import Data.Vector.Fusion.Stream.Monadic ( Step(..), SPEC(..) )-import qualified Data.Vector.Fusion.Stream.Monadic as M--import Prelude hiding ( length, null,-                        replicate, (++),-                        head, last, (!!),-                        init, tail, take, drop,-                        map, concatMap,-                        zipWith, zipWith3, zip, zip3,-                        filter, takeWhile, dropWhile,-                        elem, notElem,-                        foldl, foldl1, foldr, foldr1,-                        and, or,-                        scanl, scanl1,-                        enumFromTo, enumFromThenTo,-                        mapM, mapM_ )--import GHC.Base ( build )--#include "vector.h"---- | The type of pure streams -type Stream = M.Stream Id---- | Alternative name for monadic streams-type MStream = M.Stream--inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m b)-        -> Stream a -> Stream b-{-# INLINE_STREAM inplace #-}-inplace f s = s `seq` f s--{-# RULES--"inplace/inplace [Vector]"-  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--  #-}---- | 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 replicate #-}-replicate = M.replicate---- | Generate a stream from its indices-generate :: Int -> (Int -> a) -> Stream a-{-# INLINE generate #-}-generate = M.generate---- | 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--infixl 9 !!--- | Element at the given position-(!!) :: Stream a -> Int -> a-{-# INLINE (!!) #-}-s !! i = unId (s M.!! i)--infixl 9 !?--- | Element at the given position or 'Nothing' if out of bounds-(!?) :: Stream a -> Int -> Maybe a-{-# INLINE (!?) #-}-s !? i = unId (s M.!? i)---- Substreams--- -------------- | Extract a substream of the given length starting at the given position.-slice :: Int   -- ^ starting index-      -> Int   -- ^ length-      -> Stream a-      -> Stream a-{-# INLINE slice #-}-slice = M.slice---- | 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--- ------------------- | Map a function over a 'Stream'-map :: (a -> b) -> Stream a -> Stream b-{-# INLINE map #-}-map = M.map--unbox :: Stream (Box a) -> Stream a-{-# INLINE unbox #-}-unbox = M.unbox--concatMap :: (a -> Stream b) -> Stream a -> Stream b-{-# INLINE concatMap #-}-concatMap = M.concatMap---- Zipping--- ----------- | Pair each element in a 'Stream' with its index-indexed :: Stream a -> Stream (Int,a)-{-# INLINE indexed #-}-indexed = M.indexed---- | Pair each element in a 'Stream' with its index, starting from the right--- and counting down-indexedR :: Int -> Stream a -> Stream (Int,a)-{-# INLINE_STREAM indexedR #-}-indexedR = M.indexedR---- | Zip two 'Stream's with the given function-zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c-{-# INLINE zipWith #-}-zipWith = M.zipWith---- | Zip three 'Stream's with the given function-zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d-{-# INLINE zipWith3 #-}-zipWith3 = M.zipWith3--zipWith4 :: (a -> b -> c -> d -> e)-                    -> Stream a -> Stream b -> Stream c -> Stream d-                    -> Stream e-{-# INLINE zipWith4 #-}-zipWith4 = M.zipWith4--zipWith5 :: (a -> b -> c -> d -> e -> f)-                    -> Stream a -> Stream b -> Stream c -> Stream d-                    -> Stream e -> Stream f-{-# INLINE zipWith5 #-}-zipWith5 = M.zipWith5--zipWith6 :: (a -> b -> c -> d -> e -> f -> g)-                    -> Stream a -> Stream b -> Stream c -> Stream d-                    -> Stream e -> Stream f -> Stream g-{-# INLINE zipWith6 #-}-zipWith6 = M.zipWith6--zip :: Stream a -> Stream b -> Stream (a,b)-{-# INLINE zip #-}-zip = M.zip--zip3 :: Stream a -> Stream b -> Stream c -> Stream (a,b,c)-{-# INLINE zip3 #-}-zip3 = M.zip3--zip4 :: Stream a -> Stream b -> Stream c -> Stream d-                -> Stream (a,b,c,d)-{-# INLINE zip4 #-}-zip4 = M.zip4--zip5 :: Stream a -> Stream b -> Stream c -> Stream d-                -> Stream e -> Stream (a,b,c,d,e)-{-# INLINE zip5 #-}-zip5 = M.zip5--zip6 :: Stream a -> Stream b -> Stream c -> Stream d-                -> Stream e -> Stream f -> Stream (a,b,c,d,e,f)-{-# INLINE zip6 #-}-zip6 = M.zip6---- 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---- Specialised folds--- -------------------and :: Stream Bool -> Bool-{-# INLINE and #-}-and = unId . M.and--or :: Stream Bool -> Bool-{-# INLINE or #-}-or = unId . M.or---- Unfolding--- ------------- | Unfold-unfoldr :: (s -> Maybe (a, s)) -> s -> Stream a-{-# INLINE unfoldr #-}-unfoldr = M.unfoldr---- | Unfold at most @n@ elements-unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Stream a-{-# INLINE unfoldrN #-}-unfoldrN = M.unfoldrN---- | Apply function n-1 times to value. Zeroth element is original value.-iterateN :: Int -> (a -> a) -> a -> Stream a-{-# INLINE iterateN #-}-iterateN = M.iterateN---- 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'---- | Suffix scan-postscanl :: (a -> b -> a) -> a -> Stream b -> Stream a-{-# INLINE postscanl #-}-postscanl = M.postscanl---- | Suffix scan with strict accumulator-postscanl' :: (a -> b -> a) -> a -> Stream b -> Stream a-{-# INLINE postscanl' #-}-postscanl' = M.postscanl'---- | Haskell-style scan-scanl :: (a -> b -> a) -> a -> Stream b -> Stream a-{-# INLINE scanl #-}-scanl = M.scanl---- | Haskell-style scan with strict accumulator-scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a-{-# INLINE scanl' #-}-scanl' = M.scanl'---- | Scan over a non-empty 'Stream'-scanl1 :: (a -> a -> a) -> Stream a -> Stream a-{-# INLINE scanl1 #-}-scanl1 = M.scanl1---- | Scan over a non-empty 'Stream' with a strict accumulator-scanl1' :: (a -> a -> a) -> Stream a -> Stream a-{-# INLINE scanl1' #-}-scanl1' = M.scanl1'----- Comparisons--- --------------- FIXME: Move these to Monadic---- | 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 SPEC s1 s2-  where-    eq_loop0 !sPEC s1 s2 = case unId (step1 s1) of-                             Yield x s1' -> eq_loop1 SPEC x s1' s2-                             Skip    s1' -> eq_loop0 SPEC   s1' s2-                             Done        -> null (M.Stream step2 s2 Unknown)--    eq_loop1 !sPEC x s1 s2 = case unId (step2 s2) of-                               Yield y s2' -> x == y && eq_loop0 SPEC   s1 s2'-                               Skip    s2' ->           eq_loop1 SPEC 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 SPEC s1 s2-  where-    cmp_loop0 !sPEC s1 s2 = case unId (step1 s1) of-                              Yield x s1' -> cmp_loop1 SPEC x s1' s2-                              Skip    s1' -> cmp_loop0 SPEC   s1' s2-                              Done        -> if null (M.Stream step2 s2 Unknown)-                                               then EQ else LT--    cmp_loop1 !sPEC x s1 s2 = case unId (step2 s2) of-                                Yield y s2' -> case x `compare` y of-                                                 EQ -> cmp_loop0 SPEC s1 s2'-                                                 c  -> c-                                Skip    s2' -> cmp_loop1 SPEC 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, producing a monadic--- stream of results-mapM :: Monad m => (a -> m b) -> Stream a -> M.Stream m b-{-# INLINE mapM #-}-mapM f = M.mapM f . liftStream---- | Apply a monadic action to each element of the stream-mapM_ :: Monad m => (a -> m b) -> Stream a -> m ()-{-# INLINE mapM_ #-}-mapM_ f = M.mapM_ f . liftStream--zipWithM :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> M.Stream m c-{-# INLINE zipWithM #-}-zipWithM f as bs = M.zipWithM f (liftStream as) (liftStream bs)--zipWithM_ :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> m ()-{-# INLINE zipWithM_ #-}-zipWithM_ f as bs = M.zipWithM_ f (liftStream as) (liftStream bs)---- | Yield a monadic stream of elements that satisfy the monadic predicate-filterM :: Monad m => (a -> m Bool) -> Stream a -> M.Stream m a-{-# INLINE filterM #-}-filterM f = M.filterM f . liftStream---- | Monadic fold-foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a-{-# INLINE foldM #-}-foldM m z = M.foldM m z . liftStream---- | Monadic fold over non-empty stream-fold1M :: Monad m => (a -> a -> m a) -> Stream a -> m a-{-# INLINE fold1M #-}-fold1M m = M.fold1M m . liftStream---- | Monadic fold with strict accumulator-foldM' :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a-{-# INLINE foldM' #-}-foldM' m z = M.foldM' m z . liftStream---- | Monad fold over non-empty stream with strict accumulator-fold1M' :: Monad m => (a -> a -> m a) -> Stream a -> m a-{-# INLINE fold1M' #-}-fold1M' m = M.fold1M' m . liftStream---- Enumerations--- ---------------- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,--- @x+y+y@ etc.-enumFromStepN :: Num a => a -> a -> Int -> Stream a-{-# INLINE enumFromStepN #-}-enumFromStepN = M.enumFromStepN---- | Enumerate values------ /WARNING:/ This operations can be very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromTo :: Enum a => a -> a -> Stream a-{-# INLINE enumFromTo #-}-enumFromTo = M.enumFromTo---- | Enumerate values with a given step.------ /WARNING:/ This operations is very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromThenTo :: Enum a => a -> a -> a -> Stream a-{-# INLINE enumFromThenTo #-}-enumFromThenTo = M.enumFromThenTo---- Conversions--- --------------- | Convert a 'Stream' to a list-toList :: Stream a -> [a]-{-# INLINE toList #-}--- toList s = unId (M.toList s)-toList s = build (\c n -> toListFB c n s)---- This supports foldr/build list fusion that GHC implements-toListFB :: (a -> b -> b) -> b -> Stream a -> b-{-# INLINE [0] toListFB #-}-toListFB c n (M.Stream step s _) = go s-  where-    go s = case unId (step s) of-             Yield x s' -> x `c` go s'-             Skip    s' -> go s'-             Done       -> n---- | Create a 'Stream' from a list-fromList :: [a] -> Stream a-{-# INLINE fromList #-}-fromList = M.fromList---- | Create a 'Stream' from the first @n@ elements of a list------ > fromListN n xs = fromList (take n xs)-fromListN :: Int -> [a] -> Stream a-{-# INLINE fromListN #-}-fromListN = M.fromListN--unsafeFromList :: Size -> [a] -> Stream a-{-# INLINE unsafeFromList #-}-unsafeFromList = M.unsafeFromList---- | Create a 'Stream' of values from a 'Stream' of streamable things-flatten :: (a -> s) -> (s -> Step s b) -> Size -> Stream a -> Stream b-{-# INLINE_STREAM flatten #-}-flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . liftStream-
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, Rank2Types, BangPatterns #-}+{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Fusion.Stream.Monadic@@ -15,9 +15,6 @@ module Data.Vector.Fusion.Stream.Monadic (   Stream(..), Step(..), SPEC(..), -  -- * Size hints-  size, sized,-   -- * Length   length, null, @@ -32,13 +29,16 @@    -- * Mapping   map, mapM, mapM_, trans, unbox, concatMap, flatten,-  +   -- * Zipping   indexed, indexedR, zipWithM_,   zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,   zip, zip3, zip4, zip5, zip6, +  -- * Comparisons+  eq, cmp,+   -- * Filtering   filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, @@ -68,11 +68,10 @@   enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversions-  toList, fromList, fromListN, unsafeFromList+  toList, fromList, fromListN ) where -import Data.Vector.Fusion.Stream.Size-import Data.Vector.Fusion.Util ( Box(..), delay_inline )+import Data.Vector.Fusion.Util ( Box(..) )  import Data.Char      ( ord ) import GHC.Base       ( unsafeChr )@@ -93,67 +92,75 @@ import Data.Int  ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word, Word64 ) -#if __GLASGOW_HASKELL__ >= 700+#if __GLASGOW_HASKELL__ >= 708+import GHC.Types ( SPEC(..) )+#elif __GLASGOW_HASKELL__ >= 700 import GHC.Exts ( SpecConstrAnnotation(..) ) #endif  #include "vector.h"+#include "MachDeps.h" +#if __GLASGOW_HASKELL__ < 708 data SPEC = SPEC | SPEC2 #if __GLASGOW_HASKELL__ >= 700 {-# ANN type SPEC ForceSpecConstr #-} #endif+#endif  emptyStream :: String {-# NOINLINE emptyStream #-} emptyStream = "empty stream" -#define EMPTY_STREAM (\s -> ERROR s emptyStream)+#define EMPTY_STREAM (\state -> ERROR state emptyStream)  -- | Result of taking a single step in a stream-data Step s a = Yield a s  -- ^ a new element and a new seed-              | Skip    s  -- ^ just a new seed-              | Done       -- ^ end of stream---- | Monadic streams-data Stream m a = forall s. Stream (s -> m (Step s a)) s Size+data Step s a where+  Yield :: a -> s -> Step s a+  Skip  :: s -> Step s a+  Done  :: Step s a --- | 'Size' hint of a 'Stream'-size :: Stream m a -> Size-{-# INLINE size #-}-size (Stream _ _ sz) = sz+instance Functor (Step s) where+  {-# INLINE fmap #-}+  fmap f (Yield x s) = Yield (f x) s+  fmap _ (Skip s) = Skip s+  fmap _ Done = Done --- | 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+-- | Monadic streams+data Stream m a = forall s. Stream (s -> m (Step s a)) s  -- Length -- ------  -- | Length of a 'Stream' length :: Monad m => Stream m a -> m Int-{-# INLINE_STREAM length #-}-length s = foldl' (\n _ -> n+1) 0 s+{-# INLINE_FUSED length #-}+length = foldl' (\n _ -> n+1) 0  -- | Check if a 'Stream' is empty null :: Monad m => Stream m a -> m Bool-{-# INLINE_STREAM null #-}-null s = foldr (\_ _ -> False) True s-+{-# INLINE_FUSED null #-}+null (Stream step t) = null_loop t+  where+    null_loop s = do+      r <- step s+      case r of+        Yield _ _ -> return False+        Skip s'   -> null_loop s'+        Done      -> return True  -- Construction -- ------------  -- | Empty 'Stream' empty :: Monad m => Stream m a-{-# INLINE_STREAM empty #-}-empty = Stream (const (return Done)) () (Exact 0)+{-# INLINE_FUSED empty #-}+empty = Stream (const (return Done)) ()  -- | Singleton 'Stream' singleton :: Monad m => a -> Stream m a-{-# INLINE_STREAM singleton #-}-singleton x = Stream (return . step) True (Exact 1)+{-# INLINE_FUSED singleton #-}+singleton x = Stream (return . step) True   where     {-# INLINE_INNER step #-}     step True  = Yield x False@@ -161,16 +168,14 @@  -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a-{-# INLINE replicate #-}+{-# INLINE_FUSED replicate #-} replicate n x = replicateM n (return x)  -- | Yield a 'Stream' of values obtained by performing the monadic action the -- given number of times replicateM :: Monad m => Int -> m a -> Stream m a-{-# INLINE_STREAM replicateM #-}--- NOTE: We delay inlining max here because GHC will create a join point for--- the call to newArray# otherwise which is not really nice.-replicateM n p = Stream step n (Exact (delay_inline max n 0))+{-# INLINE_FUSED replicateM #-}+replicateM n p = Stream step n   where     {-# INLINE_INNER step #-}     step i | i <= 0    = return Done@@ -182,8 +187,8 @@  -- | 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))+{-# INLINE_FUSED generateM #-}+generateM n f = n `seq` Stream step 0   where     {-# INLINE_INNER step #-}     step i | i < n     = do@@ -204,8 +209,8 @@ 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)+{-# INLINE_FUSED (++) #-}+Stream stepa ta ++ Stream stepb tb = Stream step (Left ta)   where     {-# INLINE_INNER step #-}     step (Left  sa) = do@@ -213,7 +218,7 @@                         case r of                           Yield x sa' -> return $ Yield x (Left  sa')                           Skip    sa' -> return $ Skip    (Left  sa')-                          Done        -> return $ Skip    (Right sb)+                          Done        -> return $ Skip    (Right tb)     step (Right sb) = do                         r <- stepb sb                         case r of@@ -226,10 +231,10 @@  -- | First element of the 'Stream' or error if empty head :: Monad m => Stream m a -> m a-{-# INLINE_STREAM head #-}-head (Stream step s _) = head_loop SPEC s+{-# INLINE_FUSED head #-}+head (Stream step t) = head_loop SPEC t   where-    head_loop !sPEC s+    head_loop !_ s       = do           r <- step s           case r of@@ -241,10 +246,10 @@  -- | Last element of the 'Stream' or error if empty last :: Monad m => Stream m a -> m a-{-# INLINE_STREAM last #-}-last (Stream step s _) = last_loop0 SPEC s+{-# INLINE_FUSED last #-}+last (Stream step t) = last_loop0 SPEC t   where-    last_loop0 !sPEC s+    last_loop0 !_ s       = do           r <- step s           case r of@@ -252,7 +257,7 @@             Skip    s' -> last_loop0 SPEC   s'             Done       -> EMPTY_STREAM "last" -    last_loop1 !sPEC x s+    last_loop1 !_ x s       = do           r <- step s           case r of@@ -264,10 +269,10 @@ -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-}-Stream step s _ !! i | i < 0     = ERROR "!!" "negative index"-                     | otherwise = index_loop SPEC s i+Stream step t !! j | j < 0     = ERROR "!!" "negative index"+                   | otherwise = index_loop SPEC t j   where-    index_loop !sPEC s i+    index_loop !_ s i       = i `seq`         do           r <- step s@@ -281,9 +286,9 @@ -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Monad m => Stream m a -> Int -> m (Maybe a) {-# INLINE (!?) #-}-Stream step s _ !? i = index_loop SPEC s i+Stream step t !? j = index_loop SPEC t j   where-    index_loop !sPEC s i+    index_loop !_ s i       = i `seq`         do           r <- step s@@ -306,8 +311,8 @@  -- | 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)+{-# INLINE_FUSED init #-}+init (Stream step t) = Stream step' (Nothing, t)   where     {-# INLINE_INNER step' #-}     step' (Nothing, s) = liftM (\r ->@@ -317,7 +322,7 @@                              Done       -> EMPTY_STREAM "init"                          ) (step s) -    step' (Just x,  s) = liftM (\r -> +    step' (Just x,  s) = liftM (\r ->                            case r of                              Yield y s' -> Yield x (Just y, s')                              Skip    s' -> Skip    (Just x, s')@@ -326,13 +331,13 @@  -- | 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)+{-# INLINE_FUSED tail #-}+tail (Stream step t) = Stream step' (Left t)   where     {-# INLINE_INNER step' #-}     step' (Left  s) = liftM (\r ->                         case r of-                          Yield x s' -> Skip (Right s')+                          Yield _ s' -> Skip (Right s')                           Skip    s' -> Skip (Left  s')                           Done       -> EMPTY_STREAM "tail"                       ) (step s)@@ -346,8 +351,8 @@  -- | 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)+{-# INLINE_FUSED take #-}+take n (Stream step t) = n `seq` Stream step' (t, 0)   where     {-# INLINE_INNER step' #-}     step' (s, i) | i < n = liftM (\r ->@@ -356,17 +361,17 @@                                Skip    s' -> Skip    (s', i)                                Done       -> Done                            ) (step s)-    step' (s, i) = return Done+    step' (_, _) = 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)+{-# INLINE_FUSED drop #-}+drop n (Stream step t) = Stream step' (t, Just n)   where     {-# INLINE_INNER step' #-}     step' (s, Just i) | i > 0 = liftM (\r ->                                 case r of-                                   Yield x s' -> Skip (s', Just (i-1))+                                   Yield _ s' -> Skip (s', Just (i-1))                                    Skip    s' -> Skip (s', Just i)                                    Done       -> Done                                 ) (step s)@@ -378,7 +383,7 @@                              Skip    s' -> Skip    (s', Nothing)                              Done       -> Done                            ) (step s)-                     + -- Mapping -- ------- @@ -394,8 +399,8 @@  -- | 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+{-# INLINE_FUSED mapM #-}+mapM f (Stream step t) = Stream step' t   where     {-# INLINE_INNER step' #-}     step' s = do@@ -406,10 +411,10 @@                   Done       -> return Done  consume :: Monad m => Stream m a -> m ()-{-# INLINE_STREAM consume #-}-consume (Stream step s _) = consume_loop SPEC s+{-# INLINE_FUSED consume #-}+consume (Stream step t) = consume_loop SPEC t   where-    consume_loop !sPEC s+    consume_loop !_ s       = do           r <- step s           case r of@@ -419,18 +424,18 @@  -- | Execute a monadic action for each element of the 'Stream' mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-{-# INLINE_STREAM mapM_ #-}+{-# INLINE_FUSED mapM_ #-} mapM_ m = consume . mapM m  -- | Transform a 'Stream' to use a different monad-trans :: (Monad m, Monad m') => (forall a. m a -> m' a)-                             -> Stream m a -> Stream m' a-{-# INLINE_STREAM trans #-}-trans f (Stream step s n) = Stream (f . step) s n+trans :: (Monad m, Monad m')+      => (forall z. m z -> m' z) -> Stream m a -> Stream m' a+{-# INLINE_FUSED trans #-}+trans f (Stream step s) = Stream (f . step) s  unbox :: Monad m => Stream m (Box a) -> Stream m a-{-# INLINE_STREAM unbox #-}-unbox (Stream step s n) = Stream step' s n+{-# INLINE_FUSED unbox #-}+unbox (Stream step t) = Stream step' t   where     {-# INLINE_INNER step' #-}     step' s = do@@ -445,8 +450,8 @@  -- | 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+{-# INLINE_FUSED indexed #-}+indexed (Stream step t) = Stream step' (t,0)   where     {-# INLINE_INNER step' #-}     step' (s,i) = i `seq`@@ -460,8 +465,8 @@ -- | 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+{-# INLINE_FUSED indexedR #-}+indexedR m (Stream step t) = Stream step' (t,m)   where     {-# INLINE_INNER step' #-}     step' (s,i) = i `seq`@@ -476,9 +481,8 @@  -- | 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)+{-# INLINE_FUSED zipWithM #-}+zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)   where     {-# INLINE_INNER step #-}     step (sa, sb, Nothing) = liftM (\r ->@@ -502,18 +506,18 @@ {-# RULES  "zipWithM xs xs [Vector.Stream]" forall f xs.-  zipWithM f xs xs = mapM (\x -> f x x) xs+  zipWithM f xs xs = mapM (\x -> f x x) xs   #-} -  #-}  zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f sa sb = consume (zipWithM f sa sb)  zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d-{-# INLINE_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))+{-# INLINE_FUSED zipWith3M #-}+zipWith3M f (Stream stepa ta)+            (Stream stepb tb)+            (Stream stepc tc) = Stream step (ta, tb, tc, Nothing)   where     {-# INLINE_INNER step #-}     step (sa, sb, sc, Nothing) = do@@ -609,6 +613,65 @@ {-# INLINE zip6 #-} zip6 = zipWith6 (,,,,,) +-- Comparisons+-- -----------++-- | Check if two 'Stream's are equal+eq :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+{-# INLINE_FUSED eq #-}+eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2+  where+    eq_loop0 !_ s1 s2 = do+      r <- step1 s1+      case r of+        Yield x s1' -> eq_loop1 SPEC x s1' s2+        Skip    s1' -> eq_loop0 SPEC   s1' s2+        Done        -> eq_null s2++    eq_loop1 !_ x s1 s2 = do+      r <- step2 s2+      case r of+        Yield y s2'+          | x == y    -> eq_loop0 SPEC   s1 s2'+          | otherwise -> return False+        Skip    s2'   -> eq_loop1 SPEC x s1 s2'+        Done          -> return False++    eq_null s2 = do+      r <- step2 s2+      case r of+        Yield _ _ -> return False+        Skip s2'  -> eq_null s2'+        Done      -> return True++-- | Lexicographically compare two 'Stream's+cmp :: (Monad m, Ord a) => Stream m a -> Stream m a -> m Ordering+{-# INLINE_FUSED cmp #-}+cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2+  where+    cmp_loop0 !_ s1 s2 = do+      r <- step1 s1+      case r of+        Yield x s1' -> cmp_loop1 SPEC x s1' s2+        Skip    s1' -> cmp_loop0 SPEC   s1' s2+        Done        -> cmp_null s2++    cmp_loop1 !_ x s1 s2 = do+      r <- step2 s2+      case r of+        Yield y s2' -> case x `compare` y of+                         EQ -> cmp_loop0 SPEC s1 s2'+                         c  -> return c+        Skip    s2' -> cmp_loop1 SPEC x s1 s2'+        Done        -> return GT++    cmp_null s2 = do+      r <- step2 s2+      case r of+        Yield _ _ -> return LT+        Skip s2'  -> cmp_null s2'+        Done      -> return EQ+ -- Filtering -- --------- @@ -619,8 +682,8 @@  -- | 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)+{-# INLINE_FUSED filterM #-}+filterM f (Stream step t) = Stream step' t   where     {-# INLINE_INNER step' #-}     step' s = do@@ -640,8 +703,8 @@  -- | 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)+{-# INLINE_FUSED takeWhileM #-}+takeWhileM f (Stream step t) = Stream step' t   where     {-# INLINE_INNER step' #-}     step' s = do@@ -662,8 +725,8 @@  -- | 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)+{-# INLINE_FUSED dropWhileM #-}+dropWhileM f (Stream step t) = Stream step' (DropWhile_Drop t)   where     -- NOTE: we jump through hoops here to have only one Yield; local data     -- declarations would be nice!@@ -696,10 +759,10 @@ infix 4 `elem` -- | Check whether the 'Stream' contains an element elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-{-# INLINE_STREAM elem #-}-elem x (Stream step s _) = elem_loop SPEC s+{-# INLINE_FUSED elem #-}+elem x (Stream step t) = elem_loop SPEC t   where-    elem_loop !sPEC s+    elem_loop !_ s       = do           r <- step s           case r of@@ -723,10 +786,10 @@ -- | Yield 'Just' the first element that satisfies the monadic predicate or -- 'Nothing' if no such element exists. findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)-{-# INLINE_STREAM findM #-}-findM f (Stream step s _) = find_loop SPEC s+{-# INLINE_FUSED findM #-}+findM f (Stream step t) = find_loop SPEC t   where-    find_loop !sPEC s+    find_loop !_ s       = do           r <- step s           case r of@@ -740,16 +803,16 @@ -- | 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 #-}+{-# INLINE_FUSED findIndex #-} findIndex f = findIndexM (return . f)  -- | Yield 'Just' the index of the first element that satisfies the monadic -- predicate or 'Nothing' if no such element exists. findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)-{-# INLINE_STREAM findIndexM #-}-findIndexM f (Stream step s _) = findIndex_loop SPEC s 0+{-# INLINE_FUSED findIndexM #-}+findIndexM f (Stream step t) = findIndex_loop SPEC t 0   where-    findIndex_loop !sPEC s i+    findIndex_loop !_ s i       = do           r <- step s           case r of@@ -770,10 +833,10 @@  -- | Left fold with a monadic operator foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a-{-# INLINE_STREAM foldlM #-}-foldlM m z (Stream step s _) = foldlM_loop SPEC z s+{-# INLINE_FUSED foldlM #-}+foldlM m w (Stream step t) = foldlM_loop SPEC w t   where-    foldlM_loop !sPEC z s+    foldlM_loop !_ z s       = do           r <- step s           case r of@@ -793,14 +856,14 @@  -- | Left fold over a non-empty 'Stream' with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a-{-# INLINE_STREAM foldl1M #-}-foldl1M f (Stream step s sz) = foldl1M_loop SPEC s+{-# INLINE_FUSED foldl1M #-}+foldl1M f (Stream step t) = foldl1M_loop SPEC t   where-    foldl1M_loop !sPEC s+    foldl1M_loop !_ s       = do           r <- step s           case r of-            Yield x s' -> foldlM f x (Stream step s' (sz - 1))+            Yield x s' -> foldlM f x (Stream step s')             Skip    s' -> foldl1M_loop SPEC s'             Done       -> EMPTY_STREAM "foldl1M" @@ -816,10 +879,10 @@  -- | Left fold with a strict accumulator and a monadic operator foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a-{-# INLINE_STREAM foldlM' #-}-foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s+{-# INLINE_FUSED foldlM' #-}+foldlM' m w (Stream step t) = foldlM'_loop SPEC w t   where-    foldlM'_loop !sPEC z s+    foldlM'_loop !_ z s       = z `seq`         do           r <- step s@@ -841,14 +904,14 @@ -- | 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'_loop SPEC s+{-# INLINE_FUSED foldl1M' #-}+foldl1M' f (Stream step t) = foldl1M'_loop SPEC t   where-    foldl1M'_loop !sPEC s+    foldl1M'_loop !_ s       = do           r <- step s           case r of-            Yield x s' -> foldlM' f x (Stream step s' (sz - 1))+            Yield x s' -> foldlM' f x (Stream step s')             Skip    s' -> foldl1M'_loop SPEC s'             Done       -> EMPTY_STREAM "foldl1M'" @@ -864,10 +927,10 @@  -- | Right fold with a monadic operator foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b-{-# INLINE_STREAM foldrM #-}-foldrM f z (Stream step s _) = foldrM_loop SPEC s+{-# INLINE_FUSED foldrM #-}+foldrM f z (Stream step t) = foldrM_loop SPEC t   where-    foldrM_loop !sPEC s+    foldrM_loop !_ s       = do           r <- step s           case r of@@ -882,10 +945,10 @@  -- | Right fold over a non-empty stream with a monadic operator foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a-{-# INLINE_STREAM foldr1M #-}-foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s+{-# INLINE_FUSED foldr1M #-}+foldr1M f (Stream step t) = foldr1M_loop0 SPEC t   where-    foldr1M_loop0 !sPEC s+    foldr1M_loop0 !_ s       = do           r <- step s           case r of@@ -893,7 +956,7 @@             Skip    s' -> foldr1M_loop0 SPEC   s'             Done       -> EMPTY_STREAM "foldr1M" -    foldr1M_loop1 !sPEC x s+    foldr1M_loop1 !_ x s       = do           r <- step s           case r of@@ -905,10 +968,10 @@ -- -----------------  and :: Monad m => Stream m Bool -> m Bool-{-# INLINE_STREAM and #-}-and (Stream step s _) = and_loop SPEC s+{-# INLINE_FUSED and #-}+and (Stream step t) = and_loop SPEC t   where-    and_loop !sPEC s+    and_loop !_ s       = do           r <- step s           case r of@@ -918,10 +981,10 @@             Done           -> return True  or :: Monad m => Stream m Bool -> m Bool-{-# INLINE_STREAM or #-}-or (Stream step s _) = or_loop SPEC s+{-# INLINE_FUSED or #-}+or (Stream step t) = or_loop SPEC t   where-    or_loop !sPEC s+    or_loop !_ s       = do           r <- step s           case r of@@ -935,8 +998,8 @@ 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+{-# INLINE_FUSED concatMapM #-}+concatMapM f (Stream step t) = Stream concatMap_go (Left t)   where     concatMap_go (Left s) = do         r <- step s@@ -946,18 +1009,17 @@                 return $ Skip (Right (b_stream, s'))             Skip    s' -> return $ Skip (Left s')             Done       -> return Done-    concatMap_go (Right (Stream inner_step inner_s sz, s)) = do+    concatMap_go (Right (Stream inner_step inner_s, s)) = do         r <- inner_step inner_s         case r of-            Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s' sz, s))-            Skip    inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s))+            Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s))+            Skip    inner_s' -> return $ Skip (Right (Stream inner_step inner_s', s))             Done             -> return $ Skip (Left s)  -- | Create a 'Stream' of values from a 'Stream' of streamable things-flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size-                   -> Stream m a -> Stream m b-{-# INLINE_STREAM flatten #-}-flatten mk istep sz (Stream ostep t _) = Stream step (Left t) sz+flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b+{-# INLINE_FUSED flatten #-}+flatten mk istep (Stream ostep u) = Stream step (Left u)   where     {-# INLINE_INNER step #-}     step (Left t) = do@@ -969,7 +1031,7 @@                         Skip    t' -> return $ Skip (Left t')                         Done       -> return $ Done -    +     step (Right (s,t)) = do                            r <- istep s                            case r of@@ -982,13 +1044,13 @@  -- | Unfold unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-{-# INLINE_STREAM unfoldr #-}+{-# INLINE_FUSED unfoldr #-} unfoldr f = unfoldrM (return . f)  -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-{-# INLINE_STREAM unfoldrM #-}-unfoldrM f s = Stream step s Unknown+{-# INLINE_FUSED unfoldrM #-}+unfoldrM f t = Stream step t   where     {-# INLINE_INNER step #-}     step s = liftM (\r ->@@ -997,15 +1059,14 @@                  Nothing      -> Done              ) (f s) --- | Unfold at most @n@ elements unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a-{-# INLINE_STREAM unfoldrN #-}+{-# INLINE_FUSED unfoldrN #-} unfoldrN n f = unfoldrNM n (return . f)  -- | Unfold at most @n@ elements with a monadic functions unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a-{-# INLINE_STREAM unfoldrNM #-}-unfoldrNM n f s = Stream step (s,n) (Max (delay_inline max n 0))+{-# INLINE_FUSED unfoldrNM #-}+unfoldrNM m f t = Stream step (t,m)   where     {-# INLINE_INNER step #-}     step (s,n) | n <= 0    = return Done@@ -1017,8 +1078,8 @@  -- | Apply monadic function n times to value. Zeroth element is original value. iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a-{-# INLINE_STREAM iterateNM #-}-iterateNM n f x0 = Stream step (x0,n) (Exact (delay_inline max n 0))+{-# INLINE_FUSED iterateNM #-}+iterateNM n f x0 = Stream step (x0,n)   where     {-# INLINE_INNER step #-}     step (x,i) | i <= 0    = return Done@@ -1028,7 +1089,7 @@  -- | Apply function n times to value. Zeroth element is original value. iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a-{-# INLINE_STREAM iterateN #-}+{-# INLINE_FUSED iterateN #-} iterateN n f x0 = iterateNM n (return . f) x0  -- Scans@@ -1041,8 +1102,8 @@  -- | 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+{-# INLINE_FUSED prescanlM #-}+prescanlM f w (Stream step t) = Stream step' (t,w)   where     {-# INLINE_INNER step' #-}     step' (s,x) = do@@ -1061,8 +1122,8 @@  -- | 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+{-# INLINE_FUSED prescanlM' #-}+prescanlM' f w (Stream step t) = Stream step' (t,w)   where     {-# INLINE_INNER step' #-}     step' (s,x) = x `seq`@@ -1082,8 +1143,8 @@  -- | 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+{-# INLINE_FUSED postscanlM #-}+postscanlM f w (Stream step t) = Stream step' (t,w)   where     {-# INLINE_INNER step' #-}     step' (s,x) = do@@ -1102,8 +1163,8 @@  -- | 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+{-# INLINE_FUSED postscanlM' #-}+postscanlM' f w (Stream step t) = w `seq` Stream step' (t,w)   where     {-# INLINE_INNER step' #-}     step' (s,x) = x `seq`@@ -1143,8 +1204,8 @@  -- | 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+{-# INLINE_FUSED scanl1M #-}+scanl1M f (Stream step t) = Stream step' (t, Nothing)   where     {-# INLINE_INNER step' #-}     step' (s, Nothing) = do@@ -1171,8 +1232,8 @@ -- | 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+{-# INLINE_FUSED scanl1M' #-}+scanl1M' f (Stream step t) = Stream step' (t, Nothing)   where     {-# INLINE_INNER step' #-}     step' (s, Nothing) = do@@ -1202,12 +1263,11 @@ -- | 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 = x `seq` y `seq` n `seq`-                      Stream step (x,n) (Exact (delay_inline max n 0))+{-# INLINE_FUSED enumFromStepN #-}+enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n)   where     {-# INLINE_INNER step #-}-    step (x,n) | n > 0     = return $ Yield x (x+y,n-1)+    step (w,m) | m > 0     = return $ Yield w (w+y,m-1)                | otherwise = return $ Done  -- | Enumerate values@@ -1215,7 +1275,7 @@ -- /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 #-}+{-# INLINE_FUSED enumFromTo #-} enumFromTo x y = fromList [x .. y]  -- NOTE: We use (x+1) instead of (succ x) below because the latter checks for@@ -1223,13 +1283,11 @@  -- 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 = x `seq` y `seq` Stream step x (Exact n)+{-# INLINE_FUSED enumFromTo_small #-}+enumFromTo_small x y = x `seq` y `seq` Stream step x   where-    n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0-     {-# INLINE_INNER step #-}-    step x | x <= y    = return $ Yield x (x+1)+    step w | w <= y    = return $ Yield w (w+1)            | otherwise = return $ Done  {-# RULES@@ -1244,9 +1302,8 @@   enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8  "enumFromTo<Word16> [Stream]"-  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16+  enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16   #-} -  #-}  #if WORD_SIZE_IN_BITS > 32 @@ -1256,9 +1313,8 @@   enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32  "enumFromTo<Word32> [Stream]"-  enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32+  enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32   #-} -  #-}  #endif @@ -1274,22 +1330,31 @@ -- 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 = x `seq` y `seq` Stream step x (Exact (len x y))+enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int+{-# INLINE_FUSED enumFromTo_int #-}+enumFromTo_int x y = x `seq` y `seq` Stream step x   where-    {-# INLINE [0] len #-}-    len x y | x > y     = 0-            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"-                          (n > 0)-                        $ fromIntegral n-      where-        n = y-x+1+    -- {-# INLINE [0] len #-}+    -- len :: Int -> Int -> Int+    -- len u v | u > v     = 0+    --         | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+    --                       (n > 0)+    --                     $ n+    --   where+    --     n = v-u+1      {-# INLINE_INNER step #-}-    step x | x <= y    = return $ Yield x (x+1)+    step z | z <= y    = return $ Yield z (z+1)            | otherwise = return $ Done +enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_FUSED enumFromTo_intlike #-}+enumFromTo_intlike x y = x `seq` y `seq` Stream step x+  where+    {-# INLINE_INNER step #-}+    step z | z <= y    = return $ Yield z (z+1)+           | otherwise = return $ Done+ {-# RULES  "enumFromTo<Int> [Stream]"@@ -1298,31 +1363,21 @@ #if WORD_SIZE_IN_BITS > 32  "enumFromTo<Int64> [Stream]"-  enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64+  enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-}  #else  "enumFromTo<Int32> [Stream]"-  enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32+  enumFromTo = enumFromTo_intlike :: 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 = x `seq` y `seq` Stream step x (Exact (len x y))+{-# INLINE_FUSED enumFromTo_big_word #-}+enumFromTo_big_word x y = x `seq` y `seq` Stream step x   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)+    step z | z <= y    = return $ Yield z (z+1)            | otherwise = return $ Done  {-# RULES@@ -1344,25 +1399,17 @@  "enumFromTo<Integer> [Stream]"   enumFromTo = enumFromTo_big_word-                        :: Monad m => Integer -> Integer -> Stream m Integer+                        :: 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 = x `seq` y `seq` Stream step x (Exact (len x y))+{-# INLINE_FUSED enumFromTo_big_int #-}+enumFromTo_big_int x y = x `seq` y `seq` Stream step x   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)+    step z | z <= y    = return $ Yield z (z+1)            | otherwise = return $ Done  #if WORD_SIZE_IN_BITS > 32@@ -1370,51 +1417,41 @@ {-# RULES  "enumFromTo<Int64> [Stream]"-  enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64+  enumFromTo = enumFromTo_big_int :: 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 = x `seq` y `seq` Stream step xn (Exact n)+{-# INLINE_FUSED enumFromTo_char #-}+enumFromTo_char x y = x `seq` y `seq` Stream step xn   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)+    step zn | zn <= yn  = return $ Yield (unsafeChr zn) (zn+1)             | otherwise = return $ Done  {-# RULES  "enumFromTo<Char> [Stream]"-  enumFromTo = enumFromTo_char+  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 = n `seq` m `seq` Stream step n (Max (len n lim))+{-# INLINE_FUSED enumFromTo_double #-}+enumFromTo_double n m = n `seq` m `seq` Stream step n   where     lim = m + 1/2 -- important to float out -    {-# INLINE [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@@ -1425,10 +1462,10 @@   enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double  "enumFromTo<Float> [Stream]"-  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float+  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float   #-} -  #-} + ------------------------------------------------------------------------  -- | Enumerate values with a given step.@@ -1436,7 +1473,7 @@ -- /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 #-}+{-# INLINE_FUSED enumFromThenTo #-} enumFromThenTo x y z = fromList [x, y .. z]  -- FIXME: Specialise enumFromThenTo.@@ -1452,23 +1489,110 @@ -- | Convert a list to a 'Stream' fromList :: Monad m => [a] -> Stream m a {-# INLINE fromList #-}-fromList xs = unsafeFromList Unknown xs+fromList zs = Stream step zs+  where+    step (x:xs) = return (Yield x xs)+    step []     = return Done --- | Convert the first @n@ elements of a list to a 'Stream'+-- | Convert the first @n@ elements of a list to a 'Bundle' fromListN :: Monad m => Int -> [a] -> Stream m a-{-# INLINE_STREAM fromListN #-}-fromListN n xs = Stream step (xs,n) (Max (delay_inline max n 0))+{-# INLINE_FUSED fromListN #-}+fromListN m zs = Stream step (zs,m)   where     {-# INLINE_INNER step #-}-    step (xs,n) | n <= 0 = return Done+    step (_, n) | n <= 0 = return Done     step (x:xs,n)        = return (Yield x (xs,n-1))-    step ([],n)          = return Done+    step ([],_)          = return Done --- | Convert a list to a 'Stream' with the given 'Size' hint. -unsafeFromList :: Monad m => Size -> [a] -> Stream m a-{-# INLINE_STREAM unsafeFromList #-}-unsafeFromList sz xs = Stream step xs sz+{-+fromVector :: (Monad m, Vector v a) => v a -> Stream m a+{-# INLINE_FUSED fromVector #-}+fromVector v = v `seq` n `seq` Stream (Unf step 0)+                                      (Unf vstep True)+                                      (Just v)+                                      (Exact n)   where-    step (x:xs) = return (Yield x xs)-    step []     = return Done+    n = basicLength v++    {-# INLINE step #-}+    step i | i >= n = return Done+           | otherwise = case basicUnsafeIndexM v i of+                           Box x -> return $ Yield x (i+1)+++    {-# INLINE vstep #-}+    vstep True  = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)+    vstep False = return Done++fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a+{-# INLINE_FUSED fromVectors #-}+fromVectors vs = Stream (Unf pstep (Left vs))+                        (Unf vstep vs)+                        Nothing+                        (Exact n)+  where+    n = List.foldl' (\k v -> k + basicLength v) 0 vs++    pstep (Left []) = return Done+    pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs)))++    pstep (Right (v,i,vs))+      | i >= basicLength v = return $ Skip (Left vs)+      | otherwise          = case basicUnsafeIndexM v i of+                               Box x -> return $ Yield x (Right (v,i+1,vs))++    -- FIXME: work around bug in GHC 7.6.1+    vstep :: [v a] -> m (Step [v a] (Chunk v a))+    vstep [] = return Done+    vstep (v:vs) = return $ Yield (Chunk (basicLength v)+                                         (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"+                                                                       (M.basicLength mv == basicLength v)+                                                 $ basicUnsafeCopy mv v)) vs+++concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a+{-# INLINE_FUSED concatVectors #-}+concatVectors (Stream step s}+  = Stream (Unf pstep (Left s))+           (Unf vstep s)+           Nothing+           Unknown+  where+    pstep (Left s) = do+      r <- step s+      case r of+        Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s')))+        Skip    s' -> return (Skip (Left s'))+        Done       -> return Done++    pstep (Right (v,i,s))+      | i >= basicLength v = return (Skip (Left s))+      | otherwise          = case basicUnsafeIndexM v i of+                               Box x -> return (Yield x (Right (v,i+1,s)))+++    vstep s = do+      r <- step s+      case r of+        Yield v s' -> return (Yield (Chunk (basicLength v)+                                           (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"+                                                                          (M.basicLength mv == basicLength v)+                                                   $ basicUnsafeCopy mv v)) s')+        Skip    s' -> return (Skip s')+        Done       -> return Done++reVector :: Monad m => Stream m a -> Stream m a+{-# INLINE_FUSED reVector #-}+reVector (Stream step s, sSize = n} = Stream step s n++{-# RULES++"reVector [Vector]"+  reVector = id++"reVector/reVector [Vector]" forall s.+  reVector (reVector s) = s   #-}+++-}
− Data/Vector/Fusion/Stream/Size.hs 
@@ -1,87 +0,0 @@--- |--- Module      : Data.Vector.Fusion.Stream.Size--- Copyright   : (c) Roman Leshchinskiy 2008-2010--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : portable--- --- Size hints for streams.-----module Data.Vector.Fusion.Stream.Size (-  Size(..), smaller, larger, toMax, upperBound-) where--import Data.Vector.Fusion.Util ( delay_inline )---- | 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-{-# INLINE smaller #-}-smaller (Exact m) (Exact n) = Exact (delay_inline min m n)-smaller (Exact m) (Max   n) = Max   (delay_inline min m n)-smaller (Exact m) Unknown   = Max   m-smaller (Max   m) (Exact n) = Max   (delay_inline min m n)-smaller (Max   m) (Max   n) = Max   (delay_inline min m 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-{-# INLINE larger #-}-larger (Exact m) (Exact n)             = Exact (delay_inline max m 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   (delay_inline max m 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/Fusion/Util.hs view
@@ -6,7 +6,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : portable--- +-- -- Fusion-related utility types -- @@ -16,7 +16,7 @@   delay_inline, delayed_min ) where -import Control.Applicative+import Control.Applicative (Applicative(..))  -- | Identity monad newtype Id a = Id { unId :: a }
Data/Vector/Generic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,+{-# LANGUAGE CPP, Rank2Types, MultiParamTypeClasses, FlexibleContexts,              TypeFamilies, ScopedTypeVariables, BangPatterns #-} -- | -- Module      : Data.Vector.Generic@@ -8,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Generic interface to pure vectors. -- @@ -64,7 +64,7 @@   accum, accumulate, accumulate_,   unsafeAccum, unsafeAccumulate, unsafeAccumulate_, -  -- ** Permutations +  -- ** Permutations   reverse, backpermute, unsafeBackpermute,    -- ** Safe destructive updates@@ -79,7 +79,7 @@   map, imap, concatMap,    -- ** Monadic mapping-  mapM, mapM_, forM, forM_,+  mapM, imapM, mapM_, imapM_, forM, forM_,    -- ** Zipping   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,@@ -87,7 +87,7 @@   zip, zip3, zip4, zip5, zip6,    -- ** Monadic zipping-  zipWithM, zipWithM_,+  zipWithM, izipWithM, zipWithM_, izipWithM_,    -- ** Unzipping   unzip, unzip3, unzip4, unzip5, unzip6,@@ -115,8 +115,9 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- ** Monadic folds-  foldM, foldM', fold1M, fold1M',-  foldM_, foldM'_, fold1M_, fold1M'_,+  foldM, ifoldM, foldM', ifoldM',+  fold1M, fold1M', foldM_, ifoldM_,+  foldM'_, ifoldM'_, fold1M_, fold1M'_,    -- ** Monadic sequencing   sequence, sequence_,@@ -142,7 +143,7 @@    -- * Fusion support -  -- ** Conversion to/from Streams+  -- ** Conversion to/from Bundles   stream, unstream, streamR, unstreamR,    -- ** Recycling support@@ -162,22 +163,21 @@  import           Data.Vector.Generic.Base -import           Data.Vector.Generic.Mutable ( MVector ) import qualified Data.Vector.Generic.Mutable as M  import qualified Data.Vector.Generic.New as New import           Data.Vector.Generic.New ( New ) -import qualified Data.Vector.Fusion.Stream as Stream-import           Data.Vector.Fusion.Stream ( Stream, MStream, Step(..), inplace, liftStream )-import qualified Data.Vector.Fusion.Stream.Monadic as MStream-import           Data.Vector.Fusion.Stream.Size+import qualified Data.Vector.Fusion.Bundle as Bundle+import           Data.Vector.Fusion.Bundle ( Bundle, MBundle, lift, inplace )+import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle+import           Data.Vector.Fusion.Stream.Monadic ( Stream )+import qualified Data.Vector.Fusion.Stream.Monadic as S+import           Data.Vector.Fusion.Bundle.Size import           Data.Vector.Fusion.Util  import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive-import qualified Control.Monad as Monad-import qualified Data.List as List import Prelude hiding ( length, null,                         replicate, (++), concat,                         head, last,@@ -217,27 +217,13 @@  -- | /O(1)/ Yield the length of the vector. length :: Vector v a => v a -> Int-{-# INLINE_STREAM length #-}-length v = basicLength v--{-# RULES--"length/unstream [Vector]" forall s.-  length (new (New.unstream s)) = Stream.length s--  #-}+{-# INLINE length #-}+length = Bundle.length . stream  -- | /O(1)/ Test whether a vector if empty null :: Vector v a => v a -> Bool-{-# INLINE_STREAM null #-}-null v = basicLength v == 0--{-# RULES--"null/unstream [Vector]" forall s.-  null (new (New.unstream s)) = Stream.null s--  #-}+{-# INLINE null #-}+null = Bundle.null . stream  -- Indexing -- --------@@ -245,68 +231,68 @@ infixl 9 ! -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a-{-# INLINE_STREAM (!) #-}+{-# INLINE_FUSED (!) #-} (!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v)         $ unId (basicUnsafeIndexM v i)  infixl 9 !? -- | O(1) Safe indexing (!?) :: Vector v a => v a -> Int -> Maybe a-{-# INLINE_STREAM (!?) #-}+{-# INLINE_FUSED (!?) #-} v !? i | i < 0 || i >= length v = Nothing        | otherwise              = Just $ unsafeIndex v i  -- | /O(1)/ First element head :: Vector v a => v a -> a-{-# INLINE_STREAM head #-}+{-# INLINE_FUSED head #-} head v = v ! 0  -- | /O(1)/ Last element last :: Vector v a => v a -> a-{-# INLINE_STREAM last #-}+{-# INLINE_FUSED last #-} last v = v ! (length v - 1)  -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Vector v a => v a -> Int -> a-{-# INLINE_STREAM unsafeIndex #-}+{-# INLINE_FUSED unsafeIndex #-} unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v)                 $ unId (basicUnsafeIndexM v i)  -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Vector v a => v a -> a-{-# INLINE_STREAM unsafeHead #-}+{-# INLINE_FUSED unsafeHead #-} unsafeHead v = unsafeIndex v 0  -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Vector v a => v a -> a-{-# INLINE_STREAM unsafeLast #-}+{-# INLINE_FUSED unsafeLast #-} unsafeLast v = unsafeIndex v (length v - 1)  {-# RULES  "(!)/unstream [Vector]" forall i s.-  new (New.unstream s) ! i = s Stream.!! i+  new (New.unstream s) ! i = s Bundle.!! i  "(!?)/unstream [Vector]" forall i s.-  new (New.unstream s) !? i = s Stream.!? i+  new (New.unstream s) !? i = s Bundle.!? i  "head/unstream [Vector]" forall s.-  head (new (New.unstream s)) = Stream.head s+  head (new (New.unstream s)) = Bundle.head s  "last/unstream [Vector]" forall s.-  last (new (New.unstream s)) = Stream.last s+  last (new (New.unstream s)) = Bundle.last s  "unsafeIndex/unstream [Vector]" forall i s.-  unsafeIndex (new (New.unstream s)) i = s Stream.!! i+  unsafeIndex (new (New.unstream s)) i = s Bundle.!! i  "unsafeHead/unstream [Vector]" forall s.-  unsafeHead (new (New.unstream s)) = Stream.head s+  unsafeHead (new (New.unstream s)) = Bundle.head s  "unsafeLast/unstream [Vector]" forall s.-  unsafeLast (new (New.unstream s)) = Stream.last s+  unsafeLast (new (New.unstream s)) = Bundle.last s  #-} - #-} + -- Monadic indexing -- ---------------- @@ -330,63 +316,63 @@ -- elements) is evaluated eagerly. -- indexM :: (Vector v a, Monad m) => v a -> Int -> m a-{-# INLINE_STREAM indexM #-}+{-# INLINE_FUSED indexM #-} indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v)            $ basicUnsafeIndexM v i  -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_STREAM headM #-}+{-# INLINE_FUSED headM #-} headM v = indexM v 0  -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_STREAM lastM #-}+{-# INLINE_FUSED lastM #-} lastM v = indexM v (length v - 1)  -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a-{-# INLINE_STREAM unsafeIndexM #-}+{-# INLINE_FUSED unsafeIndexM #-} unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v)                  $ basicUnsafeIndexM v i  -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_STREAM unsafeHeadM #-}+{-# INLINE_FUSED unsafeHeadM #-} unsafeHeadM v = unsafeIndexM v 0  -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_STREAM unsafeLastM #-}+{-# INLINE_FUSED unsafeLastM #-} unsafeLastM v = unsafeIndexM v (length v - 1)  {-# RULES  "indexM/unstream [Vector]" forall s i.-  indexM (new (New.unstream s)) i = liftStream s MStream.!! i+  indexM (new (New.unstream s)) i = lift s MBundle.!! i  "headM/unstream [Vector]" forall s.-  headM (new (New.unstream s)) = MStream.head (liftStream s)+  headM (new (New.unstream s)) = MBundle.head (lift s)  "lastM/unstream [Vector]" forall s.-  lastM (new (New.unstream s)) = MStream.last (liftStream s)+  lastM (new (New.unstream s)) = MBundle.last (lift s)  "unsafeIndexM/unstream [Vector]" forall s i.-  unsafeIndexM (new (New.unstream s)) i = liftStream s MStream.!! i+  unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i  "unsafeHeadM/unstream [Vector]" forall s.-  unsafeHeadM (new (New.unstream s)) = MStream.head (liftStream s)+  unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s)  "unsafeLastM/unstream [Vector]" forall s.-  unsafeLastM (new (New.unstream s)) = MStream.last (liftStream s)+  unsafeLastM (new (New.unstream s)) = MBundle.last (lift s)   #-} -  #-} + -- Extracting subvectors (slicing) -- ------------------------------- @@ -396,33 +382,33 @@                     -> Int   -- ^ @n@ length                     -> v a                     -> v a-{-# INLINE_STREAM slice #-}+{-# INLINE_FUSED slice #-} slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v)             $ basicUnsafeSlice i n v  -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Vector v a => v a -> v a-{-# INLINE_STREAM init #-}+{-# INLINE_FUSED init #-} init v = slice 0 (length v - 1) v  -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Vector v a => v a -> v a-{-# INLINE_STREAM tail #-}+{-# INLINE_FUSED tail #-} tail v = slice 1 (length v - 1) v  -- | /O(1)/ Yield the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Vector v a => Int -> v a -> v a-{-# INLINE_STREAM take #-}+{-# INLINE_FUSED take #-} take n v = unsafeSlice 0 (delay_inline min n' (length v)) v   where n' = max n 0  -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Vector v a => Int -> v a -> v a-{-# INLINE_STREAM drop #-}+{-# INLINE_FUSED drop #-} drop n v = unsafeSlice (delay_inline min n' len)                        (delay_inline max 0 (len - n')) v   where n' = max n 0@@ -432,7 +418,7 @@ -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient.-{-# INLINE_STREAM splitAt #-}+{-# INLINE_FUSED splitAt #-} splitAt :: Vector v a => Int -> v a -> (v a, v a) splitAt n v = ( unsafeSlice 0 m v               , unsafeSlice m (delay_inline max 0 (len - n')) v@@ -448,20 +434,20 @@                           -> Int   -- ^ @n@ length                           -> v a                           -> v a-{-# INLINE_STREAM unsafeSlice #-}+{-# INLINE_FUSED unsafeSlice #-} unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v)                   $ basicUnsafeSlice i n v  -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Vector v a => v a -> v a-{-# INLINE_STREAM unsafeInit #-}+{-# INLINE_FUSED unsafeInit #-} unsafeInit v = unsafeSlice 0 (length v - 1) v  -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Vector v a => v a -> v a-{-# INLINE_STREAM unsafeTail #-}+{-# INLINE_FUSED unsafeTail #-} unsafeTail v = unsafeSlice 1 (length v - 1) v  -- | /O(1)/ Yield the first @n@ elements without copying. The vector must@@ -500,41 +486,41 @@   unsafeInit (new p) = new (New.unsafeInit p)  "unsafeTail/new [Vector]" forall p.-  unsafeTail (new p) = new (New.unsafeTail p)+  unsafeTail (new p) = new (New.unsafeTail p)   #-} -  #-} + -- Initialisation -- --------------  -- | /O(1)/ Empty vector empty :: Vector v a => v a {-# INLINE empty #-}-empty = unstream Stream.empty+empty = unstream Bundle.empty  -- | /O(1)/ Vector with exactly one element singleton :: forall v a. Vector v a => a -> v a {-# INLINE singleton #-} singleton x = elemseq (undefined :: v a) x-            $ unstream (Stream.singleton x)+            $ unstream (Bundle.singleton x)  -- | /O(n)/ Vector of the given length with the same value in each position replicate :: forall v a. Vector v a => Int -> a -> v a {-# INLINE replicate #-} replicate n x = elemseq (undefined :: v a) x               $ unstream-              $ Stream.replicate n x+              $ Bundle.replicate n x  -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Vector v a => Int -> (Int -> a) -> v a {-# INLINE generate #-}-generate n f = unstream (Stream.generate n f)+generate n f = unstream (Bundle.generate n f)  -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Vector v a => Int -> (a -> a) -> a -> v a {-# INLINE iterateN #-}-iterateN n f x = unstream (Stream.iterateN n f x)+iterateN n f x = unstream (Bundle.iterateN n f x)  -- Unfolding -- ---------@@ -547,7 +533,7 @@ -- >  = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldr #-}-unfoldr f = unstream . Stream.unfoldr f+unfoldr f = unstream . Bundle.unfoldr f  -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the@@ -556,7 +542,7 @@ -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN  :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldrN #-}-unfoldrN n f = unstream . Stream.unfoldrN n f+unfoldrN n f = unstream . Bundle.unfoldrN n f  -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector.@@ -584,7 +570,7 @@                           v'' <- unsafeFreeze v'                           fill v'' (i+1) -    fill v i = return v+    fill v _ = return v  -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part@@ -613,7 +599,7 @@                           v'' <- unsafeFreeze v'                           fill v'' (i+1) -    fill v i = return v+    fill v _ = return v   -- Enumeration@@ -636,7 +622,7 @@ enumFromStepN x y n = elemseq (undefined :: v a) x                     $ elemseq (undefined :: v a) y                     $ unstream-                    $ Stream.enumFromStepN  x y n+                    $ Bundle.enumFromStepN  x y n  -- | /O(n)/ Enumerate values from @x@ to @y@. --@@ -644,7 +630,7 @@ -- 'enumFromN' instead. enumFromTo :: (Vector v a, Enum a) => a -> a -> v a {-# INLINE enumFromTo #-}-enumFromTo x y = unstream (Stream.enumFromTo x y)+enumFromTo x y = unstream (Bundle.enumFromTo x y)  -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --@@ -652,7 +638,7 @@ -- 'enumFromStepN' instead. enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a {-# INLINE enumFromThenTo #-}-enumFromThenTo x y z = unstream (Stream.enumFromThenTo x y z)+enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z)  -- Concatenation -- -------------@@ -662,7 +648,7 @@ {-# INLINE cons #-} cons x v = elemseq (undefined :: v a) x          $ unstream-         $ Stream.cons x+         $ Bundle.cons x          $ stream v  -- | /O(n)/ Append an element@@ -670,31 +656,34 @@ {-# INLINE snoc #-} snoc v x = elemseq (undefined :: v a) x          $ unstream-         $ Stream.snoc (stream v) x+         $ Bundle.snoc (stream v) x  infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Vector v a => v a -> v a -> v a {-# INLINE (++) #-}-v ++ w = unstream (stream v Stream.++ stream w)+v ++ w = unstream (stream v Bundle.++ stream w)  -- | /O(n)/ Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a {-# INLINE concat #-}-concat vs = unstream (Stream.flatten mk step (Exact n) (Stream.fromList vs))+concat = unstream . Bundle.fromVectors+{-+concat vs = unstream (Bundle.flatten mk step (Exact n) (Bundle.fromList vs))   where     n = List.foldl' (\k v -> k + length v) 0 vs      {-# INLINE_INNER step #-}     step (v,i,k)       | i < k = case unsafeIndexM v i of-                  Box x -> Stream.Yield x (v,i+1,k)-      | otherwise = Stream.Done+                  Box x -> Bundle.Yield x (v,i+1,k)+      | otherwise = Bundle.Done      {-# INLINE mk #-}     mk v = let k = length v            in            k `seq` (v,0,k)+-}  -- Monadic initialisation -- ----------------------@@ -703,13 +692,13 @@ -- results in a vector. replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) {-# INLINE replicateM #-}-replicateM n m = unstreamM (MStream.replicateM n m)+replicateM n m = unstreamM (MBundle.replicateM n m)  -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) {-# INLINE generateM #-}-generateM n f = unstreamM (MStream.generateM n f)+generateM n f = unstreamM (MBundle.generateM n f)  -- | Execute the monadic action and freeze the resulting vector. --@@ -736,7 +725,7 @@ force :: Vector v a => v a -> v a -- FIXME: we probably ought to inline this later as the rules still might fire -- otherwise-{-# INLINE_STREAM force #-}+{-# INLINE_FUSED force #-} force v = new (clone v)  -- Bulk updates@@ -751,7 +740,7 @@                    -> [(Int, a)] -- ^ list of index/value pairs (of length @n@)                    -> v a {-# INLINE (//) #-}-v // us = update_stream v (Stream.fromList us)+v // us = update_stream v (Bundle.fromList us)  -- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, -- replace the vector element at position @i@ by @a@.@@ -783,16 +772,16 @@         -> v a   -- ^ value vector (of length @n2@)         -> v a {-# INLINE update_ #-}-update_ v is w = update_stream v (Stream.zipWith (,) (stream is) (stream w))+update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w)) -update_stream :: Vector v a => v a -> Stream (Int,a) -> v a+update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a {-# INLINE update_stream #-}-update_stream = modifyWithStream M.update+update_stream = modifyWithBundle M.update  -- | Same as ('//') but without bounds checking. unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE unsafeUpd #-}-unsafeUpd v us = unsafeUpdate_stream v (Stream.fromList us)+unsafeUpd v us = unsafeUpdate_stream v (Bundle.fromList us)  -- | Same as 'update' but without bounds checking. unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a@@ -803,11 +792,11 @@ unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ v is w-  = unsafeUpdate_stream v (Stream.zipWith (,) (stream is) (stream w))+  = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w)) -unsafeUpdate_stream :: Vector v a => v a -> Stream (Int,a) -> v a+unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a {-# INLINE unsafeUpdate_stream #-}-unsafeUpdate_stream = modifyWithStream M.unsafeUpdate+unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate  -- Accumulations -- -------------@@ -822,7 +811,7 @@       -> [(Int,b)]     -- ^ list of index/value pairs (of length @n@)       -> v a {-# INLINE accum #-}-accum f v us = accum_stream f v (Stream.fromList us)+accum f v us = accum_stream f v (Bundle.fromList us)  -- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector -- element @a@ at position @i@ by @f a b@.@@ -856,18 +845,18 @@                 -> v b           -- ^ value vector (of length @n2@)                 -> v a {-# INLINE accumulate_ #-}-accumulate_ f v is xs = accum_stream f v (Stream.zipWith (,) (stream is)+accumulate_ f v is xs = accum_stream f v (Bundle.zipWith (,) (stream is)                                                              (stream xs))-                                         -accum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a++accum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a {-# INLINE accum_stream #-}-accum_stream f = modifyWithStream (M.accum f)+accum_stream f = modifyWithBundle (M.accum f)  -- | Same as 'accum' but without bounds checking. unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE unsafeAccum #-}-unsafeAccum f v us = unsafeAccum_stream f v (Stream.fromList us)+unsafeAccum f v us = unsafeAccum_stream f v (Bundle.fromList us)  -- | Same as 'accumulate' but without bounds checking. unsafeAccumulate :: (Vector v a, Vector v (Int, b))@@ -880,12 +869,12 @@                 => (a -> b -> a) -> v a -> v Int -> v b -> v a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ f v is xs-  = unsafeAccum_stream f v (Stream.zipWith (,) (stream is) (stream xs))+  = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs))  unsafeAccum_stream-  :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a+  :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a {-# INLINE unsafeAccum_stream #-}-unsafeAccum_stream f = modifyWithStream (M.unsafeAccum f)+unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f)  -- Permutations -- ------------@@ -912,8 +901,8 @@ backpermute v is = seq v                  $ seq n                  $ unstream-                 $ Stream.unbox-                 $ Stream.map index+                 $ Bundle.unbox+                 $ Bundle.map index                  $ stream is   where     n = length v@@ -930,8 +919,8 @@ unsafeBackpermute v is = seq v                        $ seq n                        $ unstream-                       $ Stream.unbox-                       $ Stream.map index+                       $ Bundle.unbox+                       $ Bundle.map index                        $ stream is   where     n = length v@@ -958,11 +947,11 @@  -- We have to make sure that this is strict in the stream but we can't seq on -- it while fusion is happening. Hence this ugliness.-modifyWithStream :: Vector v a-                 => (forall s. Mutable v s a -> Stream b -> ST s ())-                 -> v a -> Stream b -> v a-{-# INLINE modifyWithStream #-}-modifyWithStream p v s = new (New.modifyWithStream p (clone v) s)+modifyWithBundle :: Vector v a+                 => (forall s. Mutable v s a -> Bundle u b -> ST s ())+                 -> v a -> Bundle u b -> v a+{-# INLINE modifyWithBundle #-}+modifyWithBundle p v s = new (New.modifyWithBundle p (clone v) s)  -- Indexing -- --------@@ -970,7 +959,7 @@ -- | /O(n)/ Pair each element in a vector with its index indexed :: (Vector v a, Vector v (Int,a)) => v a -> v (Int,a) {-# INLINE indexed #-}-indexed = unstream . Stream.indexed . stream+indexed = unstream . Bundle.indexed . stream  -- Mapping -- -------@@ -978,12 +967,12 @@ -- | /O(n)/ Map a function over a vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b {-# INLINE map #-}-map f = unstream . inplace (MStream.map f) . stream+map f = unstream . inplace (S.map f) id . stream  -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b {-# INLINE imap #-}-imap f = unstream . inplace (MStream.map (uncurry f) . MStream.indexed)+imap f = unstream . inplace (S.map (uncurry f) . S.indexed) id                   . stream  -- | Map a function over a vector and concatenate the results.@@ -991,28 +980,36 @@ {-# INLINE concatMap #-} -- NOTE: We can't fuse concatMap anyway so don't pretend we do. -- This seems to be slightly slower--- concatMap f = concat . Stream.toList . Stream.map f . stream+-- concatMap f = concat . Bundle.toList . Bundle.map f . stream  -- Slowest--- concatMap f = unstream . Stream.concatMap (stream . f) . stream+-- concatMap f = unstream . Bundle.concatMap (stream . f) . stream --- Seems to be fastest+-- Used to be fastest+{- concatMap f = unstream-            . Stream.flatten mk step Unknown+            . Bundle.flatten mk step Unknown             . stream   where     {-# INLINE_INNER step #-}     step (v,i,k)       | i < k = case unsafeIndexM v i of-                  Box x -> Stream.Yield x (v,i+1,k)-      | otherwise = Stream.Done+                  Box x -> Bundle.Yield x (v,i+1,k)+      | otherwise = Bundle.Done      {-# INLINE mk #-}     mk x = let v = f x                k = length v            in            k `seq` (v,0,k)+-} +-- This seems to be fastest now+concatMap f = unstream+            . Bundle.concatVectors+            . Bundle.map f+            . stream+ -- Monadic mapping -- --------------- @@ -1020,14 +1017,26 @@ -- vector of results mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b) {-# INLINE mapM #-}-mapM f = unstreamM . Stream.mapM f . stream+mapM f = unstreamM . Bundle.mapM f . stream +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, yielding a vector of results+imapM :: (Monad m, Vector v a, Vector v b)+      => (Int -> a -> m b) -> v a -> m (v b)+imapM f = unstreamM . Bundle.mapM (uncurry f) . Bundle.indexed . stream+ -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m () {-# INLINE mapM_ #-}-mapM_ f = Stream.mapM_ f . stream+mapM_ f = Bundle.mapM_ f . stream +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, ignoring the results+imapM_ :: (Monad m, Vector v a) => (Int -> a -> m b) -> v a -> m ()+{-# INLINE imapM_ #-}+imapM_ f = Bundle.mapM_ (uncurry f) . Bundle.indexed . stream+ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b)@@ -1047,21 +1056,21 @@ zipWith :: (Vector v a, Vector v b, Vector 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))+zipWith f = \xs ys -> unstream (Bundle.zipWith f (stream xs) (stream ys))  -- | Zip three vectors with the given function. zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d)          => (a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE zipWith3 #-}-zipWith3 f as bs cs = unstream (Stream.zipWith3 f (stream as)+zipWith3 f = \as bs cs -> unstream (Bundle.zipWith3 f (stream as)                                                   (stream bs)                                                   (stream cs))  zipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e)          => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE zipWith4 #-}-zipWith4 f as bs cs ds-  = unstream (Stream.zipWith4 f (stream as)+zipWith4 f = \as bs cs ds ->+    unstream (Bundle.zipWith4 f (stream as)                                 (stream bs)                                 (stream cs)                                 (stream ds))@@ -1071,8 +1080,8 @@          => (a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e                                          -> v f {-# INLINE zipWith5 #-}-zipWith5 f as bs cs ds es-  = unstream (Stream.zipWith5 f (stream as)+zipWith5 f = \as bs cs ds es ->+    unstream (Bundle.zipWith5 f (stream as)                                 (stream bs)                                 (stream cs)                                 (stream ds)@@ -1083,8 +1092,8 @@          => (a -> b -> c -> d -> e -> f -> g)          -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE zipWith6 #-}-zipWith6 f as bs cs ds es fs-  = unstream (Stream.zipWith6 f (stream as)+zipWith6 f = \as bs cs ds es fs ->+    unstream (Bundle.zipWith6 f (stream as)                                 (stream bs)                                 (stream cs)                                 (stream ds)@@ -1096,23 +1105,23 @@ izipWith :: (Vector v a, Vector v b, Vector v c)         => (Int -> a -> b -> c) -> v a -> v b -> v c {-# INLINE izipWith #-}-izipWith f xs ys = unstream-                  (Stream.zipWith (uncurry f) (Stream.indexed (stream xs))-                                                              (stream ys))+izipWith f = \xs ys ->+    unstream (Bundle.zipWith (uncurry f) (Bundle.indexed (stream xs))+                                                         (stream ys))  izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d)          => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE izipWith3 #-}-izipWith3 f as bs cs-  = unstream (Stream.zipWith3 (uncurry f) (Stream.indexed (stream as))+izipWith3 f = \as bs cs ->+    unstream (Bundle.zipWith3 (uncurry f) (Bundle.indexed (stream as))                                                           (stream bs)                                                           (stream cs))  izipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e)          => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE izipWith4 #-}-izipWith4 f as bs cs ds-  = unstream (Stream.zipWith4 (uncurry f) (Stream.indexed (stream as))+izipWith4 f = \as bs cs ds ->+    unstream (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as))                                                           (stream bs)                                                           (stream cs)                                                           (stream ds))@@ -1122,8 +1131,8 @@          => (Int -> a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d                                                 -> v e -> v f {-# INLINE izipWith5 #-}-izipWith5 f as bs cs ds es-  = unstream (Stream.zipWith5 (uncurry f) (Stream.indexed (stream as))+izipWith5 f = \as bs cs ds es ->+    unstream (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as))                                                           (stream bs)                                                           (stream cs)                                                           (stream ds)@@ -1134,8 +1143,8 @@          => (Int -> a -> b -> c -> d -> e -> f -> g)          -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE izipWith6 #-}-izipWith6 f as bs cs ds es fs-  = unstream (Stream.zipWith6 (uncurry f) (Stream.indexed (stream as))+izipWith6 f = \as bs cs ds es fs ->+    unstream (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as))                                                           (stream bs)                                                           (stream cs)                                                           (stream ds)@@ -1178,15 +1187,33 @@          => (a -> b -> m c) -> v a -> v b -> m (v c) -- FIXME: specialise for ST and IO? {-# INLINE zipWithM #-}-zipWithM f as bs = unstreamM $ Stream.zipWithM f (stream as) (stream bs)+zipWithM f = \as bs -> unstreamM $ Bundle.zipWithM f (stream as) (stream bs) +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and yield a vector of results+izipWithM :: (Monad m, Vector v a, Vector v b, Vector v c)+         => (Int -> a -> b -> m c) -> v a -> v b -> m (v c)+{-# INLINE izipWithM #-}+izipWithM m as bs = unstreamM . Bundle.zipWithM (uncurry m)+                                (Bundle.indexed (stream as))+                                $ stream bs+ -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Vector v a, Vector v b)           => (a -> b -> m c) -> v a -> v b -> m () {-# INLINE zipWithM_ #-}-zipWithM_ f as bs = Stream.zipWithM_ f (stream as) (stream bs)+zipWithM_ f = \as bs -> Bundle.zipWithM_ f (stream as) (stream bs) +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and ignore the results+izipWithM_ :: (Monad m, Vector v a, Vector v b)+          => (Int -> a -> b -> m c) -> v a -> v b -> m ()+{-# INLINE izipWithM_ #-}+izipWithM_ m as bs = Bundle.zipWithM_ (uncurry m)+                      (Bundle.indexed (stream as))+                      $ stream bs+ -- Unzipping -- --------- @@ -1198,39 +1225,39 @@ unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c))        => v (a, b, c) -> (v a, v b, v c) {-# INLINE unzip3 #-}-unzip3 xs = (map (\(a, b, c) -> a) xs,-             map (\(a, b, c) -> b) xs,-             map (\(a, b, c) -> c) xs)+unzip3 xs = (map (\(a, _, _) -> a) xs,+             map (\(_, b, _) -> b) xs,+             map (\(_, _, c) -> c) xs)  unzip4 :: (Vector v a, Vector v b, Vector v c, Vector v d,            Vector v (a, b, c, d))        => v (a, b, c, d) -> (v a, v b, v c, v d) {-# INLINE unzip4 #-}-unzip4 xs = (map (\(a, b, c, d) -> a) xs,-             map (\(a, b, c, d) -> b) xs,-             map (\(a, b, c, d) -> c) xs,-             map (\(a, b, c, d) -> d) xs)+unzip4 xs = (map (\(a, _, _, _) -> a) xs,+             map (\(_, b, _, _) -> b) xs,+             map (\(_, _, c, _) -> c) xs,+             map (\(_, _, _, d) -> d) xs)  unzip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,            Vector v (a, b, c, d, e))        => v (a, b, c, d, e) -> (v a, v b, v c, v d, v e) {-# INLINE unzip5 #-}-unzip5 xs = (map (\(a, b, c, d, e) -> a) xs,-             map (\(a, b, c, d, e) -> b) xs,-             map (\(a, b, c, d, e) -> c) xs,-             map (\(a, b, c, d, e) -> d) xs,-             map (\(a, b, c, d, e) -> e) xs)+unzip5 xs = (map (\(a, _, _, _, _) -> a) xs,+             map (\(_, b, _, _, _) -> b) xs,+             map (\(_, _, c, _, _) -> c) xs,+             map (\(_, _, _, d, _) -> d) xs,+             map (\(_, _, _, _, e) -> e) xs)  unzip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,            Vector v f, Vector v (a, b, c, d, e, f))        => v (a, b, c, d, e, f) -> (v a, v b, v c, v d, v e, v f) {-# INLINE unzip6 #-}-unzip6 xs = (map (\(a, b, c, d, e, f) -> a) xs,-             map (\(a, b, c, d, e, f) -> b) xs,-             map (\(a, b, c, d, e, f) -> c) xs,-             map (\(a, b, c, d, e, f) -> d) xs,-             map (\(a, b, c, d, e, f) -> e) xs,-             map (\(a, b, c, d, e, f) -> f) xs)+unzip6 xs = (map (\(a, _, _, _, _, _) -> a) xs,+             map (\(_, b, _, _, _, _) -> b) xs,+             map (\(_, _, c, _, _, _) -> c) xs,+             map (\(_, _, _, d, _, _) -> d) xs,+             map (\(_, _, _, _, e, _) -> e) xs,+             map (\(_, _, _, _, _, f) -> f) xs)  -- Filtering -- ---------@@ -1238,33 +1265,32 @@ -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE filter #-}-filter f = unstream . inplace (MStream.filter f) . stream+filter f = unstream . inplace (S.filter f) toMax . stream  -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a {-# INLINE ifilter #-} ifilter f = unstream-          . inplace (MStream.map snd . MStream.filter (uncurry f)-                                     . MStream.indexed)+          . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax           . stream  -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a) {-# INLINE filterM #-}-filterM f = unstreamM . Stream.filterM f . stream+filterM f = unstreamM . Bundle.filterM f . stream  -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE takeWhile #-}-takeWhile f = unstream . Stream.takeWhile f . stream+takeWhile f = unstream . Bundle.takeWhile f . stream  -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE dropWhile #-}-dropWhile f = unstream . Stream.dropWhile f . stream+dropWhile f = unstream . Bundle.dropWhile f . stream  -- Parititioning -- -------------@@ -1280,11 +1306,11 @@ -- FIXME: Make this inplace-fusible (look at how stable_partition is -- implemented in C++) -partition_stream :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)-{-# INLINE_STREAM partition_stream #-}+partition_stream :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a)+{-# INLINE_FUSED partition_stream #-} partition_stream f s = s `seq` runST (   do-    (mv1,mv2) <- M.partitionStream f s+    (mv1,mv2) <- M.partitionBundle f s     v1 <- unsafeFreeze mv1     v2 <- unsafeFreeze mv2     return (v1,v2))@@ -1298,17 +1324,17 @@ unstablePartition f = unstablePartition_stream f . stream  unstablePartition_stream-  :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)-{-# INLINE_STREAM unstablePartition_stream #-}+  :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a)+{-# INLINE_FUSED unstablePartition_stream #-} unstablePartition_stream f s = s `seq` runST (   do-    (mv1,mv2) <- M.unstablePartitionStream f s+    (mv1,mv2) <- M.unstablePartitionBundle f s     v1 <- unsafeFreeze mv1     v2 <- unsafeFreeze mv2     return (v1,v2))  unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a)-{-# INLINE_STREAM unstablePartition_new #-}+{-# INLINE_FUSED unstablePartition_new #-} unstablePartition_new f (New.New p) = runST (   do     mv <- p@@ -1320,11 +1346,11 @@  "unstablePartition" forall f p.   unstablePartition_stream f (stream (new p))-    = unstablePartition_new f p+    = unstablePartition_new f p   #-} -  #-}  + -- FIXME: make span and break fusible  -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy@@ -1340,8 +1366,8 @@ break f xs = case findIndex f xs of                Just i  -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs)                Nothing -> (xs, empty)-     + -- Searching -- --------- @@ -1349,33 +1375,32 @@ -- | /O(n)/ Check if the vector contains an element elem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE elem #-}-elem x = Stream.elem x . stream+elem x = Bundle.elem x . stream  infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE notElem #-}-notElem x = Stream.notElem x . stream+notElem x = Bundle.notElem x . stream  -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Vector v a => (a -> Bool) -> v a -> Maybe a {-# INLINE find #-}-find f = Stream.find f . stream+find f = Bundle.find f . stream  -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int {-# INLINE findIndex #-}-findIndex f = Stream.findIndex f . stream+findIndex f = Bundle.findIndex f . stream  -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int {-# INLINE findIndices #-} findIndices f = unstream-              . inplace (MStream.map fst . MStream.filter (f . snd)-                                         . MStream.indexed)+              . inplace (S.map fst . S.filter (f . snd) . S.indexed) toMax               . stream  -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or@@ -1397,65 +1422,65 @@ -- | /O(n)/ Left fold foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl #-}-foldl f z = Stream.foldl f z . stream+foldl f z = Bundle.foldl f z . stream  -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-}-foldl1 f = Stream.foldl1 f . stream+foldl1 f = Bundle.foldl1 f . stream  -- | /O(n)/ Left fold with strict accumulator foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl' #-}-foldl' f z = Stream.foldl' f z . stream+foldl' f z = Bundle.foldl' f z . stream  -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1' #-}-foldl1' f = Stream.foldl1' f . stream+foldl1' f = Bundle.foldl1' f . stream  -- | /O(n)/ Right fold foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-}-foldr f z = Stream.foldr f z . stream+foldr f z = Bundle.foldr f z . stream  -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1 #-}-foldr1 f = Stream.foldr1 f . stream+foldr1 f = Bundle.foldr1 f . stream  -- | /O(n)/ Right fold with a strict accumulator foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr' #-}-foldr' f z = Stream.foldl' (flip f) z . streamR+foldr' f z = Bundle.foldl' (flip f) z . streamR  -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1' #-}-foldr1' f = Stream.foldl1' (flip f) . streamR+foldr1' f = Bundle.foldl1' (flip f) . streamR  -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl #-}-ifoldl f z = Stream.foldl (uncurry . f) z . Stream.indexed . stream+ifoldl f z = Bundle.foldl (uncurry . f) z . Bundle.indexed . stream  -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl' #-}-ifoldl' f z = Stream.foldl' (uncurry . f) z . Stream.indexed . stream+ifoldl' f z = Bundle.foldl' (uncurry . f) z . Bundle.indexed . stream  -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr #-}-ifoldr f z = Stream.foldr (uncurry f) z . Stream.indexed . stream+ifoldr f z = Bundle.foldr (uncurry f) z . Bundle.indexed . stream  -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr' #-}-ifoldr' f z xs = Stream.foldl' (flip (uncurry f)) z-               $ Stream.indexedR (length xs) $ streamR xs+ifoldr' f z xs = Bundle.foldl' (flip (uncurry f)) z+               $ Bundle.indexedR (length xs) $ streamR xs  -- Specialised folds -- -----------------@@ -1463,47 +1488,47 @@ -- | /O(n)/ Check if all elements satisfy the predicate. all :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE all #-}-all f = Stream.and . Stream.map f . stream+all f = Bundle.and . Bundle.map f . stream  -- | /O(n)/ Check if any element satisfies the predicate. any :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE any #-}-any f = Stream.or . Stream.map f . stream+any f = Bundle.or . Bundle.map f . stream  -- | /O(n)/ Check if all elements are 'True' and :: Vector v Bool => v Bool -> Bool {-# INLINE and #-}-and = Stream.and . stream+and = Bundle.and . stream  -- | /O(n)/ Check if any element is 'True' or :: Vector v Bool => v Bool -> Bool {-# INLINE or #-}-or = Stream.or . stream+or = Bundle.or . stream  -- | /O(n)/ Compute the sum of the elements sum :: (Vector v a, Num a) => v a -> a {-# INLINE sum #-}-sum = Stream.foldl' (+) 0 . stream+sum = Bundle.foldl' (+) 0 . stream  -- | /O(n)/ Compute the produce of the elements product :: (Vector v a, Num a) => v a -> a {-# INLINE product #-}-product = Stream.foldl' (*) 1 . stream+product = Bundle.foldl' (*) 1 . stream  -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Vector v a, Ord a) => v a -> a {-# INLINE maximum #-}-maximum = Stream.foldl1' max . stream+maximum = Bundle.foldl1' max . stream  -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE maximumBy #-}-maximumBy cmp = Stream.foldl1' maxBy . stream+maximumBy cmpr = Bundle.foldl1' maxBy . stream   where     {-# INLINE maxBy #-}-    maxBy x y = case cmp x y of+    maxBy x y = case cmpr x y of                   LT -> y                   _  -> x @@ -1511,16 +1536,16 @@ -- empty. minimum :: (Vector v a, Ord a) => v a -> a {-# INLINE minimum #-}-minimum = Stream.foldl1' min . stream+minimum = Bundle.foldl1' min . stream  -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE minimumBy #-}-minimumBy cmp = Stream.foldl1' minBy . stream+minimumBy cmpr = Bundle.foldl1' minBy . stream   where     {-# INLINE minBy #-}-    minBy x y = case cmp x y of+    minBy x y = case cmpr x y of                   GT -> y                   _  -> x @@ -1534,10 +1559,10 @@ -- the given comparison function. The vector may not be empty. maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE maxIndexBy #-}-maxIndexBy cmp = fst . Stream.foldl1' imax . Stream.indexed . stream+maxIndexBy cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream   where     imax (i,x) (j,y) = i `seq` j `seq`-                       case cmp x y of+                       case cmpr x y of                          LT -> (j,y)                          _  -> (i,x) @@ -1551,10 +1576,10 @@ -- the given comparison function. The vector may not be empty. minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE minIndexBy #-}-minIndexBy cmp = fst . Stream.foldl1' imin . Stream.indexed . stream+minIndexBy cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream   where     imin (i,x) (j,y) = i `seq` j `seq`-                       case cmp x y of+                       case cmpr x y of                          GT -> (j,y)                          _  -> (i,x) @@ -1564,22 +1589,33 @@ -- | /O(n)/ Monadic fold foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM #-}-foldM m z = Stream.foldM m z . stream+foldM m z = Bundle.foldM m z . stream +-- | /O(n)/ Monadic fold (action applied to each element and its index)+ifoldM :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a+{-# INLINE ifoldM #-}+ifoldM m z = Bundle.foldM (uncurry . m) z . Bundle.indexed . stream+ -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M #-}-fold1M m = Stream.fold1M m . stream+fold1M m = Bundle.fold1M m . stream  -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM' #-}-foldM' m z = Stream.foldM' m z . stream+foldM' m z = Bundle.foldM' m z . stream +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each+-- element and its index)+ifoldM' :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a+{-# INLINE ifoldM' #-}+ifoldM' m z = Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream+ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M' #-}-fold1M' m = Stream.fold1M' m . stream+fold1M' m = Bundle.fold1M' m . stream  discard :: Monad m => m a -> m () {-# INLINE discard #-}@@ -1588,23 +1624,35 @@ -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM_ #-}-foldM_ m z = discard . Stream.foldM m z . stream+foldM_ m z = discard . Bundle.foldM m z . stream +-- | /O(n)/ Monadic fold that discards the result (action applied to+-- each element and its index)+ifoldM_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m ()+{-# INLINE ifoldM_ #-}+ifoldM_ m z = discard . Bundle.foldM (uncurry . m) z . Bundle.indexed . stream+ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M_ #-}-fold1M_ m = discard . Stream.fold1M m . stream+fold1M_ m = discard . Bundle.fold1M m . stream  -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM'_ #-}-foldM'_ m z = discard . Stream.foldM' m z . stream+foldM'_ m z = discard . Bundle.foldM' m z . stream +-- | /O(n)/ Monadic fold with strict accumulator that discards the result+-- (action applied to each element and its index)+ifoldM'_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m ()+{-# INLINE ifoldM'_ #-}+ifoldM'_ m z = discard . Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream+ -- | /O(n)/ Monad fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M'_ #-}-fold1M'_ m = discard . Stream.fold1M' m . stream+fold1M'_ m = discard . Bundle.fold1M' m . stream  -- Monadic sequencing -- ------------------@@ -1632,12 +1680,12 @@ -- prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl #-}-prescanl f z = unstream . inplace (MStream.prescanl f z) . stream+prescanl f z = unstream . inplace (S.prescanl f z) id . stream  -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl' #-}-prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream+prescanl' f z = unstream . inplace (S.prescanl' f z) id . stream  -- | /O(n)/ Scan --@@ -1649,12 +1697,12 @@ -- postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl #-}-postscanl f z = unstream . inplace (MStream.postscanl f z) . stream+postscanl f z = unstream . inplace (S.postscanl f z) id . stream  -- | /O(n)/ Scan with strict accumulator postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl' #-}-postscanl' f z = unstream . inplace (MStream.postscanl' f z) . stream+postscanl' f z = unstream . inplace (S.postscanl' f z) id . stream  -- | /O(n)/ Haskell-style scan --@@ -1663,15 +1711,15 @@ -- >         yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@--- +-- scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl #-}-scanl f z = unstream . Stream.scanl f z . stream+scanl f z = unstream . Bundle.scanl f z . stream  -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl' #-}-scanl' f z = unstream . Stream.scanl' f z . stream+scanl' f z = unstream . Bundle.scanl' f z . stream  -- | /O(n)/ Scan over a non-empty vector --@@ -1681,12 +1729,12 @@ -- scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1 #-}-scanl1 f = unstream . inplace (MStream.scanl1 f) . stream+scanl1 f = unstream . inplace (S.scanl1 f) id . stream  -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1' #-}-scanl1' f = unstream . inplace (MStream.scanl1' f) . stream+scanl1' f = unstream . inplace (S.scanl1' f) id . stream  -- | /O(n)/ Right-to-left prescan --@@ -1696,43 +1744,43 @@ -- prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr #-}-prescanr f z = unstreamR . inplace (MStream.prescanl (flip f) z) . streamR+prescanr f z = unstreamR . inplace (S.prescanl (flip f) z) id . streamR  -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr' #-}-prescanr' f z = unstreamR . inplace (MStream.prescanl' (flip f) z) . streamR+prescanr' f z = unstreamR . inplace (S.prescanl' (flip f) z) id . streamR  -- | /O(n)/ Right-to-left scan postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr #-}-postscanr f z = unstreamR . inplace (MStream.postscanl (flip f) z) . streamR+postscanr f z = unstreamR . inplace (S.postscanl (flip f) z) id . streamR  -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr' #-}-postscanr' f z = unstreamR . inplace (MStream.postscanl' (flip f) z) . streamR+postscanr' f z = unstreamR . inplace (S.postscanl' (flip f) z) id . streamR  -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr #-}-scanr f z = unstreamR . Stream.scanl (flip f) z . streamR+scanr f z = unstreamR . Bundle.scanl (flip f) z . streamR  -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr' #-}-scanr' f z = unstreamR . Stream.scanl' (flip f) z . streamR+scanr' f z = unstreamR . Bundle.scanl' (flip f) z . streamR  -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1 #-}-scanr1 f = unstreamR . inplace (MStream.scanl1 (flip f)) . streamR+scanr1 f = unstreamR . inplace (S.scanl1 (flip f)) id . streamR  -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1' #-}-scanr1' f = unstreamR . inplace (MStream.scanl1' (flip f)) . streamR+scanr1' f = unstreamR . inplace (S.scanl1' (flip f)) id . streamR  -- Conversions - Lists -- ------------------------@@ -1740,12 +1788,12 @@ -- | /O(n)/ Convert a vector to a list toList :: Vector v a => v a -> [a] {-# INLINE toList #-}-toList = Stream.toList . stream+toList = Bundle.toList . stream  -- | /O(n)/ Convert a list to a vector fromList :: Vector v a => [a] -> v a {-# INLINE fromList #-}-fromList = unstream . Stream.fromList+fromList = unstream . Bundle.fromList  -- | /O(n)/ Convert the first @n@ elements of a list to a vector --@@ -1754,7 +1802,7 @@ -- @ fromListN :: Vector v a => Int -> [a] -> v a {-# INLINE fromListN #-}-fromListN n = unstream . Stream.fromListN n+fromListN n = unstream . Bundle.fromListN n  -- Conversions - Immutable vectors -- -------------------------------@@ -1762,7 +1810,7 @@ -- | /O(n)/ Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a {-# INLINE convert #-}-convert = unstream . stream+convert = unstream . Bundle.reVector . stream  -- Conversions - Mutable vectors -- -----------------------------@@ -1782,12 +1830,12 @@ -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a)-{-# INLINE_STREAM unsafeThaw #-}+{-# INLINE_FUSED unsafeThaw #-} unsafeThaw = basicUnsafeThaw  -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a)-{-# INLINE_STREAM thaw #-}+{-# INLINE_FUSED thaw #-} thaw v = do            mv <- M.unsafeNew (length v)            unsafeCopy mv v@@ -1799,15 +1847,15 @@   unsafeThaw (new p) = New.runPrim p  "thaw/new [Vector]" forall p.-  thaw (new p) = New.runPrim p+  thaw (new p) = New.runPrim p   #-} -  #-} + {- -- | /O(n)/ Yield a mutable vector containing copies of each vector in the -- list. thawMany :: (PrimMonad m, Vector v a) => [v a] -> m (Mutable v (PrimState m) a)-{-# INLINE_STREAM thawMany #-}+{-# INLINE_FUSED thawMany #-} -- FIXME: add rule for (stream (new (New.create (thawMany vs)))) -- NOTE: We don't try to consume the list lazily as this wouldn't significantly -- change the space requirements anyway.@@ -1844,13 +1892,16 @@                                          (M.length dst == length src)                    $ (dst `seq` src `seq` basicUnsafeCopy dst src) --- Conversions to/from Streams+-- Conversions to/from Bundles -- --------------------------- --- | /O(1)/ Convert a vector to a 'Stream'-stream :: Vector v a => v a -> Stream a-{-# INLINE_STREAM stream #-}-stream v = v `seq` n `seq` (Stream.unfoldr get 0 `Stream.sized` Exact n)+-- | /O(1)/ Convert a vector to a 'Bundle'+stream :: Vector v a => v a -> Bundle v a+{-# INLINE_FUSED stream #-}+stream v = Bundle.fromVector v++{-+stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n)   where     n = length v @@ -1859,9 +1910,10 @@     {-# INLINE get #-}     get i | i >= n    = Nothing           | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1)+-} --- | /O(n)/ Construct a vector from a 'Stream'-unstream :: Vector v a => Stream a -> v a+-- | /O(n)/ Construct a vector from a 'Bundle'+unstream :: Vector v a => Bundle v a -> v a {-# INLINE unstream #-} unstream s = new (New.unstream s) @@ -1877,19 +1929,19 @@   clone (new p) = p  "inplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.-  New.unstream (inplace f (stream (new m))) = New.transform f m+  forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.+  New.unstream (inplace f g (stream (new m))) = New.transform f g m  "uninplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.-  stream (new (New.transform f m)) = inplace f (stream (new m))+  forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.+  stream (new (New.transform f g m)) = inplace f g (stream (new m))  #-} - #-} --- | /O(1)/ Convert a vector to a 'Stream', proceeding from right to left-streamR :: Vector v a => v a -> Stream a-{-# INLINE_STREAM streamR #-}-streamR v = v `seq` n `seq` (Stream.unfoldr get n `Stream.sized` Exact n)++-- | /O(1)/ Convert a vector to a 'Bundle', proceeding from right to left+streamR :: Vector v a => v a -> Bundle u a+{-# INLINE_FUSED streamR #-}+streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.sized` Exact n)   where     n = length v @@ -1899,8 +1951,8 @@             in             case basicUnsafeIndexM v i' of Box x -> Just (x, i') --- | /O(n)/ Construct a vector from a 'Stream', proceeding from right to left-unstreamR :: Vector v a => Stream a -> v a+-- | /O(n)/ Construct a vector from a 'Bundle', proceeding from right to left+unstreamR :: Vector v a => Bundle v a -> v a {-# INLINE unstreamR #-} unstreamR s = new (New.unstreamR s) @@ -1919,54 +1971,54 @@   New.unstreamR (stream (new p)) = New.modify M.reverse p  "inplace right [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.-  New.unstreamR (inplace f (streamR (new m))) = New.transformR f m+  forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.+  New.unstreamR (inplace f g (streamR (new m))) = New.transformR f g m  "uninplace right [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.-  streamR (new (New.transformR f m)) = inplace f (streamR (new m))+  forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.+  streamR (new (New.transformR f g m)) = inplace f g (streamR (new m))  #-} - #-} -unstreamM :: (Monad m, Vector v a) => MStream m a -> m (v a)-{-# INLINE_STREAM unstreamM #-}++unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a)+{-# INLINE_FUSED unstreamM #-} unstreamM s = do-                xs <- MStream.toList s-                return $ unstream $ Stream.unsafeFromList (MStream.size s) xs+                xs <- MBundle.toList s+                return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs -unstreamPrimM :: (PrimMonad m, Vector v a) => MStream m a -> m (v a)-{-# INLINE_STREAM unstreamPrimM #-}+unstreamPrimM :: (PrimMonad m, Vector v a) => MBundle m u a -> m (v a)+{-# INLINE_FUSED unstreamPrimM #-} unstreamPrimM s = M.munstream s >>= unsafeFreeze  -- FIXME: the next two functions are only necessary for the specialisations-unstreamPrimM_IO :: Vector v a => MStream IO a -> IO (v a)+unstreamPrimM_IO :: Vector v a => MBundle IO u a -> IO (v a) {-# INLINE unstreamPrimM_IO #-} unstreamPrimM_IO = unstreamPrimM -unstreamPrimM_ST :: Vector v a => MStream (ST s) a -> ST s (v a)+unstreamPrimM_ST :: Vector v a => MBundle (ST s) u a -> ST s (v a) {-# INLINE unstreamPrimM_ST #-} unstreamPrimM_ST = unstreamPrimM  {-# RULES  "unstreamM[IO]" unstreamM = unstreamPrimM_IO-"unstreamM[ST]" unstreamM = unstreamPrimM_ST+"unstreamM[ST]" unstreamM = unstreamPrimM_ST  #-} - #-}  + -- Recycling support -- -----------------  -- | Construct a vector from a monadic initialiser. new :: Vector v a => New v a -> v a-{-# INLINE_STREAM new #-}+{-# INLINE_FUSED new #-} new m = m `seq` runST (unsafeFreeze =<< New.run m)  -- | Convert a vector to an initialiser which, when run, produces a copy of -- the vector. clone :: Vector v a => v a -> New v a-{-# INLINE_STREAM clone #-}+{-# INLINE_FUSED clone #-} clone v = v `seq` New.create (   do     mv <- M.new (length v)@@ -1998,13 +2050,12 @@ -- | Generic definition of 'Prelude.showsPrec' showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS {-# INLINE showsPrec #-}-showsPrec p v = showParen (p > 10) $ showString "fromList " . shows (toList v)+showsPrec _ = shows . toList  -- | Generic definition of 'Text.Read.readPrec' readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) {-# INLINE readPrec #-}-readPrec = Read.parens $ Read.prec 10 $ do-  Read.Ident "fromList" <- Read.lexP+readPrec = do   xs <- Read.readPrec   return (fromList xs)
Data/Vector/Generic/Base.hs view
@@ -10,7 +10,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Class of pure vectors -- @@ -18,8 +18,8 @@   Vector(..), Mutable ) where -import           Data.Vector.Generic.Mutable ( MVector )-import qualified Data.Vector.Generic.Mutable as M+import           Data.Vector.Generic.Mutable.Base ( MVector )+import qualified Data.Vector.Generic.Mutable.Base as M  import Control.Monad.Primitive
Data/Vector/Generic/Mutable.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns, ScopedTypeVariables,-             TypeFamilies #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, ScopedTypeVariables #-} -- | -- Module      : Data.Vector.Generic.Mutable -- Copyright   : (c) Roman Leshchinskiy 2008-2010@@ -8,7 +7,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Generic interface to mutable vectors -- @@ -35,13 +34,14 @@    -- ** Growing   grow, unsafeGrow,+  growFront, unsafeGrowFront,    -- ** Restricting memory usage   clear,    -- * Accessing individual elements-  read, write, swap,-  unsafeRead, unsafeWrite, unsafeSwap,+  read, write, modify, swap, exchange,+  unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange,    -- * Modifying vectors @@ -50,18 +50,23 @@    -- * Internal operations   mstream, mstreamR,-  unstream, unstreamR,+  unstream, unstreamR, vunstream,   munstream, munstreamR,   transform, transformR,   fill, fillR,   unsafeAccum, accum, unsafeUpdate, update, reverse,-  unstablePartition, unstablePartitionStream, partitionStream+  unstablePartition, unstablePartitionBundle, partitionBundle ) where -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           Data.Vector.Generic.Mutable.Base+import qualified Data.Vector.Generic.Base as V++import qualified Data.Vector.Fusion.Bundle      as Bundle+import           Data.Vector.Fusion.Bundle      ( Bundle, MBundle, Chunk(..) )+import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle+import           Data.Vector.Fusion.Stream.Monadic ( Stream )+import qualified Data.Vector.Fusion.Stream.Monadic as Stream+import           Data.Vector.Fusion.Bundle.Size import           Data.Vector.Fusion.Util        ( delay_inline )  import Control.Monad.Primitive ( PrimMonad, PrimState )@@ -71,23 +76,12 @@  #include "vector.h" +{-+type family Immutable (v :: * -> * -> *) :: * -> *+ -- | Class of mutable vectors parametrised with a primitive state token. ----- Minimum complete implementation:------   * 'basicLength'------   * 'basicUnsafeSlice'------   * 'basicOverlaps'------   * 'basicUnsafeNew'------   * 'basicUnsafeRead'------   * 'basicUnsafeWrite'----class MVector v a where+class MBundle.Pointer u a => MVector v a where   -- | Length of the mutable vector. This method should not be   -- called directly, use 'length' instead.   basicLength       :: v s a -> Int@@ -129,6 +123,10 @@   -- not be called directly, use 'set' instead.   basicSet         :: PrimMonad m => v (PrimState m) a -> a -> m () +  basicUnsafeCopyPointer :: PrimMonad m => v (PrimState m) a+                                        -> Immutable v a+                                        -> m ()+   -- | Copy a vector. The two vectors may not overlap. This method should not   -- be called directly, use 'unsafeCopy' instead.   basicUnsafeCopy  :: PrimMonad m => v (PrimState m) a   -- ^ target@@ -171,6 +169,14 @@                | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v)                                              (basicUnsafeSlice 0 (n-i) v) +  {-# INLINE basicUnsafeCopyPointer #-}+  basicUnsafeCopyPointer !dst !src = do_copy 0 src+    where+      do_copy !i p | Just (x,q) <- MBundle.pget p = do+                                                      basicUnsafeWrite dst i x+                                                      do_copy (i+1) q+                   | otherwise = return ()+   {-# INLINE basicUnsafeCopy #-}   basicUnsafeCopy !dst !src = do_copy 0     where@@ -181,7 +187,7 @@                             basicUnsafeWrite dst i x                             do_copy (i+1)                 | otherwise = return ()-  +   {-# INLINE basicUnsafeMove #-}   basicUnsafeMove !dst !src     | basicOverlaps dst src = do@@ -197,6 +203,7 @@         return v'     where       n = basicLength v+-}  -- ------------------ -- Internal functions@@ -228,15 +235,15 @@                   unsafeWrite v i' x                   return (v, i')   | otherwise = do-                  (v', i) <- enlargeFront v-                  let i' = i-1+                  (v', j) <- enlargeFront v+                  let i' = j-1                   INTERNAL_CHECK(checkIndex) "unsafePrepend1" i' (length v')                     $ unsafeWrite v' i' x                   return (v', i') -mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a+mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a {-# INLINE mstream #-}-mstream v = v `seq` n `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n)+mstream v = v `seq` n `seq` (Stream.unfoldrM get 0)   where     n = length v @@ -246,10 +253,10 @@           | otherwise = return $ Nothing  fill :: (PrimMonad m, MVector v a)-           => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a)+     => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) {-# INLINE fill #-} fill v s = v `seq` do-                     n' <- MStream.foldM put 0 s+                     n' <- Stream.foldM put 0 s                      return $ unsafeSlice 0 n' v   where     {-# INLINE_INNER put #-}@@ -258,14 +265,15 @@                   $ unsafeWrite v i x                 return (i+1) -transform :: (PrimMonad m, MVector v a)-  => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a)-{-# INLINE_STREAM transform #-}+transform+  :: (PrimMonad m, MVector v a)+  => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE_FUSED transform #-} transform f v = fill v (f (mstream v)) -mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a+mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a {-# INLINE mstreamR #-}-mstreamR v = v `seq` n `seq` (MStream.unfoldrM get n `MStream.sized` Exact n)+mstreamR v = v `seq` n `seq` (Stream.unfoldrM get n)   where     n = length v @@ -277,10 +285,10 @@         j = i-1  fillR :: (PrimMonad m, MVector v a)-           => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a)+      => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) {-# INLINE fillR #-} fillR v s = v `seq` do-                      i <- MStream.foldM put n s+                      i <- Stream.foldM put n s                       return $ unsafeSlice i (n-i) v   where     n = length v@@ -292,25 +300,28 @@       where         j = i-1 -transformR :: (PrimMonad m, MVector v a)-  => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a)-{-# INLINE_STREAM transformR #-}+transformR+  :: (PrimMonad m, MVector v a)+  => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE_FUSED transformR #-} transformR f v = fillR v (f (mstreamR v)) --- | Create a new mutable vector and fill it with elements from the 'Stream'.--- The vector will grow exponentially if the maximum size of the 'Stream' is+-- | Create a new mutable vector and fill it with elements from the 'Bundle'.+-- The vector will grow exponentially if the maximum size of the 'Bundle' is -- unknown.-unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)--- NOTE: replace INLINE_STREAM by INLINE? (also in unstreamR)-{-# INLINE_STREAM unstream #-}-unstream s = munstream (Stream.liftStream s)+unstream :: (PrimMonad m, MVector v a)+         => Bundle u a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR)+{-# INLINE_FUSED unstream #-}+unstream s = munstream (Bundle.lift s)  -- | Create a new mutable vector and fill it with elements from the monadic -- stream. The vector will grow exponentially if the maximum size of the stream -- is unknown.-munstream :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)-{-# INLINE_STREAM munstream #-}-munstream s = case upperBound (MStream.size s) of+munstream :: (PrimMonad m, MVector v a)+          => MBundle m u a -> m (v (PrimState m) a)+{-# INLINE_FUSED munstream #-}+munstream s = case upperBound (MBundle.size s) of                Just n  -> munstreamMax     s n                Nothing -> munstreamUnknown s @@ -320,12 +331,12 @@ -- the shape of the vector) and one for when the vector has grown. To see the -- problem simply compile this: ----- fromList = Data.Vector.Unboxed.unstream . Stream.fromList+-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList -- -- I'm not sure this still applies (19/04/2010) -munstreamMax-  :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a)+munstreamMax :: (PrimMonad m, MVector v a)+             => MBundle m u a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamMax #-} munstreamMax s n   = do@@ -335,17 +346,17 @@                        INTERNAL_CHECK(checkIndex) "munstreamMax" i n                          $ unsafeWrite v i x                        return (i+1)-      n' <- MStream.foldM' put 0 s+      n' <- MBundle.foldM' put 0 s       return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n              $ unsafeSlice 0 n' v -munstreamUnknown-  :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+munstreamUnknown :: (PrimMonad m, MVector v a)+                 => MBundle m u a -> m (v (PrimState m) a) {-# INLINE munstreamUnknown #-} munstreamUnknown s   = do       v <- unsafeNew 0-      (v', n) <- MStream.foldM put (v, 0) s+      (v', n) <- MBundle.foldM put (v, 0) s       return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v')              $ unsafeSlice 0 n v'   where@@ -354,25 +365,103 @@                     v' <- unsafeAppend1 v i x                     return (v',i+1) --- | Create a new mutable vector and fill it with elements from the 'Stream'+++++++-- | Create a new mutable vector and fill it with elements from the 'Bundle'.+-- The vector will grow exponentially if the maximum size of the 'Bundle' is+-- unknown.+vunstream :: (PrimMonad m, V.Vector v a)+         => Bundle v a -> m (V.Mutable v (PrimState m) a)+-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR)+{-# INLINE_FUSED vunstream #-}+vunstream s = vmunstream (Bundle.lift s)++-- | Create a new mutable vector and fill it with elements from the monadic+-- stream. The vector will grow exponentially if the maximum size of the stream+-- is unknown.+vmunstream :: (PrimMonad m, V.Vector v a)+           => MBundle m v a -> m (V.Mutable v (PrimState m) a)+{-# INLINE_FUSED vmunstream #-}+vmunstream s = case upperBound (MBundle.size s) of+               Just n  -> vmunstreamMax     s n+               Nothing -> vmunstreamUnknown s++-- FIXME: I can't think of how to prevent GHC from floating out+-- unstreamUnknown. That is bad because SpecConstr then generates two+-- specialisations: one for when it is called from unstream (it doesn't know+-- the shape of the vector) and one for when the vector has grown. To see the+-- problem simply compile this:+--+-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList+--+-- I'm not sure this still applies (19/04/2010)++vmunstreamMax :: (PrimMonad m, V.Vector v a)+              => MBundle m v a -> Int -> m (V.Mutable v (PrimState m) a)+{-# INLINE vmunstreamMax #-}+vmunstreamMax s n+  = do+      v <- INTERNAL_CHECK(checkLength) "munstreamMax" n+           $ unsafeNew n+      let {-# INLINE_INNER copyChunk #-}+          copyChunk i (Chunk m f) =+            INTERNAL_CHECK(checkSlice) "munstreamMax.copyChunk" i m (length v) $ do+              f (basicUnsafeSlice i m v)+              return (i+m)++      n' <- Stream.foldlM' copyChunk 0 (MBundle.chunks s)+      return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n+             $ unsafeSlice 0 n' v++vmunstreamUnknown :: (PrimMonad m, V.Vector v a)+                 => MBundle m v a -> m (V.Mutable v (PrimState m) a)+{-# INLINE vmunstreamUnknown #-}+vmunstreamUnknown s+  = do+      v <- unsafeNew 0+      (v', n) <- Stream.foldlM copyChunk (v,0) (MBundle.chunks s)+      return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v')+             $ unsafeSlice 0 n v'+  where+    {-# INLINE_INNER copyChunk #-}+    copyChunk (v,i) (Chunk n f)+      = do+          let j = i+n+          v' <- if basicLength v < j+                  then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v))+                  else return v+          INTERNAL_CHECK(checkSlice) "munstreamUnknown.copyChunk" i n (length v')+            $ f (basicUnsafeSlice i n v')+          return (v',j)+++++-- | Create a new mutable vector and fill it with elements from the 'Bundle' -- from right to left. The vector will grow exponentially if the maximum size--- of the 'Stream' is unknown.-unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)--- NOTE: replace INLINE_STREAM by INLINE? (also in unstream)-{-# INLINE_STREAM unstreamR #-}-unstreamR s = munstreamR (Stream.liftStream s)+-- of the 'Bundle' is unknown.+unstreamR :: (PrimMonad m, MVector v a)+          => Bundle u a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_FUSED by INLINE? (also in unstream)+{-# INLINE_FUSED unstreamR #-}+unstreamR s = munstreamR (Bundle.lift s)  -- | Create a new mutable vector and fill it with elements from the monadic -- stream from right to left. The vector will grow exponentially if the maximum -- size of the stream is unknown.-munstreamR :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)-{-# INLINE_STREAM munstreamR #-}-munstreamR s = case upperBound (MStream.size s) of+munstreamR :: (PrimMonad m, MVector v a)+           => MBundle m u a -> m (v (PrimState m) a)+{-# INLINE_FUSED munstreamR #-}+munstreamR s = case upperBound (MBundle.size s) of                Just n  -> munstreamRMax     s n                Nothing -> munstreamRUnknown s -munstreamRMax-  :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a)+munstreamRMax :: (PrimMonad m, MVector v a)+              => MBundle m u a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamRMax #-} munstreamRMax s n   = do@@ -383,17 +472,17 @@                       INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n                         $ unsafeWrite v i' x                       return i'-      i <- MStream.foldM' put n s+      i <- MBundle.foldM' put n s       return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n              $ unsafeSlice i (n-i) v -munstreamRUnknown-  :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+munstreamRUnknown :: (PrimMonad m, MVector v a)+                  => MBundle m u a -> m (v (PrimState m) a) {-# INLINE munstreamRUnknown #-} munstreamRUnknown s   = do       v <- unsafeNew 0-      (v', i) <- MStream.foldM put (v, 0) s+      (v', i) <- MBundle.foldM put (v, 0) s       let n = length v'       return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n              $ unsafeSlice i (n-i) v'@@ -481,7 +570,7 @@ -- Overlapping -- ----------- --- Check whether two vectors overlap.+-- | Check whether two vectors overlap. overlaps :: MVector v a => v s a -> v s a -> Bool {-# INLINE overlaps #-} overlaps = basicOverlaps@@ -493,7 +582,7 @@ new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) {-# INLINE new #-} new n = BOUNDS_CHECK(checkLength) "new" n-      $ unsafeNew n+      $ unsafeNew n >>= \v -> basicInitialize v >> return v  -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a)@@ -511,7 +600,7 @@ -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, MVector v a) => Int -> m a -> m (v (PrimState m) a) {-# INLINE replicateM #-}-replicateM n m = munstream (MStream.replicateM n m)+replicateM n m = munstream (MBundle.replicateM n m)  -- | Create a copy of a mutable vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a)@@ -530,27 +619,37 @@                 => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE grow #-} grow v by = BOUNDS_CHECK(checkLength) "grow" by-          $ unsafeGrow v by+          $ do vnew <- unsafeGrow v by+               basicInitialize $ basicUnsafeSlice (length v) by vnew+               return vnew  growFront :: (PrimMonad m, MVector v a)                 => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE growFront #-} growFront v by = BOUNDS_CHECK(checkLength) "growFront" by-               $ unsafeGrowFront v by+               $ do vnew <- unsafeGrowFront v by+                    basicInitialize $ basicUnsafeSlice 0 by vnew+                    return vnew +enlarge_delta :: MVector v a => v s a -> Int enlarge_delta v = max (length v) 1  -- | Grow a vector logarithmically enlarge :: (PrimMonad m, MVector v a)                 => v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE enlarge #-}-enlarge v = unsafeGrow v (enlarge_delta v)+enlarge v = do vnew <- unsafeGrow v by+               basicInitialize $ basicUnsafeSlice (length v) by vnew+               return vnew+  where+    by = enlarge_delta v  enlargeFront :: (PrimMonad m, MVector v a)                 => v (PrimState m) a -> m (v (PrimState m) a, Int) {-# INLINE enlargeFront #-} enlargeFront v = do                    v' <- unsafeGrowFront v by+                   basicInitialize $ basicUnsafeSlice 0 by v'                    return (v', by)   where     by = enlarge_delta v@@ -577,7 +676,7 @@ -- ------------------------  -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors. +-- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () {-# INLINE clear #-} clear = basicClear@@ -597,6 +696,12 @@ write v i x = BOUNDS_CHECK(checkIndex) "write" i (length v)             $ unsafeWrite v i x +-- | Modify the element at the given position.+modify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE modify #-}+modify v f i = BOUNDS_CHECK(checkIndex) "modify" i (length v)+             $ unsafeModify v f i+ -- | Swap the elements at the given positions. swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-}@@ -623,6 +728,13 @@ unsafeWrite v i x = UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v)                   $ basicUnsafeWrite v i x +-- | Modify the element at the given position. No bounds checks are performed.+unsafeModify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE unsafeModify #-}+unsafeModify v f i = UNSAFE_CHECK(checkIndex) "unsafeModify" i (length v)+                   $ basicUnsafeRead v i >>= \x ->+                     basicUnsafeWrite v i (f x)+ -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: (PrimMonad m, MVector v a)                 => v (PrimState m) a -> Int -> Int -> m ()@@ -667,7 +779,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length.--- +-- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -693,7 +805,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked.--- +-- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -710,9 +822,9 @@ -- ------------  accum :: (PrimMonad m, MVector v a)-        => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m ()+      => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () {-# INLINE accum #-}-accum f !v s = Stream.mapM_ upd s+accum f !v s = Bundle.mapM_ upd s   where     {-# INLINE_INNER upd #-}     upd (i,b) = do@@ -723,9 +835,9 @@     !n = length v  update :: (PrimMonad m, MVector v a)-                        => v (PrimState m) a -> Stream (Int, a) -> m ()+                        => v (PrimState m) a -> Bundle u (Int, a) -> m () {-# INLINE update #-}-update !v s = Stream.mapM_ upd s+update !v s = Bundle.mapM_ upd s   where     {-# INLINE_INNER upd #-}     upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n@@ -734,9 +846,9 @@     !n = length v  unsafeAccum :: (PrimMonad m, MVector v a)-            => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m ()+            => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () {-# INLINE unsafeAccum #-}-unsafeAccum f !v s = Stream.mapM_ upd s+unsafeAccum f !v s = Bundle.mapM_ upd s   where     {-# INLINE_INNER upd #-}     upd (i,b) = do@@ -747,9 +859,9 @@     !n = length v  unsafeUpdate :: (PrimMonad m, MVector v a)-                        => v (PrimState m) a -> Stream (Int, a) -> m ()+                        => v (PrimState m) a -> Bundle u (Int, a) -> m () {-# INLINE unsafeUpdate #-}-unsafeUpdate !v s = Stream.mapM_ upd s+unsafeUpdate !v s = Bundle.mapM_ upd s   where     {-# INLINE_INNER upd #-}     upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n@@ -795,16 +907,16 @@                                from_left (i+1) j                         else from_right i (j-1) -unstablePartitionStream :: (PrimMonad m, MVector v a)-        => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)-{-# INLINE unstablePartitionStream #-}-unstablePartitionStream f s-  = case upperBound (Stream.size s) of+unstablePartitionBundle :: (PrimMonad m, MVector v a)+        => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE unstablePartitionBundle #-}+unstablePartitionBundle f s+  = case upperBound (Bundle.size s) of       Just n  -> unstablePartitionMax f s n       Nothing -> partitionUnknown f s  unstablePartitionMax :: (PrimMonad m, MVector v a)-        => (a -> Bool) -> Stream a -> Int+        => (a -> Bool) -> Bundle u a -> Int         -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE unstablePartitionMax #-} unstablePartitionMax f s n@@ -819,20 +931,20 @@             | otherwise = do                             unsafeWrite v (j-1) x                             return (i, j-1)-                                -      (i,j) <- Stream.foldM' put (0, n) s++      (i,j) <- Bundle.foldM' put (0, n) s       return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) -partitionStream :: (PrimMonad m, MVector v a)-        => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)-{-# INLINE partitionStream #-}-partitionStream f s-  = case upperBound (Stream.size s) of+partitionBundle :: (PrimMonad m, MVector v a)+        => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE partitionBundle #-}+partitionBundle f s+  = case upperBound (Bundle.size s) of       Just n  -> partitionMax f s n       Nothing -> partitionUnknown f s  partitionMax :: (PrimMonad m, MVector v a)-  => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a)+  => (a -> Bool) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionMax #-} partitionMax f s n   = do@@ -848,9 +960,9 @@             | otherwise = let j' = j-1 in                           do                             unsafeWrite v j' x-                            return (i,j') -                            -      (i,j) <- Stream.foldM' put (0,n) s+                            return (i,j')++      (i,j) <- Bundle.foldM' put (0,n) s       INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j)         $ return ()       let l = unsafeSlice 0 i v@@ -859,13 +971,13 @@       return (l,r)  partitionUnknown :: (PrimMonad m, MVector v a)-        => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+        => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionUnknown #-} partitionUnknown f s   = do       v1 <- unsafeNew 0       v2 <- unsafeNew 0-      (v1', n1, v2', n2) <- Stream.foldM' put (v1, 0, v2, 0) s+      (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s       INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1')         $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2')         $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2')
+ Data/Vector/Generic/Mutable/Base.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-}+-- |+-- Module      : Data.Vector.Generic.Mutable.Base+-- Copyright   : (c) Roman Leshchinskiy 2008-2011+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+--+-- Class of mutable vectors+--++module Data.Vector.Generic.Mutable.Base (+  MVector(..)+) where++import Control.Monad.Primitive ( PrimMonad, PrimState )++-- Data.Vector.Internal.Check is unused+#define NOT_VECTOR_MODULE+#include "vector.h"++-- | Class of mutable vectors parametrised with a primitive state token.+--+class MVector v a where+  -- | Length of the mutable vector. This method should not be+  -- called directly, use 'length' instead.+  basicLength       :: v s a -> Int++  -- | Yield a part of the mutable vector without copying it. This method+  -- should not be called directly, use 'unsafeSlice' instead.+  basicUnsafeSlice :: Int  -- ^ starting index+                   -> Int  -- ^ length of the slice+                   -> v s a+                   -> v s a++  -- | Check whether two vectors overlap. This method should not be+  -- called directly, use 'overlaps' instead.+  basicOverlaps    :: v s a -> v s a -> Bool++  -- | Create a mutable vector of the given length. This method should not be+  -- called directly, use 'unsafeNew' instead.+  basicUnsafeNew   :: PrimMonad m => Int -> m (v (PrimState m) a)++  -- | Initialize a vector to a standard value. This is intended to be called as+  -- part of the safe new operation (and similar operations), to properly blank+  -- the newly allocated memory if necessary.+  --+  -- Vectors that are necessarily initialized as part of creation may implement+  -- this as a no-op.+  basicInitialize :: PrimMonad m => v (PrimState m) a -> m ()++  -- | Create a mutable vector of the given length and fill it with an+  -- initial value. This method should not be called directly, use+  -- 'replicate' instead.+  basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a)++  -- | Yield the element at the given position. This method should not be+  -- called directly, use 'unsafeRead' instead.+  basicUnsafeRead  :: PrimMonad m => v (PrimState m) a -> Int -> m a++  -- | Replace the element at the given position. This method should not be+  -- called directly, use 'unsafeWrite' instead.+  basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()++  -- | Reset all elements of the vector to some undefined value, clearing all+  -- references to external objects. This is usually a noop for unboxed+  -- vectors. This method should not be called directly, use 'clear' instead.+  basicClear       :: PrimMonad m => v (PrimState m) a -> m ()++  -- | Set all elements of the vector to the given value. This method should+  -- not be called directly, use 'set' instead.+  basicSet         :: PrimMonad m => v (PrimState m) a -> a -> m ()++  -- | Copy a vector. The two vectors may not overlap. This method should not+  -- be called directly, use 'unsafeCopy' instead.+  basicUnsafeCopy  :: PrimMonad m => v (PrimState m) a   -- ^ target+                                  -> v (PrimState m) a   -- ^ source+                                  -> m ()++  -- | Move the contents of a vector. The two vectors may overlap. This method+  -- should not be called directly, use 'unsafeMove' instead.+  basicUnsafeMove  :: PrimMonad m => v (PrimState m) a   -- ^ target+                                  -> v (PrimState m) a   -- ^ source+                                  -> m ()++  -- | Grow a vector by the given number of elements. This method should not be+  -- called directly, use 'unsafeGrow' instead.+  basicUnsafeGrow  :: PrimMonad m => v (PrimState m) a -> Int+                                                       -> m (v (PrimState m) a)++  {-# INLINE basicUnsafeReplicate #-}+  basicUnsafeReplicate n x+    = do+        v <- basicUnsafeNew n+        basicSet v x+        return v++  {-# INLINE basicClear #-}+  basicClear _ = return ()++  {-# INLINE basicSet #-}+  basicSet !v x+    | n == 0    = return ()+    | otherwise = do+                    basicUnsafeWrite v 0 x+                    do_set 1+    where+      !n = basicLength v++      do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v)+                                              (basicUnsafeSlice 0 i v)+                              do_set (2*i)+               | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v)+                                             (basicUnsafeSlice 0 (n-i) v)++  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy !dst !src = do_copy 0+    where+      !n = basicLength src++      do_copy i | i < n = do+                            x <- basicUnsafeRead src i+                            basicUnsafeWrite dst i x+                            do_copy (i+1)+                | otherwise = return ()++  {-# INLINE basicUnsafeMove #-}+  basicUnsafeMove !dst !src+    | basicOverlaps dst src = do+        srcCopy <- basicUnsafeNew (basicLength src)+        basicUnsafeCopy srcCopy src+        basicUnsafeCopy dst srcCopy+    | otherwise = basicUnsafeCopy dst src++  {-# INLINE basicUnsafeGrow #-}+  basicUnsafeGrow v by+    = do+        v' <- basicUnsafeNew (n+by)+        basicUnsafeCopy (basicUnsafeSlice 0 n v') v+        return v'+    where+      n = basicLength v+
Data/Vector/Generic/New.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, FlexibleContexts #-}+{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-}  -- | -- Module      : Data.Vector.Generic.New@@ -8,30 +8,33 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Purely functional interface to initialisation of mutable vectors --  module Data.Vector.Generic.New (-  New(..), create, run, runPrim, apply, modify, modifyWithStream,+  New(..), create, run, runPrim, apply, modify, modifyWithBundle,   unstream, transform, unstreamR, transformR,   slice, init, tail, take, drop,   unsafeSlice, unsafeInit, unsafeTail ) where  import qualified Data.Vector.Generic.Mutable as MVector-import           Data.Vector.Generic.Mutable ( MVector )  import           Data.Vector.Generic.Base ( Vector, Mutable ) -import           Data.Vector.Fusion.Stream ( Stream, MStream )-import qualified Data.Vector.Fusion.Stream as Stream+import           Data.Vector.Fusion.Bundle ( Bundle )+import qualified Data.Vector.Fusion.Bundle as Bundle+import           Data.Vector.Fusion.Stream.Monadic ( Stream )+import           Data.Vector.Fusion.Bundle.Size  import Control.Monad.Primitive import Control.Monad.ST ( ST ) import Control.Monad  ( liftM ) import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) +-- Data.Vector.Internal.Check is unused+#define NOT_VECTOR_MODULE #include "vector.h"  data New v a = New (forall s. ST s (Mutable v s a))@@ -56,117 +59,120 @@ {-# INLINE modify #-} modify f (New p) = New (do { v <- p; f v; return v }) -modifyWithStream :: (forall s. Mutable v s a -> Stream b -> ST s ())-                 -> New v a -> Stream b -> New v a-{-# INLINE_STREAM modifyWithStream #-}-modifyWithStream f (New p) s = s `seq` New (do { v <- p; f v s; return v })+modifyWithBundle :: (forall s. Mutable v s a -> Bundle u b -> ST s ())+                 -> New v a -> Bundle u b -> New v a+{-# INLINE_FUSED modifyWithBundle #-}+modifyWithBundle f (New p) s = s `seq` New (do { v <- p; f v s; return v }) -unstream :: Vector v a => Stream a -> New v a-{-# INLINE_STREAM unstream #-}-unstream s = s `seq` New (MVector.unstream s)+unstream :: Vector v a => Bundle v a -> New v a+{-# INLINE_FUSED unstream #-}+unstream s = s `seq` New (MVector.vunstream s) -transform :: Vector v a =>-        (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a-{-# INLINE_STREAM transform #-}-transform f (New p) = New (MVector.transform f =<< p)+transform+  :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a)+                -> (Size -> Size) -> New v a -> New v a+{-# INLINE_FUSED 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+  forall (f1 :: forall m. Monad m => Stream m a -> Stream m a)+         (f2 :: forall m. Monad m => Stream m a -> Stream m a)+         g1 g2 p .+  transform f1 g1 (transform f2 g2 p) = transform (f1 . f2) (g1 . g2) p  "transform/unstream [New]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         s.-  transform f (unstream s) = unstream (f s)+  forall (f :: forall m. Monad m => Stream m a -> Stream m a)+         g s.+  transform f g (unstream s) = unstream (Bundle.inplace f g s)  #-} - #-}  -unstreamR :: Vector v a => Stream a -> New v a-{-# INLINE_STREAM unstreamR #-}++unstreamR :: Vector v a => Bundle v a -> New v a+{-# INLINE_FUSED unstreamR #-} unstreamR s = s `seq` New (MVector.unstreamR s) -transformR :: Vector v a =>-        (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a-{-# INLINE_STREAM transformR #-}-transformR f (New p) = New (MVector.transformR f =<< p)+transformR+  :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a)+                -> (Size -> Size) -> New v a -> New v a+{-# INLINE_FUSED transformR #-}+transformR f _ (New p) = New (MVector.transformR f =<< p)  {-# RULES  "transformR/transformR [New]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         (g :: forall m. Monad m => MStream m a -> MStream m a)+  forall (f1 :: forall m. Monad m => Stream m a -> Stream m a)+         (f2 :: forall m. Monad m => Stream m a -> Stream m a)+         g1 g2          p .-  transformR f (transformR g p) = transformR (f . g) p+  transformR f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p  "transformR/unstreamR [New]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         s.-  transformR f (unstreamR s) = unstreamR (f s)+  forall (f :: forall m. Monad m => Stream m a -> Stream m a)+         g s.+  transformR f g (unstreamR s) = unstreamR (Bundle.inplace f g s)  #-} - #-} + slice :: Vector v a => Int -> Int -> New v a -> New v a-{-# INLINE_STREAM slice #-}+{-# INLINE_FUSED slice #-} slice i n m = apply (MVector.slice i n) m  init :: Vector v a => New v a -> New v a-{-# INLINE_STREAM init #-}+{-# INLINE_FUSED init #-} init m = apply MVector.init m  tail :: Vector v a => New v a -> New v a-{-# INLINE_STREAM tail #-}+{-# INLINE_FUSED tail #-} tail m = apply MVector.tail m  take :: Vector v a => Int -> New v a -> New v a-{-# INLINE_STREAM take #-}+{-# INLINE_FUSED take #-} take n m = apply (MVector.take n) m  drop :: Vector v a => Int -> New v a -> New v a-{-# INLINE_STREAM drop #-}+{-# INLINE_FUSED drop #-} drop n m = apply (MVector.drop n) m  unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a-{-# INLINE_STREAM unsafeSlice #-}+{-# INLINE_FUSED unsafeSlice #-} unsafeSlice i n m = apply (MVector.unsafeSlice i n) m  unsafeInit :: Vector v a => New v a -> New v a-{-# INLINE_STREAM unsafeInit #-}+{-# INLINE_FUSED unsafeInit #-} unsafeInit m = apply MVector.unsafeInit m  unsafeTail :: Vector v a => New v a -> New v a-{-# INLINE_STREAM unsafeTail #-}+{-# INLINE_FUSED unsafeTail #-} unsafeTail m = apply MVector.unsafeTail m  {-# RULES  "slice/unstream [New]" forall i n s.-  slice i n (unstream s) = unstream (Stream.slice i n s)+  slice i n (unstream s) = unstream (Bundle.slice i n s)  "init/unstream [New]" forall s.-  init (unstream s) = unstream (Stream.init s)+  init (unstream s) = unstream (Bundle.init s)  "tail/unstream [New]" forall s.-  tail (unstream s) = unstream (Stream.tail s)+  tail (unstream s) = unstream (Bundle.tail s)  "take/unstream [New]" forall n s.-  take n (unstream s) = unstream (Stream.take n s)+  take n (unstream s) = unstream (Bundle.take n s)  "drop/unstream [New]" forall n s.-  drop n (unstream s) = unstream (Stream.drop n s)+  drop n (unstream s) = unstream (Bundle.drop n s)  "unsafeSlice/unstream [New]" forall i n s.-  unsafeSlice i n (unstream s) = unstream (Stream.slice i n s)+  unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s)  "unsafeInit/unstream [New]" forall s.-  unsafeInit (unstream s) = unstream (Stream.init s)+  unsafeInit (unstream s) = unstream (Bundle.init s)  "unsafeTail/unstream [New]" forall s.-  unsafeTail (unstream s) = unstream (Stream.tail s)+  unsafeTail (unstream s) = unstream (Bundle.tail s)   #-} -  #-}+
Data/Vector/Internal/Check.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module      : Data.Vector.Internal.Check -- Copyright   : (c) Roman Leshchinskiy 2009@@ -37,12 +39,12 @@  (&&) :: Bool -> Bool -> Bool {-# INLINE (&&) #-}-False && x = False+False && _ = False True && x = x  (||) :: Bool -> Bool -> Bool {-# INLINE (||) #-}-True || x = True+True || _ = True False || x = x
Data/Vector/Mutable.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns,-             TypeFamilies  #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-}  -- | -- Module      : Data.Vector.Mutable@@ -9,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Mutable boxed vectors. -- @@ -41,8 +40,8 @@   clear,    -- * Accessing individual elements-  read, write, swap,-  unsafeRead, unsafeWrite, unsafeSwap,+  read, write, modify, swap,+  unsafeRead, unsafeWrite, unsafeModify, unsafeSwap,    -- * Modifying vectors @@ -55,8 +54,6 @@ import           Data.Primitive.Array import           Control.Monad.Primitive -import Control.DeepSeq ( NFData, rnf )- import Prelude hiding ( length, null, replicate, reverse, map, read,                         take, drop, splitAt, init, tail ) @@ -88,7 +85,7 @@   basicLength (MVector _ n _) = n    {-# INLINE basicUnsafeSlice #-}-  basicUnsafeSlice j m (MVector i n arr) = MVector (i+j) m arr+  basicUnsafeSlice j m (MVector i _ arr) = MVector (i+j) m arr    {-# INLINE basicOverlaps #-}   basicOverlaps (MVector i m arr1) (MVector j n arr2)@@ -103,6 +100,10 @@         arr <- newArray n uninitialised         return (MVector 0 n arr) +  {-# INLINE basicInitialize #-}+  -- initialization is unnecessary for boxed vectors+  basicInitialize _ = return ()+   {-# INLINE basicUnsafeReplicate #-}   basicUnsafeReplicate n x     = do@@ -110,15 +111,15 @@         return (MVector 0 n arr)    {-# INLINE basicUnsafeRead #-}-  basicUnsafeRead (MVector i n arr) j = readArray arr (i+j)+  basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j)    {-# INLINE basicUnsafeWrite #-}-  basicUnsafeWrite (MVector i n arr) j x = writeArray arr (i+j) x+  basicUnsafeWrite (MVector i _ arr) j x = writeArray arr (i+j) x    {-# INLINE basicUnsafeCopy #-}   basicUnsafeCopy (MVector i n dst) (MVector j _ src)     = copyMutableArray dst i src j n-  +   basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc)     = case n of         0 -> return ()@@ -254,7 +255,7 @@ -- Overlapping -- ----------- --- Check whether two vectors overlap.+-- | Check whether two vectors overlap. overlaps :: MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps@@ -310,7 +311,7 @@ -- ------------------------  -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors. +-- references to external objects. This is usually a noop for unboxed vectors. clear :: PrimMonad m => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear@@ -328,6 +329,11 @@ {-# INLINE write #-} write = G.write +-- | Modify the element at the given position.+modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE modify #-}+modify = G.modify+ -- | Swap the elements at the given positions. swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-}@@ -344,6 +350,11 @@ {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite +-- | Modify the element at the given position. No bounds checks are performed.+unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE unsafeModify #-}+unsafeModify = G.unsafeModify+ -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-}@@ -374,7 +385,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length.--- +-- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -386,7 +397,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked.--- +-- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied
Data/Vector/Primitive.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-}+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-}  -- | -- Module      : Data.Vector.Primitive@@ -8,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Unboxed vectors of primitive types. The use of this module is not -- recommended except in very special cases. Adaptive unboxed vectors defined -- in "Data.Vector.Unboxed" are significantly more flexible at no performance@@ -67,7 +67,7 @@   accum, accumulate_,   unsafeAccum, unsafeAccumulate_, -  -- ** Permutations +  -- ** Permutations   reverse, backpermute, unsafeBackpermute,    -- ** Safe destructive updates@@ -136,7 +136,7 @@  import qualified Data.Vector.Generic           as G import           Data.Vector.Primitive.Mutable ( MVector(..) )-import qualified Data.Vector.Fusion.Stream as Stream+import qualified Data.Vector.Fusion.Bundle as Bundle import           Data.Primitive.ByteArray import           Data.Primitive ( Prim, sizeOf ) @@ -160,8 +160,6 @@                         enumFromTo, enumFromThenTo,                         mapM, mapM_ ) -import qualified Prelude- import Data.Typeable ( Typeable ) import Data.Data     ( Data(..) ) import Text.Read     ( Read(..), readListPrecDefault )@@ -228,27 +226,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  xs == ys = Stream.eq (G.stream xs) (G.stream ys)+  xs == ys = Bundle.eq (G.stream xs) (G.stream ys)    {-# INLINE (/=) #-}-  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))+  xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))  -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Ord a) => Ord (Vector a) where   {-# INLINE compare #-}-  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)+  compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)    {-# INLINE (<) #-}-  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT+  xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT    {-# INLINE (<=) #-}-  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT+  xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT    {-# INLINE (>) #-}-  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT+  xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT    {-# INLINE (>=) #-}-  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+  xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT  instance Prim a => Monoid (Vector a) where   {-# INLINE mempty #-}@@ -634,7 +632,7 @@ -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Prim a => Vector a   -- ^ initial vector (of length @m@)-                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) +                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@)                 -> Vector a {-# INLINE (//) #-} (//) = (G.//)@@ -1208,7 +1206,7 @@ -- >         yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@--- +-- scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl@@ -1332,7 +1330,7 @@   :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy-           + -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()
Data/Vector/Primitive/Mutable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Primitive.Mutable@@ -8,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Mutable primitive vectors. -- @@ -40,8 +40,8 @@   clear,    -- * Accessing individual elements-  read, write, swap,-  unsafeRead, unsafeWrite, unsafeSwap,+  read, write, modify, swap,+  unsafeRead, unsafeWrite, unsafeModify, unsafeSwap,    -- * Modifying vectors @@ -52,6 +52,7 @@ import qualified Data.Vector.Generic.Mutable as G import           Data.Primitive.ByteArray import           Data.Primitive ( Prim, sizeOf )+import           Data.Word ( Word8 ) import           Control.Monad.Primitive import           Control.Monad ( liftM ) @@ -62,6 +63,8 @@  import Data.Typeable ( Typeable ) +-- Data.Vector.Internal.Check is unnecessary+#define NOT_VECTOR_MODULE #include "vector.h"  -- | Mutable vectors of primitive types.@@ -78,7 +81,7 @@  instance Prim a => G.MVector MVector a where   basicLength (MVector _ n _) = n-  basicUnsafeSlice j m (MVector i n arr)+  basicUnsafeSlice j m (MVector i _ arr)     = MVector (i+j) m arr    {-# INLINE basicOverlaps #-}@@ -89,21 +92,33 @@       between x y z = x >= y && x < z    {-# INLINE basicUnsafeNew #-}-  basicUnsafeNew n = MVector 0 n-                     `liftM` newByteArray (n * sizeOf (undefined :: a))+  basicUnsafeNew n+    | n < 0 = error $ "Primitive.basicUnsafeNew: negative length: " ++ show n+    | n > mx = error $ "Primitive.basicUnsafeNew: length to large: " ++ show n+    | otherwise = MVector 0 n `liftM` newByteArray (n * size)+    where+      size = sizeOf (undefined :: a)+      mx = maxBound `div` size :: Int +  {-# INLINE basicInitialize #-}+  basicInitialize (MVector off n v) =+      setByteArray v (off * size) (n * size) (0 :: Word8)+    where+      size = sizeOf (undefined :: a)++   {-# INLINE basicUnsafeRead #-}-  basicUnsafeRead (MVector i n arr) j = readByteArray arr (i+j)+  basicUnsafeRead (MVector i _ arr) j = readByteArray arr (i+j)    {-# INLINE basicUnsafeWrite #-}-  basicUnsafeWrite (MVector i n arr) j x = writeByteArray arr (i+j) x+  basicUnsafeWrite (MVector i _ arr) j x = writeByteArray arr (i+j) x    {-# INLINE basicUnsafeCopy #-}   basicUnsafeCopy (MVector i n dst) (MVector j _ src)     = copyMutableByteArray dst (i*sz) src (j*sz) (n*sz)     where       sz = sizeOf (undefined :: a)-  +   {-# INLINE basicUnsafeMove #-}   basicUnsafeMove (MVector i n dst) (MVector j _ src)     = moveByteArray dst (i*sz) src (j*sz) (n * sz)@@ -183,7 +198,7 @@ -- Overlapping -- ----------- --- Check whether two vectors overlap.+-- | Check whether two vectors overlap. overlaps :: Prim a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps@@ -224,7 +239,7 @@  -- | Grow a vector by the given number of elements. The number must be -- positive.-grow :: (PrimMonad m, Prim a)  +grow :: (PrimMonad m, Prim a)               => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow@@ -240,7 +255,7 @@ -- ------------------------  -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors. +-- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear@@ -258,6 +273,11 @@ {-# INLINE write #-} write = G.write +-- | Modify the element at the given position.+modify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE modify #-}+modify = G.modify+ -- | Swap the elements at the given positions. swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-}@@ -275,6 +295,11 @@ {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite +-- | Modify the element at the given position. No bounds checks are performed.+unsafeModify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE unsafeModify #-}+unsafeModify = G.unsafeModify+ -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap     :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m ()@@ -291,7 +316,7 @@  -- | Copy a vector. The two vectors must have the same length and may not -- overlap.-copy :: (PrimMonad m, Prim a) +copy :: (PrimMonad m, Prim a)                  => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy@@ -307,7 +332,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length.--- +-- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -319,7 +344,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked.--- +-- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied
Data/Vector/Storable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Storable@@ -8,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- 'Storable'-based vectors. -- @@ -64,7 +64,7 @@   accum, accumulate_,   unsafeAccum, unsafeAccumulate_, -  -- ** Permutations +  -- ** Permutations   reverse, backpermute, unsafeBackpermute,    -- ** Safe destructive updates@@ -139,7 +139,7 @@ import qualified Data.Vector.Generic          as G import           Data.Vector.Storable.Mutable ( MVector(..) ) import Data.Vector.Storable.Internal-import qualified Data.Vector.Fusion.Stream as Stream+import qualified Data.Vector.Fusion.Bundle as Bundle  import Foreign.Storable import Foreign.ForeignPtr@@ -165,8 +165,6 @@                         enumFromTo, enumFromThenTo,                         mapM, mapM_ ) -import qualified Prelude- import Data.Typeable ( Typeable ) import Data.Data     ( Data(..) ) import Text.Read     ( Read(..), readListPrecDefault )@@ -177,6 +175,8 @@ import qualified GHC.Exts as Exts #endif +-- Data.Vector.Internal.Check is unused+#define NOT_VECTOR_MODULE #include "vector.h"  -- | 'Storable'-based vectors@@ -235,27 +235,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  xs == ys = Stream.eq (G.stream xs) (G.stream ys)+  xs == ys = Bundle.eq (G.stream xs) (G.stream ys)    {-# INLINE (/=) #-}-  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))+  xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))  -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Ord a) => Ord (Vector a) where   {-# INLINE compare #-}-  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)+  compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)    {-# INLINE (<) #-}-  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT+  xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT    {-# INLINE (<=) #-}-  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT+  xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT    {-# INLINE (>) #-}-  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT+  xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT    {-# INLINE (>=) #-}-  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+  xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT  instance Storable a => Monoid (Vector a) where   {-# INLINE mempty #-}@@ -642,7 +642,7 @@ -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Storable a => Vector a   -- ^ initial vector (of length @m@)-                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) +                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@)                 -> Vector a {-# INLINE (//) #-} (//) = (G.//)@@ -1226,7 +1226,7 @@ -- >         yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@--- +-- scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl@@ -1369,7 +1369,7 @@   :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy-           + -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()@@ -1389,16 +1389,16 @@                      -> Int             -- ^ offset                      -> Int             -- ^ length                      -> Vector a-{-# INLINE unsafeFromForeignPtr #-}+{-# INLINE_FUSED unsafeFromForeignPtr #-} unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n     where       fp' = updPtr (`advancePtr` i) fp  {-# RULES "unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n.-  unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n-  #-}+  unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n   #-} + -- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. -- -- It is assumed the pointer points directly to the data (no offset).@@ -1431,6 +1431,6 @@ -- modified through the 'Ptr. unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-}-unsafeWith (Vector n fp) = withForeignPtr fp+unsafeWith (Vector _ fp) = withForeignPtr fp
Data/Vector/Storable/Internal.hs view
@@ -6,7 +6,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Ugly internal utility functions for implementing 'Storable'-based vectors. -- @@ -14,12 +14,8 @@   getPtr, setPtr, updPtr ) where -import Control.Monad.Primitive ( unsafeInlineIO )-import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr-import Foreign.Marshal.Array ( advancePtr )-import GHC.Base         ( quotInt ) import GHC.ForeignPtr   ( ForeignPtr(..) ) import GHC.Ptr          ( Ptr(..) )
Data/Vector/Storable/Mutable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Storable.Mutable@@ -8,7 +8,7 @@ -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable--- +-- -- Mutable vectors based on Storable. -- @@ -40,8 +40,8 @@   clear,    -- * Accessing individual elements-  read, write, swap,-  unsafeRead, unsafeWrite, unsafeSwap,+  read, write, modify, swap,+  unsafeRead, unsafeWrite, unsafeModify, unsafeSwap,    -- * Modifying vectors @@ -71,7 +71,6 @@  import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )-import Foreign.C.Types ( CInt )  import Control.Monad.Primitive import Data.Primitive.Addr@@ -85,6 +84,8 @@  import Data.Typeable ( Typeable ) +-- Data.Vector.Internal.Check is not needed+#define NOT_VECTOR_MODULE #include "vector.h"  -- | Mutable 'Storable'-based vectors@@ -103,7 +104,7 @@   basicLength (MVector n _) = n    {-# INLINE basicUnsafeSlice #-}-  basicUnsafeSlice j m (MVector n fp) = MVector m (updPtr (`advancePtr` j) fp)+  basicUnsafeSlice j m (MVector _ fp) = MVector m (updPtr (`advancePtr` j) fp)    -- FIXME: this relies on non-portable pointer comparisons   {-# INLINE basicOverlaps #-}@@ -116,11 +117,18 @@    {-# INLINE basicUnsafeNew #-}   basicUnsafeNew n-    = unsafePrimToPrim-    $ do+    | n < 0 = error $ "Storable.basicUnsafeNew: negative length: " ++ show n+    | n > mx = error $ "Storable.basicUnsafeNew: length too large: " ++ show n+    | otherwise = unsafePrimToPrim $ do         fp <- mallocVector n         return $ MVector n fp+    where+      size = sizeOf (undefined :: a)+      mx = maxBound `quot` size :: Int +  {-# INLINE basicInitialize #-}+  basicInitialize = storableZero+   {-# INLINE basicUnsafeRead #-}   basicUnsafeRead (MVector _ fp) i     = unsafePrimToPrim@@ -140,7 +148,7 @@     $ withForeignPtr fp $ \p ->       withForeignPtr fq $ \q ->       copyArray p q n-  +   {-# INLINE basicUnsafeMove #-}   basicUnsafeMove (MVector n fp) (MVector _ fq)     = unsafePrimToPrim@@ -148,9 +156,21 @@       withForeignPtr fq $ \q ->       moveArray p q n +storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m ()+{-# INLINE storableZero #-}+storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \(Ptr p) -> do+  let q = Addr p+  setAddr q byteSize (0 :: Word8)+ where+ x :: a+ x = undefined++ byteSize :: Int+ byteSize = n * sizeOf x+ storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m () {-# INLINE storableSet #-}-storableSet v@(MVector n fp) x+storableSet (MVector n fp) x   | n == 0 = return ()   | otherwise = unsafePrimToPrim $                 case sizeOf x of@@ -260,7 +280,7 @@ -- Overlapping -- ----------- --- Check whether two vectors overlap.+-- | Check whether two vectors overlap. overlaps :: Storable a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps@@ -301,7 +321,7 @@  -- | Grow a vector by the given number of elements. The number must be -- positive.-grow :: (PrimMonad m, Storable a)  +grow :: (PrimMonad m, Storable a)               => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow@@ -317,7 +337,7 @@ -- ------------------------  -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors. +-- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear@@ -336,6 +356,11 @@ {-# INLINE write #-} write = G.write +-- | Modify the element at the given position.+modify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE modify #-}+modify = G.modify+ -- | Swap the elements at the given positions. swap     :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m ()@@ -354,6 +379,11 @@ {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite +-- | Modify the element at the given position. No bounds checks are performed.+unsafeModify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE unsafeModify #-}+unsafeModify = G.unsafeModify+ -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap     :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m ()@@ -370,7 +400,7 @@  -- | Copy a vector. The two vectors must have the same length and may not -- overlap.-copy :: (PrimMonad m, Storable a) +copy :: (PrimMonad m, Storable a)                  => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy@@ -386,7 +416,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length.--- +-- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -398,7 +428,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked.--- +-- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -441,16 +471,16 @@                      -> Int             -- ^ offset                      -> Int             -- ^ length                      -> MVector s a-{-# INLINE unsafeFromForeignPtr #-}+{-# INLINE_FUSED unsafeFromForeignPtr #-} unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n     where       fp' = updPtr (`advancePtr` i) fp  {-# RULES "unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n.-  unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n-  #-}+  unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n   #-} + -- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. -- -- It is assumed the pointer points directly to the data (no offset).@@ -487,5 +517,5 @@ -- the modification. unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-}-unsafeWith (MVector n fp) = withForeignPtr fp+unsafeWith (MVector _ fp) = withForeignPtr fp
Data/Vector/Unboxed.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, TypeFamilies #-}+{-# LANGUAGE CPP, Rank2Types, TypeFamilies #-}  -- | -- Module      : Data.Vector.Unboxed@@ -87,7 +87,7 @@   accum, accumulate, accumulate_,   unsafeAccum, unsafeAccumulate, unsafeAccumulate_, -  -- ** Permutations +  -- ** Permutations   reverse, backpermute, unsafeBackpermute,    -- ** Safe destructive updates@@ -102,7 +102,7 @@   map, imap, concatMap,    -- ** Monadic mapping-  mapM, mapM_, forM, forM_,+  mapM, imapM, mapM_, imapM_, forM, forM_,    -- ** Zipping   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,@@ -110,7 +110,7 @@   zip, zip3, zip4, zip5, zip6,    -- ** Monadic zipping-  zipWithM, zipWithM_,+  zipWithM, izipWithM, zipWithM_, izipWithM_,    -- ** Unzipping   unzip, unzip3, unzip4, unzip5, unzip6,@@ -138,8 +138,9 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- ** Monadic folds-  foldM, foldM', fold1M, fold1M',-  foldM_, foldM'_, fold1M_, fold1M'_,+  foldM, ifoldM, foldM', ifoldM',+  fold1M, fold1M', foldM_, ifoldM_,+  foldM'_, ifoldM'_, fold1M_, fold1M'_,    -- * Prefix sums (scans)   prescanl, prescanl',@@ -163,7 +164,7 @@  import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic as G-import qualified Data.Vector.Fusion.Stream as Stream+import qualified Data.Vector.Fusion.Bundle as Bundle import Data.Vector.Fusion.Util ( delayed_min )  import Control.Monad.ST ( ST )@@ -182,7 +183,6 @@                         scanl, scanl1, scanr, scanr1,                         enumFromTo, enumFromThenTo,                         mapM, mapM_ )-import qualified Prelude  import Text.Read     ( Read(..), readListPrecDefault ) @@ -192,32 +192,33 @@ import qualified GHC.Exts as Exts (IsList(..)) #endif +#define NOT_VECTOR_MODULE #include "vector.h"  -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  xs == ys = Stream.eq (G.stream xs) (G.stream ys)+  xs == ys = Bundle.eq (G.stream xs) (G.stream ys)    {-# INLINE (/=) #-}-  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))+  xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))  -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Ord a) => Ord (Vector a) where   {-# INLINE compare #-}-  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)+  compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)    {-# INLINE (<) #-}-  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT+  xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT    {-# INLINE (<=) #-}-  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT+  xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT    {-# INLINE (>) #-}-  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT+  xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT    {-# INLINE (>=) #-}-  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+  xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT  instance Unbox a => Monoid (Vector a) where   {-# INLINE mempty #-}@@ -610,7 +611,7 @@ -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Unbox a => Vector a   -- ^ initial vector (of length @m@)-                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) +                -> [(Int, a)] -- ^ list of index/value pairs (of length @n@)                 -> Vector a {-# INLINE (//) #-} (//) = (G.//)@@ -799,12 +800,25 @@ {-# INLINE mapM #-} mapM = G.mapM +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, yielding a vector of results+imapM :: (Monad m, Unbox a, Unbox b)+      => (Int -> a -> m b) -> Vector a -> m (Vector b)+{-# INLINE imapM #-}+imapM = G.imapM+ -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Unbox a) => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ +-- | /O(n)/ Apply the monadic action to every element of a vector and its+-- index, ignoring the results+imapM_ :: (Monad m, Unbox a) => (Int -> a -> m b) -> Vector a -> m ()+{-# INLINE imapM_ #-}+imapM_ = G.imapM_+ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b)@@ -896,6 +910,13 @@ {-# INLINE zipWithM #-} zipWithM = G.zipWithM +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and yield a vector of results+izipWithM :: (Monad m, Unbox a, Unbox b, Unbox c)+         => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE izipWithM #-}+izipWithM = G.izipWithM+ -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Unbox a, Unbox b)@@ -903,6 +924,13 @@ {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes+-- the element index and ignore the results+izipWithM_ :: (Monad m, Unbox a, Unbox b)+          => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE izipWithM_ #-}+izipWithM_ = G.izipWithM_+ -- Filtering -- --------- @@ -1165,6 +1193,11 @@ {-# INLINE foldM #-} foldM = G.foldM +-- | /O(n)/ Monadic fold (action applied to each element and its index)+ifoldM :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a+{-# INLINE ifoldM #-}+ifoldM = G.ifoldM+ -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-}@@ -1175,6 +1208,12 @@ {-# INLINE foldM' #-} foldM' = G.foldM' +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each+-- element and its index)+ifoldM' :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a+{-# INLINE ifoldM' #-}+ifoldM' = G.ifoldM'+ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-}@@ -1185,6 +1224,12 @@ {-# INLINE foldM_ #-} foldM_ = G.foldM_ +-- | /O(n)/ Monadic fold that discards the result (action applied to each+-- element and its index)+ifoldM_ :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m ()+{-# INLINE ifoldM_ #-}+ifoldM_ = G.ifoldM_+ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-}@@ -1195,6 +1240,13 @@ {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ +-- | /O(n)/ Monadic fold with strict accumulator that discards the result+-- (action applied to each element and its index)+ifoldM'_ :: (Monad m, Unbox b)+         => (a -> Int -> b -> m a) -> a -> Vector b -> m ()+{-# INLINE ifoldM'_ #-}+ifoldM'_ = G.ifoldM'_+ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m ()@@ -1245,7 +1297,7 @@ -- >         yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@--- +-- scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl@@ -1369,7 +1421,7 @@   :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy-           + -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()
Data/Vector/Unboxed/Base.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE BangPatterns, CPP, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif@@ -48,6 +48,8 @@  import Data.Data     ( Data(..) ) +-- Data.Vector.Internal.Check is unused+#define NOT_VECTOR_MODULE #include "vector.h"  data family MVector s a@@ -104,6 +106,7 @@   {-# INLINE basicUnsafeSlice #-}   {-# INLINE basicOverlaps #-}   {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicInitialize #-}   {-# INLINE basicUnsafeRead #-}   {-# INLINE basicUnsafeWrite #-}   {-# INLINE basicClear #-}@@ -113,12 +116,15 @@    basicLength (MV_Unit n) = n -  basicUnsafeSlice i m (MV_Unit n) = MV_Unit m+  basicUnsafeSlice _ m (MV_Unit _) = MV_Unit m    basicOverlaps _ _ = False    basicUnsafeNew n = return (MV_Unit n) +  -- Nothing to initialize+  basicInitialize _ = return ()+   basicUnsafeRead (MV_Unit _) _ = return ()    basicUnsafeWrite (MV_Unit _) _ () = return ()@@ -142,10 +148,10 @@   basicLength (V_Unit n) = n    {-# INLINE basicUnsafeSlice #-}-  basicUnsafeSlice i m (V_Unit n) = V_Unit m+  basicUnsafeSlice _ m (V_Unit _) = V_Unit m    {-# INLINE basicUnsafeIndexM #-}-  basicUnsafeIndexM (V_Unit _) i = return ()+  basicUnsafeIndexM (V_Unit _) _ = return ()    {-# INLINE basicUnsafeCopy #-}   basicUnsafeCopy (MV_Unit _) (V_Unit _) = return ()@@ -164,6 +170,7 @@ ; {-# INLINE basicUnsafeSlice #-}                                       \ ; {-# INLINE basicOverlaps #-}                                          \ ; {-# INLINE basicUnsafeNew #-}                                         \+; {-# INLINE basicInitialize #-}                                        \ ; {-# INLINE basicUnsafeReplicate #-}                                   \ ; {-# INLINE basicUnsafeRead #-}                                        \ ; {-# INLINE basicUnsafeWrite #-}                                       \@@ -175,6 +182,7 @@ ; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v         \ ; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2               \ ; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n                     \+; basicInitialize (con v) = M.basicInitialize v                         \ ; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x     \ ; basicUnsafeRead (con v) i = M.basicUnsafeRead v i                     \ ; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x               \@@ -305,6 +313,7 @@   {-# INLINE basicUnsafeSlice #-}   {-# INLINE basicOverlaps #-}   {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicInitialize #-}   {-# INLINE basicUnsafeReplicate #-}   {-# INLINE basicUnsafeRead #-}   {-# INLINE basicUnsafeWrite #-}@@ -316,6 +325,7 @@   basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v   basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2   basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n+  basicInitialize (MV_Bool v) = M.basicInitialize v   basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x)   basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i   basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x)@@ -354,6 +364,7 @@   {-# INLINE basicUnsafeSlice #-}   {-# INLINE basicOverlaps #-}   {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicInitialize #-}   {-# INLINE basicUnsafeReplicate #-}   {-# INLINE basicUnsafeRead #-}   {-# INLINE basicUnsafeWrite #-}@@ -365,6 +376,7 @@   basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v   basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2   basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n+  basicInitialize (MV_Complex v) = M.basicInitialize v   basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y)   basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i   basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y)
Data/Vector/Unboxed/Mutable.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module      : Data.Vector.Unboxed.Mutable -- Copyright   : (c) Roman Leshchinskiy 2009-2010@@ -42,8 +44,8 @@   unzip, unzip3, unzip4, unzip5, unzip6,    -- * Accessing individual elements-  read, write, swap,-  unsafeRead, unsafeWrite, unsafeSwap,+  read, write, modify, swap,+  unsafeRead, unsafeWrite, unsafeModify, unsafeSwap,    -- * Modifying vectors @@ -60,6 +62,8 @@                         take, drop, splitAt, init, tail,                         zip, zip3, unzip, unzip3 ) +-- don't import an unused Data.Vector.Internal.Check+#define NOT_VECTOR_MODULE #include "vector.h"  -- Length information@@ -132,7 +136,7 @@ -- Overlapping -- ----------- --- Check whether two vectors overlap.+-- | Check whether two vectors overlap. overlaps :: Unbox a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps@@ -173,7 +177,7 @@  -- | Grow a vector by the given number of elements. The number must be -- positive.-grow :: (PrimMonad m, Unbox a)  +grow :: (PrimMonad m, Unbox a)               => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow@@ -189,7 +193,7 @@ -- ------------------------  -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors. +-- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear@@ -207,6 +211,11 @@ {-# INLINE write #-} write = G.write +-- | Modify the element at the given position.+modify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE modify #-}+modify = G.modify+ -- | Swap the elements at the given positions. swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-}@@ -224,6 +233,11 @@ {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite +-- | Modify the element at the given position. No bounds checks are performed.+unsafeModify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()+{-# INLINE unsafeModify #-}+unsafeModify = G.unsafeModify+ -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap     :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m ()@@ -240,7 +254,7 @@  -- | Copy a vector. The two vectors must have the same length and may not -- overlap.-copy :: (PrimMonad m, Unbox a) +copy :: (PrimMonad m, Unbox a)                  => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy@@ -256,7 +270,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length.--- +-- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied@@ -268,7 +282,7 @@  -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked.--- +-- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied
README.md view
@@ -1,4 +1,6 @@-# The vector package+The `vector` package [![Build Status](https://travis-ci.org/haskell/vector.png?branch=master)](https://travis-ci.org/haskell/vector)+==================== -An efficient implementation of Int-indexed arrays (both mutable and-immutable), with a powerful loop optimisation framework.+An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework.++See [`vector` on Hackage](http://hackage.haskell.org/package/vector) for more information.
benchmarks/vector-benchmarks.cabal view
@@ -1,5 +1,5 @@ Name:           vector-benchmarks-Version:        0.10.0.1+Version:        0.10.9 License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -14,7 +14,7 @@   Build-Depends: base >= 2 && < 5, array,                  criterion >= 0.5 && < 0.7,                  mwc-random >= 0.5 && < 0.13,-                 vector == 0.10.0.1+                 vector == 0.10.9    if impl(ghc<6.13)     Ghc-Options: -finline-if-enough-args -fno-method-sharing
changelog view
@@ -1,3 +1,13 @@+Changes in version 0.11.0.0++ * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}`+ * Define non-bottom `fail` for `instance Monad Vector`+ * New generalized stream fusion framework+ * Various safety fixes+   - Various overflows due to vector size have been eliminated+   - Memory is initialized on creation of unboxed vectors+ * Changes to SPEC usage to allow building under more conditions+ Changes in version 0.10.12.3   * Allow building with `primtive-0.6`
include/vector.h view
@@ -1,8 +1,8 @@-#define PHASE_STREAM [1]-#define PHASE_INNER  [0]+#define PHASE_FUSED [1]+#define PHASE_INNER [0] -#define INLINE_STREAM INLINE PHASE_STREAM-#define INLINE_INNER  INLINE PHASE_INNER+#define INLINE_FUSED INLINE PHASE_FUSED+#define INLINE_INNER INLINE PHASE_INNER  #ifndef NOT_VECTOR_MODULE import qualified Data.Vector.Internal.Check as Ck@@ -16,4 +16,6 @@ #define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe) #define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal) +#define PHASE_STREAM  Please use "PHASE_FUSED" instead+#define INLINE_STREAM Please use "INLINE_FUSED" instead
internal/GenUnboxTuple.hs view
@@ -59,7 +59,7 @@                   <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars])                   <+> text "->"                   <+> text ty <+> tuple vars-             ,text "{-# INLINE_STREAM"  <+> name <+> text "#-}"+             ,text "{-# INLINE_FUSED"  <+> name <+> text "#-}"              ,name <+> sep varss                    <+> text "="                    <+> con c@@ -84,7 +84,7 @@              2 $              text "G.stream" <+> parens (name "zip" <+> sep varss)              <+> char '='-             <+> text "Stream." <> name "zipWith" <+> tuple (replicate n empty)+             <+> text "Bundle." <> name "zipWith" <+> tuple (replicate n empty)              <+> sep [parens $ text "G.stream" <+> vs | vs <- varss]              $$ text "#-}"      where
internal/unbox-tuple-instances view
@@ -8,13 +8,13 @@ instance (Unbox a, Unbox b) => Unbox (a, b) instance (Unbox a, Unbox b) => M.MVector MVector (a, b) where   {-# INLINE basicLength  #-}-  basicLength (MV_2 n_ as bs) = n_+  basicLength (MV_2 n_ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (MV_2 n_ as bs)+  basicUnsafeSlice i_ m_ (MV_2 _ as bs)       = MV_2 m_ (M.basicUnsafeSlice i_ m_ as)                 (M.basicUnsafeSlice i_ m_ bs)   {-# INLINE basicOverlaps  #-}-  basicOverlaps (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2)+  basicOverlaps (MV_2 _ as1 bs1) (MV_2 _ as2 bs2)       = M.basicOverlaps as1 as2         || M.basicOverlaps bs1 bs2   {-# INLINE basicUnsafeNew  #-}@@ -23,6 +23,11 @@           as <- M.basicUnsafeNew n_           bs <- M.basicUnsafeNew n_           return $ MV_2 n_ as bs+  {-# INLINE basicInitialize  #-}+  basicInitialize (MV_2 _ as bs)+      = do+          M.basicInitialize as+          M.basicInitialize bs   {-# INLINE basicUnsafeReplicate  #-}   basicUnsafeReplicate n_ (a, b)       = do@@ -30,33 +35,33 @@           bs <- M.basicUnsafeReplicate n_ b           return $ MV_2 n_ as bs   {-# INLINE basicUnsafeRead  #-}-  basicUnsafeRead (MV_2 n_ as bs) i_+  basicUnsafeRead (MV_2 _ as bs) i_       = do           a <- M.basicUnsafeRead as i_           b <- M.basicUnsafeRead bs i_           return (a, b)   {-# INLINE basicUnsafeWrite  #-}-  basicUnsafeWrite (MV_2 n_ as bs) i_ (a, b)+  basicUnsafeWrite (MV_2 _ as bs) i_ (a, b)       = do           M.basicUnsafeWrite as i_ a           M.basicUnsafeWrite bs i_ b   {-# INLINE basicClear  #-}-  basicClear (MV_2 n_ as bs)+  basicClear (MV_2 _ as bs)       = do           M.basicClear as           M.basicClear bs   {-# INLINE basicSet  #-}-  basicSet (MV_2 n_ as bs) (a, b)+  basicSet (MV_2 _ as bs) (a, b)       = do           M.basicSet as a           M.basicSet bs b   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2)+  basicUnsafeCopy (MV_2 _ as1 bs1) (MV_2 _ as2 bs2)       = do           M.basicUnsafeCopy as1 as2           M.basicUnsafeCopy bs1 bs2   {-# INLINE basicUnsafeMove  #-}-  basicUnsafeMove (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2)+  basicUnsafeMove (MV_2 _ as1 bs1) (MV_2 _ as2 bs2)       = do           M.basicUnsafeMove as1 as2           M.basicUnsafeMove bs1 bs2@@ -80,19 +85,19 @@           bs' <- G.basicUnsafeThaw bs           return $ MV_2 n_ as' bs'   {-# INLINE basicLength  #-}-  basicLength (V_2 n_ as bs) = n_+  basicLength (V_2 n_ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (V_2 n_ as bs)+  basicUnsafeSlice i_ m_ (V_2 _ as bs)       = V_2 m_ (G.basicUnsafeSlice i_ m_ as)                (G.basicUnsafeSlice i_ m_ bs)   {-# INLINE basicUnsafeIndexM  #-}-  basicUnsafeIndexM (V_2 n_ as bs) i_+  basicUnsafeIndexM (V_2 _ as bs) i_       = do           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_           return (a, b)   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_2 n_1 as1 bs1) (V_2 n_2 as2 bs2)+  basicUnsafeCopy (MV_2 _ as1 bs1) (V_2 _ as2 bs2)       = do           G.basicUnsafeCopy as1 as2           G.basicUnsafeCopy bs1 bs2@@ -105,30 +110,30 @@ -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => MVector s a ->                              MVector s b -> MVector s (a, b)-{-# INLINE_STREAM zip #-}+{-# INLINE_FUSED zip #-} zip as bs = MV_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs)   where len = length as `delayed_min` length bs -- | /O(1)/ Unzip 2 vectors unzip :: (Unbox a, Unbox b) => MVector s (a, b) -> (MVector s a,                                                     MVector s b) {-# INLINE unzip #-}-unzip (MV_2 n_ as bs) = (as, bs)+unzip (MV_2 _ as bs) = (as, bs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b)-{-# INLINE_STREAM zip #-}+{-# INLINE_FUSED zip #-} zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs)   where len = length as `delayed_min` length bs {-# RULES "stream/zip [Vector.Unboxed]" forall as bs .-  G.stream (zip as bs) = Stream.zipWith (,) (G.stream as)-                                            (G.stream bs)-  #-}+  G.stream (zip as bs) = Bundle.zipWith (,) (G.stream as)+                                            (G.stream bs)   #-}+ -- | /O(1)/ Unzip 2 vectors unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a,                                                  Vector b) {-# INLINE unzip #-}-unzip (V_2 n_ as bs) = (as, bs)+unzip (V_2 _ as bs) = (as, bs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c)@@ -144,14 +149,14 @@           Unbox b,           Unbox c) => M.MVector MVector (a, b, c) where   {-# INLINE basicLength  #-}-  basicLength (MV_3 n_ as bs cs) = n_+  basicLength (MV_3 n_ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (MV_3 n_ as bs cs)+  basicUnsafeSlice i_ m_ (MV_3 _ as bs cs)       = MV_3 m_ (M.basicUnsafeSlice i_ m_ as)                 (M.basicUnsafeSlice i_ m_ bs)                 (M.basicUnsafeSlice i_ m_ cs)   {-# INLINE basicOverlaps  #-}-  basicOverlaps (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2)+  basicOverlaps (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2)       = M.basicOverlaps as1 as2         || M.basicOverlaps bs1 bs2         || M.basicOverlaps cs1 cs2@@ -162,6 +167,12 @@           bs <- M.basicUnsafeNew n_           cs <- M.basicUnsafeNew n_           return $ MV_3 n_ as bs cs+  {-# INLINE basicInitialize #-}+  basicInitialize (MV_3 _ as bs cs)+      = do+          M.basicInitialize as+          M.basicInitialize bs+          M.basicInitialize cs   {-# INLINE basicUnsafeReplicate  #-}   basicUnsafeReplicate n_ (a, b, c)       = do@@ -170,38 +181,38 @@           cs <- M.basicUnsafeReplicate n_ c           return $ MV_3 n_ as bs cs   {-# INLINE basicUnsafeRead  #-}-  basicUnsafeRead (MV_3 n_ as bs cs) i_+  basicUnsafeRead (MV_3 _ as bs cs) i_       = do           a <- M.basicUnsafeRead as i_           b <- M.basicUnsafeRead bs i_           c <- M.basicUnsafeRead cs i_           return (a, b, c)   {-# INLINE basicUnsafeWrite  #-}-  basicUnsafeWrite (MV_3 n_ as bs cs) i_ (a, b, c)+  basicUnsafeWrite (MV_3 _ as bs cs) i_ (a, b, c)       = do           M.basicUnsafeWrite as i_ a           M.basicUnsafeWrite bs i_ b           M.basicUnsafeWrite cs i_ c   {-# INLINE basicClear  #-}-  basicClear (MV_3 n_ as bs cs)+  basicClear (MV_3 _ as bs cs)       = do           M.basicClear as           M.basicClear bs           M.basicClear cs   {-# INLINE basicSet  #-}-  basicSet (MV_3 n_ as bs cs) (a, b, c)+  basicSet (MV_3 _ as bs cs) (a, b, c)       = do           M.basicSet as a           M.basicSet bs b           M.basicSet cs c   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2)+  basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2)       = do           M.basicUnsafeCopy as1 as2           M.basicUnsafeCopy bs1 bs2           M.basicUnsafeCopy cs1 cs2   {-# INLINE basicUnsafeMove  #-}-  basicUnsafeMove (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2)+  basicUnsafeMove (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2)       = do           M.basicUnsafeMove as1 as2           M.basicUnsafeMove bs1 bs2@@ -231,21 +242,21 @@           cs' <- G.basicUnsafeThaw cs           return $ MV_3 n_ as' bs' cs'   {-# INLINE basicLength  #-}-  basicLength (V_3 n_ as bs cs) = n_+  basicLength (V_3 n_ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (V_3 n_ as bs cs)+  basicUnsafeSlice i_ m_ (V_3 _ as bs cs)       = V_3 m_ (G.basicUnsafeSlice i_ m_ as)                (G.basicUnsafeSlice i_ m_ bs)                (G.basicUnsafeSlice i_ m_ cs)   {-# INLINE basicUnsafeIndexM  #-}-  basicUnsafeIndexM (V_3 n_ as bs cs) i_+  basicUnsafeIndexM (V_3 _ as bs cs) i_       = do           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_           c <- G.basicUnsafeIndexM cs i_           return (a, b, c)   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (V_3 n_2 as2 bs2 cs2)+  basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (V_3 _ as2 bs2 cs2)       = do           G.basicUnsafeCopy as1 as2           G.basicUnsafeCopy bs1 bs2@@ -261,7 +272,7 @@ zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a ->                                        MVector s b ->                                        MVector s c -> MVector s (a, b, c)-{-# INLINE_STREAM zip3 #-}+{-# INLINE_FUSED zip3 #-} zip3 as bs cs = MV_3 len (unsafeSlice 0 len as)                          (unsafeSlice 0 len bs)                          (unsafeSlice 0 len cs)@@ -274,30 +285,30 @@                                                MVector s b,                                                MVector s c) {-# INLINE unzip3 #-}-unzip3 (MV_3 n_ as bs cs) = (as, bs, cs)+unzip3 (MV_3 _ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 3 vectors zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a ->                                        Vector b ->                                        Vector c -> Vector (a, b, c)-{-# INLINE_STREAM zip3 #-}+{-# INLINE_FUSED zip3 #-} zip3 as bs cs = V_3 len (unsafeSlice 0 len as)                         (unsafeSlice 0 len bs)                         (unsafeSlice 0 len cs)   where     len = length as `delayed_min` length bs `delayed_min` length cs {-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs .-  G.stream (zip3 as bs cs) = Stream.zipWith3 (, ,) (G.stream as)+  G.stream (zip3 as bs cs) = Bundle.zipWith3 (, ,) (G.stream as)                                                    (G.stream bs)-                                                   (G.stream cs)-  #-}+                                                   (G.stream cs)   #-}+ -- | /O(1)/ Unzip 3 vectors unzip3 :: (Unbox a,            Unbox b,            Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) {-# INLINE unzip3 #-}-unzip3 (V_3 n_ as bs cs) = (as, bs, cs)+unzip3 (V_3 _ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d)@@ -316,15 +327,15 @@           Unbox c,           Unbox d) => M.MVector MVector (a, b, c, d) where   {-# INLINE basicLength  #-}-  basicLength (MV_4 n_ as bs cs ds) = n_+  basicLength (MV_4 n_ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (MV_4 n_ as bs cs ds)+  basicUnsafeSlice i_ m_ (MV_4 _ as bs cs ds)       = MV_4 m_ (M.basicUnsafeSlice i_ m_ as)                 (M.basicUnsafeSlice i_ m_ bs)                 (M.basicUnsafeSlice i_ m_ cs)                 (M.basicUnsafeSlice i_ m_ ds)   {-# INLINE basicOverlaps  #-}-  basicOverlaps (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2 bs2 cs2 ds2)+  basicOverlaps (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 bs2 cs2 ds2)       = M.basicOverlaps as1 as2         || M.basicOverlaps bs1 bs2         || M.basicOverlaps cs1 cs2@@ -337,6 +348,13 @@           cs <- M.basicUnsafeNew n_           ds <- M.basicUnsafeNew n_           return $ MV_4 n_ as bs cs ds+  {-# INLINE basicInitialize #-}+  basicInitialize (MV_4 _ as bs cs ds)+      = do+          M.basicInitialize as+          M.basicInitialize bs+          M.basicInitialize cs+          M.basicInitialize ds   {-# INLINE basicUnsafeReplicate  #-}   basicUnsafeReplicate n_ (a, b, c, d)       = do@@ -346,7 +364,7 @@           ds <- M.basicUnsafeReplicate n_ d           return $ MV_4 n_ as bs cs ds   {-# INLINE basicUnsafeRead  #-}-  basicUnsafeRead (MV_4 n_ as bs cs ds) i_+  basicUnsafeRead (MV_4 _ as bs cs ds) i_       = do           a <- M.basicUnsafeRead as i_           b <- M.basicUnsafeRead bs i_@@ -354,41 +372,41 @@           d <- M.basicUnsafeRead ds i_           return (a, b, c, d)   {-# INLINE basicUnsafeWrite  #-}-  basicUnsafeWrite (MV_4 n_ as bs cs ds) i_ (a, b, c, d)+  basicUnsafeWrite (MV_4 _ as bs cs ds) i_ (a, b, c, d)       = do           M.basicUnsafeWrite as i_ a           M.basicUnsafeWrite bs i_ b           M.basicUnsafeWrite cs i_ c           M.basicUnsafeWrite ds i_ d   {-# INLINE basicClear  #-}-  basicClear (MV_4 n_ as bs cs ds)+  basicClear (MV_4 _ as bs cs ds)       = do           M.basicClear as           M.basicClear bs           M.basicClear cs           M.basicClear ds   {-# INLINE basicSet  #-}-  basicSet (MV_4 n_ as bs cs ds) (a, b, c, d)+  basicSet (MV_4 _ as bs cs ds) (a, b, c, d)       = do           M.basicSet as a           M.basicSet bs b           M.basicSet cs c           M.basicSet ds d   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2-                                                       bs2-                                                       cs2-                                                       ds2)+  basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2+                                                   bs2+                                                   cs2+                                                   ds2)       = do           M.basicUnsafeCopy as1 as2           M.basicUnsafeCopy bs1 bs2           M.basicUnsafeCopy cs1 cs2           M.basicUnsafeCopy ds1 ds2   {-# INLINE basicUnsafeMove  #-}-  basicUnsafeMove (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2-                                                       bs2-                                                       cs2-                                                       ds2)+  basicUnsafeMove (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2+                                                   bs2+                                                   cs2+                                                   ds2)       = do           M.basicUnsafeMove as1 as2           M.basicUnsafeMove bs1 bs2@@ -423,15 +441,15 @@           ds' <- G.basicUnsafeThaw ds           return $ MV_4 n_ as' bs' cs' ds'   {-# INLINE basicLength  #-}-  basicLength (V_4 n_ as bs cs ds) = n_+  basicLength (V_4 n_ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (V_4 n_ as bs cs ds)+  basicUnsafeSlice i_ m_ (V_4 _ as bs cs ds)       = V_4 m_ (G.basicUnsafeSlice i_ m_ as)                (G.basicUnsafeSlice i_ m_ bs)                (G.basicUnsafeSlice i_ m_ cs)                (G.basicUnsafeSlice i_ m_ ds)   {-# INLINE basicUnsafeIndexM  #-}-  basicUnsafeIndexM (V_4 n_ as bs cs ds) i_+  basicUnsafeIndexM (V_4 _ as bs cs ds) i_       = do           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_@@ -439,10 +457,10 @@           d <- G.basicUnsafeIndexM ds i_           return (a, b, c, d)   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (V_4 n_2 as2-                                                      bs2-                                                      cs2-                                                      ds2)+  basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (V_4 _ as2+                                                  bs2+                                                  cs2+                                                  ds2)       = do           G.basicUnsafeCopy as1 as2           G.basicUnsafeCopy bs1 bs2@@ -461,7 +479,7 @@                                                 MVector s b ->                                                 MVector s c ->                                                 MVector s d -> MVector s (a, b, c, d)-{-# INLINE_STREAM zip4 #-}+{-# INLINE_FUSED zip4 #-} zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as)                             (unsafeSlice 0 len bs)                             (unsafeSlice 0 len cs)@@ -480,7 +498,7 @@                                                   MVector s c,                                                   MVector s d) {-# INLINE unzip4 #-}-unzip4 (MV_4 n_ as bs cs ds) = (as, bs, cs, ds)+unzip4 (MV_4 _ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 4 vectors@@ -488,7 +506,7 @@                                                 Vector b ->                                                 Vector c ->                                                 Vector d -> Vector (a, b, c, d)-{-# INLINE_STREAM zip4 #-}+{-# INLINE_FUSED zip4 #-} zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as)                            (unsafeSlice 0 len bs)                            (unsafeSlice 0 len cs)@@ -499,11 +517,11 @@           length cs `delayed_min`           length ds {-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds .-  G.stream (zip4 as bs cs ds) = Stream.zipWith4 (, , ,) (G.stream as)+  G.stream (zip4 as bs cs ds) = Bundle.zipWith4 (, , ,) (G.stream as)                                                         (G.stream bs)                                                         (G.stream cs)-                                                        (G.stream ds)-  #-}+                                                        (G.stream ds)   #-}+ -- | /O(1)/ Unzip 4 vectors unzip4 :: (Unbox a,            Unbox b,@@ -513,7 +531,7 @@                                                Vector c,                                                Vector d) {-# INLINE unzip4 #-}-unzip4 (V_4 n_ as bs cs ds) = (as, bs, cs, ds)+unzip4 (V_4 _ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e)@@ -539,20 +557,20 @@           Unbox d,           Unbox e) => M.MVector MVector (a, b, c, d, e) where   {-# INLINE basicLength  #-}-  basicLength (MV_5 n_ as bs cs ds es) = n_+  basicLength (MV_5 n_ _ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (MV_5 n_ as bs cs ds es)+  basicUnsafeSlice i_ m_ (MV_5 _ as bs cs ds es)       = MV_5 m_ (M.basicUnsafeSlice i_ m_ as)                 (M.basicUnsafeSlice i_ m_ bs)                 (M.basicUnsafeSlice i_ m_ cs)                 (M.basicUnsafeSlice i_ m_ ds)                 (M.basicUnsafeSlice i_ m_ es)   {-# INLINE basicOverlaps  #-}-  basicOverlaps (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2-                                                         bs2-                                                         cs2-                                                         ds2-                                                         es2)+  basicOverlaps (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2+                                                     bs2+                                                     cs2+                                                     ds2+                                                     es2)       = M.basicOverlaps as1 as2         || M.basicOverlaps bs1 bs2         || M.basicOverlaps cs1 cs2@@ -567,6 +585,14 @@           ds <- M.basicUnsafeNew n_           es <- M.basicUnsafeNew n_           return $ MV_5 n_ as bs cs ds es+  {-# INLINE basicInitialize #-}+  basicInitialize (MV_5 _ as bs cs ds es)+      = do+          M.basicInitialize as+          M.basicInitialize bs+          M.basicInitialize cs+          M.basicInitialize ds+          M.basicInitialize es   {-# INLINE basicUnsafeReplicate  #-}   basicUnsafeReplicate n_ (a, b, c, d, e)       = do@@ -577,7 +603,7 @@           es <- M.basicUnsafeReplicate n_ e           return $ MV_5 n_ as bs cs ds es   {-# INLINE basicUnsafeRead  #-}-  basicUnsafeRead (MV_5 n_ as bs cs ds es) i_+  basicUnsafeRead (MV_5 _ as bs cs ds es) i_       = do           a <- M.basicUnsafeRead as i_           b <- M.basicUnsafeRead bs i_@@ -586,7 +612,7 @@           e <- M.basicUnsafeRead es i_           return (a, b, c, d, e)   {-# INLINE basicUnsafeWrite  #-}-  basicUnsafeWrite (MV_5 n_ as bs cs ds es) i_ (a, b, c, d, e)+  basicUnsafeWrite (MV_5 _ as bs cs ds es) i_ (a, b, c, d, e)       = do           M.basicUnsafeWrite as i_ a           M.basicUnsafeWrite bs i_ b@@ -594,7 +620,7 @@           M.basicUnsafeWrite ds i_ d           M.basicUnsafeWrite es i_ e   {-# INLINE basicClear  #-}-  basicClear (MV_5 n_ as bs cs ds es)+  basicClear (MV_5 _ as bs cs ds es)       = do           M.basicClear as           M.basicClear bs@@ -602,7 +628,7 @@           M.basicClear ds           M.basicClear es   {-# INLINE basicSet  #-}-  basicSet (MV_5 n_ as bs cs ds es) (a, b, c, d, e)+  basicSet (MV_5 _ as bs cs ds es) (a, b, c, d, e)       = do           M.basicSet as a           M.basicSet bs b@@ -610,11 +636,11 @@           M.basicSet ds d           M.basicSet es e   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2-                                                           bs2-                                                           cs2-                                                           ds2-                                                           es2)+  basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2+                                                       bs2+                                                       cs2+                                                       ds2+                                                       es2)       = do           M.basicUnsafeCopy as1 as2           M.basicUnsafeCopy bs1 bs2@@ -622,11 +648,11 @@           M.basicUnsafeCopy ds1 ds2           M.basicUnsafeCopy es1 es2   {-# INLINE basicUnsafeMove  #-}-  basicUnsafeMove (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2-                                                           bs2-                                                           cs2-                                                           ds2-                                                           es2)+  basicUnsafeMove (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2+                                                       bs2+                                                       cs2+                                                       ds2+                                                       es2)       = do           M.basicUnsafeMove as1 as2           M.basicUnsafeMove bs1 bs2@@ -666,16 +692,16 @@           es' <- G.basicUnsafeThaw es           return $ MV_5 n_ as' bs' cs' ds' es'   {-# INLINE basicLength  #-}-  basicLength (V_5 n_ as bs cs ds es) = n_+  basicLength (V_5 n_ _ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (V_5 n_ as bs cs ds es)+  basicUnsafeSlice i_ m_ (V_5 _ as bs cs ds es)       = V_5 m_ (G.basicUnsafeSlice i_ m_ as)                (G.basicUnsafeSlice i_ m_ bs)                (G.basicUnsafeSlice i_ m_ cs)                (G.basicUnsafeSlice i_ m_ ds)                (G.basicUnsafeSlice i_ m_ es)   {-# INLINE basicUnsafeIndexM  #-}-  basicUnsafeIndexM (V_5 n_ as bs cs ds es) i_+  basicUnsafeIndexM (V_5 _ as bs cs ds es) i_       = do           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_@@ -684,11 +710,11 @@           e <- G.basicUnsafeIndexM es i_           return (a, b, c, d, e)   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (V_5 n_2 as2-                                                          bs2-                                                          cs2-                                                          ds2-                                                          es2)+  basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (V_5 _ as2+                                                      bs2+                                                      cs2+                                                      ds2+                                                      es2)       = do           G.basicUnsafeCopy as1 as2           G.basicUnsafeCopy bs1 bs2@@ -714,7 +740,7 @@                      MVector s c ->                      MVector s d ->                      MVector s e -> MVector s (a, b, c, d, e)-{-# INLINE_STREAM zip5 #-}+{-# INLINE_FUSED zip5 #-} zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as)                                (unsafeSlice 0 len bs)                                (unsafeSlice 0 len cs)@@ -737,7 +763,7 @@                                                      MVector s d,                                                      MVector s e) {-# INLINE unzip5 #-}-unzip5 (MV_5 n_ as bs cs ds es) = (as, bs, cs, ds, es)+unzip5 (MV_5 _ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 5 vectors@@ -750,7 +776,7 @@                      Vector c ->                      Vector d ->                      Vector e -> Vector (a, b, c, d, e)-{-# INLINE_STREAM zip5 #-}+{-# INLINE_FUSED zip5 #-} zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as)                               (unsafeSlice 0 len bs)                               (unsafeSlice 0 len cs)@@ -767,12 +793,12 @@                  bs                  cs                  ds-                 es) = Stream.zipWith5 (, , , ,) (G.stream as)+                 es) = Bundle.zipWith5 (, , , ,) (G.stream as)                                                  (G.stream bs)                                                  (G.stream cs)                                                  (G.stream ds)-                                                 (G.stream es)-  #-}+                                                 (G.stream es)   #-}+ -- | /O(1)/ Unzip 5 vectors unzip5 :: (Unbox a,            Unbox b,@@ -784,7 +810,7 @@                                                   Vector d,                                                   Vector e) {-# INLINE unzip5 #-}-unzip5 (V_5 n_ as bs cs ds es) = (as, bs, cs, ds, es)+unzip5 (V_5 _ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e, f)@@ -814,9 +840,9 @@           Unbox e,           Unbox f) => M.MVector MVector (a, b, c, d, e, f) where   {-# INLINE basicLength  #-}-  basicLength (MV_6 n_ as bs cs ds es fs) = n_+  basicLength (MV_6 n_ _ _ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (MV_6 n_ as bs cs ds es fs)+  basicUnsafeSlice i_ m_ (MV_6 _ as bs cs ds es fs)       = MV_6 m_ (M.basicUnsafeSlice i_ m_ as)                 (M.basicUnsafeSlice i_ m_ bs)                 (M.basicUnsafeSlice i_ m_ cs)@@ -824,12 +850,12 @@                 (M.basicUnsafeSlice i_ m_ es)                 (M.basicUnsafeSlice i_ m_ fs)   {-# INLINE basicOverlaps  #-}-  basicOverlaps (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2-                                                             bs2-                                                             cs2-                                                             ds2-                                                             es2-                                                             fs2)+  basicOverlaps (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2+                                                         bs2+                                                         cs2+                                                         ds2+                                                         es2+                                                         fs2)       = M.basicOverlaps as1 as2         || M.basicOverlaps bs1 bs2         || M.basicOverlaps cs1 cs2@@ -846,6 +872,15 @@           es <- M.basicUnsafeNew n_           fs <- M.basicUnsafeNew n_           return $ MV_6 n_ as bs cs ds es fs+  {-# INLINE basicInitialize #-}+  basicInitialize (MV_6 _ as bs cs ds es fs)+      = do+          M.basicInitialize as+          M.basicInitialize bs+          M.basicInitialize cs+          M.basicInitialize ds+          M.basicInitialize es+          M.basicInitialize fs   {-# INLINE basicUnsafeReplicate  #-}   basicUnsafeReplicate n_ (a, b, c, d, e, f)       = do@@ -857,7 +892,7 @@           fs <- M.basicUnsafeReplicate n_ f           return $ MV_6 n_ as bs cs ds es fs   {-# INLINE basicUnsafeRead  #-}-  basicUnsafeRead (MV_6 n_ as bs cs ds es fs) i_+  basicUnsafeRead (MV_6 _ as bs cs ds es fs) i_       = do           a <- M.basicUnsafeRead as i_           b <- M.basicUnsafeRead bs i_@@ -867,7 +902,7 @@           f <- M.basicUnsafeRead fs i_           return (a, b, c, d, e, f)   {-# INLINE basicUnsafeWrite  #-}-  basicUnsafeWrite (MV_6 n_ as bs cs ds es fs) i_ (a, b, c, d, e, f)+  basicUnsafeWrite (MV_6 _ as bs cs ds es fs) i_ (a, b, c, d, e, f)       = do           M.basicUnsafeWrite as i_ a           M.basicUnsafeWrite bs i_ b@@ -876,7 +911,7 @@           M.basicUnsafeWrite es i_ e           M.basicUnsafeWrite fs i_ f   {-# INLINE basicClear  #-}-  basicClear (MV_6 n_ as bs cs ds es fs)+  basicClear (MV_6 _ as bs cs ds es fs)       = do           M.basicClear as           M.basicClear bs@@ -885,7 +920,7 @@           M.basicClear es           M.basicClear fs   {-# INLINE basicSet  #-}-  basicSet (MV_6 n_ as bs cs ds es fs) (a, b, c, d, e, f)+  basicSet (MV_6 _ as bs cs ds es fs) (a, b, c, d, e, f)       = do           M.basicSet as a           M.basicSet bs b@@ -894,12 +929,12 @@           M.basicSet es e           M.basicSet fs f   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2-                                                               bs2-                                                               cs2-                                                               ds2-                                                               es2-                                                               fs2)+  basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2+                                                           bs2+                                                           cs2+                                                           ds2+                                                           es2+                                                           fs2)       = do           M.basicUnsafeCopy as1 as2           M.basicUnsafeCopy bs1 bs2@@ -908,12 +943,12 @@           M.basicUnsafeCopy es1 es2           M.basicUnsafeCopy fs1 fs2   {-# INLINE basicUnsafeMove  #-}-  basicUnsafeMove (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2-                                                               bs2-                                                               cs2-                                                               ds2-                                                               es2-                                                               fs2)+  basicUnsafeMove (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2+                                                           bs2+                                                           cs2+                                                           ds2+                                                           es2+                                                           fs2)       = do           M.basicUnsafeMove as1 as2           M.basicUnsafeMove bs1 bs2@@ -958,9 +993,9 @@           fs' <- G.basicUnsafeThaw fs           return $ MV_6 n_ as' bs' cs' ds' es' fs'   {-# INLINE basicLength  #-}-  basicLength (V_6 n_ as bs cs ds es fs) = n_+  basicLength (V_6 n_ _ _ _ _ _ _) = n_   {-# INLINE basicUnsafeSlice  #-}-  basicUnsafeSlice i_ m_ (V_6 n_ as bs cs ds es fs)+  basicUnsafeSlice i_ m_ (V_6 _ as bs cs ds es fs)       = V_6 m_ (G.basicUnsafeSlice i_ m_ as)                (G.basicUnsafeSlice i_ m_ bs)                (G.basicUnsafeSlice i_ m_ cs)@@ -968,7 +1003,7 @@                (G.basicUnsafeSlice i_ m_ es)                (G.basicUnsafeSlice i_ m_ fs)   {-# INLINE basicUnsafeIndexM  #-}-  basicUnsafeIndexM (V_6 n_ as bs cs ds es fs) i_+  basicUnsafeIndexM (V_6 _ as bs cs ds es fs) i_       = do           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_@@ -978,12 +1013,12 @@           f <- G.basicUnsafeIndexM fs i_           return (a, b, c, d, e, f)   {-# INLINE basicUnsafeCopy  #-}-  basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (V_6 n_2 as2-                                                              bs2-                                                              cs2-                                                              ds2-                                                              es2-                                                              fs2)+  basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (V_6 _ as2+                                                          bs2+                                                          cs2+                                                          ds2+                                                          es2+                                                          fs2)       = do           G.basicUnsafeCopy as1 as2           G.basicUnsafeCopy bs1 bs2@@ -1013,7 +1048,7 @@                      MVector s d ->                      MVector s e ->                      MVector s f -> MVector s (a, b, c, d, e, f)-{-# INLINE_STREAM zip6 #-}+{-# INLINE_FUSED zip6 #-} zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as)                                   (unsafeSlice 0 len bs)                                   (unsafeSlice 0 len cs)@@ -1040,7 +1075,7 @@                                                         MVector s e,                                                         MVector s f) {-# INLINE unzip6 #-}-unzip6 (MV_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs)+unzip6 (MV_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 6 vectors@@ -1055,7 +1090,7 @@                      Vector d ->                      Vector e ->                      Vector f -> Vector (a, b, c, d, e, f)-{-# INLINE_STREAM zip6 #-}+{-# INLINE_FUSED zip6 #-} zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as)                                  (unsafeSlice 0 len bs)                                  (unsafeSlice 0 len cs)@@ -1075,13 +1110,13 @@                  cs                  ds                  es-                 fs) = Stream.zipWith6 (, , , , ,) (G.stream as)+                 fs) = Bundle.zipWith6 (, , , , ,) (G.stream as)                                                    (G.stream bs)                                                    (G.stream cs)                                                    (G.stream ds)                                                    (G.stream es)-                                                   (G.stream fs)-  #-}+                                                   (G.stream fs)   #-}+ -- | /O(1)/ Unzip 6 vectors unzip6 :: (Unbox a,            Unbox b,@@ -1095,5 +1130,5 @@                                                      Vector e,                                                      Vector f) {-# INLINE unzip6 #-}-unzip6 (V_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs)+unzip6 (V_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif
tests/Main.hs view
@@ -1,12 +1,12 @@ module Main (main) where  import qualified Tests.Vector-import qualified Tests.Stream+import qualified Tests.Bundle import qualified Tests.Move  import Test.Framework (defaultMain) -main = defaultMain $ Tests.Stream.tests+main = defaultMain $ Tests.Bundle.tests                   ++ Tests.Vector.tests                   ++ Tests.Move.tests
+ tests/Tests/Bundle.hs view
@@ -0,0 +1,163 @@+module Tests.Bundle ( tests ) where++import Boilerplater+import Utilities++import qualified Data.Vector.Fusion.Bundle as S++import Test.QuickCheck++import Test.Framework+import Test.Framework.Providers.QuickCheck2++import Text.Show.Functions ()+import Data.List           (foldl', foldl1', unfoldr, find, findIndex)+import System.Random       (Random)++#define COMMON_CONTEXT(a) \+ VANILLA_CONTEXT(a)++#define VANILLA_CONTEXT(a) \+  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property++testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]+testSanity _ = [+        testProperty "fromList.toList == id" prop_fromList_toList,+        testProperty "toList.fromList == id" prop_toList_fromList+    ]+  where+    prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a)+        = (S.fromList . S.toList) `eq` id+    prop_toList_fromList :: P ([a] -> [a])+        = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id++testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]+testPolymorphicFunctions _ = $(testProperties [+        'prop_eq,++        'prop_length, 'prop_null,++        'prop_empty, 'prop_singleton, 'prop_replicate,+        'prop_cons, 'prop_snoc, 'prop_append,++        'prop_head, 'prop_last, 'prop_index,++        'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,++        'prop_map, 'prop_zipWith, 'prop_zipWith3,+        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,++        'prop_elem, 'prop_notElem,+        'prop_find, 'prop_findIndex,++        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',+        'prop_foldr, 'prop_foldr1,++        'prop_prescanl, 'prop_prescanl',+        'prop_postscanl, 'prop_postscanl',+        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',++        'prop_concatMap,+        'prop_unfoldr+    ])+  where+    -- Prelude+    prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==)++    prop_length :: P (S.Bundle v a -> Int)     = S.length `eq` length+    prop_null   :: P (S.Bundle v a -> Bool)    = S.null `eq` null+    prop_empty  :: P (S.Bundle v a)            = S.empty `eq` []+    prop_singleton :: P (a -> S.Bundle v a)    = S.singleton `eq` singleton+    prop_replicate :: P (Int -> a -> S.Bundle v a)+              = (\n _ -> n < 1000) ===> S.replicate `eq` replicate+    prop_cons      :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:)+    prop_snoc      :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc+    prop_append    :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++)++    prop_head      :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head+    prop_last      :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last+    prop_index        = \xs ->+                        not (S.null xs) ==>+                        forAll (choose (0, S.length xs-1)) $ \i ->+                        unP prop xs i+      where+        prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!)++    prop_extract      = \xs ->+                        forAll (choose (0, S.length xs))     $ \i ->+                        forAll (choose (0, S.length xs - i)) $ \n ->+                        unP prop i n xs+      where+        prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice++    prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail+    prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init+    prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take+    prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop++    prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map+    prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith+    prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a)+             = S.zipWith3 `eq` zipWith3++    prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter+    prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile+    prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile++    prop_elem    :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem+    prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem+    prop_find    :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find+    prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int)+      = S.findIndex `eq` findIndex++    prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl+    prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>+                        S.foldl1 `eq` foldl1+    prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl'+    prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>+                        S.foldl1' `eq` foldl1'+    prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr+    prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>+                        S.foldr1 `eq` foldr1++    prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+                = S.prescanl `eq` prescanl+    prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+                = S.prescanl' `eq` prescanl+    prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+                = S.postscanl `eq` postscanl+    prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+                = S.postscanl' `eq` postscanl+    prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+                = S.scanl `eq` scanl+    prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)+               = S.scanl' `eq` scanl+    prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>+                 S.scanl1 `eq` scanl1+    prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>+                 S.scanl1' `eq` scanl1+ +    prop_concatMap    = forAll arbitrary $ \xs ->+                        forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs+      where+        prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap++    limitUnfolds f (theirs, ours) | ours >= 0+                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+                                  | otherwise                       = Nothing+    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a)+         = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))+           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))++testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]+testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ])+  where+    prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and+    prop_or  :: P (S.Bundle v Bool -> Bool) = S.or `eq` or++testBundleFunctions = testSanity (undefined :: S.Bundle v Int)+                      ++ testPolymorphicFunctions (undefined :: S.Bundle v Int)+                      ++ testBoolFunctions (undefined :: S.Bundle v Bool)++tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ]+
tests/Tests/Move.hs view
@@ -4,7 +4,6 @@ import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck.Property (Property(..)) - import Utilities ()  import qualified Data.Vector.Generic as G@@ -28,7 +27,6 @@   expected <- return $ basicMove v dstOff srcOff len   actual <- return $  G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v   unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual))-  tests =     [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property),
− tests/Tests/Stream.hs 
@@ -1,163 +0,0 @@-module Tests.Stream ( tests ) where--import Boilerplater-import Utilities--import qualified Data.Vector.Fusion.Stream as S--import Test.QuickCheck--import Test.Framework-import Test.Framework.Providers.QuickCheck2--import Text.Show.Functions ()-import Data.List           (foldl', foldl1', unfoldr, find, findIndex)-import System.Random       (Random)--#define COMMON_CONTEXT(a) \- VANILLA_CONTEXT(a)--#define VANILLA_CONTEXT(a) \-  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property--testSanity :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]-testSanity _ = [-        testProperty "fromList.toList == id" prop_fromList_toList,-        testProperty "toList.fromList == id" prop_toList_fromList-    ]-  where-    prop_fromList_toList :: P (S.Stream a -> S.Stream a)-        = (S.fromList . S.toList) `eq` id-    prop_toList_fromList :: P ([a] -> [a])-        = (S.toList . (S.fromList :: [a] -> S.Stream a)) `eq` id--testPolymorphicFunctions :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]-testPolymorphicFunctions _ = $(testProperties [-        'prop_eq,--        'prop_length, 'prop_null,--        'prop_empty, 'prop_singleton, 'prop_replicate,-        'prop_cons, 'prop_snoc, 'prop_append,--        'prop_head, 'prop_last, 'prop_index,--        'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,--        'prop_map, 'prop_zipWith, 'prop_zipWith3,-        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,--        'prop_elem, 'prop_notElem,-        'prop_find, 'prop_findIndex,--        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',-        'prop_foldr, 'prop_foldr1,--        'prop_prescanl, 'prop_prescanl',-        'prop_postscanl, 'prop_postscanl',-        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',--        'prop_concatMap,-        'prop_unfoldr-    ])-  where-    -- Prelude-    prop_eq :: P (S.Stream a -> S.Stream a -> Bool) = (==) `eq` (==)--    prop_length :: P (S.Stream a -> Int)     = S.length `eq` length-    prop_null   :: P (S.Stream a -> Bool)    = S.null `eq` null-    prop_empty  :: P (S.Stream a)            = S.empty `eq` []-    prop_singleton :: P (a -> S.Stream a)    = S.singleton `eq` singleton-    prop_replicate :: P (Int -> a -> S.Stream a)-              = (\n _ -> n < 1000) ===> S.replicate `eq` replicate-    prop_cons      :: P (a -> S.Stream a -> S.Stream a) = S.cons `eq` (:)-    prop_snoc      :: P (S.Stream a -> a -> S.Stream a) = S.snoc `eq` snoc-    prop_append    :: P (S.Stream a -> S.Stream a -> S.Stream a) = (S.++) `eq` (++)--    prop_head      :: P (S.Stream a -> a) = not . S.null ===> S.head `eq` head-    prop_last      :: P (S.Stream a -> a) = not . S.null ===> S.last `eq` last-    prop_index        = \xs ->-                        not (S.null xs) ==>-                        forAll (choose (0, S.length xs-1)) $ \i ->-                        unP prop xs i-      where-        prop :: P (S.Stream a -> Int -> a) = (S.!!) `eq` (!!)--    prop_extract      = \xs ->-                        forAll (choose (0, S.length xs))     $ \i ->-                        forAll (choose (0, S.length xs - i)) $ \n ->-                        unP prop i n xs-      where-        prop :: P (Int -> Int -> S.Stream a -> S.Stream a) = S.slice `eq` slice--    prop_tail :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.tail `eq` tail-    prop_init :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.init `eq` init-    prop_take :: P (Int -> S.Stream a -> S.Stream a) = S.take `eq` take-    prop_drop :: P (Int -> S.Stream a -> S.Stream a) = S.drop `eq` drop--    prop_map :: P ((a -> a) -> S.Stream a -> S.Stream a) = S.map `eq` map-    prop_zipWith :: P ((a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a) = S.zipWith `eq` zipWith-    prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a -> S.Stream a)-             = S.zipWith3 `eq` zipWith3--    prop_filter :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.filter `eq` filter-    prop_takeWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.takeWhile `eq` takeWhile-    prop_dropWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.dropWhile `eq` dropWhile--    prop_elem    :: P (a -> S.Stream a -> Bool) = S.elem `eq` elem-    prop_notElem :: P (a -> S.Stream a -> Bool) = S.notElem `eq` notElem-    prop_find    :: P ((a -> Bool) -> S.Stream a -> Maybe a) = S.find `eq` find-    prop_findIndex :: P ((a -> Bool) -> S.Stream a -> Maybe Int)-      = S.findIndex `eq` findIndex--    prop_foldl :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl `eq` foldl-    prop_foldl1 :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>-                        S.foldl1 `eq` foldl1-    prop_foldl' :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl' `eq` foldl'-    prop_foldl1' :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>-                        S.foldl1' `eq` foldl1'-    prop_foldr :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldr `eq` foldr-    prop_foldr1 :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>-                        S.foldr1 `eq` foldr1--    prop_prescanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-                = S.prescanl `eq` prescanl-    prop_prescanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-                = S.prescanl' `eq` prescanl-    prop_postscanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-                = S.postscanl `eq` postscanl-    prop_postscanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-                = S.postscanl' `eq` postscanl-    prop_scanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-                = S.scanl `eq` scanl-    prop_scanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)-               = S.scanl' `eq` scanl-    prop_scanl1 :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>-                 S.scanl1 `eq` scanl1-    prop_scanl1' :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>-                 S.scanl1' `eq` scanl1- -    prop_concatMap    = forAll arbitrary $ \xs ->-                        forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs-      where-        prop :: P ((a -> S.Stream a) -> S.Stream a -> S.Stream a) = S.concatMap `eq` concatMap--    limitUnfolds f (theirs, ours) | ours >= 0-                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))-                                  | otherwise                       = Nothing-    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Stream a)-         = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))-           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))--testBoolFunctions :: [Test]-testBoolFunctions = $(testProperties ['prop_and, 'prop_or])-  where-    prop_and :: P (S.Stream Bool -> Bool) = S.and `eq` and-    prop_or  :: P (S.Stream Bool -> Bool) = S.or `eq` or--testStreamFunctions = testSanity (undefined :: S.Stream Int)-                      ++ testPolymorphicFunctions (undefined :: S.Stream Int)-                      ++ testBoolFunctions--tests = [ testGroup "Data.Vector.Fusion.Stream" testStreamFunctions ]-
tests/Tests/Vector.hs view
@@ -8,7 +8,7 @@ import qualified Data.Vector.Primitive import qualified Data.Vector.Storable import qualified Data.Vector.Unboxed-import qualified Data.Vector.Fusion.Stream as S+import qualified Data.Vector.Fusion.Bundle as S  import Test.QuickCheck @@ -21,6 +21,9 @@ import qualified Control.Applicative as Applicative import System.Random       (Random) +import Data.Functor.Identity+import Control.Monad.Trans.Writer+ #define COMMON_CONTEXT(a, v) \  VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v) @@ -74,7 +77,7 @@     prop_fromList_toList (v :: v a)        = (V.fromList . V.toList)                        v == v     prop_toList_fromList (l :: [a])        = ((V.toList :: v a -> [a]) . V.fromList)        l == l     prop_unstream_stream (v :: v a)        = (V.unstream . V.stream)                        v == v-    prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s+    prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s  testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test] testPolymorphicFunctions _ = $(testProperties [@@ -140,10 +143,12 @@          -- Monadic mapping         {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -}+        'prop_imapM, 'prop_imapM_,          -- Zipping         'prop_zipWith, 'prop_zipWith3, {- ... -}         'prop_izipWith, 'prop_izipWith3, {- ... -}+        'prop_izipWithM, 'prop_izipWithM_,         {- 'prop_zip, ... -}          -- Monadic zipping@@ -169,6 +174,7 @@         'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',         'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1',         'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr',+        'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_,          -- Specialised folds         'prop_all, 'prop_any,@@ -272,7 +278,15 @@     prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)              = V.zipWith3 `eq` zipWith3     prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap+    prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a))+            = V.imapM `eq` imapM+    prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ())+            = V.imapM_ `eq` imapM_     prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith+    prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a))+            = V.izipWithM `eq` izipWithM+    prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ())+            = V.izipWithM_ `eq` izipWithM_     prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)              = V.izipWith3 `eq` izipWith3 @@ -315,6 +329,14 @@         = V.ifoldr `eq` ifoldr     prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a)         = V.ifoldr' `eq` ifoldr+    prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)+        = V.ifoldM `eq` ifoldM+    prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)+        = V.ifoldM' `eq` ifoldM+    prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())+        = V.ifoldM_ `eq` ifoldM_+    prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())+        = V.ifoldM'_ `eq` ifoldM_      prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all     prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any
tests/Utilities.hs view
@@ -8,13 +8,17 @@ import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Unboxed as DVU-import qualified Data.Vector.Fusion.Stream as S+import qualified Data.Vector.Fusion.Bundle as S +import Control.Monad (foldM, foldM_, zipWithM, zipWithM_)+import Control.Monad.Trans.Writer+import Data.Function (on)+import Data.Functor.Identity import Data.List ( sortBy )-+import Data.Monoid -instance Show a => Show (S.Stream a) where-    show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)+instance Show a => Show (S.Bundle v a) where+    show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s)   instance Arbitrary a => Arbitrary (DV.Vector a) where@@ -41,12 +45,24 @@ instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where     coarbitrary = coarbitrary . DVU.toList -instance Arbitrary a => Arbitrary (S.Stream a) where+instance Arbitrary a => Arbitrary (S.Bundle v a) where     arbitrary = fmap S.fromList arbitrary -instance CoArbitrary a => CoArbitrary (S.Stream a) where+instance CoArbitrary a => CoArbitrary (S.Bundle v a) where     coarbitrary = coarbitrary . S.toList +instance Arbitrary a => Arbitrary (Identity a) where+    arbitrary = fmap Identity arbitrary++instance CoArbitrary a => CoArbitrary (Identity a) where+    coarbitrary = coarbitrary . runIdentity++instance Arbitrary a => Arbitrary (Writer a ()) where+    arbitrary = fmap (writer . ((,) ())) arbitrary++instance CoArbitrary a => CoArbitrary (Writer a ()) where+    coarbitrary = coarbitrary . runWriter+ class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where   type Model a   model :: a -> Model a@@ -55,12 +71,12 @@   type EqTest a   equal :: a -> a -> EqTest a -instance Eq a => TestData (S.Stream a) where-  type Model (S.Stream a) = [a]+instance Eq a => TestData (S.Bundle v a) where+  type Model (S.Bundle v a) = [a]   model = S.toList   unmodel = S.fromList -  type EqTest (S.Stream a) = Property+  type EqTest (S.Bundle v a) = Property   equal x y = property (x == y)  instance Eq a => TestData (DV.Vector a) where@@ -129,6 +145,22 @@   type EqTest [a] = Property   equal x y = property (x == y) +instance (Eq a, TestData a) => TestData (Identity a) where+  type Model (Identity a) = Identity (Model a)+  model = fmap model+  unmodel = fmap unmodel++  type EqTest (Identity a) = Property+  equal = (property .) . on (==) runIdentity++instance (Eq a, TestData a, Monoid a) => TestData (Writer a ()) where+  type Model (Writer a ()) = Writer (Model a) ()+  model = mapWriter model+  unmodel = mapWriter unmodel++  type EqTest (Writer a ()) = Property+  equal = (property .) . on (==) execWriter+ instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where   type Model (a,b) = (Model a, Model b)   model (a,b) = (model a, model b)@@ -233,23 +265,46 @@     go (x:xs) ps j = x : go xs ps (j+1)     go [] _ _      = [] ++withIndexFirst m f = m (uncurry f) . zip [0..]+ imap :: (Int -> a -> a) -> [a] -> [a]-imap f = map (uncurry f) . zip [0..]+imap = withIndexFirst map +imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a]+imapM = withIndexFirst mapM++imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m ()+imapM_ = withIndexFirst mapM_+ izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a]-izipWith f = zipWith (uncurry f) . zip [0..]+izipWith = withIndexFirst zipWith +izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a]+izipWithM = withIndexFirst zipWithM++izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m ()+izipWithM_ = withIndexFirst zipWithM_+ izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]-izipWith3 f = zipWith3 (uncurry f) . zip [0..]+izipWith3 = withIndexFirst zipWith3  ifilter :: (Int -> a -> Bool) -> [a] -> [a]-ifilter f = map snd . filter (uncurry f) . zip [0..]+ifilter f = map snd . withIndexFirst filter f +indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..]+ ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a-ifoldl f z = foldl (uncurry . f) z . zip [0..]+ifoldl = indexedLeftFold foldl  ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z = foldr (uncurry f) z . zip [0..]++ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a+ifoldM = indexedLeftFold foldM++ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m ()+ifoldM_ = indexedLeftFold foldM_  minIndex :: Ord a => [a] -> Int minIndex = fst . foldr1 imin . zip [0..]
vector.cabal view
@@ -1,10 +1,10 @@ Name:           vector-Version:        0.10.12.3+Version:        0.11.0.0 -- don't forget to update the changelog file! License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>-Maintainer:     libraries@haskell.org+Maintainer:     Haskell Libraries Team <libraries@haskell.org> Copyright:      (c) Roman Leshchinskiy 2008-2012 Homepage:       https://github.com/haskell/vector Bug-Reports:    https://github.com/haskell/vector/issues@@ -34,7 +34,7 @@         .         * <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial> -Cabal-Version:  >= 1.10+Cabal-Version:  >=1.10 Build-Type:     Simple  Extra-Source-Files:@@ -45,7 +45,7 @@       tests/Boilerplater.hs       tests/Utilities.hs       tests/Tests/Move.hs-      tests/Tests/Stream.hs+      tests/Tests/Bundle.hs       tests/Tests/Vector.hs       benchmarks/vector-benchmarks.cabal       benchmarks/LICENSE@@ -86,15 +86,32 @@  Library   Default-Language: Haskell2010-  Default-Extensions: CPP, DeriveDataTypeable+  Other-Extensions:+        BangPatterns+        CPP+        DeriveDataTypeable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GADTs+        KindSignatures+        MagicHash+        MultiParamTypeClasses+        Rank2Types+        ScopedTypeVariables+        StandaloneDeriving+        TypeFamilies+   Exposed-Modules:         Data.Vector.Internal.Check          Data.Vector.Fusion.Util-        Data.Vector.Fusion.Stream.Size         Data.Vector.Fusion.Stream.Monadic-        Data.Vector.Fusion.Stream+        Data.Vector.Fusion.Bundle.Size+        Data.Vector.Fusion.Bundle.Monadic+        Data.Vector.Fusion.Bundle +        Data.Vector.Generic.Mutable.Base         Data.Vector.Generic.Mutable         Data.Vector.Generic.Base         Data.Vector.Generic.New@@ -120,15 +137,12 @@   Install-Includes:         vector.h -  Build-Depends: base >= 4 && < 5+  Build-Depends: base >= 4.3 && < 4.9                , primitive >= 0.5.0.1 && < 0.7-               , ghc-prim+               , ghc-prim >= 0.2 && < 0.5                , deepseq >= 1.1 && < 1.5 -  if impl(ghc<6.13)-    Ghc-Options: -finline-if-enough-args -fno-method-sharing--  Ghc-Options: -O2+  Ghc-Options: -O2 -Wall -fno-warn-orphans    if flag(BoundsChecks)     cpp-options: -DVECTOR_BOUNDS_CHECKS@@ -143,6 +157,8 @@   type:     git   location: https://github.com/haskell/vector.git ++ test-suite vector-tests-O0   Default-Language: Haskell2010   type: exitcode-stdio-1.0@@ -152,6 +168,7 @@                  random,                  QuickCheck >=  2.7  && < 2.8 , test-framework, test-framework-quickcheck2,                  transformers >= 0.2.0.0+   default-extensions: CPP,               ScopedTypeVariables,               PatternGuards,@@ -161,6 +178,7 @@               TypeSynonymInstances,               TypeFamilies,               TemplateHaskell+   Ghc-Options: -O0   Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures @@ -173,6 +191,7 @@                  random,                  QuickCheck  >= 2.7, test-framework, test-framework-quickcheck2,                  transformers >= 0.2.0.0+   default-extensions: CPP,               ScopedTypeVariables,               PatternGuards,@@ -182,5 +201,6 @@               TypeSynonymInstances,               TypeFamilies,               TemplateHaskell+   Ghc-Options: -O2   Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures