diff --git a/Data/Vector.hs b/Data/Vector.hs --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP + , DeriveDataTypeable , FlexibleInstances , MultiParamTypeClasses , TypeFamilies @@ -14,7 +15,7 @@ -- Maintainer : Roman Leshchinskiy -- 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 () diff --git a/Data/Vector/Fusion/Bundle.hs b/Data/Vector/Fusion/Bundle.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Fusion/Bundle.hs @@ -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 +-- 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 + diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Fusion/Bundle/Monadic.hs @@ -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 +-- 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 [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8 + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16 + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8 + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-} + + + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32 + +"enumFromTo [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 [Bundle]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} + +#else + +"enumFromTo [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 [Bundle]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Bundle m v Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Bundle m v Word32 + +#endif + +"enumFromTo [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 [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 [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 [Bundle]" + enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double + +"enumFromTo [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 #-} + + + diff --git a/Data/Vector/Fusion/Bundle/Size.hs b/Data/Vector/Fusion/Bundle/Size.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Fusion/Bundle/Size.hs @@ -0,0 +1,121 @@ +-- | +-- Module : Data.Vector.Fusion.Bundle.Size +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- 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 + diff --git a/Data/Vector/Fusion/Stream.hs b/Data/Vector/Fusion/Stream.hs deleted file mode 100644 --- a/Data/Vector/Fusion/Stream.hs +++ /dev/null @@ -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 --- 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 - diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs --- a/Data/Vector/Fusion/Stream/Monadic.hs +++ b/Data/Vector/Fusion/Stream/Monadic.hs @@ -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 [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 [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 [Stream]" @@ -1298,31 +1363,21 @@ #if WORD_SIZE_IN_BITS > 32 "enumFromTo [Stream]" - enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64 + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} #else "enumFromTo [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 [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 [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 [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 [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 #-} + + +-} diff --git a/Data/Vector/Fusion/Stream/Size.hs b/Data/Vector/Fusion/Stream/Size.hs deleted file mode 100644 --- a/Data/Vector/Fusion/Stream/Size.hs +++ /dev/null @@ -1,87 +0,0 @@ --- | --- Module : Data.Vector.Fusion.Stream.Size --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- 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 - diff --git a/Data/Vector/Fusion/Util.hs b/Data/Vector/Fusion/Util.hs --- a/Data/Vector/Fusion/Util.hs +++ b/Data/Vector/Fusion/Util.hs @@ -6,7 +6,7 @@ -- Maintainer : Roman Leshchinskiy -- 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 } diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -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 -- 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) diff --git a/Data/Vector/Generic/Base.hs b/Data/Vector/Generic/Base.hs --- a/Data/Vector/Generic/Base.hs +++ b/Data/Vector/Generic/Base.hs @@ -10,7 +10,7 @@ -- Maintainer : Roman Leshchinskiy -- 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 diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs --- a/Data/Vector/Generic/Mutable.hs +++ b/Data/Vector/Generic/Mutable.hs @@ -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 -- 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') diff --git a/Data/Vector/Generic/Mutable/Base.hs b/Data/Vector/Generic/Mutable/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Generic/Mutable/Base.hs @@ -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 +-- 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 + diff --git a/Data/Vector/Generic/New.hs b/Data/Vector/Generic/New.hs --- a/Data/Vector/Generic/New.hs +++ b/Data/Vector/Generic/New.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Rank2Types, FlexibleContexts #-} +{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-} -- | -- Module : Data.Vector.Generic.New @@ -8,30 +8,33 @@ -- Maintainer : Roman Leshchinskiy -- 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) #-} - #-} + diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs --- a/Data/Vector/Internal/Check.hs +++ b/Data/Vector/Internal/Check.hs @@ -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 diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs --- a/Data/Vector/Mutable.hs +++ b/Data/Vector/Mutable.hs @@ -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 -- 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 diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -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 -- 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 () diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs --- a/Data/Vector/Primitive/Mutable.hs +++ b/Data/Vector/Primitive/Mutable.hs @@ -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 -- 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 diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -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 -- 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 diff --git a/Data/Vector/Storable/Internal.hs b/Data/Vector/Storable/Internal.hs --- a/Data/Vector/Storable/Internal.hs +++ b/Data/Vector/Storable/Internal.hs @@ -6,7 +6,7 @@ -- Maintainer : Roman Leshchinskiy -- 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(..) ) diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -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 -- 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 diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -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 () diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -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) diff --git a/Data/Vector/Unboxed/Mutable.hs b/Data/Vector/Unboxed/Mutable.hs --- a/Data/Vector/Unboxed/Mutable.hs +++ b/Data/Vector/Unboxed/Mutable.hs @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/benchmarks/vector-benchmarks.cabal b/benchmarks/vector-benchmarks.cabal --- a/benchmarks/vector-benchmarks.cabal +++ b/benchmarks/vector-benchmarks.cabal @@ -1,5 +1,5 @@ Name: vector-benchmarks -Version: 0.10.0.1 +Version: 0.10.9 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy @@ -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 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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` diff --git a/include/vector.h b/include/vector.h --- a/include/vector.h +++ b/include/vector.h @@ -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 diff --git a/internal/GenUnboxTuple.hs b/internal/GenUnboxTuple.hs --- a/internal/GenUnboxTuple.hs +++ b/internal/GenUnboxTuple.hs @@ -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 diff --git a/internal/unbox-tuple-instances b/internal/unbox-tuple-instances --- a/internal/unbox-tuple-instances +++ b/internal/unbox-tuple-instances @@ -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 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 diff --git a/tests/Tests/Bundle.hs b/tests/Tests/Bundle.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Bundle.hs @@ -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 ] + diff --git a/tests/Tests/Move.hs b/tests/Tests/Move.hs --- a/tests/Tests/Move.hs +++ b/tests/Tests/Move.hs @@ -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), diff --git a/tests/Tests/Stream.hs b/tests/Tests/Stream.hs deleted file mode 100644 --- a/tests/Tests/Stream.hs +++ /dev/null @@ -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 ] - diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs --- a/tests/Tests/Vector.hs +++ b/tests/Tests/Vector.hs @@ -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 diff --git a/tests/Utilities.hs b/tests/Utilities.hs --- a/tests/Utilities.hs +++ b/tests/Utilities.hs @@ -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..] diff --git a/vector.cabal b/vector.cabal --- a/vector.cabal +++ b/vector.cabal @@ -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 -Maintainer: libraries@haskell.org +Maintainer: Haskell Libraries Team Copyright: (c) Roman Leshchinskiy 2008-2012 Homepage: https://github.com/haskell/vector Bug-Reports: https://github.com/haskell/vector/issues @@ -34,7 +34,7 @@ . * -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