diff --git a/Data/Vector.hs b/Data/Vector.hs deleted file mode 100644 --- a/Data/Vector.hs +++ /dev/null @@ -1,1753 +0,0 @@ -{-# LANGUAGE CPP - , DeriveDataTypeable - , FlexibleInstances - , MultiParamTypeClasses - , TypeFamilies - , Rank2Types - , BangPatterns - #-} - --- | --- Module : Data.Vector --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- 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: --- --- * mutable --- --- * immutable --- --- and support a rich interface of both list-like operations, and bulk --- array operations. --- --- For unboxed arrays, use "Data.Vector.Unboxed" --- - -module Data.Vector ( - -- * Boxed vectors - Vector, MVector, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Indexing - (!), (!?), head, last, - unsafeIndex, unsafeHead, unsafeLast, - - -- ** Monadic indexing - indexM, headM, lastM, - unsafeIndexM, unsafeHeadM, unsafeLastM, - - -- ** Extracting subvectors (slicing) - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- * Construction - - -- ** Initialisation - empty, singleton, replicate, generate, iterateN, - - -- ** Monadic initialisation - replicateM, generateM, iterateNM, create, createT, - - -- ** Unfolding - unfoldr, unfoldrN, - unfoldrM, unfoldrNM, - constructN, constructrN, - - -- ** Enumeration - enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, - - -- ** Concatenation - cons, snoc, (++), concat, - - -- ** Restricting memory usage - force, - - -- * Modifying vectors - - -- ** Bulk updates - (//), update, update_, - unsafeUpd, unsafeUpdate, unsafeUpdate_, - - -- ** Accumulations - accum, accumulate, accumulate_, - unsafeAccum, unsafeAccumulate, unsafeAccumulate_, - - -- ** Permutations - reverse, backpermute, unsafeBackpermute, - - -- ** Safe destructive updates - modify, - - -- * Elementwise operations - - -- ** Indexing - indexed, - - -- ** Mapping - map, imap, concatMap, - - -- ** Monadic mapping - mapM, imapM, mapM_, imapM_, forM, forM_, - - -- ** Zipping - zipWith, zipWith3, zipWith4, zipWith5, zipWith6, - izipWith, izipWith3, izipWith4, izipWith5, izipWith6, - zip, zip3, zip4, zip5, zip6, - - -- ** Monadic zipping - zipWithM, izipWithM, zipWithM_, izipWithM_, - - -- ** Unzipping - unzip, unzip3, unzip4, unzip5, unzip6, - - -- * Working with predicates - - -- ** Filtering - filter, ifilter, uniq, - mapMaybe, imapMaybe, - filterM, - takeWhile, dropWhile, - - -- ** Partitioning - partition, unstablePartition, partitionWith, span, break, - - -- ** Searching - elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, - - -- * Folding - foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', - ifoldl, ifoldl', ifoldr, ifoldr', - - -- ** Specialised folds - all, any, and, or, - sum, product, - maximum, maximumBy, minimum, minimumBy, - minIndex, minIndexBy, maxIndex, maxIndexBy, - - -- ** Monadic folds - foldM, ifoldM, foldM', ifoldM', - fold1M, fold1M',foldM_, ifoldM_, - foldM'_, ifoldM'_, fold1M_, fold1M'_, - - -- ** Monadic sequencing - sequence, sequence_, - - -- * Prefix sums (scans) - prescanl, prescanl', - postscanl, postscanl', - scanl, scanl', scanl1, scanl1', - iscanl, iscanl', - prescanr, prescanr', - postscanr, postscanr', - scanr, scanr', scanr1, scanr1', - iscanr, iscanr', - - -- * Conversions - - -- ** Lists - toList, Data.Vector.fromList, Data.Vector.fromListN, - - -- ** Other vector types - G.convert, - - -- ** Mutable vectors - freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy -) where - -import Data.Vector.Mutable ( MVector(..) ) -import Data.Primitive.Array -import qualified Data.Vector.Fusion.Bundle as Bundle -import qualified Data.Vector.Generic as G - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import Control.Monad ( MonadPlus(..), liftM, ap ) -import Control.Monad.ST ( ST ) -import Control.Monad.Primitive -import qualified Control.Monad.Fail as Fail - -import Control.Monad.Zip - -import Prelude hiding ( length, null, - replicate, (++), concat, - head, last, - init, tail, take, drop, splitAt, reverse, - map, concatMap, - zipWith, zipWith3, zip, zip3, unzip, unzip3, - filter, takeWhile, dropWhile, span, break, - elem, notElem, - foldl, foldl1, foldr, foldr1, - all, any, and, or, sum, product, minimum, maximum, - scanl, scanl1, scanr, scanr1, - enumFromTo, enumFromThenTo, - mapM, mapM_, sequence, sequence_ ) - -#if MIN_VERSION_base(4,9,0) -import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) -#endif - -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) -import Data.Semigroup ( Semigroup(..) ) - -import qualified Control.Applicative as Applicative -import qualified Data.Foldable as Foldable -import qualified Data.Traversable as Traversable - -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid ( Monoid(..) ) -#endif - -#if __GLASGOW_HASKELL__ >= 708 -import qualified GHC.Exts as Exts (IsList(..)) -#endif - - --- | Boxed vectors, supporting efficient slicing. -data Vector a = Vector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !(Array a) - deriving ( Typeable ) - -liftRnfV :: (a -> ()) -> Vector a -> () -liftRnfV elemRnf = foldl' (\_ -> elemRnf) () - -instance NFData a => NFData (Vector a) where - rnf = liftRnfV rnf - {-# INLINEABLE rnf #-} - -#if MIN_VERSION_deepseq(1,4,3) --- | @since 0.12.1.0 -instance NFData1 Vector where - liftRnf = liftRnfV - {-# INLINEABLE liftRnf #-} -#endif - -instance Show a => Show (Vector a) where - showsPrec = G.showsPrec - -instance Read a => Read (Vector a) where - readPrec = G.readPrec - readListPrec = readListPrecDefault - -#if MIN_VERSION_base(4,9,0) -instance Show1 Vector where - liftShowsPrec = G.liftShowsPrec - -instance Read1 Vector where - liftReadsPrec = G.liftReadsPrec -#endif - -#if __GLASGOW_HASKELL__ >= 708 - -instance Exts.IsList (Vector a) where - type Item (Vector a) = a - fromList = Data.Vector.fromList - fromListN = Data.Vector.fromListN - toList = toList -#endif - -instance Data a => Data (Vector a) where - gfoldl = G.gfoldl - toConstr _ = G.mkVecConstr "Data.Vector.Vector" - gunfold = G.gunfold - dataTypeOf _ = G.mkVecType "Data.Vector.Vector" - dataCast1 = G.dataCast - -type instance G.Mutable Vector = MVector - -instance G.Vector Vector a where - {-# INLINE basicUnsafeFreeze #-} - basicUnsafeFreeze (MVector i n marr) - = Vector i n `liftM` unsafeFreezeArray marr - - {-# INLINE basicUnsafeThaw #-} - basicUnsafeThaw (Vector i n arr) - = MVector i n `liftM` unsafeThawArray arr - - {-# INLINE basicLength #-} - basicLength (Vector _ n _) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr - - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector i n dst) (Vector j _ src) - = copyArray dst i src j n - --- See http://trac.haskell.org/vector/ticket/12 -instance Eq a => Eq (Vector a) where - {-# INLINE (==) #-} - xs == ys = Bundle.eq (G.stream xs) (G.stream ys) - - {-# INLINE (/=) #-} - 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 = Bundle.cmp (G.stream xs) (G.stream ys) - - {-# INLINE (<) #-} - xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT - - {-# INLINE (<=) #-} - xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT - - {-# INLINE (>) #-} - xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT - - {-# INLINE (>=) #-} - xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT - -#if MIN_VERSION_base(4,9,0) -instance Eq1 Vector where - liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) - -instance Ord1 Vector where - liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys) -#endif - -instance Semigroup (Vector a) where - {-# INLINE (<>) #-} - (<>) = (++) - - {-# INLINE sconcat #-} - sconcat = G.concatNE - -instance Monoid (Vector a) where - {-# INLINE mempty #-} - mempty = empty - - {-# INLINE mappend #-} - mappend = (++) - - {-# INLINE mconcat #-} - mconcat = concat - -instance Functor Vector where - {-# INLINE fmap #-} - fmap = map - -instance Monad Vector where - {-# INLINE return #-} - return = Applicative.pure - - {-# INLINE (>>=) #-} - (>>=) = flip concatMap - -#if !(MIN_VERSION_base(4,13,0)) - {-# INLINE fail #-} - fail = Fail.fail -- == \ _str -> empty -#endif - --- | @since 0.12.1.0 -instance Fail.MonadFail Vector where - {-# INLINE fail #-} - fail _ = empty - -instance MonadPlus Vector where - {-# INLINE mzero #-} - mzero = empty - - {-# INLINE mplus #-} - mplus = (++) - -instance MonadZip Vector where - {-# INLINE mzip #-} - mzip = zip - - {-# INLINE mzipWith #-} - mzipWith = zipWith - - {-# INLINE munzip #-} - munzip = unzip - - -instance Applicative.Applicative Vector where - {-# INLINE pure #-} - pure = singleton - - {-# INLINE (<*>) #-} - (<*>) = ap - -instance Applicative.Alternative Vector where - {-# INLINE empty #-} - empty = empty - - {-# INLINE (<|>) #-} - (<|>) = (++) - -instance Foldable.Foldable Vector where - {-# INLINE foldr #-} - foldr = foldr - - {-# INLINE foldl #-} - foldl = foldl - - {-# INLINE foldr1 #-} - foldr1 = foldr1 - - {-# INLINE foldl1 #-} - foldl1 = foldl1 - -#if MIN_VERSION_base(4,6,0) - {-# INLINE foldr' #-} - foldr' = foldr' - - {-# INLINE foldl' #-} - foldl' = foldl' -#endif - -#if MIN_VERSION_base(4,8,0) - {-# INLINE toList #-} - toList = toList - - {-# INLINE length #-} - length = length - - {-# INLINE null #-} - null = null - - {-# INLINE elem #-} - elem = elem - - {-# INLINE maximum #-} - maximum = maximum - - {-# INLINE minimum #-} - minimum = minimum - - {-# INLINE sum #-} - sum = sum - - {-# INLINE product #-} - product = product -#endif - -instance Traversable.Traversable Vector where - {-# INLINE traverse #-} - traverse f xs = - -- Get the length of the vector in /O(1)/ time - let !n = G.length xs - -- Use fromListN to be more efficient in construction of resulting vector - -- Also behaves better with compact regions, preventing runtime exceptions - in Data.Vector.fromListN n Applicative.<$> Traversable.traverse f (toList xs) - - {-# INLINE mapM #-} - mapM = mapM - - {-# INLINE sequence #-} - sequence = sequence - --- Length information --- ------------------ - --- | /O(1)/ Yield the length of the vector -length :: Vector a -> Int -{-# INLINE length #-} -length = G.length - --- | /O(1)/ Test whether a vector is empty -null :: Vector a -> Bool -{-# INLINE null #-} -null = G.null - --- Indexing --- -------- - --- | O(1) Indexing -(!) :: Vector a -> Int -> a -{-# INLINE (!) #-} -(!) = (G.!) - --- | O(1) Safe indexing -(!?) :: Vector a -> Int -> Maybe a -{-# INLINE (!?) #-} -(!?) = (G.!?) - --- | /O(1)/ First element -head :: Vector a -> a -{-# INLINE head #-} -head = G.head - --- | /O(1)/ Last element -last :: Vector a -> a -{-# INLINE last #-} -last = G.last - --- | /O(1)/ Unsafe indexing without bounds checking -unsafeIndex :: Vector a -> Int -> a -{-# INLINE unsafeIndex #-} -unsafeIndex = G.unsafeIndex - --- | /O(1)/ First element without checking if the vector is empty -unsafeHead :: Vector a -> a -{-# INLINE unsafeHead #-} -unsafeHead = G.unsafeHead - --- | /O(1)/ Last element without checking if the vector is empty -unsafeLast :: Vector a -> a -{-# INLINE unsafeLast #-} -unsafeLast = G.unsafeLast - --- Monadic indexing --- ---------------- - --- | /O(1)/ Indexing in a monad. --- --- The monad allows operations to be strict in the vector when necessary. --- Suppose vector copying is implemented like this: --- --- > copy mv v = ... write mv i (v ! i) ... --- --- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ --- would unnecessarily retain a reference to @v@ in each element written. --- --- With 'indexM', copying can be implemented like this instead: --- --- > copy mv v = ... do --- > x <- indexM v i --- > write mv i x --- --- Here, no references to @v@ are retained because indexing (but /not/ the --- elements) is evaluated eagerly. --- -indexM :: Monad m => Vector a -> Int -> m a -{-# INLINE indexM #-} -indexM = G.indexM - --- | /O(1)/ First element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -headM :: Monad m => Vector a -> m a -{-# INLINE headM #-} -headM = G.headM - --- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -lastM :: Monad m => Vector a -> m a -{-# INLINE lastM #-} -lastM = G.lastM - --- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an --- explanation of why this is useful. -unsafeIndexM :: Monad m => Vector a -> Int -> m a -{-# INLINE unsafeIndexM #-} -unsafeIndexM = G.unsafeIndexM - --- | /O(1)/ First element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeHeadM :: Monad m => Vector a -> m a -{-# INLINE unsafeHeadM #-} -unsafeHeadM = G.unsafeHeadM - --- | /O(1)/ Last element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeLastM :: Monad m => Vector a -> m a -{-# INLINE unsafeLastM #-} -unsafeLastM = G.unsafeLastM - --- Extracting subvectors (slicing) --- ------------------------------- - --- | /O(1)/ Yield a slice of the vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE slice #-} -slice = G.slice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty. -init :: Vector a -> Vector a -{-# INLINE init #-} -init = G.init - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty. -tail :: Vector a -> Vector a -{-# INLINE tail #-} -tail = G.tail - --- | /O(1)/ Yield at the first @n@ elements without copying. The vector may --- contain less than @n@ elements in which case it is returned unchanged. -take :: Int -> Vector a -> Vector a -{-# INLINE take #-} -take = G.take - --- | /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 :: Int -> Vector a -> Vector a -{-# INLINE drop #-} -drop = G.drop - --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. --- --- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ --- but slightly more efficient. -{-# INLINE splitAt #-} -splitAt :: Int -> Vector a -> (Vector a, Vector a) -splitAt = G.splitAt - --- | /O(1)/ Yield a slice of the vector without copying. The vector must --- contain at least @i+n@ elements but this is not checked. -unsafeSlice :: Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty but this is not checked. -unsafeInit :: Vector a -> Vector a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty but this is not checked. -unsafeTail :: Vector a -> Vector a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- | /O(1)/ Yield the first @n@ elements without copying. The vector must --- contain at least @n@ elements but this is not checked. -unsafeTake :: Int -> Vector a -> Vector a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - --- | /O(1)/ Yield all but the first @n@ elements without copying. The vector --- must contain at least @n@ elements but this is not checked. -unsafeDrop :: Int -> Vector a -> Vector a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - --- Initialisation --- -------------- - --- | /O(1)/ Empty vector -empty :: Vector a -{-# INLINE empty #-} -empty = G.empty - --- | /O(1)/ Vector with exactly one element -singleton :: a -> Vector a -{-# INLINE singleton #-} -singleton = G.singleton - --- | /O(n)/ Vector of the given length with the same value in each position -replicate :: Int -> a -> Vector a -{-# INLINE replicate #-} -replicate = G.replicate - --- | /O(n)/ Construct a vector of the given length by applying the function to --- each index -generate :: Int -> (Int -> a) -> Vector a -{-# INLINE generate #-} -generate = G.generate - --- | /O(n)/ Apply function n times to value. Zeroth element is original value. -iterateN :: Int -> (a -> a) -> a -> Vector a -{-# INLINE iterateN #-} -iterateN = G.iterateN - --- Unfolding --- --------- - --- | /O(n)/ Construct a vector by repeatedly applying the generator function --- to a seed. The generator function yields 'Just' the next element and the --- new seed or 'Nothing' if there are no more elements. --- --- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 --- > = <10,9,8,7,6,5,4,3,2,1> -unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldr #-} -unfoldr = G.unfoldr - --- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying --- the generator function to a seed. The generator function yields 'Just' the --- next element and the new seed or 'Nothing' if there are no more elements. --- --- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> -unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldrN #-} -unfoldrN = G.unfoldrN - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrM #-} -unfoldrM = G.unfoldrM - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrNM :: (Monad m) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrNM #-} -unfoldrNM = G.unfoldrNM - --- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the --- generator function to the already constructed part of the vector. --- --- > constructN 3 f = let a = f <> ; b = f ; c = f in --- -constructN :: Int -> (Vector a -> a) -> Vector a -{-# INLINE constructN #-} -constructN = G.constructN - --- | /O(n)/ Construct a vector with @n@ elements from right to left by --- repeatedly applying the generator function to the already constructed part --- of the vector. --- --- > constructrN 3 f = let a = f <> ; b = f ; c = f in --- -constructrN :: Int -> (Vector a -> a) -> Vector a -{-# INLINE constructrN #-} -constructrN = G.constructrN - --- Enumeration --- ----------- - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ --- etc. This operation is usually more efficient than 'enumFromTo'. --- --- > enumFromN 5 3 = <5,6,7> -enumFromN :: Num a => a -> Int -> Vector a -{-# INLINE enumFromN #-} -enumFromN = G.enumFromN - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. --- --- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> -enumFromStepN :: Num a => a -> a -> Int -> Vector a -{-# INLINE enumFromStepN #-} -enumFromStepN = G.enumFromStepN - --- | /O(n)/ Enumerate values from @x@ to @y@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromN' instead. -enumFromTo :: Enum a => a -> a -> Vector a -{-# INLINE enumFromTo #-} -enumFromTo = G.enumFromTo - --- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: Enum a => a -> a -> a -> Vector a -{-# INLINE enumFromThenTo #-} -enumFromThenTo = G.enumFromThenTo - --- Concatenation --- ------------- - --- | /O(n)/ Prepend an element -cons :: a -> Vector a -> Vector a -{-# INLINE cons #-} -cons = G.cons - --- | /O(n)/ Append an element -snoc :: Vector a -> a -> Vector a -{-# INLINE snoc #-} -snoc = G.snoc - -infixr 5 ++ --- | /O(m+n)/ Concatenate two vectors -(++) :: Vector a -> Vector a -> Vector a -{-# INLINE (++) #-} -(++) = (G.++) - --- | /O(n)/ Concatenate all vectors in the list -concat :: [Vector a] -> Vector a -{-# INLINE concat #-} -concat = G.concat - --- Monadic initialisation --- ---------------------- - --- | /O(n)/ Execute the monadic action the given number of times and store the --- results in a vector. -replicateM :: Monad m => Int -> m a -> m (Vector a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | /O(n)/ Construct a vector of the given length by applying the monadic --- action to each index -generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) -{-# INLINE generateM #-} -generateM = G.generateM - --- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a) -{-# INLINE iterateNM #-} -iterateNM = G.iterateNM - --- | Execute the monadic action and freeze the resulting vector. --- --- @ --- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> --- @ -create :: (forall s. ST s (MVector s a)) -> Vector a -{-# INLINE create #-} --- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 -create p = G.create p - --- | Execute the monadic action and freeze the resulting vectors. -createT :: Traversable.Traversable f => (forall s. ST s (f (MVector s a))) -> f (Vector a) -{-# INLINE createT #-} -createT p = G.createT p - - - --- Restricting memory usage --- ------------------------ - --- | /O(n)/ Yield the argument but force it not to retain any extra memory, --- possibly by copying it. --- --- This is especially useful when dealing with slices. For example: --- --- > force (slice 0 2 ) --- --- Here, the slice retains a reference to the huge vector. Forcing it creates --- a copy of just the elements that belong to the slice and allows the huge --- vector to be garbage collected. -force :: Vector a -> Vector a -{-# INLINE force #-} -force = G.force - --- Bulk updates --- ------------ - --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector --- element at position @i@ by @a@. --- --- > <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@) - -> Vector a -{-# INLINE (//) #-} -(//) = (G.//) - --- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, --- replace the vector element at position @i@ by @a@. --- --- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> --- -update :: Vector a -- ^ initial vector (of length @m@) - -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) - -> Vector a -{-# INLINE update #-} -update = G.update - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @a@ from the value vector, replace the element of the --- initial vector at position @i@ by @a@. --- --- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> --- --- The function 'update' provides the same functionality and is usually more --- convenient. --- --- @ --- update_ xs is ys = 'update' xs ('zip' is ys) --- @ -update_ :: Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector a -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE update_ #-} -update_ = G.update_ - --- | Same as ('//') but without bounds checking. -unsafeUpd :: Vector a -> [(Int, a)] -> Vector a -{-# INLINE unsafeUpd #-} -unsafeUpd = G.unsafeUpd - --- | Same as 'update' but without bounds checking. -unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a -{-# INLINE unsafeUpdate #-} -unsafeUpdate = G.unsafeUpdate - --- | Same as 'update_' but without bounds checking. -unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a -{-# INLINE unsafeUpdate_ #-} -unsafeUpdate_ = G.unsafeUpdate_ - --- Accumulations --- ------------- - --- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element --- @a@ at position @i@ by @f a b@. --- --- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> -accum :: (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accum #-} -accum = G.accum - --- | /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@. --- --- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> -accumulate :: (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accumulate #-} -accumulate = G.accumulate - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @b@ from the the value vector, --- replace the element of the initial vector at --- position @i@ by @f a b@. --- --- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> --- --- The function 'accumulate' provides the same functionality and is usually more --- convenient. --- --- @ --- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) --- @ -accumulate_ :: (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector b -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE accumulate_ #-} -accumulate_ = G.accumulate_ - --- | Same as 'accum' but without bounds checking. -unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a -{-# INLINE unsafeAccum #-} -unsafeAccum = G.unsafeAccum - --- | Same as 'accumulate' but without bounds checking. -unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a -{-# INLINE unsafeAccumulate #-} -unsafeAccumulate = G.unsafeAccumulate - --- | Same as 'accumulate_' but without bounds checking. -unsafeAccumulate_ - :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -{-# INLINE unsafeAccumulate_ #-} -unsafeAccumulate_ = G.unsafeAccumulate_ - --- Permutations --- ------------ - --- | /O(n)/ Reverse a vector -reverse :: Vector a -> Vector a -{-# INLINE reverse #-} -reverse = G.reverse - --- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the --- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is --- often much more efficient. --- --- > backpermute <0,3,2,3,1,0> = -backpermute :: Vector a -> Vector Int -> Vector a -{-# INLINE backpermute #-} -backpermute = G.backpermute - --- | Same as 'backpermute' but without bounds checking. -unsafeBackpermute :: Vector a -> Vector Int -> Vector a -{-# INLINE unsafeBackpermute #-} -unsafeBackpermute = G.unsafeBackpermute - --- Safe destructive updates --- ------------------------ - --- | Apply a destructive operation to a vector. The operation will be --- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. --- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ -modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a -{-# INLINE modify #-} -modify p = G.modify p - --- Indexing --- -------- - --- | /O(n)/ Pair each element in a vector with its index -indexed :: Vector a -> Vector (Int,a) -{-# INLINE indexed #-} -indexed = G.indexed - --- Mapping --- ------- - --- | /O(n)/ Map a function over a vector -map :: (a -> b) -> Vector a -> Vector b -{-# INLINE map #-} -map = G.map - --- | /O(n)/ Apply a function to every element of a vector and its index -imap :: (Int -> a -> b) -> Vector a -> Vector b -{-# INLINE imap #-} -imap = G.imap - --- | Map a function over a vector and concatenate the results. -concatMap :: (a -> Vector b) -> Vector a -> Vector b -{-# INLINE concatMap #-} -concatMap = G.concatMap - --- Monadic mapping --- --------------- - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results -mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) -{-# 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. Equivalent to @flip 'mapM'@. -forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) -{-# INLINE forM #-} -forM = G.forM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results. Equivalent to @flip 'mapM_'@. -forM_ :: Monad m => Vector a -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ = G.forM_ - --- Zipping --- ------- - --- | /O(min(m,n))/ Zip two vectors with the given function. -zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE zipWith #-} -zipWith = G.zipWith - --- | Zip three vectors with the given function. -zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE zipWith3 #-} -zipWith3 = G.zipWith3 - -zipWith4 :: (a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE zipWith4 #-} -zipWith4 = G.zipWith4 - -zipWith5 :: (a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE zipWith5 #-} -zipWith5 = G.zipWith5 - -zipWith6 :: (a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE zipWith6 #-} -zipWith6 = G.zipWith6 - --- | /O(min(m,n))/ Zip two vectors with a function that also takes the --- elements' indices. -izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE izipWith #-} -izipWith = G.izipWith - --- | Zip three vectors and their indices with the given function. -izipWith3 :: (Int -> a -> b -> c -> d) - -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE izipWith3 #-} -izipWith3 = G.izipWith3 - -izipWith4 :: (Int -> a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE izipWith4 #-} -izipWith4 = G.izipWith4 - -izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE izipWith5 #-} -izipWith5 = G.izipWith5 - -izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE izipWith6 #-} -izipWith6 = G.izipWith6 - --- | Elementwise pairing of array elements. -zip :: Vector a -> Vector b -> Vector (a, b) -{-# INLINE zip #-} -zip = G.zip - --- | zip together three vectors into a vector of triples -zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) -{-# INLINE zip3 #-} -zip3 = G.zip3 - -zip4 :: Vector a -> Vector b -> Vector c -> Vector d - -> Vector (a, b, c, d) -{-# INLINE zip4 #-} -zip4 = G.zip4 - -zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector (a, b, c, d, e) -{-# INLINE zip5 #-} -zip5 = G.zip5 - -zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f - -> Vector (a, b, c, d, e, f) -{-# INLINE zip6 #-} -zip6 = G.zip6 - --- Unzipping --- --------- - --- | /O(min(m,n))/ Unzip a vector of pairs. -unzip :: Vector (a, b) -> (Vector a, Vector b) -{-# INLINE unzip #-} -unzip = G.unzip - -unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) -{-# INLINE unzip3 #-} -unzip3 = G.unzip3 - -unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) -{-# INLINE unzip4 #-} -unzip4 = G.unzip4 - -unzip5 :: Vector (a, b, c, d, e) - -> (Vector a, Vector b, Vector c, Vector d, Vector e) -{-# INLINE unzip5 #-} -unzip5 = G.unzip5 - -unzip6 :: Vector (a, b, c, d, e, f) - -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) -{-# INLINE unzip6 #-} -unzip6 = G.unzip6 - --- Monadic zipping --- --------------- - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a --- vector of results -zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) -{-# 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 --- --------- - --- | /O(n)/ Drop elements that do not satisfy the predicate -filter :: (a -> Bool) -> Vector a -> Vector a -{-# INLINE filter #-} -filter = G.filter - --- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to --- values and their indices -ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a -{-# INLINE ifilter #-} -ifilter = G.ifilter - --- | /O(n)/ Drop repeated adjacent elements. -uniq :: (Eq a) => Vector a -> Vector a -{-# INLINE uniq #-} -uniq = G.uniq - --- | /O(n)/ Drop elements when predicate returns Nothing -mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b -{-# INLINE mapMaybe #-} -mapMaybe = G.mapMaybe - --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing -imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b -{-# INLINE imapMaybe #-} -imapMaybe = G.imapMaybe - --- | /O(n)/ Drop elements that do not satisfy the monadic predicate -filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) -{-# INLINE filterM #-} -filterM = G.filterM - --- | /O(n)/ Yield the longest prefix of elements satisfying the predicate --- without copying. -takeWhile :: (a -> Bool) -> Vector a -> Vector a -{-# INLINE takeWhile #-} -takeWhile = G.takeWhile - --- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate --- without copying. -dropWhile :: (a -> Bool) -> Vector a -> Vector a -{-# INLINE dropWhile #-} -dropWhile = G.dropWhile - --- Parititioning --- ------------- - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. The --- relative order of the elements is preserved at the cost of a sometimes --- reduced performance compared to 'unstablePartition'. -partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE partition #-} -partition = G.partition - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. --- The order of the elements is not preserved but the operation is often --- faster than 'partition'. -unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE unstablePartition #-} -unstablePartition = G.unstablePartition - --- | /O(n)/ Split the vector in two parts, the first one containing the --- @Right@ elements and the second containing the @Left@ elements. --- The relative order of the elements is preserved. --- --- @since 0.12.1.0 -partitionWith :: (a -> Either b c) -> Vector a -> (Vector b, Vector c) -{-# INLINE partitionWith #-} -partitionWith = G.partitionWith - --- | /O(n)/ Split the vector into the longest prefix of elements that satisfy --- the predicate and the rest without copying. -span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE span #-} -span = G.span - --- | /O(n)/ Split the vector into the longest prefix of elements that do not --- satisfy the predicate and the rest without copying. -break :: (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE break #-} -break = G.break - --- Searching --- --------- - -infix 4 `elem` --- | /O(n)/ Check if the vector contains an element -elem :: Eq a => a -> Vector a -> Bool -{-# INLINE elem #-} -elem = G.elem - -infix 4 `notElem` --- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') -notElem :: Eq a => a -> Vector a -> Bool -{-# INLINE notElem #-} -notElem = G.notElem - --- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' --- if no such element exists. -find :: (a -> Bool) -> Vector a -> Maybe a -{-# INLINE find #-} -find = G.find - --- | /O(n)/ Yield 'Just' the index of the first element matching the predicate --- or 'Nothing' if no such element exists. -findIndex :: (a -> Bool) -> Vector a -> Maybe Int -{-# INLINE findIndex #-} -findIndex = G.findIndex - --- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending --- order. -findIndices :: (a -> Bool) -> Vector a -> Vector Int -{-# INLINE findIndices #-} -findIndices = G.findIndices - --- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or --- 'Nothing' if the vector does not contain the element. This is a specialised --- version of 'findIndex'. -elemIndex :: Eq a => a -> Vector a -> Maybe Int -{-# INLINE elemIndex #-} -elemIndex = G.elemIndex - --- | /O(n)/ Yield the indices of all occurences of the given element in --- ascending order. This is a specialised version of 'findIndices'. -elemIndices :: Eq a => a -> Vector a -> Vector Int -{-# INLINE elemIndices #-} -elemIndices = G.elemIndices - --- Folding --- ------- - --- | /O(n)/ Left fold -foldl :: (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl #-} -foldl = G.foldl - --- | /O(n)/ Left fold on non-empty vectors -foldl1 :: (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1 #-} -foldl1 = G.foldl1 - --- | /O(n)/ Left fold with strict accumulator -foldl' :: (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl' #-} -foldl' = G.foldl' - --- | /O(n)/ Left fold on non-empty vectors with strict accumulator -foldl1' :: (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1' #-} -foldl1' = G.foldl1' - --- | /O(n)/ Right fold -foldr :: (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr #-} -foldr = G.foldr - --- | /O(n)/ Right fold on non-empty vectors -foldr1 :: (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1 #-} -foldr1 = G.foldr1 - --- | /O(n)/ Right fold with a strict accumulator -foldr' :: (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr' #-} -foldr' = G.foldr' - --- | /O(n)/ Right fold on non-empty vectors with strict accumulator -foldr1' :: (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1' #-} -foldr1' = G.foldr1' - --- | /O(n)/ Left fold (function applied to each element and its index) -ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl #-} -ifoldl = G.ifoldl - --- | /O(n)/ Left fold with strict accumulator (function applied to each element --- and its index) -ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl' #-} -ifoldl' = G.ifoldl' - --- | /O(n)/ Right fold (function applied to each element and its index) -ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr #-} -ifoldr = G.ifoldr - --- | /O(n)/ Right fold with strict accumulator (function applied to each --- element and its index) -ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr' #-} -ifoldr' = G.ifoldr' - --- Specialised folds --- ----------------- - --- | /O(n)/ Check if all elements satisfy the predicate. -all :: (a -> Bool) -> Vector a -> Bool -{-# INLINE all #-} -all = G.all - --- | /O(n)/ Check if any element satisfies the predicate. -any :: (a -> Bool) -> Vector a -> Bool -{-# INLINE any #-} -any = G.any - --- | /O(n)/ Check if all elements are 'True' -and :: Vector Bool -> Bool -{-# INLINE and #-} -and = G.and - --- | /O(n)/ Check if any element is 'True' -or :: Vector Bool -> Bool -{-# INLINE or #-} -or = G.or - --- | /O(n)/ Compute the sum of the elements -sum :: Num a => Vector a -> a -{-# INLINE sum #-} -sum = G.sum - --- | /O(n)/ Compute the produce of the elements -product :: Num a => Vector a -> a -{-# INLINE product #-} -product = G.product - --- | /O(n)/ Yield the maximum element of the vector. The vector may not be --- empty. -maximum :: Ord a => Vector a -> a -{-# INLINE maximum #-} -maximum = G.maximum - --- | /O(n)/ Yield the maximum element of the vector according to the given --- comparison function. The vector may not be empty. -maximumBy :: (a -> a -> Ordering) -> Vector a -> a -{-# INLINE maximumBy #-} -maximumBy = G.maximumBy - --- | /O(n)/ Yield the minimum element of the vector. The vector may not be --- empty. -minimum :: Ord a => Vector a -> a -{-# INLINE minimum #-} -minimum = G.minimum - --- | /O(n)/ Yield the minimum element of the vector according to the given --- comparison function. The vector may not be empty. -minimumBy :: (a -> a -> Ordering) -> Vector a -> a -{-# INLINE minimumBy #-} -minimumBy = G.minimumBy - --- | /O(n)/ Yield the index of the maximum element of the vector. The vector --- may not be empty. -maxIndex :: Ord a => Vector a -> Int -{-# INLINE maxIndex #-} -maxIndex = G.maxIndex - --- | /O(n)/ Yield the index of the maximum element of the vector according to --- the given comparison function. The vector may not be empty. -maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE maxIndexBy #-} -maxIndexBy = G.maxIndexBy - --- | /O(n)/ Yield the index of the minimum element of the vector. The vector --- may not be empty. -minIndex :: Ord a => Vector a -> Int -{-# INLINE minIndex #-} -minIndex = G.minIndex - --- | /O(n)/ Yield the index of the minimum element of the vector according to --- the given comparison function. The vector may not be empty. -minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE minIndexBy #-} -minIndexBy = G.minIndexBy - --- Monadic folds --- ------------- - --- | /O(n)/ Monadic fold -foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a -{-# 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 #-} -fold1M = G.fold1M - --- | /O(n)/ Monadic fold with strict accumulator -foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a -{-# 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' #-} -fold1M' = G.fold1M' - --- | /O(n)/ Monadic fold that discards the result -foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () -{-# 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_ #-} -fold1M_ = G.fold1M_ - --- | /O(n)/ Monadic fold with strict accumulator that discards the result -foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () -{-# 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 () -{-# INLINE fold1M'_ #-} -fold1M'_ = G.fold1M'_ - --- Monadic sequencing --- ------------------ - --- | Evaluate each action and collect the results -sequence :: Monad m => Vector (m a) -> m (Vector a) -{-# INLINE sequence #-} -sequence = G.sequence - --- | Evaluate each action and discard the results -sequence_ :: Monad m => Vector (m a) -> m () -{-# INLINE sequence_ #-} -sequence_ = G.sequence_ - --- Prefix sums (scans) --- ------------------- - --- | /O(n)/ Prescan --- --- @ --- prescanl f z = 'init' . 'scanl' f z --- @ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ --- -prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl #-} -prescanl = G.prescanl - --- | /O(n)/ Prescan with strict accumulator -prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl' #-} -prescanl' = G.prescanl' - --- | /O(n)/ Scan --- --- @ --- postscanl f z = 'tail' . 'scanl' f z --- @ --- --- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ --- -postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl #-} -postscanl = G.postscanl - --- | /O(n)/ Scan with strict accumulator -postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl' #-} -postscanl' = G.postscanl' - --- | /O(n)/ Haskell-style scan --- --- > scanl f z = --- > where y1 = z --- > 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 - --- | /O(n)/ Haskell-style scan with strict accumulator -scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE scanl' #-} -scanl' = G.scanl' - --- | /O(n)/ Scan over a vector with its index -iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE iscanl #-} -iscanl = G.iscanl - --- | /O(n)/ Scan over a vector (strictly) with its index -iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE iscanl' #-} -iscanl' = G.iscanl' - --- | /O(n)/ Scan over a non-empty vector --- --- > scanl f = --- > where y1 = x1 --- > yi = f y(i-1) xi --- -scanl1 :: (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1 #-} -scanl1 = G.scanl1 - --- | /O(n)/ Scan over a non-empty vector with a strict accumulator -scanl1' :: (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1' #-} -scanl1' = G.scanl1' - --- | /O(n)/ Right-to-left prescan --- --- @ --- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' --- @ --- -prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr #-} -prescanr = G.prescanr - --- | /O(n)/ Right-to-left prescan with strict accumulator -prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr' #-} -prescanr' = G.prescanr' - --- | /O(n)/ Right-to-left scan -postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr #-} -postscanr = G.postscanr - --- | /O(n)/ Right-to-left scan with strict accumulator -postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr' #-} -postscanr' = G.postscanr' - --- | /O(n)/ Right-to-left Haskell-style scan -scanr :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr #-} -scanr = G.scanr - --- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator -scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr' #-} -scanr' = G.scanr' - --- | /O(n)/ Right-to-left scan over a vector with its index -iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE iscanr #-} -iscanr = G.iscanr - --- | /O(n)/ Right-to-left scan over a vector (strictly) with its index -iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE iscanr' #-} -iscanr' = G.iscanr' - --- | /O(n)/ Right-to-left scan over a non-empty vector -scanr1 :: (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1 #-} -scanr1 = G.scanr1 - --- | /O(n)/ Right-to-left scan over a non-empty vector with a strict --- accumulator -scanr1' :: (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1' #-} -scanr1' = G.scanr1' - --- Conversions - Lists --- ------------------------ - --- | /O(n)/ Convert a vector to a list -toList :: Vector a -> [a] -{-# INLINE toList #-} -toList = G.toList - --- | /O(n)/ Convert a list to a vector -fromList :: [a] -> Vector a -{-# INLINE fromList #-} -fromList = G.fromList - --- | /O(n)/ Convert the first @n@ elements of a list to a vector --- --- @ --- fromListN n xs = 'fromList' ('take' n xs) --- @ -fromListN :: Int -> [a] -> Vector a -{-# INLINE fromListN #-} -fromListN = G.fromListN - --- Conversions - Mutable vectors --- ----------------------------- - --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without --- copying. The mutable vector may not be used after this operation. -unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) -{-# INLINE unsafeFreeze #-} -unsafeFreeze = G.unsafeFreeze - --- | /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 a -> m (MVector (PrimState m) a) -{-# INLINE unsafeThaw #-} -unsafeThaw = G.unsafeThaw - --- | /O(n)/ Yield a mutable copy of the immutable vector. -thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) -{-# INLINE thaw #-} -thaw = G.thaw - --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) -{-# INLINE freeze #-} -freeze = G.freeze - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. This is not checked. -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 () -{-# INLINE copy #-} -copy = G.copy diff --git a/Data/Vector/Fusion/Bundle.hs b/Data/Vector/Fusion/Bundle.hs deleted file mode 100644 --- a/Data/Vector/Fusion/Bundle.hs +++ /dev/null @@ -1,655 +0,0 @@ -{-# 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, eqBy, cmpBy -) 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_ ) - -#if MIN_VERSION_base(4,9,0) -import Data.Functor.Classes (Eq1 (..), Ord1 (..)) -#endif - -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 = eqBy (==) - -eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool -{-# INLINE eqBy #-} -eqBy e x y = unId (M.eqBy e x y) - --- | Lexicographically compare two 'Bundle's -cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering -{-# INLINE cmp #-} -cmp = cmpBy compare - -cmpBy :: (a -> b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering -{-# INLINE cmpBy #-} -cmpBy c x y = unId (M.cmpBy c 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 - -#if MIN_VERSION_base(4,9,0) -instance Eq1 (M.Bundle Id v) where - {-# INLINE liftEq #-} - liftEq = eqBy - -instance Ord1 (M.Bundle Id v) where - {-# INLINE liftCompare #-} - liftCompare = cmpBy -#endif - --- 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 deleted file mode 100644 --- a/Data/Vector/Fusion/Bundle/Monadic.hs +++ /dev/null @@ -1,1139 +0,0 @@ -{-# 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 - eqBy, cmpBy, - - -- * 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 ) -import Data.Word ( Word8, Word16, Word32, Word64 ) - -#if !MIN_VERSION_base(4,8,0) -import Data.Word ( Word ) -#endif - -#include "vector.h" -#include "MachDeps.h" - -#if WORD_SIZE_IN_BITS > 32 -import Data.Int ( Int64 ) -#endif - -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) (smallerThan 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 -eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool -{-# INLINE_FUSED eqBy #-} -eqBy eq x y - | sizesAreDifferent (sSize x) (sSize y) = return False - | otherwise = S.eqBy eq (sElems x) (sElems y) - where - sizesAreDifferent :: Size -> Size -> Bool - sizesAreDifferent (Exact a) (Exact b) = a /= b - sizesAreDifferent (Exact a) (Max b) = a > b - sizesAreDifferent (Max a) (Exact b) = a < b - sizesAreDifferent _ _ = False - --- | Lexicographically compare two 'Bundle's -cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering -{-# INLINE_FUSED cmpBy #-} -cmpBy cmp x y = S.cmpBy cmp (sElems x) (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 (Just x)) (Exact n) - where - n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 - - {-# INLINE_INNER step #-} - step Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (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 (Just 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 Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (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 (Just 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 Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (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 (Just 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 Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (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 #-} - - -#if WORD_SIZE_IN_BITS > 32 - --- 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 (Just 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 Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (z+1)) - | otherwise = return $ Done - - -{-# 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 ini) (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 #-} --- GHC changed definition of Enum for Double in GHC8.6 so we have to --- accomodate both definitions in order to preserve validity of --- rewrite rule --- --- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081 --- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f -#if MIN_VERSION_base(4,12,0) - ini = 0 - step x | x' <= lim = return $ Yield x' (x+1) - | otherwise = return $ Done - where - x' = x + n -#else - ini = n - step x | x <= lim = return $ Yield x (x+1) - | otherwise = return $ Done -#endif - -{-# 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 deleted file mode 100644 --- a/Data/Vector/Fusion/Bundle/Size.hs +++ /dev/null @@ -1,129 +0,0 @@ --- | --- 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, smallerThan, 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 - --- | Select a safe smaller than known size. -smallerThan :: Int -> Size -> Size -{-# INLINE smallerThan #-} -smallerThan m (Exact n) = Exact (delay_inline min m n) -smallerThan m (Max n) = Max (delay_inline min m n) -smallerThan _ 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/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs deleted file mode 100644 --- a/Data/Vector/Fusion/Stream/Monadic.hs +++ /dev/null @@ -1,1664 +0,0 @@ -{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} - --- | --- Module : Data.Vector.Fusion.Stream.Monadic --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Monadic stream combinators. --- - -module Data.Vector.Fusion.Stream.Monadic ( - Stream(..), Step(..), SPEC(..), - - -- * 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 - eqBy, cmpBy, - - -- * Filtering - filter, filterM, uniq, mapMaybe, 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 -) where - -import Data.Vector.Fusion.Util ( Box(..) ) - -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 ) -import Data.Word ( Word8, Word16, Word32, Word64 ) - -#if !MIN_VERSION_base(4,8,0) -import Data.Word ( Word8, Word16, Word32, Word, Word64 ) -#endif - -#if __GLASGOW_HASKELL__ >= 708 -import GHC.Types ( SPEC(..) ) -#elif __GLASGOW_HASKELL__ >= 700 -import GHC.Exts ( SpecConstrAnnotation(..) ) -#endif - -#include "vector.h" -#include "MachDeps.h" - -#if WORD_SIZE_IN_BITS > 32 -import Data.Int ( Int64 ) -#endif - -#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 (\state -> ERROR state emptyStream) - --- | Result of taking a single step in a stream -data Step s a where - Yield :: a -> s -> Step s a - Skip :: s -> Step s a - Done :: Step s a - -instance Functor (Step s) where - {-# INLINE fmap #-} - fmap f (Yield x s) = Yield (f x) s - fmap _ (Skip s) = Skip s - fmap _ Done = Done - --- | 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_FUSED length #-} -length = foldl' (\n _ -> n+1) 0 - --- | Check if a 'Stream' is empty -null :: Monad m => Stream m a -> m Bool -{-# 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_FUSED empty #-} -empty = Stream (const (return Done)) () - --- | Singleton 'Stream' -singleton :: Monad m => a -> Stream m a -{-# INLINE_FUSED singleton #-} -singleton x = Stream (return . step) True - where - {-# INLINE_INNER step #-} - step True = Yield x False - step False = Done - --- | Replicate a value to a given length -replicate :: Monad m => Int -> a -> Stream m a -{-# INLINE_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_FUSED replicateM #-} -replicateM n p = Stream step n - where - {-# INLINE_INNER step #-} - step i | i <= 0 = return Done - | otherwise = do { x <- p; return $ Yield x (i-1) } - -generate :: Monad m => Int -> (Int -> a) -> Stream m a -{-# INLINE generate #-} -generate n f = generateM n (return . f) - --- | Generate a stream from its indices -generateM :: Monad m => Int -> (Int -> m a) -> Stream m a -{-# INLINE_FUSED generateM #-} -generateM n f = n `seq` Stream step 0 - where - {-# INLINE_INNER step #-} - step i | i < n = do - x <- f i - return $ Yield x (i+1) - | otherwise = return Done - --- | Prepend an element -cons :: Monad m => a -> Stream m a -> Stream m a -{-# INLINE cons #-} -cons x s = singleton x ++ s - --- | Append an element -snoc :: Monad m => Stream m a -> a -> Stream m a -{-# INLINE snoc #-} -snoc s x = s ++ singleton x - -infixr 5 ++ --- | Concatenate two 'Stream's -(++) :: Monad m => Stream m a -> Stream m a -> Stream m a -{-# INLINE_FUSED (++) #-} -Stream stepa ta ++ Stream stepb tb = Stream step (Left ta) - where - {-# INLINE_INNER step #-} - step (Left sa) = do - r <- stepa sa - case r of - Yield x sa' -> return $ Yield x (Left sa') - Skip sa' -> return $ Skip (Left sa') - Done -> return $ Skip (Right tb) - step (Right sb) = do - r <- stepb sb - case r of - Yield x sb' -> return $ Yield x (Right sb') - Skip sb' -> return $ Skip (Right sb') - Done -> return $ Done - --- Accessing elements --- ------------------ - --- | First element of the 'Stream' or error if empty -head :: Monad m => Stream m a -> m a -{-# INLINE_FUSED head #-} -head (Stream step t) = head_loop SPEC t - where - head_loop !_ s - = do - r <- step s - case r of - Yield x _ -> return x - Skip s' -> head_loop SPEC s' - Done -> EMPTY_STREAM "head" - - - --- | Last element of the 'Stream' or error if empty -last :: Monad m => Stream m a -> m a -{-# INLINE_FUSED last #-} -last (Stream step t) = last_loop0 SPEC t - where - last_loop0 !_ s - = do - r <- step s - case r of - Yield x s' -> last_loop1 SPEC x s' - Skip s' -> last_loop0 SPEC s' - Done -> EMPTY_STREAM "last" - - last_loop1 !_ x s - = do - r <- step s - case r of - Yield y s' -> last_loop1 SPEC y s' - Skip s' -> last_loop1 SPEC x s' - Done -> return x - -infixl 9 !! --- | Element at the given position -(!!) :: Monad m => Stream m a -> Int -> m a -{-# INLINE (!!) #-} -Stream step t !! j | j < 0 = ERROR "!!" "negative index" - | otherwise = index_loop SPEC t j - where - index_loop !_ s i - = i `seq` - do - r <- step s - case r of - Yield x s' | i == 0 -> return x - | otherwise -> index_loop SPEC s' (i-1) - Skip s' -> index_loop SPEC s' i - Done -> EMPTY_STREAM "!!" - -infixl 9 !? --- | Element at the given position or 'Nothing' if out of bounds -(!?) :: Monad m => Stream m a -> Int -> m (Maybe a) -{-# INLINE (!?) #-} -Stream step t !? j = index_loop SPEC t j - where - index_loop !_ s i - = i `seq` - do - r <- step s - case r of - Yield x s' | i == 0 -> return (Just x) - | otherwise -> index_loop SPEC s' (i-1) - Skip s' -> index_loop SPEC s' i - Done -> return Nothing - --- Substreams --- ---------- - --- | Extract a substream of the given length starting at the given position. -slice :: Monad m => Int -- ^ starting index - -> Int -- ^ length - -> Stream m a - -> Stream m a -{-# INLINE slice #-} -slice i n s = take n (drop i s) - --- | All but the last element -init :: Monad m => Stream m a -> Stream m a -{-# INLINE_FUSED init #-} -init (Stream step t) = Stream step' (Nothing, t) - where - {-# INLINE_INNER step' #-} - step' (Nothing, s) = liftM (\r -> - case r of - Yield x s' -> Skip (Just x, s') - Skip s' -> Skip (Nothing, s') - Done -> EMPTY_STREAM "init" - ) (step s) - - step' (Just x, s) = liftM (\r -> - case r of - Yield y s' -> Yield x (Just y, s') - Skip s' -> Skip (Just x, s') - Done -> Done - ) (step s) - --- | All but the first element -tail :: Monad m => Stream m a -> Stream m a -{-# INLINE_FUSED tail #-} -tail (Stream step t) = Stream step' (Left t) - where - {-# INLINE_INNER step' #-} - step' (Left s) = liftM (\r -> - case r of - Yield _ s' -> Skip (Right s') - Skip s' -> Skip (Left s') - Done -> EMPTY_STREAM "tail" - ) (step s) - - step' (Right s) = liftM (\r -> - case r of - Yield x s' -> Yield x (Right s') - Skip s' -> Skip (Right s') - Done -> Done - ) (step s) - --- | The first @n@ elements -take :: Monad m => Int -> Stream m a -> Stream m a -{-# INLINE_FUSED take #-} -take n (Stream step t) = n `seq` Stream step' (t, 0) - where - {-# INLINE_INNER step' #-} - step' (s, i) | i < n = liftM (\r -> - case r of - Yield x s' -> Yield x (s', i+1) - Skip s' -> Skip (s', i) - Done -> Done - ) (step s) - step' (_, _) = return Done - --- | All but the first @n@ elements -drop :: Monad m => Int -> Stream m a -> Stream m a -{-# 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 _ s' -> Skip (s', Just (i-1)) - Skip s' -> Skip (s', Just i) - Done -> Done - ) (step s) - | otherwise = return $ Skip (s, Nothing) - - step' (s, Nothing) = liftM (\r -> - case r of - Yield x s' -> Yield x (s', Nothing) - Skip s' -> Skip (s', Nothing) - Done -> Done - ) (step s) - --- Mapping --- ------- - -instance Monad m => Functor (Stream m) where - {-# INLINE fmap #-} - fmap = map - --- | Map a function over a 'Stream' -map :: Monad m => (a -> b) -> Stream m a -> Stream m b -{-# INLINE map #-} -map f = mapM (return . f) - - --- | Map a monadic function over a 'Stream' -mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b -{-# INLINE_FUSED mapM #-} -mapM f (Stream step t) = Stream step' t - where - {-# INLINE_INNER step' #-} - step' s = do - r <- step s - case r of - Yield x s' -> liftM (`Yield` s') (f x) - Skip s' -> return (Skip s') - Done -> return Done - -consume :: Monad m => Stream m a -> m () -{-# INLINE_FUSED consume #-} -consume (Stream step t) = consume_loop SPEC t - where - consume_loop !_ s - = do - r <- step s - case r of - Yield _ s' -> consume_loop SPEC s' - Skip s' -> consume_loop SPEC s' - Done -> return () - --- | Execute a monadic action for each element of the 'Stream' -mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () -{-# INLINE_FUSED mapM_ #-} -mapM_ m = consume . mapM m - --- | Transform a 'Stream' to use a different monad -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_FUSED unbox #-} -unbox (Stream step t) = Stream step' t - where - {-# INLINE_INNER step' #-} - step' s = do - r <- step s - case r of - Yield (Box x) s' -> return $ Yield x s' - Skip s' -> return $ Skip s' - Done -> return $ Done - --- Zipping --- ------- - --- | Pair each element in a 'Stream' with its index -indexed :: Monad m => Stream m a -> Stream m (Int,a) -{-# INLINE_FUSED indexed #-} -indexed (Stream step t) = Stream step' (t,0) - where - {-# INLINE_INNER step' #-} - step' (s,i) = i `seq` - do - r <- step s - case r of - Yield x s' -> return $ Yield (i,x) (s', i+1) - Skip s' -> return $ Skip (s', i) - Done -> return Done - --- | Pair each element in a 'Stream' with its index, starting from the right --- and counting down -indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a) -{-# INLINE_FUSED indexedR #-} -indexedR m (Stream step t) = Stream step' (t,m) - where - {-# INLINE_INNER step' #-} - step' (s,i) = i `seq` - do - r <- step s - case r of - Yield x s' -> let i' = i-1 - in - return $ Yield (i',x) (s', i') - Skip s' -> return $ Skip (s', i) - Done -> return Done - --- | Zip two 'Stream's with the given monadic function -zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c -{-# 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 -> - case r of - Yield x sa' -> Skip (sa', sb, Just x) - Skip sa' -> Skip (sa', sb, Nothing) - Done -> Done - ) (stepa sa) - - step (sa, sb, Just x) = do - r <- stepb sb - case r of - Yield y sb' -> - do - z <- f x y - return $ Yield z (sa, sb', Nothing) - Skip sb' -> return $ Skip (sa, sb', Just x) - Done -> return $ Done - --- FIXME: This might expose an opportunity for inplace execution. -{-# RULES - -"zipWithM xs xs [Vector.Stream]" forall f xs. - zipWithM f xs xs = mapM (\x -> f x x) xs #-} - - -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_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 - r <- stepa sa - return $ case r of - Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing)) - Skip sa' -> Skip (sa', sb, sc, Nothing) - Done -> Done - - step (sa, sb, sc, Just (x, Nothing)) = do - r <- stepb sb - return $ case r of - Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y)) - Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing)) - Done -> Done - - step (sa, sb, sc, Just (x, Just y)) = do - r <- stepc sc - case r of - Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing)) - Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y)) - Done -> return $ Done - -zipWith4M :: Monad m => (a -> b -> c -> d -> m e) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -{-# INLINE zipWith4M #-} -zipWith4M f sa sb sc sd - = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) - -zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m f -{-# INLINE zipWith5M #-} -zipWith5M f sa sb sc sd se - = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) - -zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m f -> Stream m g -{-# INLINE zipWith6M #-} -zipWith6M fn sa sb sc sd se sf - = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) - (zip3 sd se sf) - -zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c -{-# INLINE zipWith #-} -zipWith f = zipWithM (\a b -> return (f a b)) - -zipWith3 :: Monad m => (a -> b -> c -> d) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d -{-# INLINE zipWith3 #-} -zipWith3 f = zipWith3M (\a b c -> return (f a b c)) - -zipWith4 :: Monad m => (a -> b -> c -> d -> e) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -{-# INLINE zipWith4 #-} -zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) - -zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m f -{-# INLINE zipWith5 #-} -zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) - -zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) - -> Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m f -> Stream m g -{-# INLINE zipWith6 #-} -zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) - -zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b) -{-# INLINE zip #-} -zip = zipWith (,) - -zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c) -{-# INLINE zip3 #-} -zip3 = zipWith3 (,,) - -zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m (a,b,c,d) -{-# INLINE zip4 #-} -zip4 = zipWith4 (,,,) - -zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m (a,b,c,d,e) -{-# INLINE zip5 #-} -zip5 = zipWith5 (,,,,) - -zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d - -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f) -{-# INLINE zip6 #-} -zip6 = zipWith6 (,,,,,) - --- Comparisons --- ----------- - --- | Check if two 'Stream's are equal -eqBy :: (Monad m) => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool -{-# INLINE_FUSED eqBy #-} -eqBy 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' - | eq 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 -cmpBy :: (Monad m) => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering -{-# INLINE_FUSED cmpBy #-} -cmpBy 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 `cmp` 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 --- --------- - --- | Drop elements which do not satisfy the predicate -filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -{-# INLINE filter #-} -filter f = filterM (return . f) - -mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b -{-# INLINE_FUSED mapMaybe #-} -mapMaybe f (Stream step t) = Stream step' t - where - {-# INLINE_INNER step' #-} - step' s = do - r <- step s - case r of - Yield x s' -> do - return $ case f x of - Nothing -> Skip s' - Just b' -> Yield b' s' - Skip s' -> return $ Skip s' - Done -> return $ Done - --- | Drop elements which do not satisfy the monadic predicate -filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -{-# INLINE_FUSED filterM #-} -filterM f (Stream step t) = Stream step' t - where - {-# INLINE_INNER step' #-} - step' s = do - r <- step s - case r of - Yield x s' -> do - b <- f x - return $ if b then Yield x s' - else Skip s' - Skip s' -> return $ Skip s' - Done -> return $ Done - --- | Drop repeated adjacent elements. -uniq :: (Eq a, Monad m) => Stream m a -> Stream m a -{-# INLINE_FUSED uniq #-} -uniq (Stream step st) = Stream step' (Nothing,st) - where - {-# INLINE_INNER step' #-} - step' (Nothing, s) = do r <- step s - case r of - Yield x s' -> return $ Yield x (Just x , s') - Skip s' -> return $ Skip (Nothing, s') - Done -> return Done - step' (Just x0, s) = do r <- step s - case r of - Yield x s' | x == x0 -> return $ Skip (Just x0, s') - | otherwise -> return $ Yield x (Just x , s') - Skip s' -> return $ Skip (Just x0, s') - Done -> return Done - --- | Longest prefix of elements that satisfy the predicate -takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -{-# INLINE takeWhile #-} -takeWhile f = takeWhileM (return . f) - --- | Longest prefix of elements that satisfy the monadic predicate -takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -{-# INLINE_FUSED takeWhileM #-} -takeWhileM f (Stream step t) = Stream step' t - where - {-# INLINE_INNER step' #-} - step' s = do - r <- step s - case r of - Yield x s' -> do - b <- f x - return $ if b then Yield x s' else Done - Skip s' -> return $ Skip s' - Done -> return $ Done - --- | Drop the longest prefix of elements that satisfy the predicate -dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -{-# INLINE dropWhile #-} -dropWhile f = dropWhileM (return . f) - -data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s - --- | Drop the longest prefix of elements that satisfy the monadic predicate -dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -{-# INLINE_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! - - {-# INLINE_INNER step' #-} - step' (DropWhile_Drop s) - = do - r <- step s - case r of - Yield x s' -> do - b <- f x - return $ if b then Skip (DropWhile_Drop s') - else Skip (DropWhile_Yield x s') - Skip s' -> return $ Skip (DropWhile_Drop s') - Done -> return $ Done - - step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s) - - step' (DropWhile_Next s) - = liftM (\r -> - case r of - Yield x s' -> Skip (DropWhile_Yield x s') - Skip s' -> Skip (DropWhile_Next s') - Done -> Done - ) (step s) - --- Searching --- --------- - -infix 4 `elem` --- | Check whether the 'Stream' contains an element -elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool -{-# INLINE_FUSED elem #-} -elem x (Stream step t) = elem_loop SPEC t - where - elem_loop !_ s - = do - r <- step s - case r of - Yield y s' | x == y -> return True - | otherwise -> elem_loop SPEC s' - Skip s' -> elem_loop SPEC s' - Done -> return False - -infix 4 `notElem` --- | Inverse of `elem` -notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool -{-# INLINE notElem #-} -notElem x s = liftM not (elem x s) - --- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' --- if no such element exists. -find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a) -{-# INLINE find #-} -find f = findM (return . f) - --- | Yield 'Just' the first element that satisfies the monadic predicate or --- 'Nothing' if no such element exists. -findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a) -{-# INLINE_FUSED findM #-} -findM f (Stream step t) = find_loop SPEC t - where - find_loop !_ s - = do - r <- step s - case r of - Yield x s' -> do - b <- f x - if b then return $ Just x - else find_loop SPEC s' - Skip s' -> find_loop SPEC s' - Done -> return Nothing - --- | Yield 'Just' the index of the first element that satisfies the predicate --- or 'Nothing' if no such element exists. -findIndex :: Monad m => (a -> Bool) -> Stream m 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) -> Stream m a -> m (Maybe Int) -{-# INLINE_FUSED findIndexM #-} -findIndexM f (Stream step t) = findIndex_loop SPEC t 0 - where - findIndex_loop !_ s i - = do - r <- step s - case r of - Yield x s' -> do - b <- f x - if b then return $ Just i - else findIndex_loop SPEC s' (i+1) - Skip s' -> findIndex_loop SPEC s' i - Done -> return Nothing - --- Folding --- ------- - --- | Left fold -foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a -{-# INLINE foldl #-} -foldl f = foldlM (\a b -> return (f a b)) - --- | Left fold with a monadic operator -foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -{-# INLINE_FUSED foldlM #-} -foldlM m w (Stream step t) = foldlM_loop SPEC w t - where - foldlM_loop !_ z s - = do - r <- step s - case r of - Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' } - Skip s' -> foldlM_loop SPEC z s' - Done -> return z - --- | Same as 'foldlM' -foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -{-# INLINE foldM #-} -foldM = foldlM - --- | Left fold over a non-empty 'Stream' -foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a -{-# INLINE foldl1 #-} -foldl1 f = foldl1M (\a b -> return (f a b)) - --- | Left fold over a non-empty 'Stream' with a monadic operator -foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a -{-# INLINE_FUSED foldl1M #-} -foldl1M f (Stream step t) = foldl1M_loop SPEC t - where - foldl1M_loop !_ s - = do - r <- step s - case r of - Yield x s' -> foldlM f x (Stream step s') - Skip s' -> foldl1M_loop SPEC s' - Done -> EMPTY_STREAM "foldl1M" - --- | Same as 'foldl1M' -fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a -{-# INLINE fold1M #-} -fold1M = foldl1M - --- | Left fold with a strict accumulator -foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a -{-# INLINE foldl' #-} -foldl' f = foldlM' (\a b -> return (f a b)) - --- | Left fold with a strict accumulator and a monadic operator -foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -{-# INLINE_FUSED foldlM' #-} -foldlM' m w (Stream step t) = foldlM'_loop SPEC w t - where - foldlM'_loop !_ z s - = z `seq` - do - r <- step s - case r of - Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' } - Skip s' -> foldlM'_loop SPEC z s' - Done -> return z - --- | Same as 'foldlM'' -foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -{-# INLINE foldM' #-} -foldM' = foldlM' - --- | Left fold over a non-empty 'Stream' with a strict accumulator -foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a -{-# INLINE foldl1' #-} -foldl1' f = foldl1M' (\a b -> return (f a b)) - --- | Left fold over a non-empty 'Stream' with a strict accumulator and a --- monadic operator -foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a -{-# INLINE_FUSED foldl1M' #-} -foldl1M' f (Stream step t) = foldl1M'_loop SPEC t - where - foldl1M'_loop !_ s - = do - r <- step s - case r of - Yield x s' -> foldlM' f x (Stream step s') - Skip s' -> foldl1M'_loop SPEC s' - Done -> EMPTY_STREAM "foldl1M'" - --- | Same as 'foldl1M'' -fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a -{-# INLINE fold1M' #-} -fold1M' = foldl1M' - --- | Right fold -foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b -{-# INLINE foldr #-} -foldr f = foldrM (\a b -> return (f a b)) - --- | Right fold with a monadic operator -foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b -{-# INLINE_FUSED foldrM #-} -foldrM f z (Stream step t) = foldrM_loop SPEC t - where - foldrM_loop !_ s - = do - r <- step s - case r of - Yield x s' -> f x =<< foldrM_loop SPEC s' - Skip s' -> foldrM_loop SPEC s' - Done -> return z - --- | Right fold over a non-empty stream -foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a -{-# INLINE foldr1 #-} -foldr1 f = foldr1M (\a b -> return (f a b)) - --- | Right fold over a non-empty stream with a monadic operator -foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a -{-# INLINE_FUSED foldr1M #-} -foldr1M f (Stream step t) = foldr1M_loop0 SPEC t - where - foldr1M_loop0 !_ s - = do - r <- step s - case r of - Yield x s' -> foldr1M_loop1 SPEC x s' - Skip s' -> foldr1M_loop0 SPEC s' - Done -> EMPTY_STREAM "foldr1M" - - foldr1M_loop1 !_ x s - = do - r <- step s - case r of - Yield y s' -> f x =<< foldr1M_loop1 SPEC y s' - Skip s' -> foldr1M_loop1 SPEC x s' - Done -> return x - --- Specialised folds --- ----------------- - -and :: Monad m => Stream m Bool -> m Bool -{-# INLINE_FUSED and #-} -and (Stream step t) = and_loop SPEC t - where - and_loop !_ s - = do - r <- step s - case r of - Yield False _ -> return False - Yield True s' -> and_loop SPEC s' - Skip s' -> and_loop SPEC s' - Done -> return True - -or :: Monad m => Stream m Bool -> m Bool -{-# INLINE_FUSED or #-} -or (Stream step t) = or_loop SPEC t - where - or_loop !_ s - = do - r <- step s - case r of - Yield False s' -> or_loop SPEC s' - Yield True _ -> return True - Skip s' -> or_loop SPEC s' - Done -> return False - -concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b -{-# INLINE concatMap #-} -concatMap f = concatMapM (return . f) - -concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b -{-# INLINE_FUSED concatMapM #-} -concatMapM f (Stream step t) = Stream concatMap_go (Left t) - where - concatMap_go (Left s) = do - r <- step s - case r of - Yield a s' -> do - b_stream <- f a - return $ Skip (Right (b_stream, s')) - Skip s' -> return $ Skip (Left s') - Done -> return Done - concatMap_go (Right (Stream inner_step inner_s, s)) = do - r <- inner_step inner_s - case r of - 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)) -> 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 - r <- ostep t - case r of - Yield a t' -> do - s <- mk a - s `seq` return (Skip (Right (s,t'))) - Skip t' -> return $ Skip (Left t') - Done -> return $ Done - - - step (Right (s,t)) = do - r <- istep s - case r of - Yield x s' -> return $ Yield x (Right (s',t)) - Skip s' -> return $ Skip (Right (s',t)) - Done -> return $ Skip (Left t) - --- Unfolding --- --------- - --- | Unfold -unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a -{-# 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_FUSED unfoldrM #-} -unfoldrM f t = Stream step t - where - {-# INLINE_INNER step #-} - step s = liftM (\r -> - case r of - Just (x, s') -> Yield x s' - Nothing -> Done - ) (f s) - -unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m 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 -> Stream m a -{-# INLINE_FUSED unfoldrNM #-} -unfoldrNM m f t = Stream step (t,m) - where - {-# INLINE_INNER step #-} - step (s,n) | n <= 0 = return Done - | otherwise = liftM (\r -> - case r of - Just (x,s') -> Yield x (s',n-1) - Nothing -> Done - ) (f s) - --- | Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a -{-# INLINE_FUSED iterateNM #-} -iterateNM n f x0 = Stream step (x0,n) - where - {-# INLINE_INNER step #-} - step (x,i) | i <= 0 = return Done - | i == n = return $ Yield x (x,i-1) - | otherwise = do a <- f x - return $ Yield a (a,i-1) - --- | Apply function n times to value. Zeroth element is original value. -iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a -{-# INLINE_FUSED iterateN #-} -iterateN n f x0 = iterateNM n (return . f) x0 - --- Scans --- ----- - --- | Prefix scan -prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE prescanl #-} -prescanl f = prescanlM (\a b -> return (f a b)) - --- | Prefix scan with a monadic operator -prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE_FUSED prescanlM #-} -prescanlM f w (Stream step t) = Stream step' (t,w) - where - {-# INLINE_INNER step' #-} - step' (s,x) = do - r <- step s - case r of - Yield y s' -> do - z <- f x y - return $ Yield x (s', z) - Skip s' -> return $ Skip (s', x) - Done -> return Done - --- | Prefix scan with strict accumulator -prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE prescanl' #-} -prescanl' f = prescanlM' (\a b -> return (f a b)) - --- | Prefix scan with strict accumulator and a monadic operator -prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE_FUSED prescanlM' #-} -prescanlM' f w (Stream step t) = Stream step' (t,w) - where - {-# INLINE_INNER step' #-} - step' (s,x) = x `seq` - do - r <- step s - case r of - Yield y s' -> do - z <- f x y - return $ Yield x (s', z) - Skip s' -> return $ Skip (s', x) - Done -> return Done - --- | Suffix scan -postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE postscanl #-} -postscanl f = postscanlM (\a b -> return (f a b)) - --- | Suffix scan with a monadic operator -postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE_FUSED postscanlM #-} -postscanlM f w (Stream step t) = Stream step' (t,w) - where - {-# INLINE_INNER step' #-} - step' (s,x) = do - r <- step s - case r of - Yield y s' -> do - z <- f x y - return $ Yield z (s',z) - Skip s' -> return $ Skip (s',x) - Done -> return Done - --- | Suffix scan with strict accumulator -postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE postscanl' #-} -postscanl' f = postscanlM' (\a b -> return (f a b)) - --- | Suffix scan with strict acccumulator and a monadic operator -postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE_FUSED postscanlM' #-} -postscanlM' f w (Stream step t) = w `seq` Stream step' (t,w) - where - {-# INLINE_INNER step' #-} - step' (s,x) = x `seq` - do - r <- step s - case r of - Yield y s' -> do - z <- f x y - z `seq` return (Yield z (s',z)) - Skip s' -> return $ Skip (s',x) - Done -> return Done - --- | Haskell-style scan -scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE scanl #-} -scanl f = scanlM (\a b -> return (f a b)) - --- | Haskell-style scan with a monadic operator -scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE scanlM #-} -scanlM f z s = z `cons` postscanlM f z s - --- | Haskell-style scan with strict accumulator -scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -{-# INLINE scanl' #-} -scanl' f = scanlM' (\a b -> return (f a b)) - --- | Haskell-style scan with strict accumulator and a monadic operator -scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -{-# INLINE scanlM' #-} -scanlM' f z s = z `seq` (z `cons` postscanlM f z s) - --- | Scan over a non-empty 'Stream' -scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a -{-# INLINE scanl1 #-} -scanl1 f = scanl1M (\x y -> return (f x y)) - --- | Scan over a non-empty 'Stream' with a monadic operator -scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a -{-# INLINE_FUSED scanl1M #-} -scanl1M f (Stream step t) = Stream step' (t, Nothing) - where - {-# INLINE_INNER step' #-} - step' (s, Nothing) = do - r <- step s - case r of - Yield x s' -> return $ Yield x (s', Just x) - Skip s' -> return $ Skip (s', Nothing) - Done -> EMPTY_STREAM "scanl1M" - - step' (s, Just x) = do - r <- step s - case r of - Yield y s' -> do - z <- f x y - return $ Yield z (s', Just z) - Skip s' -> return $ Skip (s', Just x) - Done -> return Done - --- | Scan over a non-empty 'Stream' with a strict accumulator -scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a -{-# INLINE scanl1' #-} -scanl1' f = scanl1M' (\x y -> return (f x y)) - --- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic --- operator -scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a -{-# INLINE_FUSED scanl1M' #-} -scanl1M' f (Stream step t) = Stream step' (t, Nothing) - where - {-# INLINE_INNER step' #-} - step' (s, Nothing) = do - r <- step s - case r of - Yield x s' -> x `seq` return (Yield x (s', Just x)) - Skip s' -> return $ Skip (s', Nothing) - Done -> EMPTY_STREAM "scanl1M" - - step' (s, Just x) = x `seq` - do - r <- step s - case r of - Yield y s' -> do - z <- f x y - z `seq` return (Yield z (s', Just z)) - Skip s' -> return $ Skip (s', Just x) - Done -> return Done - --- Enumerations --- ------------ - --- The Enum class is broken for this, there just doesn't seem to be a --- way to implement this generically. We have to specialise for as many types --- as we can but this doesn't help in polymorphic loops. - --- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. -enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a -{-# INLINE_FUSED enumFromStepN #-} -enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n) - where - {-# INLINE_INNER step #-} - step (w,m) | m > 0 = return $ Yield w (w+y,m-1) - | otherwise = return $ Done - --- | Enumerate values --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a -{-# INLINE_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 -> Stream m a -{-# INLINE_FUSED enumFromTo_small #-} -enumFromTo_small x y = x `seq` y `seq` Stream step (Just x) - where - {-# INLINE_INNER step #-} - step Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (z+1)) - | otherwise = return $ Done - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16 #-} - - -#if WORD_SIZE_IN_BITS > 32 - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32 #-} - - -#endif - --- NOTE: We could implement a generic "too large" test: --- --- len x y | x > y = 0 --- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n --- | otherwise = error --- where --- n = y-x+1 --- --- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for --- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 --- - -enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int -{-# INLINE_FUSED enumFromTo_int #-} -enumFromTo_int x y = x `seq` y `seq` Stream step (Just x) - 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 Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (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 (Just x) - where - {-# INLINE_INNER step #-} - step Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (z+1)) - | otherwise = return $ Done - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int - -#if WORD_SIZE_IN_BITS > 32 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} - -#else - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32 #-} - -#endif - -enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a -{-# INLINE_FUSED enumFromTo_big_word #-} -enumFromTo_big_word x y = x `seq` y `seq` Stream step (Just x) - where - {-# INLINE_INNER step #-} - step Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (z+1)) - | otherwise = return $ Done - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_big_word - :: Monad m => Word64 -> Word64 -> Stream m Word64 - -#if WORD_SIZE_IN_BITS == 32 - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_big_word - :: Monad m => Word32 -> Word32 -> Stream m Word32 - -#endif - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_big_word - :: Monad m => Integer -> Integer -> Stream m Integer #-} - - - -#if WORD_SIZE_IN_BITS > 32 - --- FIXME: the "too large" test is totally wrong -enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a -{-# INLINE_FUSED enumFromTo_big_int #-} -enumFromTo_big_int x y = x `seq` y `seq` Stream step (Just x) - where - {-# INLINE_INNER step #-} - step Nothing = return $ Done - step (Just z) | z == y = return $ Yield z Nothing - | z < y = return $ Yield z (Just (z+1)) - | otherwise = return $ Done - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} - - - -#endif - -enumFromTo_char :: Monad m => Char -> Char -> Stream m Char -{-# INLINE_FUSED enumFromTo_char #-} -enumFromTo_char x y = x `seq` y `seq` Stream step xn - where - xn = ord x - yn = ord y - - {-# INLINE_INNER step #-} - step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) - | otherwise = return $ Done - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_char #-} - - - ------------------------------------------------------------------------- - --- Specialise enumFromTo for Float and Double. --- Also, try to do something about pairs? - -enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a -{-# INLINE_FUSED enumFromTo_double #-} -enumFromTo_double n m = n `seq` m `seq` Stream step ini - where - lim = m + 1/2 -- important to float out - --- GHC changed definition of Enum for Double in GHC8.6 so we have to --- accomodate both definitions in order to preserve validity of --- rewrite rule --- --- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081 --- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f -#if MIN_VERSION_base(4,12,0) - ini = 0 - step x | x' <= lim = return $ Yield x' (x+1) - | otherwise = return $ Done - where - x' = x + n -#else - ini = n - step x | x <= lim = return $ Yield x (x+1) - | otherwise = return $ Done -#endif - -{-# RULES - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double - -"enumFromTo [Stream]" - enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float #-} - - - ------------------------------------------------------------------------- - --- | Enumerate values with a given step. --- --- /WARNING:/ This operation is very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a -{-# INLINE_FUSED enumFromThenTo #-} -enumFromThenTo x y z = fromList [x, y .. z] - --- FIXME: Specialise enumFromThenTo. - --- Conversions --- ----------- - --- | Convert a 'Stream' to a list -toList :: Monad m => Stream m a -> m [a] -{-# INLINE toList #-} -toList = foldr (:) [] - --- | Convert a list to a 'Stream' -fromList :: Monad m => [a] -> Stream m a -{-# INLINE fromList #-} -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 'Bundle' -fromListN :: Monad m => Int -> [a] -> Stream m a -{-# INLINE_FUSED fromListN #-} -fromListN m zs = Stream step (zs,m) - where - {-# INLINE_INNER step #-} - step (_, n) | n <= 0 = return Done - step (x:xs,n) = return (Yield x (xs,n-1)) - step ([],_) = return Done - -{- -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 - 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/Util.hs b/Data/Vector/Fusion/Util.hs deleted file mode 100644 --- a/Data/Vector/Fusion/Util.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE CPP #-} --- | --- Module : Data.Vector.Fusion.Util --- Copyright : (c) Roman Leshchinskiy 2009 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : portable --- --- Fusion-related utility types --- - -module Data.Vector.Fusion.Util ( - Id(..), Box(..), - - delay_inline, delayed_min -) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative (Applicative(..)) -#endif - --- | Identity monad -newtype Id a = Id { unId :: a } - -instance Functor Id where - fmap f (Id x) = Id (f x) - -instance Applicative Id where - pure = Id - Id f <*> Id x = Id (f x) - -instance Monad Id where - return = pure - Id x >>= f = f x - --- | Box monad -data Box a = Box { unBox :: a } - -instance Functor Box where - fmap f (Box x) = Box (f x) - -instance Applicative Box where - pure = Box - Box f <*> Box x = Box (f x) - -instance Monad Box where - return = pure - Box x >>= f = f x - --- | Delay inlining a function until late in the game (simplifier phase 0). -delay_inline :: (a -> b) -> a -> b -{-# INLINE [0] delay_inline #-} -delay_inline f = f - --- | `min` inlined in phase 0 -delayed_min :: Int -> Int -> Int -{-# INLINE [0] delayed_min #-} -delayed_min m n = min m n diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs deleted file mode 100644 --- a/Data/Vector/Generic.hs +++ /dev/null @@ -1,2240 +0,0 @@ -{-# LANGUAGE CPP, Rank2Types, MultiParamTypeClasses, FlexibleContexts, - TypeFamilies, ScopedTypeVariables, BangPatterns #-} --- | --- Module : Data.Vector.Generic --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Generic interface to pure vectors. --- - -module Data.Vector.Generic ( - -- * Immutable vectors - Vector(..), Mutable, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Indexing - (!), (!?), head, last, - unsafeIndex, unsafeHead, unsafeLast, - - -- ** Monadic indexing - indexM, headM, lastM, - unsafeIndexM, unsafeHeadM, unsafeLastM, - - -- ** Extracting subvectors (slicing) - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- * Construction - - -- ** Initialisation - empty, singleton, replicate, generate, iterateN, - - -- ** Monadic initialisation - replicateM, generateM, iterateNM, create, createT, - - -- ** Unfolding - unfoldr, unfoldrN, - unfoldrM, unfoldrNM, - constructN, constructrN, - - -- ** Enumeration - enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, - - -- ** Concatenation - cons, snoc, (++), concat, concatNE, - - -- ** Restricting memory usage - force, - - -- * Modifying vectors - - -- ** Bulk updates - (//), update, update_, - unsafeUpd, unsafeUpdate, unsafeUpdate_, - - -- ** Accumulations - accum, accumulate, accumulate_, - unsafeAccum, unsafeAccumulate, unsafeAccumulate_, - - -- ** Permutations - reverse, backpermute, unsafeBackpermute, - - -- ** Safe destructive updates - modify, - - -- * Elementwise operations - - -- ** Indexing - indexed, - - -- ** Mapping - map, imap, concatMap, - - -- ** Monadic mapping - mapM, imapM, mapM_, imapM_, forM, forM_, - - -- ** Zipping - zipWith, zipWith3, zipWith4, zipWith5, zipWith6, - izipWith, izipWith3, izipWith4, izipWith5, izipWith6, - zip, zip3, zip4, zip5, zip6, - - -- ** Monadic zipping - zipWithM, izipWithM, zipWithM_, izipWithM_, - - -- ** Unzipping - unzip, unzip3, unzip4, unzip5, unzip6, - - -- * Working with predicates - - -- ** Filtering - filter, ifilter, uniq, - mapMaybe, imapMaybe, - filterM, - takeWhile, dropWhile, - - -- ** Partitioning - partition, partitionWith, unstablePartition, span, break, - - -- ** Searching - elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, - - -- * Folding - foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', - ifoldl, ifoldl', ifoldr, ifoldr', - - -- ** Specialised folds - all, any, and, or, - sum, product, - maximum, maximumBy, minimum, minimumBy, - minIndex, minIndexBy, maxIndex, maxIndexBy, - - -- ** Monadic folds - foldM, ifoldM, foldM', ifoldM', - fold1M, fold1M', foldM_, ifoldM_, - foldM'_, ifoldM'_, fold1M_, fold1M'_, - - -- ** Monadic sequencing - sequence, sequence_, - - -- * Prefix sums (scans) - prescanl, prescanl', - postscanl, postscanl', - scanl, scanl', scanl1, scanl1', - iscanl, iscanl', - prescanr, prescanr', - postscanr, postscanr', - scanr, scanr', scanr1, scanr1', - iscanr, iscanr', - - -- * Conversions - - -- ** Lists - toList, fromList, fromListN, - - -- ** Different vector types - convert, - - -- ** Mutable vectors - freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, - - -- * Fusion support - - -- ** Conversion to/from Bundles - stream, unstream, streamR, unstreamR, - - -- ** Recycling support - new, clone, - - -- * Utilities - - -- ** Comparisons - eq, cmp, - eqBy, cmpBy, - - -- ** Show and Read - showsPrec, readPrec, - liftShowsPrec, liftReadsPrec, - - -- ** @Data@ and @Typeable@ - gfoldl, gunfold, dataCast, mkVecType, mkVecConstr, mkType -) where - -import Data.Vector.Generic.Base - -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.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 Prelude hiding ( length, null, - replicate, (++), concat, - head, last, - init, tail, take, drop, splitAt, reverse, - map, concat, concatMap, - zipWith, zipWith3, zip, zip3, unzip, unzip3, - filter, takeWhile, dropWhile, span, break, - elem, notElem, - foldl, foldl1, foldr, foldr1, - all, any, and, or, sum, product, maximum, minimum, - scanl, scanl1, scanr, scanr1, - enumFromTo, enumFromThenTo, - mapM, mapM_, sequence, sequence_, - showsPrec ) - -import qualified Text.Read as Read -import qualified Data.List.NonEmpty as NonEmpty - -#if __GLASGOW_HASKELL__ >= 707 -import Data.Typeable ( Typeable, gcast1 ) -#else -import Data.Typeable ( Typeable1, gcast1 ) -#endif - -#include "vector.h" - -import Data.Data ( Data, DataType, Constr, Fixity(Prefix), - mkDataType, mkConstr, constrIndex, -#if MIN_VERSION_base(4,2,0) - mkNoRepType ) -#else - mkNorepType ) -#endif -import qualified Data.Traversable as T (Traversable(mapM)) - -#if !MIN_VERSION_base(4,2,0) -mkNoRepType :: String -> DataType -mkNoRepType = mkNorepType -#endif - --- Length information --- ------------------ - --- | /O(1)/ Yield the length of the vector -length :: Vector v a => v a -> Int -{-# INLINE length #-} -length = Bundle.length . stream' - --- | /O(1)/ Test whether a vector is empty -null :: Vector v a => v a -> Bool -{-# INLINE null #-} -null = Bundle.null . stream - --- Indexing --- -------- - -infixl 9 ! --- | O(1) Indexing -(!) :: Vector v a => v a -> Int -> a -{-# 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_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_FUSED head #-} -head v = v ! 0 - --- | /O(1)/ Last element -last :: Vector v a => v a -> a -{-# 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_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_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_FUSED unsafeLast #-} -unsafeLast v = unsafeIndex v (length v - 1) - -{-# RULES - -"(!)/unstream [Vector]" forall i s. - new (New.unstream s) ! i = s Bundle.!! i - -"(!?)/unstream [Vector]" forall i s. - new (New.unstream s) !? i = s Bundle.!? i - -"head/unstream [Vector]" forall s. - head (new (New.unstream s)) = Bundle.head s - -"last/unstream [Vector]" forall s. - last (new (New.unstream s)) = Bundle.last s - -"unsafeIndex/unstream [Vector]" forall i s. - unsafeIndex (new (New.unstream s)) i = s Bundle.!! i - -"unsafeHead/unstream [Vector]" forall s. - unsafeHead (new (New.unstream s)) = Bundle.head s - -"unsafeLast/unstream [Vector]" forall s. - unsafeLast (new (New.unstream s)) = Bundle.last s #-} - - - --- Monadic indexing --- ---------------- - --- | /O(1)/ Indexing in a monad. --- --- The monad allows operations to be strict in the vector when necessary. --- Suppose vector copying is implemented like this: --- --- > copy mv v = ... write mv i (v ! i) ... --- --- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ --- would unnecessarily retain a reference to @v@ in each element written. --- --- With 'indexM', copying can be implemented like this instead: --- --- > copy mv v = ... do --- > x <- indexM v i --- > write mv i x --- --- Here, no references to @v@ are retained because indexing (but /not/ the --- elements) is evaluated eagerly. --- -indexM :: (Vector v a, Monad m) => v a -> Int -> m a -{-# 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_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_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_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_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_FUSED unsafeLastM #-} -unsafeLastM v = unsafeIndexM v (length v - 1) - -{-# RULES - -"indexM/unstream [Vector]" forall s i. - indexM (new (New.unstream s)) i = lift s MBundle.!! i - -"headM/unstream [Vector]" forall s. - headM (new (New.unstream s)) = MBundle.head (lift s) - -"lastM/unstream [Vector]" forall s. - lastM (new (New.unstream s)) = MBundle.last (lift s) - -"unsafeIndexM/unstream [Vector]" forall s i. - unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i - -"unsafeHeadM/unstream [Vector]" forall s. - unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s) - -"unsafeLastM/unstream [Vector]" forall s. - unsafeLastM (new (New.unstream s)) = MBundle.last (lift s) #-} - - - --- Extracting subvectors (slicing) --- ------------------------------- - --- | /O(1)/ Yield a slice of the vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Vector v a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> v a - -> v a -{-# 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_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_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_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_FUSED drop #-} -drop n v = unsafeSlice (delay_inline min n' len) - (delay_inline max 0 (len - n')) v - where n' = max n 0 - len = length v - --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. --- --- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ --- but slightly more efficient. -{-# 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 - ) - where - m = delay_inline min n' len - n' = max n 0 - len = length v - --- | /O(1)/ Yield a slice of the vector without copying. The vector must --- contain at least @i+n@ elements but this is not checked. -unsafeSlice :: Vector v a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> v a - -> v a -{-# 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_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_FUSED unsafeTail #-} -unsafeTail v = unsafeSlice 1 (length v - 1) v - --- | /O(1)/ Yield the first @n@ elements without copying. The vector must --- contain at least @n@ elements but this is not checked. -unsafeTake :: Vector v a => Int -> v a -> v a -{-# INLINE unsafeTake #-} -unsafeTake n v = unsafeSlice 0 n v - --- | /O(1)/ Yield all but the first @n@ elements without copying. The vector --- must contain at least @n@ elements but this is not checked. -unsafeDrop :: Vector v a => Int -> v a -> v a -{-# INLINE unsafeDrop #-} -unsafeDrop n v = unsafeSlice n (length v - n) v - - --- Turned off due to: https://github.com/haskell/vector/issues/257 --- "slice/new [Vector]" forall i n p. --- slice i n (new p) = new (New.slice i n p) - -{-# RULES - -"init/new [Vector]" forall p. - init (new p) = new (New.init p) - -"tail/new [Vector]" forall p. - tail (new p) = new (New.tail p) - -"take/new [Vector]" forall n p. - take n (new p) = new (New.take n p) - -"drop/new [Vector]" forall n p. - drop n (new p) = new (New.drop n p) - -"unsafeSlice/new [Vector]" forall i n p. - unsafeSlice i n (new p) = new (New.unsafeSlice i n p) - -"unsafeInit/new [Vector]" forall p. - unsafeInit (new p) = new (New.unsafeInit p) - -"unsafeTail/new [Vector]" forall p. - unsafeTail (new p) = new (New.unsafeTail p) #-} - - - --- Initialisation --- -------------- - --- | /O(1)/ Empty vector -empty :: Vector v a => v a -{-# INLINE 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 (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 - $ 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 (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 (Bundle.iterateN n f x) - --- Unfolding --- --------- - --- | /O(n)/ Construct a vector by repeatedly applying the generator function --- to a seed. The generator function yields 'Just' the next element and the --- new seed or 'Nothing' if there are no more elements. --- --- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 --- > = <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 . Bundle.unfoldr f - --- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying --- the generator function to a seed. The generator function yields 'Just' the --- next element and the new seed or 'Nothing' if there are no more elements. --- --- > 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 . Bundle.unfoldrN n f - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrM :: (Monad m, Vector v a) => (b -> m (Maybe (a, b))) -> b -> m (v a) -{-# INLINE unfoldrM #-} -unfoldrM f = unstreamM . MBundle.unfoldrM f - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrNM :: (Monad m, Vector v a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (v a) -{-# INLINE unfoldrNM #-} -unfoldrNM n f = unstreamM . MBundle.unfoldrNM n f - --- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the --- generator function to the already constructed part of the vector. --- --- > constructN 3 f = let a = f <> ; b = f ; c = f in --- -constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a -{-# INLINE constructN #-} --- NOTE: We *CANNOT* wrap this in New and then fuse because the elements --- might contain references to the immutable vector! -constructN !n f = runST ( - do - v <- M.new n - v' <- unsafeFreeze v - fill v' 0 - ) - where - fill :: forall s. v a -> Int -> ST s (v a) - fill !v i | i < n = let x = f (unsafeTake i v) - in - elemseq v x $ - do - v' <- unsafeThaw v - M.unsafeWrite v' i x - v'' <- unsafeFreeze v' - fill v'' (i+1) - - 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 --- of the vector. --- --- > constructrN 3 f = let a = f <> ; b = f ; c = f in --- -constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a -{-# INLINE constructrN #-} --- NOTE: We *CANNOT* wrap this in New and then fuse because the elements --- might contain references to the immutable vector! -constructrN !n f = runST ( - do - v <- n `seq` M.new n - v' <- unsafeFreeze v - fill v' 0 - ) - where - fill :: forall s. v a -> Int -> ST s (v a) - fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) - in - elemseq v x $ - do - v' <- unsafeThaw v - M.unsafeWrite v' (n-i-1) x - v'' <- unsafeFreeze v' - fill v'' (i+1) - - fill v _ = return v - - --- Enumeration --- ----------- - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ --- etc. This operation is usually more efficient than 'enumFromTo'. --- --- > enumFromN 5 3 = <5,6,7> -enumFromN :: (Vector v a, Num a) => a -> Int -> v a -{-# INLINE enumFromN #-} -enumFromN x n = enumFromStepN x 1 n - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. --- --- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> -enumFromStepN :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a -{-# INLINE enumFromStepN #-} -enumFromStepN x y n = elemseq (undefined :: v a) x - $ elemseq (undefined :: v a) y - $ unstream - $ Bundle.enumFromStepN x y n - --- | /O(n)/ Enumerate values from @x@ to @y@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromN' instead. -enumFromTo :: (Vector v a, Enum a) => a -> a -> v a -{-# INLINE enumFromTo #-} -enumFromTo x y = unstream (Bundle.enumFromTo x y) - --- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a -{-# INLINE enumFromThenTo #-} -enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z) - --- Concatenation --- ------------- - --- | /O(n)/ Prepend an element -cons :: forall v a. Vector v a => a -> v a -> v a -{-# INLINE cons #-} -cons x v = elemseq (undefined :: v a) x - $ unstream - $ Bundle.cons x - $ stream v - --- | /O(n)/ Append an element -snoc :: forall v a. Vector v a => v a -> a -> v a -{-# INLINE snoc #-} -snoc v x = elemseq (undefined :: v a) x - $ unstream - $ 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 Bundle.++ stream w) - --- | /O(n)/ Concatenate all vectors in the list -concat :: Vector v a => [v a] -> v a -{-# INLINE concat #-} -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 -> Bundle.Yield x (v,i+1,k) - | otherwise = Bundle.Done - - {-# INLINE mk #-} - mk v = let k = length v - in - k `seq` (v,0,k) --} - --- | /O(n)/ Concatenate all vectors in the non-empty list -concatNE :: Vector v a => NonEmpty.NonEmpty (v a) -> v a -concatNE = concat . NonEmpty.toList - --- Monadic initialisation --- ---------------------- - --- | /O(n)/ Execute the monadic action the given number of times and store the --- results in a vector. -replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) -{-# INLINE replicateM #-} -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 (MBundle.generateM n f) - --- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: (Monad m, Vector v a) => Int -> (a -> m a) -> a -> m (v a) -{-# INLINE iterateNM #-} -iterateNM n f x = unstreamM (MBundle.iterateNM n f x) - --- | Execute the monadic action and freeze the resulting vector. --- --- @ --- create (do { v \<- 'M.new' 2; 'M.write' v 0 \'a\'; 'M.write' v 1 \'b\'; return v }) = \<'a','b'\> --- @ -create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a -{-# INLINE create #-} -create p = new (New.create p) - --- | Execute the monadic action and freeze the resulting vectors. -createT - :: (T.Traversable f, Vector v a) - => (forall s. ST s (f (Mutable v s a))) -> f (v a) -{-# INLINE createT #-} -createT p = runST (p >>= T.mapM unsafeFreeze) - --- Restricting memory usage --- ------------------------ - --- | /O(n)/ Yield the argument but force it not to retain any extra memory, --- possibly by copying it. --- --- This is especially useful when dealing with slices. For example: --- --- > force (slice 0 2 ) --- --- Here, the slice retains a reference to the huge vector. Forcing it creates --- a copy of just the elements that belong to the slice and allows the huge --- vector to be garbage collected. -force :: Vector v a => v a -> v a --- FIXME: we probably ought to inline this later as the rules still might fire --- otherwise -{-# INLINE_FUSED force #-} -force v = new (clone v) - --- Bulk updates --- ------------ - --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector --- element at position @i@ by @a@. --- --- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> --- -(//) :: Vector v a => v a -- ^ initial vector (of length @m@) - -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) - -> v a -{-# INLINE (//) #-} -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@. --- --- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> --- -update :: (Vector v a, Vector v (Int, a)) - => v a -- ^ initial vector (of length @m@) - -> v (Int, a) -- ^ vector of index/value pairs (of length @n@) - -> v a -{-# INLINE update #-} -update v w = update_stream v (stream w) - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @a@ from the value vector, replace the element of the --- initial vector at position @i@ by @a@. --- --- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> --- --- This function is useful for instances of 'Vector' that cannot store pairs. --- Otherwise, 'update' is probably more convenient. --- --- @ --- update_ xs is ys = 'update' xs ('zip' is ys) --- @ -update_ :: (Vector v a, Vector v Int) - => v a -- ^ initial vector (of length @m@) - -> v Int -- ^ index vector (of length @n1@) - -> v a -- ^ value vector (of length @n2@) - -> v a -{-# INLINE update_ #-} -update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w)) - -update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a -{-# INLINE update_stream #-} -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 (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 -{-# INLINE unsafeUpdate #-} -unsafeUpdate v w = unsafeUpdate_stream v (stream w) - --- | Same as 'update_' but without bounds checking. -unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a -{-# INLINE unsafeUpdate_ #-} -unsafeUpdate_ v is w - = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w)) - -unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a -{-# INLINE unsafeUpdate_stream #-} -unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate - --- Accumulations --- ------------- - --- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element --- @a@ at position @i@ by @f a b@. --- --- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> -accum :: Vector v a - => (a -> b -> a) -- ^ accumulating function @f@ - -> v a -- ^ initial vector (of length @m@) - -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) - -> v a -{-# INLINE accum #-} -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@. --- --- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> -accumulate :: (Vector v a, Vector v (Int, b)) - => (a -> b -> a) -- ^ accumulating function @f@ - -> v a -- ^ initial vector (of length @m@) - -> v (Int,b) -- ^ vector of index/value pairs (of length @n@) - -> v a -{-# INLINE accumulate #-} -accumulate f v us = accum_stream f v (stream us) - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @b@ from the the value vector, --- replace the element of the initial vector at --- position @i@ by @f a b@. --- --- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> --- --- This function is useful for instances of 'Vector' that cannot store pairs. --- Otherwise, 'accumulate' is probably more convenient: --- --- @ --- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) --- @ -accumulate_ :: (Vector v a, Vector v Int, Vector v b) - => (a -> b -> a) -- ^ accumulating function @f@ - -> v a -- ^ initial vector (of length @m@) - -> v Int -- ^ index vector (of length @n1@) - -> v b -- ^ value vector (of length @n2@) - -> v a -{-# INLINE accumulate_ #-} -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 -> Bundle u (Int,b) -> v a -{-# INLINE accum_stream #-} -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 (Bundle.fromList us) - --- | Same as 'accumulate' but without bounds checking. -unsafeAccumulate :: (Vector v a, Vector v (Int, b)) - => (a -> b -> a) -> v a -> v (Int,b) -> v a -{-# INLINE unsafeAccumulate #-} -unsafeAccumulate f v us = unsafeAccum_stream f v (stream us) - --- | Same as 'accumulate_' but without bounds checking. -unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b) - => (a -> b -> a) -> v a -> v Int -> v b -> v a -{-# INLINE unsafeAccumulate_ #-} -unsafeAccumulate_ f v is xs - = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs)) - -unsafeAccum_stream - :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a -{-# INLINE unsafeAccum_stream #-} -unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f) - --- Permutations --- ------------ - --- | /O(n)/ Reverse a vector -reverse :: (Vector v a) => v a -> v a -{-# INLINE reverse #-} --- FIXME: make this fuse better, add support for recycling -reverse = unstream . streamR - --- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the --- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is --- often much more efficient. --- --- > backpermute <0,3,2,3,1,0> = -backpermute :: (Vector v a, Vector v Int) - => v a -- ^ @xs@ value vector - -> v Int -- ^ @is@ index vector (of length @n@) - -> v a -{-# INLINE backpermute #-} --- This somewhat non-intuitive definition ensures that the resulting vector --- does not retain references to the original one even if it is lazy in its --- elements. This would not be the case if we simply used map (v!) -backpermute v is = seq v - $ seq n - $ unstream - $ Bundle.unbox - $ Bundle.map index - $ stream is - where - n = length v - - {-# INLINE index #-} - -- NOTE: we do it this way to avoid triggering LiberateCase on n in - -- polymorphic code - index i = BOUNDS_CHECK(checkIndex) "backpermute" i n - $ basicUnsafeIndexM v i - --- | Same as 'backpermute' but without bounds checking. -unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a -{-# INLINE unsafeBackpermute #-} -unsafeBackpermute v is = seq v - $ seq n - $ unstream - $ Bundle.unbox - $ Bundle.map index - $ stream is - where - n = length v - - {-# INLINE index #-} - -- NOTE: we do it this way to avoid triggering LiberateCase on n in - -- polymorphic code - index i = UNSAFE_CHECK(checkIndex) "unsafeBackpermute" i n - $ basicUnsafeIndexM v i - --- Safe destructive updates --- ------------------------ - --- | Apply a destructive operation to a vector. The operation will be --- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. --- --- @ --- modify (\\v -> 'M.write' v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ -modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a -{-# INLINE modify #-} -modify p = new . New.modify p . clone - --- 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. -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 --- -------- - --- | /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 . Bundle.indexed . stream - --- Mapping --- ------- - --- | /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 (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 (S.map (uncurry f) . S.indexed) id - . stream - --- | Map a function over a vector and concatenate the results. -concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b -{-# INLINE concatMap #-} --- NOTE: We can't fuse concatMap anyway so don't pretend we do. --- This seems to be slightly slower --- concatMap f = concat . Bundle.toList . Bundle.map f . stream - --- Slowest --- concatMap f = unstream . Bundle.concatMap (stream . f) . stream - --- Used to be fastest -{- -concatMap f = unstream - . Bundle.flatten mk step Unknown - . stream - where - {-# INLINE_INNER step #-} - step (v,i,k) - | i < k = case unsafeIndexM v i of - 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 --- --------------- - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- 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 . 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 = 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. Equivalent to @flip 'mapM'@. -forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) -{-# INLINE forM #-} -forM as f = mapM f as - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results. Equivalent to @flip 'mapM_'@. -forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ as f = mapM_ f as - --- Zipping --- ------- - --- | /O(min(m,n))/ Zip two vectors with the given function. -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 (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 (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 (Bundle.zipWith4 f (stream as) - (stream bs) - (stream cs) - (stream ds)) - -zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, - Vector v f) - => (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 (Bundle.zipWith5 f (stream as) - (stream bs) - (stream cs) - (stream ds) - (stream es)) - -zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, - Vector v f, Vector v g) - => (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 (Bundle.zipWith6 f (stream as) - (stream bs) - (stream cs) - (stream ds) - (stream es) - (stream fs)) - --- | /O(min(m,n))/ Zip two vectors with a function that also takes the --- elements' indices. -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 (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 (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 (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as)) - (stream bs) - (stream cs) - (stream ds)) - -izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, - Vector v f) - => (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 (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as)) - (stream bs) - (stream cs) - (stream ds) - (stream es)) - -izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, - Vector v f, Vector v g) - => (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 (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as)) - (stream bs) - (stream cs) - (stream ds) - (stream es) - (stream fs)) - --- | /O(min(m,n))/ Zip two vectors -zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) -{-# INLINE zip #-} -zip = zipWith (,) - -zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) - => v a -> v b -> v c -> v (a, b, c) -{-# INLINE zip3 #-} -zip3 = zipWith3 (,,) - -zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) - => v a -> v b -> v c -> v d -> v (a, b, c, d) -{-# INLINE zip4 #-} -zip4 = zipWith4 (,,,) - -zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, - Vector v (a, b, c, d, e)) - => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e) -{-# INLINE zip5 #-} -zip5 = zipWith5 (,,,,) - -zip6 :: (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 -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f) -{-# INLINE zip6 #-} -zip6 = zipWith6 (,,,,,) - --- Monadic zipping --- --------------- - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a --- vector of results -zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) - => (a -> b -> m c) -> v a -> v b -> m (v c) --- FIXME: specialise for ST and IO? -{-# INLINE zipWithM #-} -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 -> 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 --- --------- - --- | /O(min(m,n))/ Unzip a vector of pairs. -unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) -{-# INLINE unzip #-} -unzip xs = (map fst xs, map snd xs) - -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, _, _) -> 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, _, _, _) -> 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, _, _, _, _) -> 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, _, _, _, _, _) -> a) xs, - map (\(_, b, _, _, _, _) -> b) xs, - map (\(_, _, c, _, _, _) -> c) xs, - map (\(_, _, _, d, _, _) -> d) xs, - map (\(_, _, _, _, e, _) -> e) xs, - map (\(_, _, _, _, _, f) -> f) xs) - --- Filtering --- --------- - --- | /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 (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 (S.map snd . S.filter (uncurry f) . S.indexed) toMax - . stream - --- | /O(n)/ Drop repeated adjacent elements. -uniq :: (Vector v a, Eq a) => v a -> v a -{-# INLINE uniq #-} -uniq = unstream . inplace S.uniq toMax . stream - --- | /O(n)/ Drop elements when predicate returns Nothing -mapMaybe :: (Vector v a, Vector v b) => (a -> Maybe b) -> v a -> v b -{-# INLINE mapMaybe #-} -mapMaybe f = unstream . inplace (S.mapMaybe f) toMax . stream - --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing -imapMaybe :: (Vector v a, Vector v b) => (Int -> a -> Maybe b) -> v a -> v b -{-# INLINE imapMaybe #-} -imapMaybe f = unstream - . inplace (S.mapMaybe (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 . 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 . 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 . Bundle.dropWhile f . stream - --- Parititioning --- ------------- - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. The --- relative order of the elements is preserved at the cost of a sometimes --- reduced performance compared to 'unstablePartition'. -partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) -{-# INLINE partition #-} -partition f = partition_stream f . stream - --- FIXME: Make this inplace-fusible (look at how stable_partition is --- implemented in C++) - -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.partitionBundle f s - v1 <- unsafeFreeze mv1 - v2 <- unsafeFreeze mv2 - return (v1,v2)) - -partitionWith :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> v a -> (v b, v c) -{-# INLINE partitionWith #-} -partitionWith f = partition_with_stream f . stream - -partition_with_stream :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> Bundle u a -> (v b, v c) -{-# INLINE_FUSED partition_with_stream #-} -partition_with_stream f s = s `seq` runST ( - do - (mv1,mv2) <- M.partitionWithBundle f s - v1 <- unsafeFreeze mv1 - v2 <- unsafeFreeze mv2 - return (v1,v2)) - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. --- The order of the elements is not preserved but the operation is often --- faster than 'partition'. -unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) -{-# INLINE unstablePartition #-} -unstablePartition f = unstablePartition_stream f . 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.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_FUSED unstablePartition_new #-} -unstablePartition_new f (New.New p) = runST ( - do - mv <- p - i <- M.unstablePartition f mv - v <- unsafeFreeze mv - return (unsafeTake i v, unsafeDrop i v)) - -{-# RULES - -"unstablePartition" forall f p. - unstablePartition_stream f (stream (new p)) - = unstablePartition_new f p #-} - - - - --- FIXME: make span and break fusible - --- | /O(n)/ Split the vector into the longest prefix of elements that satisfy --- the predicate and the rest without copying. -span :: Vector v a => (a -> Bool) -> v a -> (v a, v a) -{-# INLINE span #-} -span f = break (not . f) - --- | /O(n)/ Split the vector into the longest prefix of elements that do not --- satisfy the predicate and the rest without copying. -break :: Vector v a => (a -> Bool) -> v a -> (v a, v a) -{-# INLINE break #-} -break f xs = case findIndex f xs of - Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs) - Nothing -> (xs, empty) - - --- Searching --- --------- - -infix 4 `elem` --- | /O(n)/ Check if the vector contains an element -elem :: (Vector v a, Eq a) => a -> v a -> Bool -{-# INLINE elem #-} -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 = 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 = 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 = 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 (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 --- 'Nothing' if the vector does not contain the element. This is a specialised --- version of 'findIndex'. -elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int -{-# INLINE elemIndex #-} -elemIndex x = findIndex (x==) - --- | /O(n)/ Yield the indices of all occurences of the given element in --- ascending order. This is a specialised version of 'findIndices'. -elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int -{-# INLINE elemIndices #-} -elemIndices x = findIndices (x==) - --- Folding --- ------- - --- | /O(n)/ Left fold -foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a -{-# INLINE foldl #-} -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 = 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 = 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 = Bundle.foldl1' f . stream - --- | /O(n)/ Right fold -foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b -{-# INLINE foldr #-} -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 = 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 = 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 = 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 = 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 = 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 = 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 = Bundle.foldl' (flip (uncurry f)) z - $ Bundle.indexedR (length xs) $ streamR xs - --- Specialised folds --- ----------------- - --- | /O(n)/ Check if all elements satisfy the predicate. -all :: Vector v a => (a -> Bool) -> v a -> Bool -{-# INLINE all #-} -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 = Bundle.or . Bundle.map f . stream - --- | /O(n)/ Check if all elements are 'True' -and :: Vector v Bool => v Bool -> Bool -{-# INLINE and #-} -and = Bundle.and . stream - --- | /O(n)/ Check if any element is 'True' -or :: Vector v Bool => v Bool -> Bool -{-# INLINE or #-} -or = Bundle.or . stream - --- | /O(n)/ Compute the sum of the elements -sum :: (Vector v a, Num a) => v a -> a -{-# INLINE sum #-} -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 = 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 = 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 cmpr = Bundle.foldl1' maxBy . stream - where - {-# INLINE maxBy #-} - maxBy x y = case cmpr x y of - LT -> y - _ -> x - --- | /O(n)/ Yield the minimum element of the vector. The vector may not be --- empty. -minimum :: (Vector v a, Ord a) => v a -> a -{-# INLINE minimum #-} -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 cmpr = Bundle.foldl1' minBy . stream - where - {-# INLINE minBy #-} - minBy x y = case cmpr x y of - GT -> y - _ -> x - --- | /O(n)/ Yield the index of the maximum element of the vector. The vector --- may not be empty. -maxIndex :: (Vector v a, Ord a) => v a -> Int -{-# INLINE maxIndex #-} -maxIndex = maxIndexBy compare - --- | /O(n)/ Yield the index of the maximum element of the vector according to --- the given comparison function. The vector may not be empty. -maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int -{-# INLINE maxIndexBy #-} -maxIndexBy cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream - where - imax (i,x) (j,y) = i `seq` j `seq` - case cmpr x y of - LT -> (j,y) - _ -> (i,x) - --- | /O(n)/ Yield the index of the minimum element of the vector. The vector --- may not be empty. -minIndex :: (Vector v a, Ord a) => v a -> Int -{-# INLINE minIndex #-} -minIndex = minIndexBy compare - --- | /O(n)/ Yield the index of the minimum element of the vector according to --- the given comparison function. The vector may not be empty. -minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int -{-# INLINE minIndexBy #-} -minIndexBy cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream - where - imin (i,x) (j,y) = i `seq` j `seq` - case cmpr x y of - GT -> (j,y) - _ -> (i,x) - --- Monadic folds --- ------------- - --- | /O(n)/ Monadic fold -foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a -{-# INLINE foldM #-} -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 = 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 = 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 = Bundle.fold1M' m . stream - -discard :: Monad m => m a -> m () -{-# INLINE discard #-} -discard m = m >> return () - --- | /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 . 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 . 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 . 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 . Bundle.fold1M' m . stream - --- Monadic sequencing --- ------------------ - --- | Evaluate each action and collect the results -sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) -{-# INLINE sequence #-} -sequence = mapM id - --- | Evaluate each action and discard the results -sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () -{-# INLINE sequence_ #-} -sequence_ = mapM_ id - --- Prefix sums (scans) --- ------------------- - --- | /O(n)/ Prescan --- --- @ --- prescanl f z = 'init' . 'scanl' f z --- @ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ --- -prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a -{-# INLINE prescanl #-} -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 (S.prescanl' f z) id . stream - --- | /O(n)/ Scan --- --- @ --- postscanl f z = 'tail' . 'scanl' f z --- @ --- --- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ --- -postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a -{-# INLINE postscanl #-} -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 (S.postscanl' f z) id . stream - --- | /O(n)/ Haskell-style scan --- --- > scanl f z = --- > where y1 = z --- > 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 . 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 . Bundle.scanl' f z . stream - --- | /O(n)/ Scan over a vector with its index -iscanl :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a -{-# INLINE iscanl #-} -iscanl f z = - unstream - . inplace (S.scanl (\a (i, b) -> f i a b) z . S.indexed) (+1) - . stream - --- | /O(n)/ Scan over a vector (strictly) with its index -iscanl' :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a -{-# INLINE iscanl' #-} -iscanl' f z = - unstream - . inplace (S.scanl' (\a (i, b) -> f i a b) z . S.indexed) (+1) - . stream - - --- | /O(n)/ Scan over a non-empty vector --- --- > scanl f = --- > where y1 = x1 --- > yi = f y(i-1) xi --- -scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a -{-# INLINE scanl1 #-} -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 (S.scanl1' f) id . stream - --- | /O(n)/ Right-to-left prescan --- --- @ --- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' --- @ --- -prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b -{-# INLINE prescanr #-} -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 (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 (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 (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 . 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 . Bundle.scanl' (flip f) z . streamR - --- | /O(n)/ Right-to-left scan over a vector with its index -iscanr :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b -{-# INLINE iscanr #-} -iscanr f z v = - unstreamR - . inplace (S.scanl (flip $ uncurry f) z . S.indexedR n) (+1) - . streamR - $ v - where n = length v - --- | /O(n)/ Right-to-left scan over a vector (strictly) with its index -iscanr' :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b -{-# INLINE iscanr' #-} -iscanr' f z v = - unstreamR - . inplace (S.scanl' (flip $ uncurry f) z . S.indexedR n) (+1) - . streamR - $ v - where n = length v - --- | /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 (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 (S.scanl1' (flip f)) id . streamR - --- Conversions - Lists --- ------------------------ - --- | /O(n)/ Convert a vector to a list -toList :: Vector v a => v a -> [a] -{-# INLINE toList #-} -toList = Bundle.toList . stream - --- | /O(n)/ Convert a list to a vector -fromList :: Vector v a => [a] -> v a -{-# INLINE fromList #-} -fromList = unstream . Bundle.fromList - --- | /O(n)/ Convert the first @n@ elements of a list to a vector --- --- @ --- fromListN n xs = 'fromList' ('take' n xs) --- @ -fromListN :: Vector v a => Int -> [a] -> v a -{-# INLINE fromListN #-} -fromListN n = unstream . Bundle.fromListN n - --- Conversions - Immutable vectors --- ------------------------------- - --- | /O(n)/ Convert different vector types -convert :: (Vector v a, Vector w a) => v a -> w a -{-# INLINE convert #-} -convert = unstream . Bundle.reVector . stream - --- Conversions - Mutable vectors --- ----------------------------- - --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without --- copying. The mutable vector may not be used after this operation. -unsafeFreeze - :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) -{-# INLINE unsafeFreeze #-} -unsafeFreeze = basicUnsafeFreeze - --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) -{-# INLINE freeze #-} -freeze mv = unsafeFreeze =<< M.clone mv - --- | /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_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_FUSED thaw #-} -thaw v = do - mv <- M.unsafeNew (length v) - unsafeCopy mv v - return mv - -{-# RULES - -"unsafeThaw/new [Vector]" forall p. - unsafeThaw (new p) = New.runPrim p - -"thaw/new [Vector]" forall 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_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. -thawMany vs = do - mv <- M.new n - thaw_loop mv vs - return mv - where - n = List.foldl' (\k v -> k + length v) 0 vs - - thaw_loop mv [] = mv `seq` return () - thaw_loop mv (v:vs) - = do - let n = length v - unsafeCopy (M.unsafeTake n mv) v - thaw_loop (M.unsafeDrop n mv) vs --} - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. -copy - :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () -{-# INLINE copy #-} -copy dst src = BOUNDS_CHECK(check) "copy" "length mismatch" - (M.length dst == length src) - $ unsafeCopy dst src - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. This is not checked. -unsafeCopy - :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" - (M.length dst == length src) - $ (dst `seq` src `seq` basicUnsafeCopy dst src) - --- Conversions to/from Bundles --- --------------------------- - --- | /O(1)/ Convert a vector to a 'Bundle' -stream :: Vector v a => v a -> Bundle v a -{-# INLINE_FUSED stream #-} -stream v = stream' v - --- Same as 'stream', but can be used to avoid having a cycle in the dependency --- graph of functions, which forces GHC to create a loop breaker. -stream' :: Vector v a => v a -> Bundle v a -{-# INLINE stream' #-} -stream' v = Bundle.fromVector v - -{- -stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n) - where - n = length v - - -- NOTE: the False case comes first in Core so making it the recursive one - -- makes the code easier to read - {-# 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 'Bundle' -unstream :: Vector v a => Bundle v a -> v a -{-# INLINE unstream #-} -unstream s = new (New.unstream s) - -{-# RULES - -"stream/unstream [Vector]" forall s. - stream (new (New.unstream s)) = s - -"New.unstream/stream [Vector]" forall v. - New.unstream (stream v) = clone v - -"clone/new [Vector]" forall p. - clone (new p) = p - -"inplace [Vector]" - 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 => 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 '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 - - {-# INLINE get #-} - get 0 = Nothing - get i = let i' = i-1 - in - case basicUnsafeIndexM v i' of Box x -> Just (x, i') - --- | /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) - -{-# RULES - -"streamR/unstreamR [Vector]" forall s. - streamR (new (New.unstreamR s)) = s - -"New.unstreamR/streamR/new [Vector]" forall p. - New.unstreamR (streamR (new p)) = p - -"New.unstream/streamR/new [Vector]" forall p. - New.unstream (streamR (new p)) = New.modify M.reverse p - -"New.unstreamR/stream/new [Vector]" forall p. - New.unstreamR (stream (new p)) = New.modify M.reverse p - -"inplace right [Vector]" - 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 => 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) => MBundle m u a -> m (v a) -{-# INLINE_FUSED unstreamM #-} -unstreamM s = do - xs <- MBundle.toList s - return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs - -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 => MBundle IO u a -> IO (v a) -{-# INLINE unstreamPrimM_IO #-} -unstreamPrimM_IO = unstreamPrimM - -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 #-} - - - - --- Recycling support --- ----------------- - --- | Construct a vector from a monadic initialiser. -new :: Vector v a => New v a -> v a -{-# 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_FUSED clone #-} -clone v = v `seq` New.create ( - do - mv <- M.new (length v) - unsafeCopy mv v - return mv) - --- Comparisons --- ----------- - --- | /O(n)/ Check if two vectors are equal. All 'Vector' instances are also --- instances of 'Eq' and it is usually more appropriate to use those. This --- function is primarily intended for implementing 'Eq' instances for new --- vector types. -eq :: (Vector v a, Eq a) => v a -> v a -> Bool -{-# INLINE eq #-} -xs `eq` ys = stream xs == stream ys - --- | /O(n)/ -eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool -{-# INLINE eqBy #-} -eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys) - --- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are --- also instances of 'Ord' and it is usually more appropriate to use those. This --- function is primarily intended for implementing 'Ord' instances for new --- vector types. -cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering -{-# INLINE cmp #-} -cmp xs ys = compare (stream xs) (stream ys) - --- | /O(n)/ -cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering -cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys) - --- Show --- ---- - --- | Generic definition of 'Prelude.showsPrec' -showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS -{-# INLINE showsPrec #-} -showsPrec _ = shows . toList - -liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS -{-# INLINE liftShowsPrec #-} -liftShowsPrec _ s _ = s . toList - --- | Generic definition of 'Text.Read.readPrec' -readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) -{-# INLINE readPrec #-} -readPrec = do - xs <- Read.readPrec - return (fromList xs) - --- | /Note:/ uses 'ReadS' -liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a) -liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ] - --- Data and Typeable --- ----------------- - --- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a --- list. -gfoldl :: (Vector v a, Data a) - => (forall d b. Data d => c (d -> b) -> d -> c b) - -> (forall g. g -> c g) - -> v a - -> c (v a) -{-# INLINE gfoldl #-} -gfoldl f z v = z fromList `f` toList v - -mkVecConstr :: String -> Constr -{-# INLINE mkVecConstr #-} -mkVecConstr name = mkConstr (mkVecType name) "fromList" [] Prefix - -mkVecType :: String -> DataType -{-# INLINE mkVecType #-} -mkVecType name = mkDataType name [mkVecConstr name] - -mkType :: String -> DataType -{-# INLINE mkType #-} -mkType = mkNoRepType - -gunfold :: (Vector v a, Data a) - => (forall b r. Data b => c (b -> r) -> c r) - -> (forall r. r -> c r) - -> Constr -> c (v a) -gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - -#if __GLASGOW_HASKELL__ >= 707 -dataCast :: (Vector v a, Data a, Typeable v, Typeable t) -#else -dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) -#endif - => (forall d. Data d => c (t d)) -> Maybe (c (v a)) -{-# INLINE dataCast #-} -dataCast f = gcast1 f diff --git a/Data/Vector/Generic/Base.hs b/Data/Vector/Generic/Base.hs deleted file mode 100644 --- a/Data/Vector/Generic/Base.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, - TypeFamilies, ScopedTypeVariables, BangPatterns #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TypeFamilyDependencies #-} -#endif -{-# OPTIONS_HADDOCK hide #-} - --- | --- Module : Data.Vector.Generic.Base --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Class of pure vectors --- - -module Data.Vector.Generic.Base ( - Vector(..), Mutable -) where - -import Data.Vector.Generic.Mutable.Base ( MVector ) -import qualified Data.Vector.Generic.Mutable.Base as M - -import Control.Monad.Primitive - --- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with --- the state token @s@. It is injective on GHC 8 and newer. --- -#if MIN_VERSION_base(4,9,0) -type family Mutable (v :: * -> *) = (mv :: * -> * -> *) | mv -> v -#else -type family Mutable (v :: * -> *) :: * -> * -> * -#endif - --- | Class of immutable vectors. Every immutable vector is associated with its --- mutable version through the 'Mutable' type family. Methods of this class --- should not be used directly. Instead, "Data.Vector.Generic" and other --- Data.Vector modules provide safe and fusible wrappers. --- --- Minimum complete implementation: --- --- * 'basicUnsafeFreeze' --- --- * 'basicUnsafeThaw' --- --- * 'basicLength' --- --- * 'basicUnsafeSlice' --- --- * 'basicUnsafeIndexM' --- -class MVector (Mutable v) a => Vector v a where - -- | /Assumed complexity: O(1)/ - -- - -- Unsafely convert a mutable vector to its immutable version - -- without copying. The mutable vector may not be used after - -- this operation. - basicUnsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) - - -- | /Assumed complexity: O(1)/ - -- - -- Unsafely convert an immutable vector to its mutable version without - -- copying. The immutable vector may not be used after this operation. - basicUnsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a) - - -- | /Assumed complexity: O(1)/ - -- - -- Yield the length of the vector. - basicLength :: v a -> Int - - -- | /Assumed complexity: O(1)/ - -- - -- Yield a slice of the vector without copying it. No range checks are - -- performed. - basicUnsafeSlice :: Int -- ^ starting index - -> Int -- ^ length - -> v a -> v a - - -- | /Assumed complexity: O(1)/ - -- - -- Yield the element at the given position in a monad. No range checks are - -- performed. - -- - -- The monad allows us to be strict in the vector if we want. Suppose we had - -- - -- > unsafeIndex :: v a -> Int -> a - -- - -- instead. Now, if we wanted to copy a vector, we'd do something like - -- - -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ... - -- - -- For lazy vectors, the indexing would not be evaluated which means that we - -- would retain a reference to the original vector in each element we write. - -- This is not what we want! - -- - -- With 'basicUnsafeIndexM', we can do - -- - -- > copy mv v ... = ... case basicUnsafeIndexM v i of - -- > Box x -> unsafeWrite mv i x ... - -- - -- which does not have this problem because indexing (but not the returned - -- element!) is evaluated immediately. - -- - basicUnsafeIndexM :: Monad m => v a -> Int -> m a - - -- | /Assumed complexity: O(n)/ - -- - -- Copy an immutable vector into a mutable one. The two vectors must have - -- the same length but this is not checked. - -- - -- Instances of 'Vector' should redefine this method if they wish to support - -- an efficient block copy operation. - -- - -- Default definition: copying basic on 'basicUnsafeIndexM' and - -- 'basicUnsafeWrite'. - basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m () - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy !dst !src = do_copy 0 - where - !n = basicLength src - - do_copy i | i < n = do - x <- basicUnsafeIndexM src i - M.basicUnsafeWrite dst i x - do_copy (i+1) - | otherwise = return () - - -- | Evaluate @a@ as far as storing it in a vector would and yield @b@. - -- The @v a@ argument only fixes the type and is not touched. The method is - -- only used for optimisation purposes. Thus, it is safe for instances of - -- 'Vector' to evaluate @a@ less than it would be when stored in a vector - -- although this might result in suboptimal code. - -- - -- > elemseq v x y = (singleton x `asTypeOf` v) `seq` y - -- - -- Default defintion: @a@ is not evaluated at all - -- - elemseq :: v a -> a -> b -> b - - {-# INLINE elemseq #-} - elemseq _ = \_ x -> x - - diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs deleted file mode 100644 --- a/Data/Vector/Generic/Mutable.hs +++ /dev/null @@ -1,1096 +0,0 @@ -{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, ScopedTypeVariables #-} --- | --- Module : Data.Vector.Generic.Mutable --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Generic interface to mutable vectors --- - -module Data.Vector.Generic.Mutable ( - -- * Class of mutable vector types - MVector(..), - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Extracting subvectors - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- ** Overlapping - overlaps, - - -- * Construction - - -- ** Initialisation - new, unsafeNew, replicate, replicateM, clone, - - -- ** Growing - grow, unsafeGrow, - growFront, unsafeGrowFront, - - -- ** Restricting memory usage - clear, - - -- * Accessing individual elements - read, write, modify, swap, exchange, - unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange, - - -- * Modifying vectors - nextPermutation, - - -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove, - - -- * Internal operations - mstream, mstreamR, - unstream, unstreamR, vunstream, - munstream, munstreamR, - transform, transformR, - fill, fillR, - unsafeAccum, accum, unsafeUpdate, update, reverse, - unstablePartition, unstablePartitionBundle, partitionBundle, - partitionWithBundle -) where - -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 ) - -import Prelude hiding ( length, null, replicate, reverse, map, read, - take, drop, splitAt, init, tail ) - -#include "vector.h" - -{- -type family Immutable (v :: * -> * -> *) :: * -> * - --- | Class of mutable vectors parametrised with a primitive state token. --- -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 - - -- | 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) - - -- | 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 () - - 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 - -> 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 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 - !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 <- clone 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 --} - --- ------------------ --- Internal functions --- ------------------ - -unsafeAppend1 :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a) -{-# INLINE_INNER unsafeAppend1 #-} - -- NOTE: The case distinction has to be on the outside because - -- GHC creates a join point for the unsafeWrite even when everything - -- is inlined. This is bad because with the join point, v isn't getting - -- unboxed. -unsafeAppend1 v i x - | i < length v = do - unsafeWrite v i x - return v - | otherwise = do - v' <- enlarge v - INTERNAL_CHECK(checkIndex) "unsafeAppend1" i (length v') - $ unsafeWrite v' i x - return v' - -unsafePrepend1 :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int) -{-# INLINE_INNER unsafePrepend1 #-} -unsafePrepend1 v i x - | i /= 0 = do - let i' = i-1 - unsafeWrite v i' x - return (v, i') - | otherwise = do - (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 -> Stream m a -{-# INLINE mstream #-} -mstream v = v `seq` n `seq` (Stream.unfoldrM get 0) - where - n = length v - - {-# INLINE_INNER get #-} - get i | i < n = do x <- unsafeRead v i - return $ Just (x, i+1) - | otherwise = return $ Nothing - -fill :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) -{-# INLINE fill #-} -fill v s = v `seq` do - n' <- Stream.foldM put 0 s - return $ unsafeSlice 0 n' v - where - {-# INLINE_INNER put #-} - put i x = do - INTERNAL_CHECK(checkIndex) "fill" i (length v) - $ unsafeWrite v i x - return (i+1) - -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 -> Stream m a -{-# INLINE mstreamR #-} -mstreamR v = v `seq` n `seq` (Stream.unfoldrM get n) - where - n = length v - - {-# INLINE_INNER get #-} - get i | j >= 0 = do x <- unsafeRead v j - return $ Just (x,j) - | otherwise = return Nothing - where - j = i-1 - -fillR :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) -{-# INLINE fillR #-} -fillR v s = v `seq` do - i <- Stream.foldM put n s - return $ unsafeSlice i (n-i) v - where - n = length v - - {-# INLINE_INNER put #-} - put i x = do - unsafeWrite v j x - return j - where - j = i-1 - -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 'Bundle'. --- The vector will grow exponentially if the maximum size of the 'Bundle' is --- unknown. -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) - => 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 - --- 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) - -munstreamMax :: (PrimMonad m, MVector v a) - => MBundle m u a -> Int -> m (v (PrimState m) a) -{-# INLINE munstreamMax #-} -munstreamMax s n - = do - v <- INTERNAL_CHECK(checkLength) "munstreamMax" n - $ unsafeNew n - let put i x = do - INTERNAL_CHECK(checkIndex) "munstreamMax" i n - $ unsafeWrite v i x - return (i+1) - n' <- MBundle.foldM' put 0 s - return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n - $ unsafeSlice 0 n' v - -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) <- MBundle.foldM put (v, 0) s - return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') - $ unsafeSlice 0 n v' - where - {-# INLINE_INNER put #-} - put (v,i) x = do - v' <- unsafeAppend1 v i x - return (v',i+1) - - - - - - - --- | 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 '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) - => 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) - => MBundle m u a -> Int -> m (v (PrimState m) a) -{-# INLINE munstreamRMax #-} -munstreamRMax s n - = do - v <- INTERNAL_CHECK(checkLength) "munstreamRMax" n - $ unsafeNew n - let put i x = do - let i' = i-1 - INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n - $ unsafeWrite v i' x - return i' - 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) - => MBundle m u a -> m (v (PrimState m) a) -{-# INLINE munstreamRUnknown #-} -munstreamRUnknown s - = do - v <- unsafeNew 0 - (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' - where - {-# INLINE_INNER put #-} - put (v,i) x = unsafePrepend1 v i x - --- Length --- ------ - --- | Length of the mutable vector. -length :: MVector v a => v s a -> Int -{-# INLINE length #-} -length = basicLength - --- | Check whether the vector is empty -null :: MVector v a => v s a -> Bool -{-# INLINE null #-} -null v = length v == 0 - --- Extracting subvectors --- --------------------- - --- | Yield a part of the mutable vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: MVector v a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> v s a - -> v s a -{-# INLINE slice #-} -slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) - $ unsafeSlice i n v - -take :: MVector v a => Int -> v s a -> v s a -{-# INLINE take #-} -take n v = unsafeSlice 0 (min (max n 0) (length v)) v - -drop :: MVector v a => Int -> v s a -> v s a -{-# INLINE drop #-} -drop n v = unsafeSlice (min m n') (max 0 (m - n')) v - where - n' = max n 0 - m = length v - -{-# INLINE splitAt #-} -splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) -splitAt n v = ( unsafeSlice 0 m v - , unsafeSlice m (max 0 (len - n')) v - ) - where - m = min n' len - n' = max n 0 - len = length v - -init :: MVector v a => v s a -> v s a -{-# INLINE init #-} -init v = slice 0 (length v - 1) v - -tail :: MVector v a => v s a -> v s a -{-# INLINE tail #-} -tail v = slice 1 (length v - 1) v - --- | Yield a part of the mutable vector without copying it. No bounds checks --- are performed. -unsafeSlice :: MVector v a => Int -- ^ starting index - -> Int -- ^ length of the slice - -> v s a - -> v s a -{-# INLINE unsafeSlice #-} -unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) - $ basicUnsafeSlice i n v - -unsafeInit :: MVector v a => v s a -> v s a -{-# INLINE unsafeInit #-} -unsafeInit v = unsafeSlice 0 (length v - 1) v - -unsafeTail :: MVector v a => v s a -> v s a -{-# INLINE unsafeTail #-} -unsafeTail v = unsafeSlice 1 (length v - 1) v - -unsafeTake :: MVector v a => Int -> v s a -> v s a -{-# INLINE unsafeTake #-} -unsafeTake n v = unsafeSlice 0 n v - -unsafeDrop :: MVector v a => Int -> v s a -> v s a -{-# INLINE unsafeDrop #-} -unsafeDrop n v = unsafeSlice n (length v - n) v - --- Overlapping --- ----------- - --- | Check whether two vectors overlap. -overlaps :: MVector v a => v s a -> v s a -> Bool -{-# INLINE overlaps #-} -overlaps = basicOverlaps - --- Initialisation --- -------------- - --- | Create a mutable vector of the given length. -new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) -{-# INLINE new #-} -new n = BOUNDS_CHECK(checkLength) "new" n - $ unsafeNew n >>= \v -> basicInitialize v >> return v - --- | Create a mutable vector of the given length. The memory is not initialized. -unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) -{-# INLINE unsafeNew #-} -unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n - $ basicUnsafeNew n - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with an initial value. -replicate :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) -{-# INLINE replicate #-} -replicate n x = basicUnsafeReplicate (delay_inline max 0 n) x - --- | Create a mutable vector of the given length (0 if the length is negative) --- 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 (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) -{-# INLINE clone #-} -clone v = do - v' <- unsafeNew (length v) - unsafeCopy v' v - return v' - --- Growing --- ------- - --- | Grow a vector by the given number of elements. The number must be --- positive. -grow :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> m (v (PrimState m) a) -{-# INLINE grow #-} -grow v by = BOUNDS_CHECK(checkLength) "grow" 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 - $ 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 = 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 - --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> m (v (PrimState m) a) -{-# INLINE unsafeGrow #-} -unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n - $ basicUnsafeGrow v n - -unsafeGrowFront :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> m (v (PrimState m) a) -{-# INLINE unsafeGrowFront #-} -unsafeGrowFront v by = UNSAFE_CHECK(checkLength) "unsafeGrowFront" by - $ do - let n = length v - v' <- basicUnsafeNew (by+n) - basicUnsafeCopy (basicUnsafeSlice by n v') v - return v' - --- Restricting memory usage --- ------------------------ - --- | Reset all elements of the vector to some undefined value, clearing all --- 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 - --- Accessing individual elements --- ----------------------------- - --- | Yield the element at the given position. -read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a -{-# INLINE read #-} -read v i = BOUNDS_CHECK(checkIndex) "read" i (length v) - $ unsafeRead v i - --- | Replace the element at the given position. -write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () -{-# INLINE write #-} -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 #-} -swap v i j = BOUNDS_CHECK(checkIndex) "swap" i (length v) - $ BOUNDS_CHECK(checkIndex) "swap" j (length v) - $ unsafeSwap v i j - --- | Replace the element at the given position and return the old element. -exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a -{-# INLINE exchange #-} -exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v) - $ unsafeExchange v i x - --- | Yield the element at the given position. No bounds checks are performed. -unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a -{-# INLINE unsafeRead #-} -unsafeRead v i = UNSAFE_CHECK(checkIndex) "unsafeRead" i (length v) - $ basicUnsafeRead v i - --- | Replace the element at the given position. No bounds checks are performed. -unsafeWrite :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> a -> m () -{-# INLINE unsafeWrite #-} -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 () -{-# INLINE unsafeSwap #-} -unsafeSwap v i j = UNSAFE_CHECK(checkIndex) "unsafeSwap" i (length v) - $ UNSAFE_CHECK(checkIndex) "unsafeSwap" j (length v) - $ do - x <- unsafeRead v i - y <- unsafeRead v j - unsafeWrite v i y - unsafeWrite v j x - --- | Replace the element at the given position and return the old element. No --- bounds checks are performed. -unsafeExchange :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Int -> a -> m a -{-# INLINE unsafeExchange #-} -unsafeExchange v i x = UNSAFE_CHECK(checkIndex) "unsafeExchange" i (length v) - $ do - y <- unsafeRead v i - unsafeWrite v i x - return y - --- Filling and copying --- ------------------- - --- | Set all elements of the vector to the given value. -set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () -{-# INLINE set #-} -set = basicSet - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. -copy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target - -> v (PrimState m) a -- ^ source - -> m () -{-# INLINE copy #-} -copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors" - (not (dst `overlaps` src)) - $ BOUNDS_CHECK(check) "copy" "length mismatch" - (length dst == length src) - $ unsafeCopy dst src - --- | 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 --- to the target vector. -move :: (PrimMonad m, MVector v a) - => v (PrimState m) a -- ^ target - -> v (PrimState m) a -- ^ source - -> m () -{-# INLINE move #-} -move dst src = BOUNDS_CHECK(check) "move" "length mismatch" - (length dst == length src) - $ unsafeMove dst src - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. This is not checked. -unsafeCopy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target - -> v (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" - (length dst == length src) - $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors" - (not (dst `overlaps` src)) - $ (dst `seq` src `seq` basicUnsafeCopy dst src) - --- | 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 --- to the target vector. -unsafeMove :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target - -> v (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeMove #-} -unsafeMove dst src = UNSAFE_CHECK(check) "unsafeMove" "length mismatch" - (length dst == length src) - $ (dst `seq` src `seq` basicUnsafeMove dst src) - --- Permutations --- ------------ - -accum :: (PrimMonad m, MVector v a) - => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () -{-# INLINE accum #-} -accum f !v s = Bundle.mapM_ upd s - where - {-# INLINE_INNER upd #-} - upd (i,b) = do - a <- BOUNDS_CHECK(checkIndex) "accum" i n - $ unsafeRead v i - unsafeWrite v i (f a b) - - !n = length v - -update :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Bundle u (Int, a) -> m () -{-# INLINE update #-} -update !v s = Bundle.mapM_ upd s - where - {-# INLINE_INNER upd #-} - upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n - $ unsafeWrite v i b - - !n = length v - -unsafeAccum :: (PrimMonad m, MVector v a) - => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () -{-# INLINE unsafeAccum #-} -unsafeAccum f !v s = Bundle.mapM_ upd s - where - {-# INLINE_INNER upd #-} - upd (i,b) = do - a <- UNSAFE_CHECK(checkIndex) "accum" i n - $ unsafeRead v i - unsafeWrite v i (f a b) - - !n = length v - -unsafeUpdate :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> Bundle u (Int, a) -> m () -{-# INLINE unsafeUpdate #-} -unsafeUpdate !v s = Bundle.mapM_ upd s - where - {-# INLINE_INNER upd #-} - upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n - $ unsafeWrite v i b - - !n = length v - -reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () -{-# INLINE reverse #-} -reverse !v = reverse_loop 0 (length v - 1) - where - reverse_loop i j | i < j = do - unsafeSwap v i j - reverse_loop (i + 1) (j - 1) - reverse_loop _ _ = return () - -unstablePartition :: forall m v a. (PrimMonad m, MVector v a) - => (a -> Bool) -> v (PrimState m) a -> m Int -{-# INLINE unstablePartition #-} -unstablePartition f !v = from_left 0 (length v) - where - -- NOTE: GHC 6.10.4 panics without the signatures on from_left and - -- from_right - from_left :: Int -> Int -> m Int - from_left i j - | i == j = return i - | otherwise = do - x <- unsafeRead v i - if f x - then from_left (i+1) j - else from_right i (j-1) - - from_right :: Int -> Int -> m Int - from_right i j - | i == j = return i - | otherwise = do - x <- unsafeRead v j - if f x - then do - y <- unsafeRead v i - unsafeWrite v i x - unsafeWrite v j y - from_left (i+1) j - else from_right i (j-1) - -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) -> Bundle u a -> Int - -> m (v (PrimState m) a, v (PrimState m) a) -{-# INLINE unstablePartitionMax #-} -unstablePartitionMax f s n - = do - v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n - $ unsafeNew n - let {-# INLINE_INNER put #-} - put (i, j) x - | f x = do - unsafeWrite v i x - return (i+1, j) - | otherwise = do - unsafeWrite v (j-1) x - return (i, j-1) - - (i,j) <- Bundle.foldM' put (0, n) s - return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) - -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) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a) -{-# INLINE partitionMax #-} -partitionMax f s n - = do - v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n - $ unsafeNew n - - let {-# INLINE_INNER put #-} - put (i,j) x - | f x = do - unsafeWrite v i x - return (i+1,j) - - | otherwise = let j' = j-1 in - do - unsafeWrite v j' x - 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 - r = unsafeSlice j (n-j) v - reverse r - return (l,r) - -partitionUnknown :: (PrimMonad m, MVector v 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) <- 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') - where - -- NOTE: The case distinction has to be on the outside because - -- GHC creates a join point for the unsafeWrite even when everything - -- is inlined. This is bad because with the join point, v isn't getting - -- unboxed. - {-# INLINE_INNER put #-} - put (v1, i1, v2, i2) x - | f x = do - v1' <- unsafeAppend1 v1 i1 x - return (v1', i1+1, v2, i2) - | otherwise = do - v2' <- unsafeAppend1 v2 i2 x - return (v1, i1, v2', i2+1) - - -partitionWithBundle :: (PrimMonad m, MVector v a, MVector v b, MVector v c) - => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c) -{-# INLINE partitionWithBundle #-} -partitionWithBundle f s - = case upperBound (Bundle.size s) of - Just n -> partitionWithMax f s n - Nothing -> partitionWithUnknown f s - -partitionWithMax :: (PrimMonad m, MVector v a, MVector v b, MVector v c) - => (a -> Either b c) -> Bundle u a -> Int -> m (v (PrimState m) b, v (PrimState m) c) -{-# INLINE partitionWithMax #-} -partitionWithMax f s n - = do - v1 <- unsafeNew n - v2 <- unsafeNew n - let {-# INLINE_INNER put #-} - put (i1, i2) x = case f x of - Left b -> do - unsafeWrite v1 i1 b - return (i1+1, i2) - Right c -> do - unsafeWrite v2 i2 c - return (i1, i2+1) - (n1, n2) <- Bundle.foldM' put (0, 0) s - INTERNAL_CHECK(checkSlice) "partitionEithersMax" 0 n1 (length v1) - $ INTERNAL_CHECK(checkSlice) "partitionEithersMax" 0 n2 (length v2) - $ return (unsafeSlice 0 n1 v1, unsafeSlice 0 n2 v2) - -partitionWithUnknown :: forall m v u a b c. - (PrimMonad m, MVector v a, MVector v b, MVector v c) - => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c) -{-# INLINE partitionWithUnknown #-} -partitionWithUnknown f s - = do - v1 <- unsafeNew 0 - v2 <- unsafeNew 0 - (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s - INTERNAL_CHECK(checkSlice) "partitionEithersUnknown" 0 n1 (length v1') - $ INTERNAL_CHECK(checkSlice) "partitionEithersUnknown" 0 n2 (length v2') - $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') - where - put :: (v (PrimState m) b, Int, v (PrimState m) c, Int) - -> a - -> m (v (PrimState m) b, Int, v (PrimState m) c, Int) - {-# INLINE_INNER put #-} - put (v1, i1, v2, i2) x = case f x of - Left b -> do - v1' <- unsafeAppend1 v1 i1 b - return (v1', i1+1, v2, i2) - Right c -> do - v2' <- unsafeAppend1 v2 i2 c - return (v1, i1, v2', i2+1) - -{- -http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations - -The following algorithm generates the next permutation lexicographically after -a given permutation. It changes the given permutation in-place. - -1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, - the permutation is the last permutation. -2. Find the largest index l greater than k such that a[k] < a[l]. -3. Swap the value of a[k] with that of a[l]. -4. Reverse the sequence from a[k + 1] up to and including the final element a[n] --} - --- | Compute the next (lexicographically) permutation of given vector in-place. --- Returns False when input is the last permutation -nextPermutation :: (PrimMonad m,Ord e,MVector v e) => v (PrimState m) e -> m Bool -nextPermutation v - | dim < 2 = return False - | otherwise = do - val <- unsafeRead v 0 - (k,l) <- loop val (-1) 0 val 1 - if k < 0 - then return False - else unsafeSwap v k l >> - reverse (unsafeSlice (k+1) (dim-k-1) v) >> - return True - where loop !kval !k !l !prev !i - | i == dim = return (k,l) - | otherwise = do - cur <- unsafeRead v i - -- TODO: make tuple unboxed - let (kval',k') = if prev < cur then (prev,i-1) else (kval,k) - l' = if kval' < cur then i else l - loop kval' k' l' cur (i+1) - dim = length v diff --git a/Data/Vector/Generic/Mutable/Base.hs b/Data/Vector/Generic/Mutable/Base.hs deleted file mode 100644 --- a/Data/Vector/Generic/Mutable/Base.hs +++ /dev/null @@ -1,147 +0,0 @@ -{-# 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. - -- - -- @since 0.11.0.0 - 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 deleted file mode 100644 --- a/Data/Vector/Generic/New.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-} - --- | --- Module : Data.Vector.Generic.New --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- 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, 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.Base ( Vector, Mutable ) - -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)) - -create :: (forall s. ST s (Mutable v s a)) -> New v a -{-# INLINE create #-} -create p = New p - -run :: New v a -> ST s (Mutable v s a) -{-# INLINE run #-} -run (New p) = p - -runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) -{-# INLINE runPrim #-} -runPrim (New p) = primToPrim p - -apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a -{-# INLINE apply #-} -apply f (New p) = New (liftM f p) - -modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a -{-# INLINE modify #-} -modify f (New p) = New (do { v <- p; f v; 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 => 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 => 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 (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 => Stream m a -> Stream m a) - g s. - transform f g (unstream s) = unstream (Bundle.inplace f g s) #-} - - - - -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 => 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 (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 f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p - -"transformR/unstreamR [New]" - 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_FUSED slice #-} -slice i n m = apply (MVector.slice i n) m - -init :: Vector v a => New v a -> New v a -{-# INLINE_FUSED init #-} -init m = apply MVector.init m - -tail :: Vector v a => New v a -> New v a -{-# INLINE_FUSED tail #-} -tail m = apply MVector.tail m - -take :: Vector v a => Int -> New v a -> New v a -{-# INLINE_FUSED take #-} -take n m = apply (MVector.take n) m - -drop :: Vector v a => Int -> New v a -> New v a -{-# INLINE_FUSED drop #-} -drop n m = apply (MVector.drop n) m - -unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a -{-# INLINE_FUSED unsafeSlice #-} -unsafeSlice i n m = apply (MVector.unsafeSlice i n) m - -unsafeInit :: Vector v a => New v a -> New v a -{-# INLINE_FUSED unsafeInit #-} -unsafeInit m = apply MVector.unsafeInit m - -unsafeTail :: Vector v a => New v a -> New v a -{-# INLINE_FUSED unsafeTail #-} -unsafeTail m = apply MVector.unsafeTail m - -{-# RULES - -"slice/unstream [New]" forall i n s. - slice i n (unstream s) = unstream (Bundle.slice i n s) - -"init/unstream [New]" forall s. - init (unstream s) = unstream (Bundle.init s) - -"tail/unstream [New]" forall s. - tail (unstream s) = unstream (Bundle.tail s) - -"take/unstream [New]" forall n s. - take n (unstream s) = unstream (Bundle.take n s) - -"drop/unstream [New]" forall n s. - drop n (unstream s) = unstream (Bundle.drop n s) - -"unsafeSlice/unstream [New]" forall i n s. - unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s) - -"unsafeInit/unstream [New]" forall s. - unsafeInit (unstream s) = unstream (Bundle.init s) - -"unsafeTail/unstream [New]" forall s. - unsafeTail (unstream s) = unstream (Bundle.tail s) #-} - - - diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs deleted file mode 100644 --- a/Data/Vector/Internal/Check.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE CPP #-} - --- | --- Module : Data.Vector.Internal.Check --- Copyright : (c) Roman Leshchinskiy 2009 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Bounds checking infrastructure --- - -{-# LANGUAGE MagicHash #-} - -module Data.Vector.Internal.Check ( - Checks(..), doChecks, - - error, internalError, - check, checkIndex, checkLength, checkSlice -) where - -import GHC.Base( Int(..) ) -import GHC.Prim( Int# ) -import Prelude hiding( error, (&&), (||), not ) -import qualified Prelude as P - --- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline --- these functions into unfoldings which makes the intermediate code size --- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. -infixr 2 || -infixr 3 && - -not :: Bool -> Bool -{-# INLINE not #-} -not True = False -not False = True - -(&&) :: Bool -> Bool -> Bool -{-# INLINE (&&) #-} -False && _ = False -True && x = x - -(||) :: Bool -> Bool -> Bool -{-# INLINE (||) #-} -True || _ = True -False || x = x - - -data Checks = Bounds | Unsafe | Internal deriving( Eq ) - -doBoundsChecks :: Bool -#ifdef VECTOR_BOUNDS_CHECKS -doBoundsChecks = True -#else -doBoundsChecks = False -#endif - -doUnsafeChecks :: Bool -#ifdef VECTOR_UNSAFE_CHECKS -doUnsafeChecks = True -#else -doUnsafeChecks = False -#endif - -doInternalChecks :: Bool -#ifdef VECTOR_INTERNAL_CHECKS -doInternalChecks = True -#else -doInternalChecks = False -#endif - - -doChecks :: Checks -> Bool -{-# INLINE doChecks #-} -doChecks Bounds = doBoundsChecks -doChecks Unsafe = doUnsafeChecks -doChecks Internal = doInternalChecks - -error_msg :: String -> Int -> String -> String -> String -error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg - -error :: String -> Int -> String -> String -> a -{-# NOINLINE error #-} -error file line loc msg - = P.error $ error_msg file line loc msg - -internalError :: String -> Int -> String -> String -> a -{-# NOINLINE internalError #-} -internalError file line loc msg - = P.error $ unlines - ["*** Internal error in package vector ***" - ,"*** Please submit a bug report at http://trac.haskell.org/vector" - ,error_msg file line loc msg] - - -checkError :: String -> Int -> Checks -> String -> String -> a -{-# NOINLINE checkError #-} -checkError file line kind loc msg - = case kind of - Internal -> internalError file line loc msg - _ -> error file line loc msg - -check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a -{-# INLINE check #-} -check file line kind loc msg cond x - | not (doChecks kind) || cond = x - | otherwise = checkError file line kind loc msg - -checkIndex_msg :: Int -> Int -> String -{-# INLINE checkIndex_msg #-} -checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# - -checkIndex_msg# :: Int# -> Int# -> String -{-# NOINLINE checkIndex_msg# #-} -checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#) - -checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a -{-# INLINE checkIndex #-} -checkIndex file line kind loc i n x - = check file line kind loc (checkIndex_msg i n) (i >= 0 && i String -{-# INLINE checkLength_msg #-} -checkLength_msg (I# n#) = checkLength_msg# n# - -checkLength_msg# :: Int# -> String -{-# NOINLINE checkLength_msg# #-} -checkLength_msg# n# = "negative length " ++ show (I# n#) - -checkLength :: String -> Int -> Checks -> String -> Int -> a -> a -{-# INLINE checkLength #-} -checkLength file line kind loc n x - = check file line kind loc (checkLength_msg n) (n >= 0) x - - -checkSlice_msg :: Int -> Int -> Int -> String -{-# INLINE checkSlice_msg #-} -checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n# - -checkSlice_msg# :: Int# -> Int# -> Int# -> String -{-# NOINLINE checkSlice_msg# #-} -checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) - -checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a -{-# INLINE checkSlice #-} -checkSlice file line kind loc i m n x - = check file line kind loc (checkSlice_msg i m n) - (i >= 0 && m >= 0 && m <= n - i) x - diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs deleted file mode 100644 --- a/Data/Vector/Mutable.hs +++ /dev/null @@ -1,424 +0,0 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-} - --- | --- Module : Data.Vector.Mutable --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Mutable boxed vectors. --- - -module Data.Vector.Mutable ( - -- * Mutable boxed vectors - MVector(..), IOVector, STVector, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Extracting subvectors - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- ** Overlapping - overlaps, - - -- * Construction - - -- ** Initialisation - new, unsafeNew, replicate, replicateM, clone, - - -- ** Growing - grow, unsafeGrow, - - -- ** Restricting memory usage - clear, - - -- * Accessing individual elements - read, write, modify, swap, - unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, - - -- * Modifying vectors - nextPermutation, - - -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove -) where - -import Control.Monad (when) -import qualified Data.Vector.Generic.Mutable as G -import Data.Primitive.Array -import Control.Monad.Primitive - -import Prelude hiding ( length, null, replicate, reverse, read, - take, drop, splitAt, init, tail ) - -import Data.Typeable ( Typeable ) - -#include "vector.h" - - - --- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). -data MVector s a = MVector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !(MutableArray s a) - deriving ( Typeable ) - -type IOVector = MVector RealWorld -type STVector s = MVector s - --- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54 -{- -instance NFData a => NFData (MVector s a) where - rnf (MVector i n arr) = unsafeInlineST $ force i - where - force !ix | ix < n = do x <- readArray arr ix - rnf x `seq` force (ix+1) - | otherwise = return () --} - -instance G.MVector MVector a where - {-# INLINE basicLength #-} - basicLength (MVector _ n _) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice j m (MVector i _ arr) = MVector (i+j) m arr - - {-# INLINE basicOverlaps #-} - basicOverlaps (MVector i m arr1) (MVector j n arr2) - = sameMutableArray arr1 arr2 - && (between i j (j+n) || between j i (i+m)) - where - between x y z = x >= y && x < z - - {-# INLINE basicUnsafeNew #-} - basicUnsafeNew n - = do - 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 - arr <- newArray n x - return (MVector 0 n arr) - - {-# INLINE basicUnsafeRead #-} - basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j) - - {-# INLINE basicUnsafeWrite #-} - 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 () - 1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst - 2 -> do - x <- readArray arrSrc iSrc - y <- readArray arrSrc (iSrc + 1) - writeArray arrDst iDst x - writeArray arrDst (iDst + 1) y - _ - | overlaps dst src - -> case compare iDst iSrc of - LT -> moveBackwards arrDst iDst iSrc n - EQ -> return () - GT | (iDst - iSrc) * 2 < n - -> moveForwardsLargeOverlap arrDst iDst iSrc n - | otherwise - -> moveForwardsSmallOverlap arrDst iDst iSrc n - | otherwise -> G.basicUnsafeCopy dst src - - {-# INLINE basicClear #-} - basicClear v = G.set v uninitialised - -{-# INLINE moveBackwards #-} -moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () -moveBackwards !arr !dstOff !srcOff !len = - INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff) - $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) - -{-# INLINE moveForwardsSmallOverlap #-} --- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. -moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () -moveForwardsSmallOverlap !arr !dstOff !srcOff !len = - INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff) - $ do - tmp <- newArray overlap uninitialised - loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i - loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) - loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i) - where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap - --- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. -moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () -moveForwardsLargeOverlap !arr !dstOff !srcOff !len = - INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff) - $ do - queue <- newArray nonOverlap uninitialised - loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i - let mov !i !qTop = when (i < dstOff + len) $ do - x <- readArray arr i - y <- readArray queue qTop - writeArray arr i y - writeArray queue qTop x - mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1) - mov dstOff 0 - where nonOverlap = dstOff - srcOff - -{-# INLINE loopM #-} -loopM :: Monad m => Int -> (Int -> m a) -> m () -loopM !n k = let - go i = when (i < n) (k i >> go (i+1)) - in go 0 - -uninitialised :: a -uninitialised = error "Data.Vector.Mutable: uninitialised element. If you are trying to compact a vector, use the 'force' function to remove uninitialised elements from the underlying array." - --- Length information --- ------------------ - --- | Length of the mutable vector. -length :: MVector s a -> Int -{-# INLINE length #-} -length = G.length - --- | Check whether the vector is empty -null :: MVector s a -> Bool -{-# INLINE null #-} -null = G.null - --- Extracting subvectors --- --------------------- - --- | Yield a part of the mutable vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> MVector s a - -> MVector s a -{-# INLINE slice #-} -slice = G.slice - -take :: Int -> MVector s a -> MVector s a -{-# INLINE take #-} -take = G.take - -drop :: Int -> MVector s a -> MVector s a -{-# INLINE drop #-} -drop = G.drop - -{-# INLINE splitAt #-} -splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) -splitAt = G.splitAt - -init :: MVector s a -> MVector s a -{-# INLINE init #-} -init = G.init - -tail :: MVector s a -> MVector s a -{-# INLINE tail #-} -tail = G.tail - --- | Yield a part of the mutable vector without copying it. No bounds checks --- are performed. -unsafeSlice :: Int -- ^ starting index - -> Int -- ^ length of the slice - -> MVector s a - -> MVector s a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - -unsafeTake :: Int -> MVector s a -> MVector s a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - -unsafeDrop :: Int -> MVector s a -> MVector s a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - -unsafeInit :: MVector s a -> MVector s a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - -unsafeTail :: MVector s a -> MVector s a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- Overlapping --- ----------- - --- | Check whether two vectors overlap. -overlaps :: MVector s a -> MVector s a -> Bool -{-# INLINE overlaps #-} -overlaps = G.overlaps - --- Initialisation --- -------------- - --- | Create a mutable vector of the given length. -new :: PrimMonad m => Int -> m (MVector (PrimState m) a) -{-# INLINE new #-} -new = G.new - --- | Create a mutable vector of the given length. The memory is not initialized. -unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeNew #-} -unsafeNew = G.unsafeNew - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with an initial value. -replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE replicate #-} -replicate = G.replicate - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with values produced by repeatedly executing the monadic action. -replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | Create a copy of a mutable vector. -clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) -{-# INLINE clone #-} -clone = G.clone - --- Growing --- ------- - --- | Grow a vector by the given number of elements. The number must be --- positive. -grow :: PrimMonad m - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE grow #-} -grow = G.grow - --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: PrimMonad m - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeGrow #-} -unsafeGrow = G.unsafeGrow - --- Restricting memory usage --- ------------------------ - --- | Reset all elements of the vector to some undefined value, clearing all --- 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 - --- Accessing individual elements --- ----------------------------- - --- | Yield the element at the given position. -read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a -{-# INLINE read #-} -read = G.read - --- | Replace the element at the given position. -write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 #-} -swap = G.swap - - --- | Yield the element at the given position. No bounds checks are performed. -unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a -{-# INLINE unsafeRead #-} -unsafeRead = G.unsafeRead - --- | Replace the element at the given position. No bounds checks are performed. -unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 #-} -unsafeSwap = G.unsafeSwap - --- Filling and copying --- ------------------- - --- | Set all elements of the vector to the given value. -set :: PrimMonad m => MVector (PrimState m) a -> a -> m () -{-# INLINE set #-} -set = G.set - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. -copy :: PrimMonad m => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE copy #-} -copy = G.copy - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. This is not checked. -unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy = G.unsafeCopy - --- | 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 --- to the target vector. -move :: PrimMonad m => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE move #-} -move = G.move - --- | 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 --- to the target vector. -unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeMove #-} -unsafeMove = G.unsafeMove - --- | Compute the next (lexicographically) permutation of given vector in-place. --- Returns False when input is the last permutation -nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool -{-# INLINE nextPermutation #-} -nextPermutation = G.nextPermutation diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs deleted file mode 100644 --- a/Data/Vector/Primitive.hs +++ /dev/null @@ -1,1414 +0,0 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} - - --- | --- Module : Data.Vector.Primitive --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- 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 --- cost. --- - -module Data.Vector.Primitive ( - -- * Primitive vectors - Vector(..), MVector(..), Prim, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Indexing - (!), (!?), head, last, - unsafeIndex, unsafeHead, unsafeLast, - - -- ** Monadic indexing - indexM, headM, lastM, - unsafeIndexM, unsafeHeadM, unsafeLastM, - - -- ** Extracting subvectors (slicing) - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- * Construction - - -- ** Initialisation - empty, singleton, replicate, generate, iterateN, - - -- ** Monadic initialisation - replicateM, generateM, iterateNM, create, createT, - - -- ** Unfolding - unfoldr, unfoldrN, - unfoldrM, unfoldrNM, - constructN, constructrN, - - -- ** Enumeration - enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, - - -- ** Concatenation - cons, snoc, (++), concat, - - -- ** Restricting memory usage - force, - - -- * Modifying vectors - - -- ** Bulk updates - (//), update_, - unsafeUpd, unsafeUpdate_, - - -- ** Accumulations - accum, accumulate_, - unsafeAccum, unsafeAccumulate_, - - -- ** Permutations - reverse, backpermute, unsafeBackpermute, - - -- ** Safe destructive updates - modify, - - -- * Elementwise operations - - -- ** Mapping - map, imap, concatMap, - - -- ** Monadic mapping - mapM, mapM_, forM, forM_, - - -- ** Zipping - zipWith, zipWith3, zipWith4, zipWith5, zipWith6, - izipWith, izipWith3, izipWith4, izipWith5, izipWith6, - - -- ** Monadic zipping - zipWithM, zipWithM_, - - -- * Working with predicates - - -- ** Filtering - filter, ifilter, uniq, - mapMaybe, imapMaybe, - filterM, - takeWhile, dropWhile, - - -- ** Partitioning - partition, unstablePartition, partitionWith, span, break, - - -- ** Searching - elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, - - -- * Folding - foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', - ifoldl, ifoldl', ifoldr, ifoldr', - - -- ** Specialised folds - all, any, - sum, product, - maximum, maximumBy, minimum, minimumBy, - minIndex, minIndexBy, maxIndex, maxIndexBy, - - -- ** Monadic folds - foldM, foldM', fold1M, fold1M', - foldM_, foldM'_, fold1M_, fold1M'_, - - -- * Prefix sums (scans) - prescanl, prescanl', - postscanl, postscanl', - scanl, scanl', scanl1, scanl1', - prescanr, prescanr', - postscanr, postscanr', - scanr, scanr', scanr1, scanr1', - - -- * Conversions - - -- ** Lists - toList, fromList, fromListN, - - -- ** Other vector types - G.convert, - - -- ** Mutable vectors - freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy -) where - -import qualified Data.Vector.Generic as G -import Data.Vector.Primitive.Mutable ( MVector(..) ) -import qualified Data.Vector.Fusion.Bundle as Bundle -import Data.Primitive.ByteArray -import Data.Primitive ( Prim, sizeOf ) - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import Control.Monad ( liftM ) -import Control.Monad.ST ( ST ) -import Control.Monad.Primitive - -import Prelude hiding ( length, null, - replicate, (++), concat, - head, last, - init, tail, take, drop, splitAt, reverse, - map, concatMap, - zipWith, zipWith3, zip, zip3, unzip, unzip3, - filter, takeWhile, dropWhile, span, break, - elem, notElem, - foldl, foldl1, foldr, foldr1, - all, any, sum, product, minimum, maximum, - scanl, scanl1, scanr, scanr1, - enumFromTo, enumFromThenTo, - mapM, mapM_ ) - -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) -import Data.Semigroup ( Semigroup(..) ) - -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid ( Monoid(..) ) -import Data.Traversable ( Traversable ) -#endif - -#if __GLASGOW_HASKELL__ >= 708 -import qualified GHC.Exts as Exts -#endif - - --- | Unboxed vectors of primitive types -data Vector a = Vector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !ByteArray -- ^ offset, length, underlying byte array - deriving ( Typeable ) - -instance NFData (Vector a) where - rnf (Vector _ _ _) = () - -#if MIN_VERSION_deepseq(1,4,3) --- | @since 0.12.1.0 -instance NFData1 Vector where - liftRnf _ (Vector _ _ _) = () -#endif - -instance (Show a, Prim a) => Show (Vector a) where - showsPrec = G.showsPrec - -instance (Read a, Prim a) => Read (Vector a) where - readPrec = G.readPrec - readListPrec = readListPrecDefault - -instance (Data a, Prim a) => Data (Vector a) where - gfoldl = G.gfoldl - toConstr _ = G.mkVecConstr "Data.Vector.Primitive.Vector" - gunfold = G.gunfold - dataTypeOf _ = G.mkVecType "Data.Vector.Primitive.Vector" - dataCast1 = G.dataCast - - -type instance G.Mutable Vector = MVector - -instance Prim a => G.Vector Vector a where - {-# INLINE basicUnsafeFreeze #-} - basicUnsafeFreeze (MVector i n marr) - = Vector i n `liftM` unsafeFreezeByteArray marr - - {-# INLINE basicUnsafeThaw #-} - basicUnsafeThaw (Vector i n arr) - = MVector i n `liftM` unsafeThawByteArray arr - - {-# INLINE basicLength #-} - basicLength (Vector _ n _) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr - - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector i _ arr) j = return $! indexByteArray arr (i+j) - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector i n dst) (Vector j _ src) - = copyByteArray dst (i*sz) src (j*sz) (n*sz) - where - sz = sizeOf (undefined :: a) - - {-# INLINE elemseq #-} - elemseq _ = seq - --- See http://trac.haskell.org/vector/ticket/12 -instance (Prim a, Eq a) => Eq (Vector a) where - {-# INLINE (==) #-} - xs == ys = Bundle.eq (G.stream xs) (G.stream ys) - - {-# INLINE (/=) #-} - 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 = Bundle.cmp (G.stream xs) (G.stream ys) - - {-# INLINE (<) #-} - xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT - - {-# INLINE (<=) #-} - xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT - - {-# INLINE (>) #-} - xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT - - {-# INLINE (>=) #-} - xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT - -instance Prim a => Semigroup (Vector a) where - {-# INLINE (<>) #-} - (<>) = (++) - - {-# INLINE sconcat #-} - sconcat = G.concatNE - -instance Prim a => Monoid (Vector a) where - {-# INLINE mempty #-} - mempty = empty - - {-# INLINE mappend #-} - mappend = (++) - - {-# INLINE mconcat #-} - mconcat = concat - -#if __GLASGOW_HASKELL__ >= 708 - -instance Prim a => Exts.IsList (Vector a) where - type Item (Vector a) = a - fromList = fromList - fromListN = fromListN - toList = toList - -#endif --- Length --- ------ - --- | /O(1)/ Yield the length of the vector -length :: Prim a => Vector a -> Int -{-# INLINE length #-} -length = G.length - --- | /O(1)/ Test whether a vector is empty -null :: Prim a => Vector a -> Bool -{-# INLINE null #-} -null = G.null - --- Indexing --- -------- - --- | O(1) Indexing -(!) :: Prim a => Vector a -> Int -> a -{-# INLINE (!) #-} -(!) = (G.!) - --- | O(1) Safe indexing -(!?) :: Prim a => Vector a -> Int -> Maybe a -{-# INLINE (!?) #-} -(!?) = (G.!?) - --- | /O(1)/ First element -head :: Prim a => Vector a -> a -{-# INLINE head #-} -head = G.head - --- | /O(1)/ Last element -last :: Prim a => Vector a -> a -{-# INLINE last #-} -last = G.last - --- | /O(1)/ Unsafe indexing without bounds checking -unsafeIndex :: Prim a => Vector a -> Int -> a -{-# INLINE unsafeIndex #-} -unsafeIndex = G.unsafeIndex - --- | /O(1)/ First element without checking if the vector is empty -unsafeHead :: Prim a => Vector a -> a -{-# INLINE unsafeHead #-} -unsafeHead = G.unsafeHead - --- | /O(1)/ Last element without checking if the vector is empty -unsafeLast :: Prim a => Vector a -> a -{-# INLINE unsafeLast #-} -unsafeLast = G.unsafeLast - --- Monadic indexing --- ---------------- - --- | /O(1)/ Indexing in a monad. --- --- The monad allows operations to be strict in the vector when necessary. --- Suppose vector copying is implemented like this: --- --- > copy mv v = ... write mv i (v ! i) ... --- --- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ --- would unnecessarily retain a reference to @v@ in each element written. --- --- With 'indexM', copying can be implemented like this instead: --- --- > copy mv v = ... do --- > x <- indexM v i --- > write mv i x --- --- Here, no references to @v@ are retained because indexing (but /not/ the --- elements) is evaluated eagerly. --- -indexM :: (Prim a, Monad m) => Vector a -> Int -> m a -{-# INLINE indexM #-} -indexM = G.indexM - --- | /O(1)/ First element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -headM :: (Prim a, Monad m) => Vector a -> m a -{-# INLINE headM #-} -headM = G.headM - --- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -lastM :: (Prim a, Monad m) => Vector a -> m a -{-# INLINE lastM #-} -lastM = G.lastM - --- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an --- explanation of why this is useful. -unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a -{-# INLINE unsafeIndexM #-} -unsafeIndexM = G.unsafeIndexM - --- | /O(1)/ First element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a -{-# INLINE unsafeHeadM #-} -unsafeHeadM = G.unsafeHeadM - --- | /O(1)/ Last element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeLastM :: (Prim a, Monad m) => Vector a -> m a -{-# INLINE unsafeLastM #-} -unsafeLastM = G.unsafeLastM - --- Extracting subvectors (slicing) --- ------------------------------- - --- | /O(1)/ Yield a slice of the vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Prim a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE slice #-} -slice = G.slice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty. -init :: Prim a => Vector a -> Vector a -{-# INLINE init #-} -init = G.init - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty. -tail :: Prim a => Vector a -> Vector a -{-# INLINE tail #-} -tail = G.tail - --- | /O(1)/ Yield at the first @n@ elements without copying. The vector may --- contain less than @n@ elements in which case it is returned unchanged. -take :: Prim a => Int -> Vector a -> Vector a -{-# INLINE take #-} -take = G.take - --- | /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 :: Prim a => Int -> Vector a -> Vector a -{-# INLINE drop #-} -drop = G.drop - --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. --- --- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ --- but slightly more efficient. -{-# INLINE splitAt #-} -splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) -splitAt = G.splitAt - --- | /O(1)/ Yield a slice of the vector without copying. The vector must --- contain at least @i+n@ elements but this is not checked. -unsafeSlice :: Prim a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty but this is not checked. -unsafeInit :: Prim a => Vector a -> Vector a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty but this is not checked. -unsafeTail :: Prim a => Vector a -> Vector a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- | /O(1)/ Yield the first @n@ elements without copying. The vector must --- contain at least @n@ elements but this is not checked. -unsafeTake :: Prim a => Int -> Vector a -> Vector a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - --- | /O(1)/ Yield all but the first @n@ elements without copying. The vector --- must contain at least @n@ elements but this is not checked. -unsafeDrop :: Prim a => Int -> Vector a -> Vector a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - --- Initialisation --- -------------- - --- | /O(1)/ Empty vector -empty :: Prim a => Vector a -{-# INLINE empty #-} -empty = G.empty - --- | /O(1)/ Vector with exactly one element -singleton :: Prim a => a -> Vector a -{-# INLINE singleton #-} -singleton = G.singleton - --- | /O(n)/ Vector of the given length with the same value in each position -replicate :: Prim a => Int -> a -> Vector a -{-# INLINE replicate #-} -replicate = G.replicate - --- | /O(n)/ Construct a vector of the given length by applying the function to --- each index -generate :: Prim a => Int -> (Int -> a) -> Vector a -{-# INLINE generate #-} -generate = G.generate - --- | /O(n)/ Apply function n times to value. Zeroth element is original value. -iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a -{-# INLINE iterateN #-} -iterateN = G.iterateN - --- Unfolding --- --------- - --- | /O(n)/ Construct a vector by repeatedly applying the generator function --- to a seed. The generator function yields 'Just' the next element and the --- new seed or 'Nothing' if there are no more elements. --- --- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 --- > = <10,9,8,7,6,5,4,3,2,1> -unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldr #-} -unfoldr = G.unfoldr - --- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying --- the generator function to a seed. The generator function yields 'Just' the --- next element and the new seed or 'Nothing' if there are no more elements. --- --- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> -unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldrN #-} -unfoldrN = G.unfoldrN - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrM :: (Monad m, Prim a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrM #-} -unfoldrM = G.unfoldrM - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrNM :: (Monad m, Prim a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrNM #-} -unfoldrNM = G.unfoldrNM - --- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the --- generator function to the already constructed part of the vector. --- --- > constructN 3 f = let a = f <> ; b = f ; c = f in --- -constructN :: Prim a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructN #-} -constructN = G.constructN - --- | /O(n)/ Construct a vector with @n@ elements from right to left by --- repeatedly applying the generator function to the already constructed part --- of the vector. --- --- > constructrN 3 f = let a = f <> ; b = f ; c = f in --- -constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructrN #-} -constructrN = G.constructrN - --- Enumeration --- ----------- - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ --- etc. This operation is usually more efficient than 'enumFromTo'. --- --- > enumFromN 5 3 = <5,6,7> -enumFromN :: (Prim a, Num a) => a -> Int -> Vector a -{-# INLINE enumFromN #-} -enumFromN = G.enumFromN - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. --- --- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> -enumFromStepN :: (Prim a, Num a) => a -> a -> Int -> Vector a -{-# INLINE enumFromStepN #-} -enumFromStepN = G.enumFromStepN - --- | /O(n)/ Enumerate values from @x@ to @y@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromN' instead. -enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a -{-# INLINE enumFromTo #-} -enumFromTo = G.enumFromTo - --- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a -{-# INLINE enumFromThenTo #-} -enumFromThenTo = G.enumFromThenTo - --- Concatenation --- ------------- - --- | /O(n)/ Prepend an element -cons :: Prim a => a -> Vector a -> Vector a -{-# INLINE cons #-} -cons = G.cons - --- | /O(n)/ Append an element -snoc :: Prim a => Vector a -> a -> Vector a -{-# INLINE snoc #-} -snoc = G.snoc - -infixr 5 ++ --- | /O(m+n)/ Concatenate two vectors -(++) :: Prim a => Vector a -> Vector a -> Vector a -{-# INLINE (++) #-} -(++) = (G.++) - --- | /O(n)/ Concatenate all vectors in the list -concat :: Prim a => [Vector a] -> Vector a -{-# INLINE concat #-} -concat = G.concat - --- Monadic initialisation --- ---------------------- - --- | /O(n)/ Execute the monadic action the given number of times and store the --- results in a vector. -replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | /O(n)/ Construct a vector of the given length by applying the monadic --- action to each index -generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) -{-# INLINE generateM #-} -generateM = G.generateM - --- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: (Monad m, Prim a) => Int -> (a -> m a) -> a -> m (Vector a) -{-# INLINE iterateNM #-} -iterateNM = G.iterateNM - --- | Execute the monadic action and freeze the resulting vector. --- --- @ --- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> --- @ -create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a -{-# INLINE create #-} --- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 -create p = G.create p - --- | Execute the monadic action and freeze the resulting vectors. -createT :: (Traversable f, Prim a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) -{-# INLINE createT #-} -createT p = G.createT p - --- Restricting memory usage --- ------------------------ - --- | /O(n)/ Yield the argument but force it not to retain any extra memory, --- possibly by copying it. --- --- This is especially useful when dealing with slices. For example: --- --- > force (slice 0 2 ) --- --- Here, the slice retains a reference to the huge vector. Forcing it creates --- a copy of just the elements that belong to the slice and allows the huge --- vector to be garbage collected. -force :: Prim a => Vector a -> Vector a -{-# INLINE force #-} -force = G.force - --- Bulk updates --- ------------ - --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector --- element at position @i@ by @a@. --- --- > <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@) - -> Vector a -{-# INLINE (//) #-} -(//) = (G.//) - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @a@ from the value vector, replace the element of the --- initial vector at position @i@ by @a@. --- --- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> --- -update_ :: Prim a - => Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector a -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE update_ #-} -update_ = G.update_ - --- | Same as ('//') but without bounds checking. -unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a -{-# INLINE unsafeUpd #-} -unsafeUpd = G.unsafeUpd - --- | Same as 'update_' but without bounds checking. -unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a -{-# INLINE unsafeUpdate_ #-} -unsafeUpdate_ = G.unsafeUpdate_ - --- Accumulations --- ------------- - --- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element --- @a@ at position @i@ by @f a b@. --- --- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> -accum :: Prim a - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accum #-} -accum = G.accum - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @b@ from the the value vector, --- replace the element of the initial vector at --- position @i@ by @f a b@. --- --- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> --- -accumulate_ :: (Prim a, Prim b) - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector b -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE accumulate_ #-} -accumulate_ = G.accumulate_ - --- | Same as 'accum' but without bounds checking. -unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a -{-# INLINE unsafeAccum #-} -unsafeAccum = G.unsafeAccum - --- | Same as 'accumulate_' but without bounds checking. -unsafeAccumulate_ :: (Prim a, Prim b) => - (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -{-# INLINE unsafeAccumulate_ #-} -unsafeAccumulate_ = G.unsafeAccumulate_ - --- Permutations --- ------------ - --- | /O(n)/ Reverse a vector -reverse :: Prim a => Vector a -> Vector a -{-# INLINE reverse #-} -reverse = G.reverse - --- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the --- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is --- often much more efficient. --- --- > backpermute <0,3,2,3,1,0> = -backpermute :: Prim a => Vector a -> Vector Int -> Vector a -{-# INLINE backpermute #-} -backpermute = G.backpermute - --- | Same as 'backpermute' but without bounds checking. -unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a -{-# INLINE unsafeBackpermute #-} -unsafeBackpermute = G.unsafeBackpermute - --- Safe destructive updates --- ------------------------ - --- | Apply a destructive operation to a vector. The operation will be --- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. --- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ -modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a -{-# INLINE modify #-} -modify p = G.modify p - --- Mapping --- ------- - --- | /O(n)/ Map a function over a vector -map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b -{-# INLINE map #-} -map = G.map - --- | /O(n)/ Apply a function to every element of a vector and its index -imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b -{-# INLINE imap #-} -imap = G.imap - --- | Map a function over a vector and concatenate the results. -concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b -{-# INLINE concatMap #-} -concatMap = G.concatMap - --- Monadic mapping --- --------------- - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results -mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b) -{-# INLINE mapM #-} -mapM = G.mapM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results -mapM_ :: (Monad m, Prim a) => (a -> m b) -> Vector a -> m () -{-# INLINE mapM_ #-} -mapM_ = G.mapM_ - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equivalent to @flip 'mapM'@. -forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) -{-# INLINE forM #-} -forM = G.forM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results. Equivalent to @flip 'mapM_'@. -forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ = G.forM_ - --- Zipping --- ------- - --- | /O(min(m,n))/ Zip two vectors with the given function. -zipWith :: (Prim a, Prim b, Prim c) - => (a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE zipWith #-} -zipWith = G.zipWith - --- | Zip three vectors with the given function. -zipWith3 :: (Prim a, Prim b, Prim c, Prim d) - => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE zipWith3 #-} -zipWith3 = G.zipWith3 - -zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) - => (a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE zipWith4 #-} -zipWith4 = G.zipWith4 - -zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, - Prim f) - => (a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE zipWith5 #-} -zipWith5 = G.zipWith5 - -zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, - Prim f, Prim g) - => (a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE zipWith6 #-} -zipWith6 = G.zipWith6 - --- | /O(min(m,n))/ Zip two vectors with a function that also takes the --- elements' indices. -izipWith :: (Prim a, Prim b, Prim c) - => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE izipWith #-} -izipWith = G.izipWith - --- | Zip three vectors and their indices with the given function. -izipWith3 :: (Prim a, Prim b, Prim c, Prim d) - => (Int -> a -> b -> c -> d) - -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE izipWith3 #-} -izipWith3 = G.izipWith3 - -izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) - => (Int -> a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE izipWith4 #-} -izipWith4 = G.izipWith4 - -izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, - Prim f) - => (Int -> a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE izipWith5 #-} -izipWith5 = G.izipWith5 - -izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, - Prim f, Prim g) - => (Int -> a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE izipWith6 #-} -izipWith6 = G.izipWith6 - --- Monadic zipping --- --------------- - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a --- vector of results -zipWithM :: (Monad m, Prim a, Prim b, Prim c) - => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) -{-# INLINE zipWithM #-} -zipWithM = G.zipWithM - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the --- results -zipWithM_ :: (Monad m, Prim a, Prim b) - => (a -> b -> m c) -> Vector a -> Vector b -> m () -{-# INLINE zipWithM_ #-} -zipWithM_ = G.zipWithM_ - --- Filtering --- --------- - --- | /O(n)/ Drop elements that do not satisfy the predicate -filter :: Prim a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE filter #-} -filter = G.filter - --- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to --- values and their indices -ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a -{-# INLINE ifilter #-} -ifilter = G.ifilter - --- | /O(n)/ Drop repeated adjacent elements. -uniq :: (Prim a, Eq a) => Vector a -> Vector a -{-# INLINE uniq #-} -uniq = G.uniq - --- | /O(n)/ Drop elements when predicate returns Nothing -mapMaybe :: (Prim a, Prim b) => (a -> Maybe b) -> Vector a -> Vector b -{-# INLINE mapMaybe #-} -mapMaybe = G.mapMaybe - --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing -imapMaybe :: (Prim a, Prim b) => (Int -> a -> Maybe b) -> Vector a -> Vector b -{-# INLINE imapMaybe #-} -imapMaybe = G.imapMaybe - --- | /O(n)/ Drop elements that do not satisfy the monadic predicate -filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) -{-# INLINE filterM #-} -filterM = G.filterM - --- | /O(n)/ Yield the longest prefix of elements satisfying the predicate --- without copying. -takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE takeWhile #-} -takeWhile = G.takeWhile - --- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate --- without copying. -dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE dropWhile #-} -dropWhile = G.dropWhile - --- Parititioning --- ------------- - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. The --- relative order of the elements is preserved at the cost of a sometimes --- reduced performance compared to 'unstablePartition'. -partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE partition #-} -partition = G.partition - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. --- The order of the elements is not preserved but the operation is often --- faster than 'partition'. -unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE unstablePartition #-} -unstablePartition = G.unstablePartition - --- | /O(n)/ Split the vector in two parts, the first one containing the --- @Right@ elements and the second containing the @Left@ elements. --- The relative order of the elements is preserved. --- --- @since 0.12.1.0 -partitionWith :: (Prim a, Prim b, Prim c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) -{-# INLINE partitionWith #-} -partitionWith = G.partitionWith - --- | /O(n)/ Split the vector into the longest prefix of elements that satisfy --- the predicate and the rest without copying. -span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE span #-} -span = G.span - --- | /O(n)/ Split the vector into the longest prefix of elements that do not --- satisfy the predicate and the rest without copying. -break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE break #-} -break = G.break - --- Searching --- --------- - -infix 4 `elem` --- | /O(n)/ Check if the vector contains an element -elem :: (Prim a, Eq a) => a -> Vector a -> Bool -{-# INLINE elem #-} -elem = G.elem - -infix 4 `notElem` --- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') -notElem :: (Prim a, Eq a) => a -> Vector a -> Bool -{-# INLINE notElem #-} -notElem = G.notElem - --- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' --- if no such element exists. -find :: Prim a => (a -> Bool) -> Vector a -> Maybe a -{-# INLINE find #-} -find = G.find - --- | /O(n)/ Yield 'Just' the index of the first element matching the predicate --- or 'Nothing' if no such element exists. -findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int -{-# INLINE findIndex #-} -findIndex = G.findIndex - --- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending --- order. -findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int -{-# INLINE findIndices #-} -findIndices = G.findIndices - --- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or --- 'Nothing' if the vector does not contain the element. This is a specialised --- version of 'findIndex'. -elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int -{-# INLINE elemIndex #-} -elemIndex = G.elemIndex - --- | /O(n)/ Yield the indices of all occurences of the given element in --- ascending order. This is a specialised version of 'findIndices'. -elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int -{-# INLINE elemIndices #-} -elemIndices = G.elemIndices - --- Folding --- ------- - --- | /O(n)/ Left fold -foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl #-} -foldl = G.foldl - --- | /O(n)/ Left fold on non-empty vectors -foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1 #-} -foldl1 = G.foldl1 - --- | /O(n)/ Left fold with strict accumulator -foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl' #-} -foldl' = G.foldl' - --- | /O(n)/ Left fold on non-empty vectors with strict accumulator -foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1' #-} -foldl1' = G.foldl1' - --- | /O(n)/ Right fold -foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr #-} -foldr = G.foldr - --- | /O(n)/ Right fold on non-empty vectors -foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1 #-} -foldr1 = G.foldr1 - --- | /O(n)/ Right fold with a strict accumulator -foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr' #-} -foldr' = G.foldr' - --- | /O(n)/ Right fold on non-empty vectors with strict accumulator -foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1' #-} -foldr1' = G.foldr1' - --- | /O(n)/ Left fold (function applied to each element and its index) -ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl #-} -ifoldl = G.ifoldl - --- | /O(n)/ Left fold with strict accumulator (function applied to each element --- and its index) -ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl' #-} -ifoldl' = G.ifoldl' - --- | /O(n)/ Right fold (function applied to each element and its index) -ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr #-} -ifoldr = G.ifoldr - --- | /O(n)/ Right fold with strict accumulator (function applied to each --- element and its index) -ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr' #-} -ifoldr' = G.ifoldr' - --- Specialised folds --- ----------------- - --- | /O(n)/ Check if all elements satisfy the predicate. -all :: Prim a => (a -> Bool) -> Vector a -> Bool -{-# INLINE all #-} -all = G.all - --- | /O(n)/ Check if any element satisfies the predicate. -any :: Prim a => (a -> Bool) -> Vector a -> Bool -{-# INLINE any #-} -any = G.any - --- | /O(n)/ Compute the sum of the elements -sum :: (Prim a, Num a) => Vector a -> a -{-# INLINE sum #-} -sum = G.sum - --- | /O(n)/ Compute the produce of the elements -product :: (Prim a, Num a) => Vector a -> a -{-# INLINE product #-} -product = G.product - --- | /O(n)/ Yield the maximum element of the vector. The vector may not be --- empty. -maximum :: (Prim a, Ord a) => Vector a -> a -{-# INLINE maximum #-} -maximum = G.maximum - --- | /O(n)/ Yield the maximum element of the vector according to the given --- comparison function. The vector may not be empty. -maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE maximumBy #-} -maximumBy = G.maximumBy - --- | /O(n)/ Yield the minimum element of the vector. The vector may not be --- empty. -minimum :: (Prim a, Ord a) => Vector a -> a -{-# INLINE minimum #-} -minimum = G.minimum - --- | /O(n)/ Yield the minimum element of the vector according to the given --- comparison function. The vector may not be empty. -minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE minimumBy #-} -minimumBy = G.minimumBy - --- | /O(n)/ Yield the index of the maximum element of the vector. The vector --- may not be empty. -maxIndex :: (Prim a, Ord a) => Vector a -> Int -{-# INLINE maxIndex #-} -maxIndex = G.maxIndex - --- | /O(n)/ Yield the index of the maximum element of the vector according to --- the given comparison function. The vector may not be empty. -maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE maxIndexBy #-} -maxIndexBy = G.maxIndexBy - --- | /O(n)/ Yield the index of the minimum element of the vector. The vector --- may not be empty. -minIndex :: (Prim a, Ord a) => Vector a -> Int -{-# INLINE minIndex #-} -minIndex = G.minIndex - --- | /O(n)/ Yield the index of the minimum element of the vector according to --- the given comparison function. The vector may not be empty. -minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE minIndexBy #-} -minIndexBy = G.minIndexBy - --- Monadic folds --- ------------- - --- | /O(n)/ Monadic fold -foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# INLINE foldM #-} -foldM = G.foldM - --- | /O(n)/ Monadic fold over non-empty vectors -fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a -{-# INLINE fold1M #-} -fold1M = G.fold1M - --- | /O(n)/ Monadic fold with strict accumulator -foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# INLINE foldM' #-} -foldM' = G.foldM' - --- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a -{-# INLINE fold1M' #-} -fold1M' = G.fold1M' - --- | /O(n)/ Monadic fold that discards the result -foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# INLINE foldM_ #-} -foldM_ = G.foldM_ - --- | /O(n)/ Monadic fold over non-empty vectors that discards the result -fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () -{-# INLINE fold1M_ #-} -fold1M_ = G.fold1M_ - --- | /O(n)/ Monadic fold with strict accumulator that discards the result -foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# INLINE foldM'_ #-} -foldM'_ = G.foldM'_ - --- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator --- that discards the result -fold1M'_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () -{-# INLINE fold1M'_ #-} -fold1M'_ = G.fold1M'_ - --- Prefix sums (scans) --- ------------------- - --- | /O(n)/ Prescan --- --- @ --- prescanl f z = 'init' . 'scanl' f z --- @ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ --- -prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl #-} -prescanl = G.prescanl - --- | /O(n)/ Prescan with strict accumulator -prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl' #-} -prescanl' = G.prescanl' - --- | /O(n)/ Scan --- --- @ --- postscanl f z = 'tail' . 'scanl' f z --- @ --- --- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ --- -postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl #-} -postscanl = G.postscanl - --- | /O(n)/ Scan with strict accumulator -postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl' #-} -postscanl' = G.postscanl' - --- | /O(n)/ Haskell-style scan --- --- > scanl f z = --- > where y1 = z --- > 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 - --- | /O(n)/ Haskell-style scan with strict accumulator -scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE scanl' #-} -scanl' = G.scanl' - --- | /O(n)/ Scan over a non-empty vector --- --- > scanl f = --- > where y1 = x1 --- > yi = f y(i-1) xi --- -scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1 #-} -scanl1 = G.scanl1 - --- | /O(n)/ Scan over a non-empty vector with a strict accumulator -scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1' #-} -scanl1' = G.scanl1' - --- | /O(n)/ Right-to-left prescan --- --- @ --- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' --- @ --- -prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr #-} -prescanr = G.prescanr - --- | /O(n)/ Right-to-left prescan with strict accumulator -prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr' #-} -prescanr' = G.prescanr' - --- | /O(n)/ Right-to-left scan -postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr #-} -postscanr = G.postscanr - --- | /O(n)/ Right-to-left scan with strict accumulator -postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr' #-} -postscanr' = G.postscanr' - --- | /O(n)/ Right-to-left Haskell-style scan -scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr #-} -scanr = G.scanr - --- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator -scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr' #-} -scanr' = G.scanr' - --- | /O(n)/ Right-to-left scan over a non-empty vector -scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1 #-} -scanr1 = G.scanr1 - --- | /O(n)/ Right-to-left scan over a non-empty vector with a strict --- accumulator -scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1' #-} -scanr1' = G.scanr1' - --- Conversions - Lists --- ------------------------ - --- | /O(n)/ Convert a vector to a list -toList :: Prim a => Vector a -> [a] -{-# INLINE toList #-} -toList = G.toList - --- | /O(n)/ Convert a list to a vector -fromList :: Prim a => [a] -> Vector a -{-# INLINE fromList #-} -fromList = G.fromList - --- | /O(n)/ Convert the first @n@ elements of a list to a vector --- --- @ --- fromListN n xs = 'fromList' ('take' n xs) --- @ -fromListN :: Prim a => Int -> [a] -> Vector a -{-# INLINE fromListN #-} -fromListN = G.fromListN - --- Conversions - Mutable vectors --- ----------------------------- - --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without --- copying. The mutable vector may not be used after this operation. -unsafeFreeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE unsafeFreeze #-} -unsafeFreeze = G.unsafeFreeze - --- | /O(1)/ Unsafely convert an immutable vector to a mutable one without --- copying. The immutable vector may not be used after this operation. -unsafeThaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE unsafeThaw #-} -unsafeThaw = G.unsafeThaw - --- | /O(n)/ Yield a mutable copy of the immutable vector. -thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE thaw #-} -thaw = G.thaw - --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE freeze #-} -freeze = G.freeze - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. This is not checked. -unsafeCopy - :: (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 () -{-# INLINE copy #-} -copy = G.copy diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs deleted file mode 100644 --- a/Data/Vector/Primitive/Mutable.hs +++ /dev/null @@ -1,382 +0,0 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} - --- | --- Module : Data.Vector.Primitive.Mutable --- Copyright : (c) Roman Leshchinskiy 2008-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Mutable primitive vectors. --- - -module Data.Vector.Primitive.Mutable ( - -- * Mutable vectors of primitive types - MVector(..), IOVector, STVector, Prim, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Extracting subvectors - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- ** Overlapping - overlaps, - - -- * Construction - - -- ** Initialisation - new, unsafeNew, replicate, replicateM, clone, - - -- ** Growing - grow, unsafeGrow, - - -- ** Restricting memory usage - clear, - - -- * Accessing individual elements - read, write, modify, swap, - unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, - - -- * Modifying vectors - nextPermutation, - - -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove -) where - -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 ) - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import Prelude hiding ( length, null, replicate, reverse, map, read, - take, drop, splitAt, init, tail ) - -import Data.Typeable ( Typeable ) - --- Data.Vector.Internal.Check is unnecessary -#define NOT_VECTOR_MODULE -#include "vector.h" - --- | Mutable vectors of primitive types. -data MVector s a = MVector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !(MutableByteArray s) -- ^ offset, length, underlying mutable byte array - deriving ( Typeable ) - -type IOVector = MVector RealWorld -type STVector s = MVector s - -instance NFData (MVector s a) where - rnf (MVector _ _ _) = () - -#if MIN_VERSION_deepseq(1,4,3) -instance NFData1 (MVector s) where - liftRnf _ (MVector _ _ _) = () -#endif - -instance Prim a => G.MVector MVector a where - basicLength (MVector _ n _) = n - basicUnsafeSlice j m (MVector i _ arr) - = MVector (i+j) m arr - - {-# INLINE basicOverlaps #-} - basicOverlaps (MVector i m arr1) (MVector j n arr2) - = sameMutableByteArray arr1 arr2 - && (between i j (j+n) || between j i (i+m)) - where - between x y z = x >= y && x < z - - {-# INLINE basicUnsafeNew #-} - 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 _ arr) j = readByteArray arr (i+j) - - {-# INLINE basicUnsafeWrite #-} - 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) - where - sz = sizeOf (undefined :: a) - - {-# INLINE basicSet #-} - basicSet (MVector i n arr) x = setByteArray arr i n x - --- Length information --- ------------------ - --- | Length of the mutable vector. -length :: Prim a => MVector s a -> Int -{-# INLINE length #-} -length = G.length - --- | Check whether the vector is empty -null :: Prim a => MVector s a -> Bool -{-# INLINE null #-} -null = G.null - --- Extracting subvectors --- --------------------- - --- | Yield a part of the mutable vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Prim a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> MVector s a - -> MVector s a -{-# INLINE slice #-} -slice = G.slice - -take :: Prim a => Int -> MVector s a -> MVector s a -{-# INLINE take #-} -take = G.take - -drop :: Prim a => Int -> MVector s a -> MVector s a -{-# INLINE drop #-} -drop = G.drop - -splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) -{-# INLINE splitAt #-} -splitAt = G.splitAt - -init :: Prim a => MVector s a -> MVector s a -{-# INLINE init #-} -init = G.init - -tail :: Prim a => MVector s a -> MVector s a -{-# INLINE tail #-} -tail = G.tail - --- | Yield a part of the mutable vector without copying it. No bounds checks --- are performed. -unsafeSlice :: Prim a - => Int -- ^ starting index - -> Int -- ^ length of the slice - -> MVector s a - -> MVector s a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - -unsafeTake :: Prim a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - -unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - -unsafeInit :: Prim a => MVector s a -> MVector s a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - -unsafeTail :: Prim a => MVector s a -> MVector s a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- Overlapping --- ----------- - --- | Check whether two vectors overlap. -overlaps :: Prim a => MVector s a -> MVector s a -> Bool -{-# INLINE overlaps #-} -overlaps = G.overlaps - --- Initialisation --- -------------- - --- | Create a mutable vector of the given length. -new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) -{-# INLINE new #-} -new = G.new - --- | Create a mutable vector of the given length. The memory is not initialized. -unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeNew #-} -unsafeNew = G.unsafeNew - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with an initial value. -replicate :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE replicate #-} -replicate = G.replicate - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with values produced by repeatedly executing the monadic action. -replicateM :: (PrimMonad m, Prim a) => Int -> m a -> m (MVector (PrimState m) a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | Create a copy of a mutable vector. -clone :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -> m (MVector (PrimState m) a) -{-# INLINE clone #-} -clone = G.clone - --- Growing --- ------- - --- | Grow a vector by the given number of elements. The number must be --- positive. -grow :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE grow #-} -grow = G.grow - --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeGrow #-} -unsafeGrow = G.unsafeGrow - --- Restricting memory usage --- ------------------------ - --- | Reset all elements of the vector to some undefined value, clearing all --- 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 - --- Accessing individual elements --- ----------------------------- - --- | Yield the element at the given position. -read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE read #-} -read = G.read - --- | Replace the element at the given position. -write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 #-} -swap = G.swap - - --- | Yield the element at the given position. No bounds checks are performed. -unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE unsafeRead #-} -unsafeRead = G.unsafeRead - --- | Replace the element at the given position. No bounds checks are performed. -unsafeWrite - :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 () -{-# INLINE unsafeSwap #-} -unsafeSwap = G.unsafeSwap - --- Filling and copying --- ------------------- - --- | Set all elements of the vector to the given value. -set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () -{-# INLINE set #-} -set = G.set - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. -copy :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE copy #-} -copy = G.copy - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. This is not checked. -unsafeCopy :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy = G.unsafeCopy - --- | 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 --- to the target vector. -move :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE move #-} -move = G.move - --- | 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 --- to the target vector. -unsafeMove :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeMove #-} -unsafeMove = G.unsafeMove - --- | Compute the next (lexicographically) permutation of given vector in-place. --- Returns False when input is the last permutation -nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool -{-# INLINE nextPermutation #-} -nextPermutation = G.nextPermutation diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs deleted file mode 100644 --- a/Data/Vector/Storable.hs +++ /dev/null @@ -1,1511 +0,0 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} - - --- | --- Module : Data.Vector.Storable --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- 'Storable'-based vectors. --- - -module Data.Vector.Storable ( - -- * Storable vectors - Vector, MVector(..), Storable, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Indexing - (!), (!?), head, last, - unsafeIndex, unsafeHead, unsafeLast, - - -- ** Monadic indexing - indexM, headM, lastM, - unsafeIndexM, unsafeHeadM, unsafeLastM, - - -- ** Extracting subvectors (slicing) - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- * Construction - - -- ** Initialisation - empty, singleton, replicate, generate, iterateN, - - -- ** Monadic initialisation - replicateM, generateM, iterateNM, create, createT, - - -- ** Unfolding - unfoldr, unfoldrN, - unfoldrM, unfoldrNM, - constructN, constructrN, - - -- ** Enumeration - enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, - - -- ** Concatenation - cons, snoc, (++), concat, - - -- ** Restricting memory usage - force, - - -- * Modifying vectors - - -- ** Bulk updates - (//), update_, - unsafeUpd, unsafeUpdate_, - - -- ** Accumulations - accum, accumulate_, - unsafeAccum, unsafeAccumulate_, - - -- ** Permutations - reverse, backpermute, unsafeBackpermute, - - -- ** Safe destructive updates - modify, - - -- * Elementwise operations - - -- ** Mapping - map, imap, concatMap, - - -- ** Monadic mapping - mapM, mapM_, forM, forM_, - - -- ** Zipping - zipWith, zipWith3, zipWith4, zipWith5, zipWith6, - izipWith, izipWith3, izipWith4, izipWith5, izipWith6, - - -- ** Monadic zipping - zipWithM, zipWithM_, - - -- * Working with predicates - - -- ** Filtering - filter, ifilter, uniq, - mapMaybe, imapMaybe, - filterM, - takeWhile, dropWhile, - - -- ** Partitioning - partition, unstablePartition, partitionWith, span, break, - - -- ** Searching - elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, - - -- * Folding - foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', - ifoldl, ifoldl', ifoldr, ifoldr', - - -- ** Specialised folds - all, any, and, or, - sum, product, - maximum, maximumBy, minimum, minimumBy, - minIndex, minIndexBy, maxIndex, maxIndexBy, - - -- ** Monadic folds - foldM, foldM', fold1M, fold1M', - foldM_, foldM'_, fold1M_, fold1M'_, - - -- * Prefix sums (scans) - prescanl, prescanl', - postscanl, postscanl', - scanl, scanl', scanl1, scanl1', - prescanr, prescanr', - postscanr, postscanr', - scanr, scanr', scanr1, scanr1', - - -- * Conversions - - -- ** Lists - toList, fromList, fromListN, - - -- ** Other vector types - G.convert, unsafeCast, - - -- ** Mutable vectors - freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, - - -- * Raw pointers - unsafeFromForeignPtr, unsafeFromForeignPtr0, - unsafeToForeignPtr, unsafeToForeignPtr0, - unsafeWith -) where - -import qualified Data.Vector.Generic as G -import Data.Vector.Storable.Mutable ( MVector(..) ) -import Data.Vector.Storable.Internal -import qualified Data.Vector.Fusion.Bundle as Bundle - -import Foreign.Storable -import Foreign.ForeignPtr -import Foreign.Ptr -import Foreign.Marshal.Array ( advancePtr, copyArray ) - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import Control.Monad.ST ( ST ) -import Control.Monad.Primitive - -import Prelude hiding ( length, null, - replicate, (++), concat, - head, last, - init, tail, take, drop, splitAt, reverse, - map, concatMap, - zipWith, zipWith3, zip, zip3, unzip, unzip3, - filter, takeWhile, dropWhile, span, break, - elem, notElem, - foldl, foldl1, foldr, foldr1, - all, any, and, or, sum, product, minimum, maximum, - scanl, scanl1, scanr, scanr1, - enumFromTo, enumFromThenTo, - mapM, mapM_ ) - -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) -import Data.Semigroup ( Semigroup(..) ) - -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid ( Monoid(..) ) -import Data.Traversable ( Traversable ) -#endif - -#if __GLASGOW_HASKELL__ >= 708 -import qualified GHC.Exts as Exts -#endif - --- Data.Vector.Internal.Check is unused -#define NOT_VECTOR_MODULE -#include "vector.h" - - - --- | 'Storable'-based vectors -data Vector a = Vector {-# UNPACK #-} !Int - {-# UNPACK #-} !(ForeignPtr a) - deriving ( Typeable ) - -instance NFData (Vector a) where - rnf (Vector _ _) = () - -#if MIN_VERSION_deepseq(1,4,3) --- | @since 0.12.1.0 -instance NFData1 Vector where - liftRnf _ (Vector _ _) = () -#endif - -instance (Show a, Storable a) => Show (Vector a) where - showsPrec = G.showsPrec - -instance (Read a, Storable a) => Read (Vector a) where - readPrec = G.readPrec - readListPrec = readListPrecDefault - -instance (Data a, Storable a) => Data (Vector a) where - gfoldl = G.gfoldl - toConstr _ = G.mkVecConstr "Data.Vector.Storable.Vector" - gunfold = G.gunfold - dataTypeOf _ = G.mkVecType "Data.Vector.Storable.Vector" - dataCast1 = G.dataCast - - -type instance G.Mutable Vector = MVector - -instance Storable a => G.Vector Vector a where - {-# INLINE basicUnsafeFreeze #-} - basicUnsafeFreeze (MVector n fp) = return $ Vector n fp - - {-# INLINE basicUnsafeThaw #-} - basicUnsafeThaw (Vector n fp) = return $ MVector n fp - - {-# INLINE basicLength #-} - basicLength (Vector n _) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) - - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector _ fp) i = return - . unsafeInlineIO - $ withForeignPtr fp $ \p -> - peekElemOff p i - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector n fp) (Vector _ fq) - = unsafePrimToPrim - $ withForeignPtr fp $ \p -> - withForeignPtr fq $ \q -> - copyArray p q n - - {-# INLINE elemseq #-} - elemseq _ = seq - --- See http://trac.haskell.org/vector/ticket/12 -instance (Storable a, Eq a) => Eq (Vector a) where - {-# INLINE (==) #-} - xs == ys = Bundle.eq (G.stream xs) (G.stream ys) - - {-# INLINE (/=) #-} - 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 = Bundle.cmp (G.stream xs) (G.stream ys) - - {-# INLINE (<) #-} - xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT - - {-# INLINE (<=) #-} - xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT - - {-# INLINE (>) #-} - xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT - - {-# INLINE (>=) #-} - xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT - -instance Storable a => Semigroup (Vector a) where - {-# INLINE (<>) #-} - (<>) = (++) - - {-# INLINE sconcat #-} - sconcat = G.concatNE - -instance Storable a => Monoid (Vector a) where - {-# INLINE mempty #-} - mempty = empty - - {-# INLINE mappend #-} - mappend = (++) - - {-# INLINE mconcat #-} - mconcat = concat - -#if __GLASGOW_HASKELL__ >= 708 - -instance Storable a => Exts.IsList (Vector a) where - type Item (Vector a) = a - fromList = fromList - fromListN = fromListN - toList = toList - -#endif - --- Length --- ------ - --- | /O(1)/ Yield the length of the vector -length :: Storable a => Vector a -> Int -{-# INLINE length #-} -length = G.length - --- | /O(1)/ Test whether a vector is empty -null :: Storable a => Vector a -> Bool -{-# INLINE null #-} -null = G.null - --- Indexing --- -------- - --- | O(1) Indexing -(!) :: Storable a => Vector a -> Int -> a -{-# INLINE (!) #-} -(!) = (G.!) - --- | O(1) Safe indexing -(!?) :: Storable a => Vector a -> Int -> Maybe a -{-# INLINE (!?) #-} -(!?) = (G.!?) - --- | /O(1)/ First element -head :: Storable a => Vector a -> a -{-# INLINE head #-} -head = G.head - --- | /O(1)/ Last element -last :: Storable a => Vector a -> a -{-# INLINE last #-} -last = G.last - --- | /O(1)/ Unsafe indexing without bounds checking -unsafeIndex :: Storable a => Vector a -> Int -> a -{-# INLINE unsafeIndex #-} -unsafeIndex = G.unsafeIndex - --- | /O(1)/ First element without checking if the vector is empty -unsafeHead :: Storable a => Vector a -> a -{-# INLINE unsafeHead #-} -unsafeHead = G.unsafeHead - --- | /O(1)/ Last element without checking if the vector is empty -unsafeLast :: Storable a => Vector a -> a -{-# INLINE unsafeLast #-} -unsafeLast = G.unsafeLast - --- Monadic indexing --- ---------------- - --- | /O(1)/ Indexing in a monad. --- --- The monad allows operations to be strict in the vector when necessary. --- Suppose vector copying is implemented like this: --- --- > copy mv v = ... write mv i (v ! i) ... --- --- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ --- would unnecessarily retain a reference to @v@ in each element written. --- --- With 'indexM', copying can be implemented like this instead: --- --- > copy mv v = ... do --- > x <- indexM v i --- > write mv i x --- --- Here, no references to @v@ are retained because indexing (but /not/ the --- elements) is evaluated eagerly. --- -indexM :: (Storable a, Monad m) => Vector a -> Int -> m a -{-# INLINE indexM #-} -indexM = G.indexM - --- | /O(1)/ First element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -headM :: (Storable a, Monad m) => Vector a -> m a -{-# INLINE headM #-} -headM = G.headM - --- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -lastM :: (Storable a, Monad m) => Vector a -> m a -{-# INLINE lastM #-} -lastM = G.lastM - --- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an --- explanation of why this is useful. -unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a -{-# INLINE unsafeIndexM #-} -unsafeIndexM = G.unsafeIndexM - --- | /O(1)/ First element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a -{-# INLINE unsafeHeadM #-} -unsafeHeadM = G.unsafeHeadM - --- | /O(1)/ Last element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeLastM :: (Storable a, Monad m) => Vector a -> m a -{-# INLINE unsafeLastM #-} -unsafeLastM = G.unsafeLastM - --- Extracting subvectors (slicing) --- ------------------------------- - --- | /O(1)/ Yield a slice of the vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Storable a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE slice #-} -slice = G.slice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty. -init :: Storable a => Vector a -> Vector a -{-# INLINE init #-} -init = G.init - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty. -tail :: Storable a => Vector a -> Vector a -{-# INLINE tail #-} -tail = G.tail - --- | /O(1)/ Yield at the first @n@ elements without copying. The vector may --- contain less than @n@ elements in which case it is returned unchanged. -take :: Storable a => Int -> Vector a -> Vector a -{-# INLINE take #-} -take = G.take - --- | /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 :: Storable a => Int -> Vector a -> Vector a -{-# INLINE drop #-} -drop = G.drop - --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. --- --- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ --- but slightly more efficient. -{-# INLINE splitAt #-} -splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) -splitAt = G.splitAt - --- | /O(1)/ Yield a slice of the vector without copying. The vector must --- contain at least @i+n@ elements but this is not checked. -unsafeSlice :: Storable a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty but this is not checked. -unsafeInit :: Storable a => Vector a -> Vector a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty but this is not checked. -unsafeTail :: Storable a => Vector a -> Vector a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- | /O(1)/ Yield the first @n@ elements without copying. The vector must --- contain at least @n@ elements but this is not checked. -unsafeTake :: Storable a => Int -> Vector a -> Vector a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - --- | /O(1)/ Yield all but the first @n@ elements without copying. The vector --- must contain at least @n@ elements but this is not checked. -unsafeDrop :: Storable a => Int -> Vector a -> Vector a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - --- Initialisation --- -------------- - --- | /O(1)/ Empty vector -empty :: Storable a => Vector a -{-# INLINE empty #-} -empty = G.empty - --- | /O(1)/ Vector with exactly one element -singleton :: Storable a => a -> Vector a -{-# INLINE singleton #-} -singleton = G.singleton - --- | /O(n)/ Vector of the given length with the same value in each position -replicate :: Storable a => Int -> a -> Vector a -{-# INLINE replicate #-} -replicate = G.replicate - --- | /O(n)/ Construct a vector of the given length by applying the function to --- each index -generate :: Storable a => Int -> (Int -> a) -> Vector a -{-# INLINE generate #-} -generate = G.generate - --- | /O(n)/ Apply function n times to value. Zeroth element is original value. -iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a -{-# INLINE iterateN #-} -iterateN = G.iterateN - --- Unfolding --- --------- - --- | /O(n)/ Construct a vector by repeatedly applying the generator function --- to a seed. The generator function yields 'Just' the next element and the --- new seed or 'Nothing' if there are no more elements. --- --- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 --- > = <10,9,8,7,6,5,4,3,2,1> -unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldr #-} -unfoldr = G.unfoldr - --- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying --- the generator function to a seed. The generator function yields 'Just' the --- next element and the new seed or 'Nothing' if there are no more elements. --- --- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> -unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldrN #-} -unfoldrN = G.unfoldrN - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrM :: (Monad m, Storable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrM #-} -unfoldrM = G.unfoldrM - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrNM :: (Monad m, Storable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrNM #-} -unfoldrNM = G.unfoldrNM - --- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the --- generator function to the already constructed part of the vector. --- --- > constructN 3 f = let a = f <> ; b = f ; c = f in --- -constructN :: Storable a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructN #-} -constructN = G.constructN - --- | /O(n)/ Construct a vector with @n@ elements from right to left by --- repeatedly applying the generator function to the already constructed part --- of the vector. --- --- > constructrN 3 f = let a = f <> ; b = f ; c = f in --- -constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructrN #-} -constructrN = G.constructrN - --- Enumeration --- ----------- - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ --- etc. This operation is usually more efficient than 'enumFromTo'. --- --- > enumFromN 5 3 = <5,6,7> -enumFromN :: (Storable a, Num a) => a -> Int -> Vector a -{-# INLINE enumFromN #-} -enumFromN = G.enumFromN - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. --- --- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> -enumFromStepN :: (Storable a, Num a) => a -> a -> Int -> Vector a -{-# INLINE enumFromStepN #-} -enumFromStepN = G.enumFromStepN - --- | /O(n)/ Enumerate values from @x@ to @y@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromN' instead. -enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a -{-# INLINE enumFromTo #-} -enumFromTo = G.enumFromTo - --- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a -{-# INLINE enumFromThenTo #-} -enumFromThenTo = G.enumFromThenTo - --- Concatenation --- ------------- - --- | /O(n)/ Prepend an element -cons :: Storable a => a -> Vector a -> Vector a -{-# INLINE cons #-} -cons = G.cons - --- | /O(n)/ Append an element -snoc :: Storable a => Vector a -> a -> Vector a -{-# INLINE snoc #-} -snoc = G.snoc - -infixr 5 ++ --- | /O(m+n)/ Concatenate two vectors -(++) :: Storable a => Vector a -> Vector a -> Vector a -{-# INLINE (++) #-} -(++) = (G.++) - --- | /O(n)/ Concatenate all vectors in the list -concat :: Storable a => [Vector a] -> Vector a -{-# INLINE concat #-} -concat = G.concat - --- Monadic initialisation --- ---------------------- - --- | /O(n)/ Execute the monadic action the given number of times and store the --- results in a vector. -replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | /O(n)/ Construct a vector of the given length by applying the monadic --- action to each index -generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) -{-# INLINE generateM #-} -generateM = G.generateM - --- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: (Monad m, Storable a) => Int -> (a -> m a) -> a -> m (Vector a) -{-# INLINE iterateNM #-} -iterateNM = G.iterateNM - --- | Execute the monadic action and freeze the resulting vector. --- --- @ --- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> --- @ -create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a -{-# INLINE create #-} --- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 -create p = G.create p - --- | Execute the monadic action and freeze the resulting vectors. -createT :: (Traversable f, Storable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) -{-# INLINE createT #-} -createT p = G.createT p - --- Restricting memory usage --- ------------------------ - --- | /O(n)/ Yield the argument but force it not to retain any extra memory, --- possibly by copying it. --- --- This is especially useful when dealing with slices. For example: --- --- > force (slice 0 2 ) --- --- Here, the slice retains a reference to the huge vector. Forcing it creates --- a copy of just the elements that belong to the slice and allows the huge --- vector to be garbage collected. -force :: Storable a => Vector a -> Vector a -{-# INLINE force #-} -force = G.force - --- Bulk updates --- ------------ - --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector --- element at position @i@ by @a@. --- --- > <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@) - -> Vector a -{-# INLINE (//) #-} -(//) = (G.//) - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @a@ from the value vector, replace the element of the --- initial vector at position @i@ by @a@. --- --- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> --- -update_ :: Storable a - => Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector a -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE update_ #-} -update_ = G.update_ - --- | Same as ('//') but without bounds checking. -unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a -{-# INLINE unsafeUpd #-} -unsafeUpd = G.unsafeUpd - --- | Same as 'update_' but without bounds checking. -unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a -{-# INLINE unsafeUpdate_ #-} -unsafeUpdate_ = G.unsafeUpdate_ - --- Accumulations --- ------------- - --- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element --- @a@ at position @i@ by @f a b@. --- --- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> -accum :: Storable a - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accum #-} -accum = G.accum - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @b@ from the the value vector, --- replace the element of the initial vector at --- position @i@ by @f a b@. --- --- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> --- -accumulate_ :: (Storable a, Storable b) - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector b -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE accumulate_ #-} -accumulate_ = G.accumulate_ - --- | Same as 'accum' but without bounds checking. -unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a -{-# INLINE unsafeAccum #-} -unsafeAccum = G.unsafeAccum - --- | Same as 'accumulate_' but without bounds checking. -unsafeAccumulate_ :: (Storable a, Storable b) => - (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -{-# INLINE unsafeAccumulate_ #-} -unsafeAccumulate_ = G.unsafeAccumulate_ - --- Permutations --- ------------ - --- | /O(n)/ Reverse a vector -reverse :: Storable a => Vector a -> Vector a -{-# INLINE reverse #-} -reverse = G.reverse - --- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the --- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is --- often much more efficient. --- --- > backpermute <0,3,2,3,1,0> = -backpermute :: Storable a => Vector a -> Vector Int -> Vector a -{-# INLINE backpermute #-} -backpermute = G.backpermute - --- | Same as 'backpermute' but without bounds checking. -unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a -{-# INLINE unsafeBackpermute #-} -unsafeBackpermute = G.unsafeBackpermute - --- Safe destructive updates --- ------------------------ - --- | Apply a destructive operation to a vector. The operation will be --- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. --- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ -modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a -{-# INLINE modify #-} -modify p = G.modify p - --- Mapping --- ------- - --- | /O(n)/ Map a function over a vector -map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b -{-# INLINE map #-} -map = G.map - --- | /O(n)/ Apply a function to every element of a vector and its index -imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b -{-# INLINE imap #-} -imap = G.imap - --- | Map a function over a vector and concatenate the results. -concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b -{-# INLINE concatMap #-} -concatMap = G.concatMap - --- Monadic mapping --- --------------- - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results -mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b) -{-# INLINE mapM #-} -mapM = G.mapM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results -mapM_ :: (Monad m, Storable a) => (a -> m b) -> Vector a -> m () -{-# INLINE mapM_ #-} -mapM_ = G.mapM_ - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equivalent to @flip 'mapM'@. -forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) -{-# INLINE forM #-} -forM = G.forM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results. Equivalent to @flip 'mapM_'@. -forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ = G.forM_ - --- Zipping --- ------- - --- | /O(min(m,n))/ Zip two vectors with the given function. -zipWith :: (Storable a, Storable b, Storable c) - => (a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE zipWith #-} -zipWith = G.zipWith - --- | Zip three vectors with the given function. -zipWith3 :: (Storable a, Storable b, Storable c, Storable d) - => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE zipWith3 #-} -zipWith3 = G.zipWith3 - -zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) - => (a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE zipWith4 #-} -zipWith4 = G.zipWith4 - -zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, - Storable f) - => (a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE zipWith5 #-} -zipWith5 = G.zipWith5 - -zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, - Storable f, Storable g) - => (a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE zipWith6 #-} -zipWith6 = G.zipWith6 - --- | /O(min(m,n))/ Zip two vectors with a function that also takes the --- elements' indices. -izipWith :: (Storable a, Storable b, Storable c) - => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE izipWith #-} -izipWith = G.izipWith - --- | Zip three vectors and their indices with the given function. -izipWith3 :: (Storable a, Storable b, Storable c, Storable d) - => (Int -> a -> b -> c -> d) - -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE izipWith3 #-} -izipWith3 = G.izipWith3 - -izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) - => (Int -> a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE izipWith4 #-} -izipWith4 = G.izipWith4 - -izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, - Storable f) - => (Int -> a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE izipWith5 #-} -izipWith5 = G.izipWith5 - -izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, - Storable f, Storable g) - => (Int -> a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE izipWith6 #-} -izipWith6 = G.izipWith6 - --- Monadic zipping --- --------------- - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a --- vector of results -zipWithM :: (Monad m, Storable a, Storable b, Storable c) - => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) -{-# INLINE zipWithM #-} -zipWithM = G.zipWithM - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the --- results -zipWithM_ :: (Monad m, Storable a, Storable b) - => (a -> b -> m c) -> Vector a -> Vector b -> m () -{-# INLINE zipWithM_ #-} -zipWithM_ = G.zipWithM_ - --- Filtering --- --------- - --- | /O(n)/ Drop elements that do not satisfy the predicate -filter :: Storable a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE filter #-} -filter = G.filter - --- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to --- values and their indices -ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a -{-# INLINE ifilter #-} -ifilter = G.ifilter - --- | /O(n)/ Drop repeated adjacent elements. -uniq :: (Storable a, Eq a) => Vector a -> Vector a -{-# INLINE uniq #-} -uniq = G.uniq - --- | /O(n)/ Drop elements when predicate returns Nothing -mapMaybe :: (Storable a, Storable b) => (a -> Maybe b) -> Vector a -> Vector b -{-# INLINE mapMaybe #-} -mapMaybe = G.mapMaybe - --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing -imapMaybe :: (Storable a, Storable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b -{-# INLINE imapMaybe #-} -imapMaybe = G.imapMaybe - --- | /O(n)/ Drop elements that do not satisfy the monadic predicate -filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) -{-# INLINE filterM #-} -filterM = G.filterM - --- | /O(n)/ Yield the longest prefix of elements satisfying the predicate --- without copying. -takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE takeWhile #-} -takeWhile = G.takeWhile - --- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate --- without copying. -dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE dropWhile #-} -dropWhile = G.dropWhile - --- Parititioning --- ------------- - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. The --- relative order of the elements is preserved at the cost of a sometimes --- reduced performance compared to 'unstablePartition'. -partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE partition #-} -partition = G.partition - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. --- The order of the elements is not preserved but the operation is often --- faster than 'partition'. -unstablePartition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE unstablePartition #-} -unstablePartition = G.unstablePartition - --- | /O(n)/ Split the vector in two parts, the first one containing the --- @Right@ elements and the second containing the @Left@ elements. --- The relative order of the elements is preserved. --- --- @since 0.12.1.0 -partitionWith :: (Storable a, Storable b, Storable c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) -{-# INLINE partitionWith #-} -partitionWith = G.partitionWith - --- | /O(n)/ Split the vector into the longest prefix of elements that satisfy --- the predicate and the rest without copying. -span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE span #-} -span = G.span - --- | /O(n)/ Split the vector into the longest prefix of elements that do not --- satisfy the predicate and the rest without copying. -break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE break #-} -break = G.break - --- Searching --- --------- - -infix 4 `elem` --- | /O(n)/ Check if the vector contains an element -elem :: (Storable a, Eq a) => a -> Vector a -> Bool -{-# INLINE elem #-} -elem = G.elem - -infix 4 `notElem` --- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') -notElem :: (Storable a, Eq a) => a -> Vector a -> Bool -{-# INLINE notElem #-} -notElem = G.notElem - --- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' --- if no such element exists. -find :: Storable a => (a -> Bool) -> Vector a -> Maybe a -{-# INLINE find #-} -find = G.find - --- | /O(n)/ Yield 'Just' the index of the first element matching the predicate --- or 'Nothing' if no such element exists. -findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int -{-# INLINE findIndex #-} -findIndex = G.findIndex - --- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending --- order. -findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int -{-# INLINE findIndices #-} -findIndices = G.findIndices - --- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or --- 'Nothing' if the vector does not contain the element. This is a specialised --- version of 'findIndex'. -elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int -{-# INLINE elemIndex #-} -elemIndex = G.elemIndex - --- | /O(n)/ Yield the indices of all occurences of the given element in --- ascending order. This is a specialised version of 'findIndices'. -elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int -{-# INLINE elemIndices #-} -elemIndices = G.elemIndices - --- Folding --- ------- - --- | /O(n)/ Left fold -foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl #-} -foldl = G.foldl - --- | /O(n)/ Left fold on non-empty vectors -foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1 #-} -foldl1 = G.foldl1 - --- | /O(n)/ Left fold with strict accumulator -foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl' #-} -foldl' = G.foldl' - --- | /O(n)/ Left fold on non-empty vectors with strict accumulator -foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1' #-} -foldl1' = G.foldl1' - --- | /O(n)/ Right fold -foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr #-} -foldr = G.foldr - --- | /O(n)/ Right fold on non-empty vectors -foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1 #-} -foldr1 = G.foldr1 - --- | /O(n)/ Right fold with a strict accumulator -foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr' #-} -foldr' = G.foldr' - --- | /O(n)/ Right fold on non-empty vectors with strict accumulator -foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1' #-} -foldr1' = G.foldr1' - --- | /O(n)/ Left fold (function applied to each element and its index) -ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl #-} -ifoldl = G.ifoldl - --- | /O(n)/ Left fold with strict accumulator (function applied to each element --- and its index) -ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl' #-} -ifoldl' = G.ifoldl' - --- | /O(n)/ Right fold (function applied to each element and its index) -ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr #-} -ifoldr = G.ifoldr - --- | /O(n)/ Right fold with strict accumulator (function applied to each --- element and its index) -ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr' #-} -ifoldr' = G.ifoldr' - --- Specialised folds --- ----------------- - --- | /O(n)/ Check if all elements satisfy the predicate. -all :: Storable a => (a -> Bool) -> Vector a -> Bool -{-# INLINE all #-} -all = G.all - --- | /O(n)/ Check if any element satisfies the predicate. -any :: Storable a => (a -> Bool) -> Vector a -> Bool -{-# INLINE any #-} -any = G.any - --- | /O(n)/ Check if all elements are 'True' -and :: Vector Bool -> Bool -{-# INLINE and #-} -and = G.and - --- | /O(n)/ Check if any element is 'True' -or :: Vector Bool -> Bool -{-# INLINE or #-} -or = G.or - --- | /O(n)/ Compute the sum of the elements -sum :: (Storable a, Num a) => Vector a -> a -{-# INLINE sum #-} -sum = G.sum - --- | /O(n)/ Compute the produce of the elements -product :: (Storable a, Num a) => Vector a -> a -{-# INLINE product #-} -product = G.product - --- | /O(n)/ Yield the maximum element of the vector. The vector may not be --- empty. -maximum :: (Storable a, Ord a) => Vector a -> a -{-# INLINE maximum #-} -maximum = G.maximum - --- | /O(n)/ Yield the maximum element of the vector according to the given --- comparison function. The vector may not be empty. -maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE maximumBy #-} -maximumBy = G.maximumBy - --- | /O(n)/ Yield the minimum element of the vector. The vector may not be --- empty. -minimum :: (Storable a, Ord a) => Vector a -> a -{-# INLINE minimum #-} -minimum = G.minimum - --- | /O(n)/ Yield the minimum element of the vector according to the given --- comparison function. The vector may not be empty. -minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE minimumBy #-} -minimumBy = G.minimumBy - --- | /O(n)/ Yield the index of the maximum element of the vector. The vector --- may not be empty. -maxIndex :: (Storable a, Ord a) => Vector a -> Int -{-# INLINE maxIndex #-} -maxIndex = G.maxIndex - --- | /O(n)/ Yield the index of the maximum element of the vector according to --- the given comparison function. The vector may not be empty. -maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE maxIndexBy #-} -maxIndexBy = G.maxIndexBy - --- | /O(n)/ Yield the index of the minimum element of the vector. The vector --- may not be empty. -minIndex :: (Storable a, Ord a) => Vector a -> Int -{-# INLINE minIndex #-} -minIndex = G.minIndex - --- | /O(n)/ Yield the index of the minimum element of the vector according to --- the given comparison function. The vector may not be empty. -minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE minIndexBy #-} -minIndexBy = G.minIndexBy - --- Monadic folds --- ------------- - --- | /O(n)/ Monadic fold -foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# INLINE foldM #-} -foldM = G.foldM - --- | /O(n)/ Monadic fold over non-empty vectors -fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a -{-# INLINE fold1M #-} -fold1M = G.fold1M - --- | /O(n)/ Monadic fold with strict accumulator -foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# INLINE foldM' #-} -foldM' = G.foldM' - --- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a -{-# INLINE fold1M' #-} -fold1M' = G.fold1M' - --- | /O(n)/ Monadic fold that discards the result -foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# INLINE foldM_ #-} -foldM_ = G.foldM_ - --- | /O(n)/ Monadic fold over non-empty vectors that discards the result -fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () -{-# INLINE fold1M_ #-} -fold1M_ = G.fold1M_ - --- | /O(n)/ Monadic fold with strict accumulator that discards the result -foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# INLINE foldM'_ #-} -foldM'_ = G.foldM'_ - --- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator --- that discards the result -fold1M'_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () -{-# INLINE fold1M'_ #-} -fold1M'_ = G.fold1M'_ - --- Prefix sums (scans) --- ------------------- - --- | /O(n)/ Prescan --- --- @ --- prescanl f z = 'init' . 'scanl' f z --- @ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ --- -prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl #-} -prescanl = G.prescanl - --- | /O(n)/ Prescan with strict accumulator -prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl' #-} -prescanl' = G.prescanl' - --- | /O(n)/ Scan --- --- @ --- postscanl f z = 'tail' . 'scanl' f z --- @ --- --- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ --- -postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl #-} -postscanl = G.postscanl - --- | /O(n)/ Scan with strict accumulator -postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl' #-} -postscanl' = G.postscanl' - --- | /O(n)/ Haskell-style scan --- --- > scanl f z = --- > where y1 = z --- > 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 - --- | /O(n)/ Haskell-style scan with strict accumulator -scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE scanl' #-} -scanl' = G.scanl' - --- | /O(n)/ Scan over a non-empty vector --- --- > scanl f = --- > where y1 = x1 --- > yi = f y(i-1) xi --- -scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1 #-} -scanl1 = G.scanl1 - --- | /O(n)/ Scan over a non-empty vector with a strict accumulator -scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1' #-} -scanl1' = G.scanl1' - --- | /O(n)/ Right-to-left prescan --- --- @ --- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' --- @ --- -prescanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr #-} -prescanr = G.prescanr - --- | /O(n)/ Right-to-left prescan with strict accumulator -prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr' #-} -prescanr' = G.prescanr' - --- | /O(n)/ Right-to-left scan -postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr #-} -postscanr = G.postscanr - --- | /O(n)/ Right-to-left scan with strict accumulator -postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr' #-} -postscanr' = G.postscanr' - --- | /O(n)/ Right-to-left Haskell-style scan -scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr #-} -scanr = G.scanr - --- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator -scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr' #-} -scanr' = G.scanr' - --- | /O(n)/ Right-to-left scan over a non-empty vector -scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1 #-} -scanr1 = G.scanr1 - --- | /O(n)/ Right-to-left scan over a non-empty vector with a strict --- accumulator -scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1' #-} -scanr1' = G.scanr1' - --- Conversions - Lists --- ------------------------ - --- | /O(n)/ Convert a vector to a list -toList :: Storable a => Vector a -> [a] -{-# INLINE toList #-} -toList = G.toList - --- | /O(n)/ Convert a list to a vector -fromList :: Storable a => [a] -> Vector a -{-# INLINE fromList #-} -fromList = G.fromList - --- | /O(n)/ Convert the first @n@ elements of a list to a vector --- --- @ --- fromListN n xs = 'fromList' ('take' n xs) --- @ -fromListN :: Storable a => Int -> [a] -> Vector a -{-# INLINE fromListN #-} -fromListN = G.fromListN - --- Conversions - Unsafe casts --- -------------------------- - --- | /O(1)/ Unsafely cast a vector from one element type to another. --- The operation just changes the type of the underlying pointer and does not --- modify the elements. --- --- The resulting vector contains as many elements as can fit into the --- underlying memory block. --- -unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b -{-# INLINE unsafeCast #-} -unsafeCast (Vector n fp) - = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) - (castForeignPtr fp) - --- Conversions - Mutable vectors --- ----------------------------- - --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without --- copying. The mutable vector may not be used after this operation. -unsafeFreeze - :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE unsafeFreeze #-} -unsafeFreeze = G.unsafeFreeze - --- | /O(1)/ Unsafely convert an immutable vector to a mutable one without --- copying. The immutable vector may not be used after this operation. -unsafeThaw - :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE unsafeThaw #-} -unsafeThaw = G.unsafeThaw - --- | /O(n)/ Yield a mutable copy of the immutable vector. -thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE thaw #-} -thaw = G.thaw - --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE freeze #-} -freeze = G.freeze - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. This is not checked. -unsafeCopy - :: (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 () -{-# INLINE copy #-} -copy = G.copy - --- Conversions - Raw pointers --- -------------------------- - --- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length. --- --- The data may not be modified through the 'ForeignPtr' afterwards. --- --- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. -unsafeFromForeignPtr :: Storable a - => ForeignPtr a -- ^ pointer - -> Int -- ^ offset - -> Int -- ^ length - -> Vector a -{-# 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 #-} - - --- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. --- --- It is assumed the pointer points directly to the data (no offset). --- Use `unsafeFromForeignPtr` if you need to specify an offset. --- --- The data may not be modified through the 'ForeignPtr' afterwards. -unsafeFromForeignPtr0 :: Storable a - => ForeignPtr a -- ^ pointer - -> Int -- ^ length - -> Vector a -{-# INLINE unsafeFromForeignPtr0 #-} -unsafeFromForeignPtr0 fp n = Vector n fp - --- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the --- data and its length. The data may not be modified through the 'ForeignPtr'. -unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) -{-# INLINE unsafeToForeignPtr #-} -unsafeToForeignPtr (Vector n fp) = (fp, 0, n) - --- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. --- --- You can assume the pointer points directly to the data (no offset). --- --- The data may not be modified through the 'ForeignPtr'. -unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int) -{-# INLINE unsafeToForeignPtr0 #-} -unsafeToForeignPtr0 (Vector n fp) = (fp, n) - --- | Pass a pointer to the vector's data to the IO action. The data may not be --- modified through the 'Ptr. -unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b -{-# INLINE unsafeWith #-} -unsafeWith (Vector _ fp) = withForeignPtr fp diff --git a/Data/Vector/Storable/Internal.hs b/Data/Vector/Storable/Internal.hs deleted file mode 100644 --- a/Data/Vector/Storable/Internal.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | --- Module : Data.Vector.Storable.Internal --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Ugly internal utility functions for implementing 'Storable'-based vectors. --- - -module Data.Vector.Storable.Internal ( - getPtr, setPtr, updPtr -) where - -import Foreign.ForeignPtr () -import Foreign.Ptr () -import GHC.ForeignPtr ( ForeignPtr(..) ) -import GHC.Ptr ( Ptr(..) ) - -getPtr :: ForeignPtr a -> Ptr a -{-# INLINE getPtr #-} -getPtr (ForeignPtr addr _) = Ptr addr - -setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a -{-# INLINE setPtr #-} -setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c - -updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a -{-# INLINE updPtr #-} -updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } - diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs deleted file mode 100644 --- a/Data/Vector/Storable/Mutable.hs +++ /dev/null @@ -1,586 +0,0 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-} - - - --- | --- Module : Data.Vector.Storable.Mutable --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Mutable vectors based on Storable. --- - -module Data.Vector.Storable.Mutable( - -- * Mutable vectors of 'Storable' types - MVector(..), IOVector, STVector, Storable, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Extracting subvectors - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- ** Overlapping - overlaps, - - -- * Construction - - -- ** Initialisation - new, unsafeNew, replicate, replicateM, clone, - - -- ** Growing - grow, unsafeGrow, - - -- ** Restricting memory usage - clear, - - -- * Accessing individual elements - read, write, modify, swap, - unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, - - -- * Modifying vectors - - -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove, - - -- * Unsafe conversions - unsafeCast, - - - -- * Raw pointers - unsafeFromForeignPtr, unsafeFromForeignPtr0, - unsafeToForeignPtr, unsafeToForeignPtr0, - unsafeWith -) where - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import qualified Data.Vector.Generic.Mutable as G -import Data.Vector.Storable.Internal - -import Foreign.Storable -import Foreign.ForeignPtr - -#if __GLASGOW_HASKELL__ >= 706 -import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) -#elif __GLASGOW_HASKELL__ >= 700 -import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray, - unsafeFreezeByteArray) -import GHC.Prim (byteArrayContents#, unsafeCoerce#) -import GHC.ForeignPtr -#endif - -import GHC.Base ( Int(..) ) - -import Foreign.Ptr (castPtr,plusPtr) -import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) - -import Control.Monad.Primitive -import Data.Primitive.Types (Prim) -import qualified Data.Primitive.Types as DPT - -import GHC.Word (Word8, Word16, Word32, Word64) -import GHC.Ptr (Ptr(..)) - -import Prelude hiding ( length, null, replicate, reverse, map, read, - take, drop, splitAt, init, tail ) - -import Data.Typeable ( Typeable ) - - --- Data.Vector.Internal.Check is not needed -#define NOT_VECTOR_MODULE -#include "vector.h" - - - --- | Mutable 'Storable'-based vectors -data MVector s a = MVector {-# UNPACK #-} !Int - {-# UNPACK #-} !(ForeignPtr a) - deriving ( Typeable ) - -type IOVector = MVector RealWorld -type STVector s = MVector s - -instance NFData (MVector s a) where - rnf (MVector _ _) = () - -#if MIN_VERSION_deepseq(1,4,3) -instance NFData1 (MVector s) where - liftRnf _ (MVector _ _) = () -#endif - -instance Storable a => G.MVector MVector a where - {-# INLINE basicLength #-} - basicLength (MVector n _) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice j m (MVector _ fp) = MVector m (updPtr (`advancePtr` j) fp) - - -- FIXME: this relies on non-portable pointer comparisons - {-# INLINE basicOverlaps #-} - basicOverlaps (MVector m fp) (MVector n fq) - = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) - where - between x y z = x >= y && x < z - p = getPtr fp - q = getPtr fq - - {-# INLINE basicUnsafeNew #-} - basicUnsafeNew n - | 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) `max` 1 - mx = maxBound `quot` size :: Int - - {-# INLINE basicInitialize #-} - basicInitialize = storableZero - - {-# INLINE basicUnsafeRead #-} - basicUnsafeRead (MVector _ fp) i - = unsafePrimToPrim - $ withForeignPtr fp (`peekElemOff` i) - - {-# INLINE basicUnsafeWrite #-} - basicUnsafeWrite (MVector _ fp) i x - = unsafePrimToPrim - $ withForeignPtr fp $ \p -> pokeElemOff p i x - - {-# INLINE basicSet #-} - basicSet = storableSet - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector n fp) (MVector _ fq) - = unsafePrimToPrim - $ withForeignPtr fp $ \p -> - withForeignPtr fq $ \q -> - copyArray p q n - - {-# INLINE basicUnsafeMove #-} - basicUnsafeMove (MVector n fp) (MVector _ fq) - = unsafePrimToPrim - $ withForeignPtr fp $ \p -> - 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-> do - memsetPrimPtr_vector (castPtr ptr) 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 (MVector n fp) x - | n == 0 = return () - | otherwise = unsafePrimToPrim $ - case sizeOf x of - 1 -> storableSetAsPrim n fp x (undefined :: Word8) - 2 -> storableSetAsPrim n fp x (undefined :: Word16) - 4 -> storableSetAsPrim n fp x (undefined :: Word32) - 8 -> storableSetAsPrim n fp x (undefined :: Word64) - _ -> withForeignPtr fp $ \p -> do - poke p x - - let do_set i - | 2*i < n = do - copyArray (p `advancePtr` i) p i - do_set (2*i) - | otherwise = copyArray (p `advancePtr` i) p (n-i) - - do_set 1 - -storableSetAsPrim - :: forall a b . (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () -{-# INLINE [0] storableSetAsPrim #-} -storableSetAsPrim n fp x _y = withForeignPtr fp $ \ ptr -> do - poke ptr x - -- we dont equate storable and prim reps, so we need to write to a slot - -- in storable - -- then read it back as a prim - w<- peakPrimPtr_vector ((castPtr ptr) :: Ptr b) 0 - memsetPrimPtr_vector ((castPtr ptr) `plusPtr` sizeOf x ) (n-1) w - - - -{- -AFTER primitive 0.7 is pretty old, move to using setPtr. which is really -a confusing misnomer for whats often called memset (intialize ) --} --- Fill a memory block with the given value. The length is in --- elements of type @a@ rather than in bytes. -memsetPrimPtr_vector :: forall a c m. (Prim c, PrimMonad m) => Ptr a -> Int -> c -> m () -memsetPrimPtr_vector (Ptr addr#) (I# n#) x = primitive_ (DPT.setOffAddr# addr# 0# n# x) -{-# INLINE memsetPrimPtr_vector #-} - - --- Read a value from a memory position given by an address and an offset. --- The offset is in elements of type @a@ rather than in bytes. -peakPrimPtr_vector :: (Prim a, PrimMonad m) => Ptr a -> Int -> m a -peakPrimPtr_vector (Ptr addr#) (I# i#) = primitive (DPT.readOffAddr# addr# i#) -{-# INLINE peakPrimPtr_vector #-} - -{-# INLINE mallocVector #-} -mallocVector :: Storable a => Int -> IO (ForeignPtr a) -mallocVector = -#if __GLASGOW_HASKELL__ >= 706 - doMalloc undefined - where - doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) - doMalloc dummy size = - mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy) -#elif __GLASGOW_HASKELL__ >= 700 - doMalloc undefined - where - doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) - doMalloc dummy size = do - arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign - newConcForeignPtr - (Ptr (byteArrayContents# (unsafeCoerce# arr#))) - -- Keep reference to mutable byte array until whole ForeignPtr goes out - -- of scope. - (touch arr) - where - arrSize = size * sizeOf dummy - arrAlign = alignment dummy -#else - mallocForeignPtrArray -#endif - --- Length information --- ------------------ - --- | Length of the mutable vector. -length :: Storable a => MVector s a -> Int -{-# INLINE length #-} -length = G.length - --- | Check whether the vector is empty -null :: Storable a => MVector s a -> Bool -{-# INLINE null #-} -null = G.null - --- Extracting subvectors --- --------------------- - --- | Yield a part of the mutable vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Storable a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> MVector s a - -> MVector s a -{-# INLINE slice #-} -slice = G.slice - -take :: Storable a => Int -> MVector s a -> MVector s a -{-# INLINE take #-} -take = G.take - -drop :: Storable a => Int -> MVector s a -> MVector s a -{-# INLINE drop #-} -drop = G.drop - -splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) -{-# INLINE splitAt #-} -splitAt = G.splitAt - -init :: Storable a => MVector s a -> MVector s a -{-# INLINE init #-} -init = G.init - -tail :: Storable a => MVector s a -> MVector s a -{-# INLINE tail #-} -tail = G.tail - --- | Yield a part of the mutable vector without copying it. No bounds checks --- are performed. -unsafeSlice :: Storable a - => Int -- ^ starting index - -> Int -- ^ length of the slice - -> MVector s a - -> MVector s a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - -unsafeTake :: Storable a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - -unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - -unsafeInit :: Storable a => MVector s a -> MVector s a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - -unsafeTail :: Storable a => MVector s a -> MVector s a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- Overlapping --- ----------- - --- | Check whether two vectors overlap. -overlaps :: Storable a => MVector s a -> MVector s a -> Bool -{-# INLINE overlaps #-} -overlaps = G.overlaps - --- Initialisation --- -------------- - --- | Create a mutable vector of the given length. -new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) -{-# INLINE new #-} -new = G.new - --- | Create a mutable vector of the given length. The memory is not initialized. -unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeNew #-} -unsafeNew = G.unsafeNew - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with an initial value. -replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE replicate #-} -replicate = G.replicate - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with values produced by repeatedly executing the monadic action. -replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | Create a copy of a mutable vector. -clone :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> m (MVector (PrimState m) a) -{-# INLINE clone #-} -clone = G.clone - --- Growing --- ------- - --- | Grow a vector by the given number of elements. The number must be --- positive. -grow :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE grow #-} -grow = G.grow - --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeGrow #-} -unsafeGrow = G.unsafeGrow - --- Restricting memory usage --- ------------------------ - --- | Reset all elements of the vector to some undefined value, clearing all --- 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 - --- Accessing individual elements --- ----------------------------- - --- | Yield the element at the given position. -read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE read #-} -read = G.read - --- | Replace the element at the given position. -write - :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 () -{-# INLINE swap #-} -swap = G.swap - - --- | Yield the element at the given position. No bounds checks are performed. -unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE unsafeRead #-} -unsafeRead = G.unsafeRead - --- | Replace the element at the given position. No bounds checks are performed. -unsafeWrite - :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 () -{-# INLINE unsafeSwap #-} -unsafeSwap = G.unsafeSwap - --- Filling and copying --- ------------------- - --- | Set all elements of the vector to the given value. -set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () -{-# INLINE set #-} -set = G.set - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. -copy :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE copy #-} -copy = G.copy - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. This is not checked. -unsafeCopy :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy = G.unsafeCopy - --- | 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 --- to the target vector. -move :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE move #-} -move = G.move - --- | 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 --- to the target vector. -unsafeMove :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeMove #-} -unsafeMove = G.unsafeMove - --- Unsafe conversions --- ------------------ - --- | /O(1)/ Unsafely cast a mutable vector from one element type to another. --- The operation just changes the type of the underlying pointer and does not --- modify the elements. --- --- The resulting vector contains as many elements as can fit into the --- underlying memory block. --- -unsafeCast :: forall a b s. - (Storable a, Storable b) => MVector s a -> MVector s b -{-# INLINE unsafeCast #-} -unsafeCast (MVector n fp) - = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) - (castForeignPtr fp) - --- Raw pointers --- ------------ - --- | Create a mutable vector from a 'ForeignPtr' with an offset and a length. --- --- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector --- could have been frozen before the modification. --- --- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. -unsafeFromForeignPtr :: Storable a - => ForeignPtr a -- ^ pointer - -> Int -- ^ offset - -> Int -- ^ length - -> MVector s a -{-# 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 #-} - - --- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. --- --- It is assumed the pointer points directly to the data (no offset). --- Use `unsafeFromForeignPtr` if you need to specify an offset. --- --- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector --- could have been frozen before the modification. -unsafeFromForeignPtr0 :: Storable a - => ForeignPtr a -- ^ pointer - -> Int -- ^ length - -> MVector s a -{-# INLINE unsafeFromForeignPtr0 #-} -unsafeFromForeignPtr0 fp n = MVector n fp - --- | Yield the underlying 'ForeignPtr' together with the offset to the data --- and its length. Modifying the data through the 'ForeignPtr' is --- unsafe if the vector could have frozen before the modification. -unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) -{-# INLINE unsafeToForeignPtr #-} -unsafeToForeignPtr (MVector n fp) = (fp, 0, n) - --- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. --- --- You can assume the pointer points directly to the data (no offset). --- --- Modifying the data through the 'ForeignPtr' is unsafe if the vector could --- have frozen before the modification. -unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int) -{-# INLINE unsafeToForeignPtr0 #-} -unsafeToForeignPtr0 (MVector n fp) = (fp, n) - --- | Pass a pointer to the vector's data to the IO action. Modifying data --- through the pointer is unsafe if the vector could have been frozen before --- the modification. -unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b -{-# INLINE unsafeWith #-} -unsafeWith (MVector _ fp) = withForeignPtr fp - diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs deleted file mode 100644 --- a/Data/Vector/Unboxed.hs +++ /dev/null @@ -1,1497 +0,0 @@ -{-# LANGUAGE CPP, Rank2Types, TypeFamilies #-} - --- | --- Module : Data.Vector.Unboxed --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Adaptive unboxed vectors. The implementation is based on type families --- and picks an efficient, specialised representation for every element type. --- In particular, unboxed vectors of pairs are represented as pairs of unboxed --- vectors. --- --- Implementing unboxed vectors for new data types can be very easy. Here is --- how the library does this for 'Complex' by simply wrapping vectors of --- pairs. --- --- @ --- newtype instance 'MVector' s ('Complex' a) = MV_Complex ('MVector' s (a,a)) --- newtype instance 'Vector' ('Complex' a) = V_Complex ('Vector' (a,a)) --- --- instance ('RealFloat' a, 'Unbox' a) => 'Data.Vector.Generic.Mutable.MVector' 'MVector' ('Complex' a) where --- {-\# INLINE basicLength \#-} --- basicLength (MV_Complex v) = 'Data.Vector.Generic.Mutable.basicLength' v --- ... --- --- instance ('RealFloat' a, 'Unbox' a) => Data.Vector.Generic.Vector 'Vector' ('Complex' a) where --- {-\# INLINE basicLength \#-} --- basicLength (V_Complex v) = Data.Vector.Generic.basicLength v --- ... --- --- instance ('RealFloat' a, 'Unbox' a) => 'Unbox' ('Complex' a) --- @ - -module Data.Vector.Unboxed ( - -- * Unboxed vectors - Vector, MVector(..), Unbox, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Indexing - (!), (!?), head, last, - unsafeIndex, unsafeHead, unsafeLast, - - -- ** Monadic indexing - indexM, headM, lastM, - unsafeIndexM, unsafeHeadM, unsafeLastM, - - -- ** Extracting subvectors (slicing) - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- * Construction - - -- ** Initialisation - empty, singleton, replicate, generate, iterateN, - - -- ** Monadic initialisation - replicateM, generateM, iterateNM, create, createT, - - -- ** Unfolding - unfoldr, unfoldrN, - unfoldrM, unfoldrNM, - constructN, constructrN, - - -- ** Enumeration - enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, - - -- ** Concatenation - cons, snoc, (++), concat, - - -- ** Restricting memory usage - force, - - -- * Modifying vectors - - -- ** Bulk updates - (//), update, update_, - unsafeUpd, unsafeUpdate, unsafeUpdate_, - - -- ** Accumulations - accum, accumulate, accumulate_, - unsafeAccum, unsafeAccumulate, unsafeAccumulate_, - - -- ** Permutations - reverse, backpermute, unsafeBackpermute, - - -- ** Safe destructive updates - modify, - - -- * Elementwise operations - - -- ** Indexing - indexed, - - -- ** Mapping - map, imap, concatMap, - - -- ** Monadic mapping - mapM, imapM, mapM_, imapM_, forM, forM_, - - -- ** Zipping - zipWith, zipWith3, zipWith4, zipWith5, zipWith6, - izipWith, izipWith3, izipWith4, izipWith5, izipWith6, - zip, zip3, zip4, zip5, zip6, - - -- ** Monadic zipping - zipWithM, izipWithM, zipWithM_, izipWithM_, - - -- ** Unzipping - unzip, unzip3, unzip4, unzip5, unzip6, - - -- * Working with predicates - - -- ** Filtering - filter, ifilter, uniq, - mapMaybe, imapMaybe, - filterM, - takeWhile, dropWhile, - - -- ** Partitioning - partition, unstablePartition, partitionWith, span, break, - - -- ** Searching - elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, - - -- * Folding - foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', - ifoldl, ifoldl', ifoldr, ifoldr', - - -- ** Specialised folds - all, any, and, or, - sum, product, - maximum, maximumBy, minimum, minimumBy, - minIndex, minIndexBy, maxIndex, maxIndexBy, - - -- ** Monadic folds - foldM, ifoldM, foldM', ifoldM', - fold1M, fold1M', foldM_, ifoldM_, - foldM'_, ifoldM'_, fold1M_, fold1M'_, - - -- * Prefix sums (scans) - prescanl, prescanl', - postscanl, postscanl', - scanl, scanl', scanl1, scanl1', - prescanr, prescanr', - postscanr, postscanr', - scanr, scanr', scanr1, scanr1', - - -- * Conversions - - -- ** Lists - toList, fromList, fromListN, - - -- ** Other vector types - G.convert, - - -- ** Mutable vectors - freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy -) where - -import Data.Vector.Unboxed.Base -import qualified Data.Vector.Generic as G -import qualified Data.Vector.Fusion.Bundle as Bundle -import Data.Vector.Fusion.Util ( delayed_min ) - -import Control.Monad.ST ( ST ) -import Control.Monad.Primitive - -import Prelude hiding ( length, null, - replicate, (++), concat, - head, last, - init, tail, take, drop, splitAt, reverse, - map, concatMap, - zipWith, zipWith3, zip, zip3, unzip, unzip3, - filter, takeWhile, dropWhile, span, break, - elem, notElem, - foldl, foldl1, foldr, foldr1, - all, any, and, or, sum, product, minimum, maximum, - scanl, scanl1, scanr, scanr1, - enumFromTo, enumFromThenTo, - mapM, mapM_ ) - -import Text.Read ( Read(..), readListPrecDefault ) -import Data.Semigroup ( Semigroup(..) ) - -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid ( Monoid(..) ) -import Data.Traversable ( Traversable ) -#endif - -#if __GLASGOW_HASKELL__ >= 708 -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 = Bundle.eq (G.stream xs) (G.stream ys) - - {-# INLINE (/=) #-} - 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 = Bundle.cmp (G.stream xs) (G.stream ys) - - {-# INLINE (<) #-} - xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT - - {-# INLINE (<=) #-} - xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT - - {-# INLINE (>) #-} - xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT - - {-# INLINE (>=) #-} - xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT - -instance Unbox a => Semigroup (Vector a) where - {-# INLINE (<>) #-} - (<>) = (++) - - {-# INLINE sconcat #-} - sconcat = G.concatNE - -instance Unbox a => Monoid (Vector a) where - {-# INLINE mempty #-} - mempty = empty - - {-# INLINE mappend #-} - mappend = (++) - - {-# INLINE mconcat #-} - mconcat = concat - -instance (Show a, Unbox a) => Show (Vector a) where - showsPrec = G.showsPrec - -instance (Read a, Unbox a) => Read (Vector a) where - readPrec = G.readPrec - readListPrec = readListPrecDefault - -#if __GLASGOW_HASKELL__ >= 708 - -instance (Unbox e) => Exts.IsList (Vector e) where - type Item (Vector e) = e - fromList = fromList - fromListN = fromListN - toList = toList - -#endif - --- Length information --- ------------------ - --- | /O(1)/ Yield the length of the vector -length :: Unbox a => Vector a -> Int -{-# INLINE length #-} -length = G.length - --- | /O(1)/ Test whether a vector is empty -null :: Unbox a => Vector a -> Bool -{-# INLINE null #-} -null = G.null - --- Indexing --- -------- - --- | O(1) Indexing -(!) :: Unbox a => Vector a -> Int -> a -{-# INLINE (!) #-} -(!) = (G.!) - --- | O(1) Safe indexing -(!?) :: Unbox a => Vector a -> Int -> Maybe a -{-# INLINE (!?) #-} -(!?) = (G.!?) - --- | /O(1)/ First element -head :: Unbox a => Vector a -> a -{-# INLINE head #-} -head = G.head - --- | /O(1)/ Last element -last :: Unbox a => Vector a -> a -{-# INLINE last #-} -last = G.last - --- | /O(1)/ Unsafe indexing without bounds checking -unsafeIndex :: Unbox a => Vector a -> Int -> a -{-# INLINE unsafeIndex #-} -unsafeIndex = G.unsafeIndex - --- | /O(1)/ First element without checking if the vector is empty -unsafeHead :: Unbox a => Vector a -> a -{-# INLINE unsafeHead #-} -unsafeHead = G.unsafeHead - --- | /O(1)/ Last element without checking if the vector is empty -unsafeLast :: Unbox a => Vector a -> a -{-# INLINE unsafeLast #-} -unsafeLast = G.unsafeLast - --- Monadic indexing --- ---------------- - --- | /O(1)/ Indexing in a monad. --- --- The monad allows operations to be strict in the vector when necessary. --- Suppose vector copying is implemented like this: --- --- > copy mv v = ... write mv i (v ! i) ... --- --- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ --- would unnecessarily retain a reference to @v@ in each element written. --- --- With 'indexM', copying can be implemented like this instead: --- --- > copy mv v = ... do --- > x <- indexM v i --- > write mv i x --- --- Here, no references to @v@ are retained because indexing (but /not/ the --- elements) is evaluated eagerly. --- -indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a -{-# INLINE indexM #-} -indexM = G.indexM - --- | /O(1)/ First element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -headM :: (Unbox a, Monad m) => Vector a -> m a -{-# INLINE headM #-} -headM = G.headM - --- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an --- explanation of why this is useful. -lastM :: (Unbox a, Monad m) => Vector a -> m a -{-# INLINE lastM #-} -lastM = G.lastM - --- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an --- explanation of why this is useful. -unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a -{-# INLINE unsafeIndexM #-} -unsafeIndexM = G.unsafeIndexM - --- | /O(1)/ First element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a -{-# INLINE unsafeHeadM #-} -unsafeHeadM = G.unsafeHeadM - --- | /O(1)/ Last element in a monad without checking for empty vectors. --- See 'indexM' for an explanation of why this is useful. -unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a -{-# INLINE unsafeLastM #-} -unsafeLastM = G.unsafeLastM - --- Extracting subvectors (slicing) --- ------------------------------- - --- | /O(1)/ Yield a slice of the vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Unbox a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE slice #-} -slice = G.slice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty. -init :: Unbox a => Vector a -> Vector a -{-# INLINE init #-} -init = G.init - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty. -tail :: Unbox a => Vector a -> Vector a -{-# INLINE tail #-} -tail = G.tail - --- | /O(1)/ Yield at the first @n@ elements without copying. The vector may --- contain less than @n@ elements in which case it is returned unchanged. -take :: Unbox a => Int -> Vector a -> Vector a -{-# INLINE take #-} -take = G.take - --- | /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 :: Unbox a => Int -> Vector a -> Vector a -{-# INLINE drop #-} -drop = G.drop - --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. --- --- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ --- but slightly more efficient. -{-# INLINE splitAt #-} -splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) -splitAt = G.splitAt - --- | /O(1)/ Yield a slice of the vector without copying. The vector must --- contain at least @i+n@ elements but this is not checked. -unsafeSlice :: Unbox a => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> Vector a - -> Vector a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - --- | /O(1)/ Yield all but the last element without copying. The vector may not --- be empty but this is not checked. -unsafeInit :: Unbox a => Vector a -> Vector a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - --- | /O(1)/ Yield all but the first element without copying. The vector may not --- be empty but this is not checked. -unsafeTail :: Unbox a => Vector a -> Vector a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- | /O(1)/ Yield the first @n@ elements without copying. The vector must --- contain at least @n@ elements but this is not checked. -unsafeTake :: Unbox a => Int -> Vector a -> Vector a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - --- | /O(1)/ Yield all but the first @n@ elements without copying. The vector --- must contain at least @n@ elements but this is not checked. -unsafeDrop :: Unbox a => Int -> Vector a -> Vector a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - --- Initialisation --- -------------- - --- | /O(1)/ Empty vector -empty :: Unbox a => Vector a -{-# INLINE empty #-} -empty = G.empty - --- | /O(1)/ Vector with exactly one element -singleton :: Unbox a => a -> Vector a -{-# INLINE singleton #-} -singleton = G.singleton - --- | /O(n)/ Vector of the given length with the same value in each position -replicate :: Unbox a => Int -> a -> Vector a -{-# INLINE replicate #-} -replicate = G.replicate - --- | /O(n)/ Construct a vector of the given length by applying the function to --- each index -generate :: Unbox a => Int -> (Int -> a) -> Vector a -{-# INLINE generate #-} -generate = G.generate - --- | /O(n)/ Apply function n times to value. Zeroth element is original value. -iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a -{-# INLINE iterateN #-} -iterateN = G.iterateN - --- Unfolding --- --------- - --- | /O(n)/ Construct a vector by repeatedly applying the generator function --- to a seed. The generator function yields 'Just' the next element and the --- new seed or 'Nothing' if there are no more elements. --- --- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 --- > = <10,9,8,7,6,5,4,3,2,1> -unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldr #-} -unfoldr = G.unfoldr - --- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying --- the generator function to a seed. The generator function yields 'Just' the --- next element and the new seed or 'Nothing' if there are no more elements. --- --- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> -unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a -{-# INLINE unfoldrN #-} -unfoldrN = G.unfoldrN - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrM :: (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrM #-} -unfoldrM = G.unfoldrM - --- | /O(n)/ Construct a vector by repeatedly applying the monadic --- generator function to a seed. The generator function yields 'Just' --- the next element and the new seed or 'Nothing' if there are no more --- elements. -unfoldrNM :: (Monad m, Unbox a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) -{-# INLINE unfoldrNM #-} -unfoldrNM = G.unfoldrNM - --- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the --- generator function to the already constructed part of the vector. --- --- > constructN 3 f = let a = f <> ; b = f ; c = f in --- -constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructN #-} -constructN = G.constructN - --- | /O(n)/ Construct a vector with @n@ elements from right to left by --- repeatedly applying the generator function to the already constructed part --- of the vector. --- --- > constructrN 3 f = let a = f <> ; b = f ; c = f in --- -constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a -{-# INLINE constructrN #-} -constructrN = G.constructrN - --- Enumeration --- ----------- - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ --- etc. This operation is usually more efficient than 'enumFromTo'. --- --- > enumFromN 5 3 = <5,6,7> -enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a -{-# INLINE enumFromN #-} -enumFromN = G.enumFromN - --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, --- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. --- --- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> -enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> Vector a -{-# INLINE enumFromStepN #-} -enumFromStepN = G.enumFromStepN - --- | /O(n)/ Enumerate values from @x@ to @y@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromN' instead. -enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a -{-# INLINE enumFromTo #-} -enumFromTo = G.enumFromTo - --- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --- --- /WARNING:/ This operation can be very inefficient. If at all possible, use --- 'enumFromStepN' instead. -enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a -{-# INLINE enumFromThenTo #-} -enumFromThenTo = G.enumFromThenTo - --- Concatenation --- ------------- - --- | /O(n)/ Prepend an element -cons :: Unbox a => a -> Vector a -> Vector a -{-# INLINE cons #-} -cons = G.cons - --- | /O(n)/ Append an element -snoc :: Unbox a => Vector a -> a -> Vector a -{-# INLINE snoc #-} -snoc = G.snoc - -infixr 5 ++ --- | /O(m+n)/ Concatenate two vectors -(++) :: Unbox a => Vector a -> Vector a -> Vector a -{-# INLINE (++) #-} -(++) = (G.++) - --- | /O(n)/ Concatenate all vectors in the list -concat :: Unbox a => [Vector a] -> Vector a -{-# INLINE concat #-} -concat = G.concat - --- Monadic initialisation --- ---------------------- - --- | /O(n)/ Execute the monadic action the given number of times and store the --- results in a vector. -replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | /O(n)/ Construct a vector of the given length by applying the monadic --- action to each index -generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) -{-# INLINE generateM #-} -generateM = G.generateM - --- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. -iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a) -{-# INLINE iterateNM #-} -iterateNM = G.iterateNM - --- | Execute the monadic action and freeze the resulting vector. --- --- @ --- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> --- @ -create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a -{-# INLINE create #-} --- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 -create p = G.create p - --- | Execute the monadic action and freeze the resulting vectors. -createT :: (Traversable f, Unbox a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) -{-# INLINE createT #-} -createT p = G.createT p - --- Restricting memory usage --- ------------------------ - --- | /O(n)/ Yield the argument but force it not to retain any extra memory, --- possibly by copying it. --- --- This is especially useful when dealing with slices. For example: --- --- > force (slice 0 2 ) --- --- Here, the slice retains a reference to the huge vector. Forcing it creates --- a copy of just the elements that belong to the slice and allows the huge --- vector to be garbage collected. -force :: Unbox a => Vector a -> Vector a -{-# INLINE force #-} -force = G.force - --- Bulk updates --- ------------ - --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector --- element at position @i@ by @a@. --- --- > <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@) - -> Vector a -{-# INLINE (//) #-} -(//) = (G.//) - --- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, --- replace the vector element at position @i@ by @a@. --- --- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> --- -update :: Unbox a - => Vector a -- ^ initial vector (of length @m@) - -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) - -> Vector a -{-# INLINE update #-} -update = G.update - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @a@ from the value vector, replace the element of the --- initial vector at position @i@ by @a@. --- --- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> --- --- The function 'update' provides the same functionality and is usually more --- convenient. --- --- @ --- update_ xs is ys = 'update' xs ('zip' is ys) --- @ -update_ :: Unbox a - => Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector a -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE update_ #-} -update_ = G.update_ - --- | Same as ('//') but without bounds checking. -unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a -{-# INLINE unsafeUpd #-} -unsafeUpd = G.unsafeUpd - --- | Same as 'update' but without bounds checking. -unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a -{-# INLINE unsafeUpdate #-} -unsafeUpdate = G.unsafeUpdate - --- | Same as 'update_' but without bounds checking. -unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a -{-# INLINE unsafeUpdate_ #-} -unsafeUpdate_ = G.unsafeUpdate_ - --- Accumulations --- ------------- - --- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element --- @a@ at position @i@ by @f a b@. --- --- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> -accum :: Unbox a - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accum #-} -accum = G.accum - --- | /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@. --- --- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> -accumulate :: (Unbox a, Unbox b) - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) - -> Vector a -{-# INLINE accumulate #-} -accumulate = G.accumulate - --- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the --- corresponding value @b@ from the the value vector, --- replace the element of the initial vector at --- position @i@ by @f a b@. --- --- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> --- --- The function 'accumulate' provides the same functionality and is usually more --- convenient. --- --- @ --- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) --- @ -accumulate_ :: (Unbox a, Unbox b) - => (a -> b -> a) -- ^ accumulating function @f@ - -> Vector a -- ^ initial vector (of length @m@) - -> Vector Int -- ^ index vector (of length @n1@) - -> Vector b -- ^ value vector (of length @n2@) - -> Vector a -{-# INLINE accumulate_ #-} -accumulate_ = G.accumulate_ - --- | Same as 'accum' but without bounds checking. -unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a -{-# INLINE unsafeAccum #-} -unsafeAccum = G.unsafeAccum - --- | Same as 'accumulate' but without bounds checking. -unsafeAccumulate :: (Unbox a, Unbox b) - => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a -{-# INLINE unsafeAccumulate #-} -unsafeAccumulate = G.unsafeAccumulate - --- | Same as 'accumulate_' but without bounds checking. -unsafeAccumulate_ :: (Unbox a, Unbox b) => - (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -{-# INLINE unsafeAccumulate_ #-} -unsafeAccumulate_ = G.unsafeAccumulate_ - --- Permutations --- ------------ - --- | /O(n)/ Reverse a vector -reverse :: Unbox a => Vector a -> Vector a -{-# INLINE reverse #-} -reverse = G.reverse - --- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the --- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is --- often much more efficient. --- --- > backpermute <0,3,2,3,1,0> = -backpermute :: Unbox a => Vector a -> Vector Int -> Vector a -{-# INLINE backpermute #-} -backpermute = G.backpermute - --- | Same as 'backpermute' but without bounds checking. -unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a -{-# INLINE unsafeBackpermute #-} -unsafeBackpermute = G.unsafeBackpermute - --- Safe destructive updates --- ------------------------ - --- | Apply a destructive operation to a vector. The operation will be --- performed in place if it is safe to do so and will modify a copy of the --- vector otherwise. --- --- @ --- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> --- @ -modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a -{-# INLINE modify #-} -modify p = G.modify p - --- Indexing --- -------- - --- | /O(n)/ Pair each element in a vector with its index -indexed :: Unbox a => Vector a -> Vector (Int,a) -{-# INLINE indexed #-} -indexed = G.indexed - --- Mapping --- ------- - --- | /O(n)/ Map a function over a vector -map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b -{-# INLINE map #-} -map = G.map - --- | /O(n)/ Apply a function to every element of a vector and its index -imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b -{-# INLINE imap #-} -imap = G.imap - --- | Map a function over a vector and concatenate the results. -concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b -{-# INLINE concatMap #-} -concatMap = G.concatMap - --- Monadic mapping --- --------------- - --- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results -mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b) -{-# 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. Equivalent to @flip 'mapM'@. -forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) -{-# INLINE forM #-} -forM = G.forM - --- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the --- results. Equivalent to @flip 'mapM_'@. -forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m () -{-# INLINE forM_ #-} -forM_ = G.forM_ - --- Zipping --- ------- - --- | /O(min(m,n))/ Zip two vectors with the given function. -zipWith :: (Unbox a, Unbox b, Unbox c) - => (a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE zipWith #-} -zipWith = G.zipWith - --- | Zip three vectors with the given function. -zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) - => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE zipWith3 #-} -zipWith3 = G.zipWith3 - -zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) - => (a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE zipWith4 #-} -zipWith4 = G.zipWith4 - -zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) - => (a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE zipWith5 #-} -zipWith5 = G.zipWith5 - -zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) - => (a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE zipWith6 #-} -zipWith6 = G.zipWith6 - --- | /O(min(m,n))/ Zip two vectors with a function that also takes the --- elements' indices. -izipWith :: (Unbox a, Unbox b, Unbox c) - => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c -{-# INLINE izipWith #-} -izipWith = G.izipWith - --- | Zip three vectors and their indices with the given function. -izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) - => (Int -> a -> b -> c -> d) - -> Vector a -> Vector b -> Vector c -> Vector d -{-# INLINE izipWith3 #-} -izipWith3 = G.izipWith3 - -izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) - => (Int -> a -> b -> c -> d -> e) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -{-# INLINE izipWith4 #-} -izipWith4 = G.izipWith4 - -izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) - => (Int -> a -> b -> c -> d -> e -> f) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -{-# INLINE izipWith5 #-} -izipWith5 = G.izipWith5 - -izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) - => (Int -> a -> b -> c -> d -> e -> f -> g) - -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e - -> Vector f -> Vector g -{-# INLINE izipWith6 #-} -izipWith6 = G.izipWith6 - --- Monadic zipping --- --------------- - --- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a --- vector of results -zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) - => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) -{-# 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) - => (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, Unbox a, Unbox b) - => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () -{-# INLINE izipWithM_ #-} -izipWithM_ = G.izipWithM_ - --- Filtering --- --------- - --- | /O(n)/ Drop elements that do not satisfy the predicate -filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE filter #-} -filter = G.filter - --- | /O(n)/ Drop repeated adjacent elements. -uniq :: (Unbox a, Eq a) => Vector a -> Vector a -{-# INLINE uniq #-} -uniq = G.uniq - --- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to --- values and their indices -ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a -{-# INLINE ifilter #-} -ifilter = G.ifilter - --- | /O(n)/ Drop elements when predicate returns Nothing -mapMaybe :: (Unbox a, Unbox b) => (a -> Maybe b) -> Vector a -> Vector b -{-# INLINE mapMaybe #-} -mapMaybe = G.mapMaybe - --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing -imapMaybe :: (Unbox a, Unbox b) => (Int -> a -> Maybe b) -> Vector a -> Vector b -{-# INLINE imapMaybe #-} -imapMaybe = G.imapMaybe - --- | /O(n)/ Drop elements that do not satisfy the monadic predicate -filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) -{-# INLINE filterM #-} -filterM = G.filterM - --- | /O(n)/ Yield the longest prefix of elements satisfying the predicate --- without copying. -takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE takeWhile #-} -takeWhile = G.takeWhile - --- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate --- without copying. -dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a -{-# INLINE dropWhile #-} -dropWhile = G.dropWhile - --- Parititioning --- ------------- - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. The --- relative order of the elements is preserved at the cost of a sometimes --- reduced performance compared to 'unstablePartition'. -partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE partition #-} -partition = G.partition - --- | /O(n)/ Split the vector in two parts, the first one containing those --- elements that satisfy the predicate and the second one those that don't. --- The order of the elements is not preserved but the operation is often --- faster than 'partition'. -unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE unstablePartition #-} -unstablePartition = G.unstablePartition - --- | /O(n)/ Split the vector in two parts, the first one containing the --- @Right@ elements and the second containing the @Left@ elements. --- The relative order of the elements is preserved. --- --- @since 0.12.1.0 -partitionWith :: (Unbox a, Unbox b, Unbox c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) -{-# INLINE partitionWith #-} -partitionWith = G.partitionWith - --- | /O(n)/ Split the vector into the longest prefix of elements that satisfy --- the predicate and the rest without copying. -span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE span #-} -span = G.span - --- | /O(n)/ Split the vector into the longest prefix of elements that do not --- satisfy the predicate and the rest without copying. -break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) -{-# INLINE break #-} -break = G.break - --- Searching --- --------- - -infix 4 `elem` --- | /O(n)/ Check if the vector contains an element -elem :: (Unbox a, Eq a) => a -> Vector a -> Bool -{-# INLINE elem #-} -elem = G.elem - -infix 4 `notElem` --- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') -notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool -{-# INLINE notElem #-} -notElem = G.notElem - --- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' --- if no such element exists. -find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a -{-# INLINE find #-} -find = G.find - --- | /O(n)/ Yield 'Just' the index of the first element matching the predicate --- or 'Nothing' if no such element exists. -findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int -{-# INLINE findIndex #-} -findIndex = G.findIndex - --- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending --- order. -findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int -{-# INLINE findIndices #-} -findIndices = G.findIndices - --- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or --- 'Nothing' if the vector does not contain the element. This is a specialised --- version of 'findIndex'. -elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int -{-# INLINE elemIndex #-} -elemIndex = G.elemIndex - --- | /O(n)/ Yield the indices of all occurences of the given element in --- ascending order. This is a specialised version of 'findIndices'. -elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int -{-# INLINE elemIndices #-} -elemIndices = G.elemIndices - --- Folding --- ------- - --- | /O(n)/ Left fold -foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl #-} -foldl = G.foldl - --- | /O(n)/ Left fold on non-empty vectors -foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1 #-} -foldl1 = G.foldl1 - --- | /O(n)/ Left fold with strict accumulator -foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a -{-# INLINE foldl' #-} -foldl' = G.foldl' - --- | /O(n)/ Left fold on non-empty vectors with strict accumulator -foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldl1' #-} -foldl1' = G.foldl1' - --- | /O(n)/ Right fold -foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr #-} -foldr = G.foldr - --- | /O(n)/ Right fold on non-empty vectors -foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1 #-} -foldr1 = G.foldr1 - --- | /O(n)/ Right fold with a strict accumulator -foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b -{-# INLINE foldr' #-} -foldr' = G.foldr' - --- | /O(n)/ Right fold on non-empty vectors with strict accumulator -foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a -{-# INLINE foldr1' #-} -foldr1' = G.foldr1' - --- | /O(n)/ Left fold (function applied to each element and its index) -ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl #-} -ifoldl = G.ifoldl - --- | /O(n)/ Left fold with strict accumulator (function applied to each element --- and its index) -ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a -{-# INLINE ifoldl' #-} -ifoldl' = G.ifoldl' - --- | /O(n)/ Right fold (function applied to each element and its index) -ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr #-} -ifoldr = G.ifoldr - --- | /O(n)/ Right fold with strict accumulator (function applied to each --- element and its index) -ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b -{-# INLINE ifoldr' #-} -ifoldr' = G.ifoldr' - --- Specialised folds --- ----------------- - --- | /O(n)/ Check if all elements satisfy the predicate. -all :: Unbox a => (a -> Bool) -> Vector a -> Bool -{-# INLINE all #-} -all = G.all - --- | /O(n)/ Check if any element satisfies the predicate. -any :: Unbox a => (a -> Bool) -> Vector a -> Bool -{-# INLINE any #-} -any = G.any - --- | /O(n)/ Check if all elements are 'True' -and :: Vector Bool -> Bool -{-# INLINE and #-} -and = G.and - --- | /O(n)/ Check if any element is 'True' -or :: Vector Bool -> Bool -{-# INLINE or #-} -or = G.or - --- | /O(n)/ Compute the sum of the elements -sum :: (Unbox a, Num a) => Vector a -> a -{-# INLINE sum #-} -sum = G.sum - --- | /O(n)/ Compute the produce of the elements -product :: (Unbox a, Num a) => Vector a -> a -{-# INLINE product #-} -product = G.product - --- | /O(n)/ Yield the maximum element of the vector. The vector may not be --- empty. -maximum :: (Unbox a, Ord a) => Vector a -> a -{-# INLINE maximum #-} -maximum = G.maximum - --- | /O(n)/ Yield the maximum element of the vector according to the given --- comparison function. The vector may not be empty. -maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE maximumBy #-} -maximumBy = G.maximumBy - --- | /O(n)/ Yield the minimum element of the vector. The vector may not be --- empty. -minimum :: (Unbox a, Ord a) => Vector a -> a -{-# INLINE minimum #-} -minimum = G.minimum - --- | /O(n)/ Yield the minimum element of the vector according to the given --- comparison function. The vector may not be empty. -minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a -{-# INLINE minimumBy #-} -minimumBy = G.minimumBy - --- | /O(n)/ Yield the index of the maximum element of the vector. The vector --- may not be empty. -maxIndex :: (Unbox a, Ord a) => Vector a -> Int -{-# INLINE maxIndex #-} -maxIndex = G.maxIndex - --- | /O(n)/ Yield the index of the maximum element of the vector according to --- the given comparison function. The vector may not be empty. -maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE maxIndexBy #-} -maxIndexBy = G.maxIndexBy - --- | /O(n)/ Yield the index of the minimum element of the vector. The vector --- may not be empty. -minIndex :: (Unbox a, Ord a) => Vector a -> Int -{-# INLINE minIndex #-} -minIndex = G.minIndex - --- | /O(n)/ Yield the index of the minimum element of the vector according to --- the given comparison function. The vector may not be empty. -minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int -{-# INLINE minIndexBy #-} -minIndexBy = G.minIndexBy - --- Monadic folds --- ------------- - --- | /O(n)/ Monadic fold -foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# 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 #-} -fold1M = G.fold1M - --- | /O(n)/ Monadic fold with strict accumulator -foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a -{-# 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' #-} -fold1M' = G.fold1M' - --- | /O(n)/ Monadic fold that discards the result -foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# 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_ #-} -fold1M_ = G.fold1M_ - --- | /O(n)/ Monadic fold with strict accumulator that discards the result -foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () -{-# 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 () -{-# INLINE fold1M'_ #-} -fold1M'_ = G.fold1M'_ - --- Prefix sums (scans) --- ------------------- - --- | /O(n)/ Prescan --- --- @ --- prescanl f z = 'init' . 'scanl' f z --- @ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ --- -prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl #-} -prescanl = G.prescanl - --- | /O(n)/ Prescan with strict accumulator -prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE prescanl' #-} -prescanl' = G.prescanl' - --- | /O(n)/ Scan --- --- @ --- postscanl f z = 'tail' . 'scanl' f z --- @ --- --- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ --- -postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl #-} -postscanl = G.postscanl - --- | /O(n)/ Scan with strict accumulator -postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE postscanl' #-} -postscanl' = G.postscanl' - --- | /O(n)/ Haskell-style scan --- --- > scanl f z = --- > where y1 = z --- > 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 - --- | /O(n)/ Haskell-style scan with strict accumulator -scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -{-# INLINE scanl' #-} -scanl' = G.scanl' - --- | /O(n)/ Scan over a non-empty vector --- --- > scanl f = --- > where y1 = x1 --- > yi = f y(i-1) xi --- -scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1 #-} -scanl1 = G.scanl1 - --- | /O(n)/ Scan over a non-empty vector with a strict accumulator -scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanl1' #-} -scanl1' = G.scanl1' - --- | /O(n)/ Right-to-left prescan --- --- @ --- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' --- @ --- -prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr #-} -prescanr = G.prescanr - --- | /O(n)/ Right-to-left prescan with strict accumulator -prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE prescanr' #-} -prescanr' = G.prescanr' - --- | /O(n)/ Right-to-left scan -postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr #-} -postscanr = G.postscanr - --- | /O(n)/ Right-to-left scan with strict accumulator -postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE postscanr' #-} -postscanr' = G.postscanr' - --- | /O(n)/ Right-to-left Haskell-style scan -scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr #-} -scanr = G.scanr - --- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator -scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -{-# INLINE scanr' #-} -scanr' = G.scanr' - --- | /O(n)/ Right-to-left scan over a non-empty vector -scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1 #-} -scanr1 = G.scanr1 - --- | /O(n)/ Right-to-left scan over a non-empty vector with a strict --- accumulator -scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -{-# INLINE scanr1' #-} -scanr1' = G.scanr1' - --- Conversions - Lists --- ------------------------ - --- | /O(n)/ Convert a vector to a list -toList :: Unbox a => Vector a -> [a] -{-# INLINE toList #-} -toList = G.toList - --- | /O(n)/ Convert a list to a vector -fromList :: Unbox a => [a] -> Vector a -{-# INLINE fromList #-} -fromList = G.fromList - --- | /O(n)/ Convert the first @n@ elements of a list to a vector --- --- @ --- fromListN n xs = 'fromList' ('take' n xs) --- @ -fromListN :: Unbox a => Int -> [a] -> Vector a -{-# INLINE fromListN #-} -fromListN = G.fromListN - --- Conversions - Mutable vectors --- ----------------------------- - --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without --- copying. The mutable vector may not be used after this operation. -unsafeFreeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE unsafeFreeze #-} -unsafeFreeze = G.unsafeFreeze - --- | /O(1)/ Unsafely convert an immutable vector to a mutable one without --- copying. The immutable vector may not be used after this operation. -unsafeThaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE unsafeThaw #-} -unsafeThaw = G.unsafeThaw - --- | /O(n)/ Yield a mutable copy of the immutable vector. -thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -{-# INLINE thaw #-} -thaw = G.thaw - --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -{-# INLINE freeze #-} -freeze = G.freeze - --- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must --- have the same length. This is not checked. -unsafeCopy - :: (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 () -{-# INLINE copy #-} -copy = G.copy - - -#define DEFINE_IMMUTABLE -#include "unbox-tuple-instances" diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs deleted file mode 100644 --- a/Data/Vector/Unboxed/Base.hs +++ /dev/null @@ -1,593 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} -#if __GLASGOW_HASKELL__ >= 707 -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif -{-# OPTIONS_HADDOCK hide #-} - --- | --- Module : Data.Vector.Unboxed.Base --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Adaptive unboxed vectors: basic implementation --- - -module Data.Vector.Unboxed.Base ( - MVector(..), IOVector, STVector, Vector(..), Unbox -) where - -import qualified Data.Vector.Generic as G -import qualified Data.Vector.Generic.Mutable as M - -import qualified Data.Vector.Primitive as P - -import Control.Applicative (Const(..)) - -import Control.DeepSeq ( NFData(rnf) -#if MIN_VERSION_deepseq(1,4,3) - , NFData1(liftRnf) -#endif - ) - -import Control.Monad.Primitive -import Control.Monad ( liftM ) - -#if MIN_VERSION_base(4,8,0) -import Data.Functor.Identity -#endif -#if MIN_VERSION_base(4,9,0) -import Data.Functor.Compose -#endif - -import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Complex -import Data.Monoid (Dual(..),Sum(..),Product(..),All(..),Any(..)) -#if MIN_VERSION_base(4,8,0) -import Data.Monoid (Alt(..)) -#endif -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup (Min(..),Max(..),First(..),Last(..),WrappedMonoid(..),Arg(..)) -#endif -#if !MIN_VERSION_base(4,8,0) -import Data.Word ( Word ) -#endif - -#if __GLASGOW_HASKELL__ >= 707 -import Data.Typeable ( Typeable ) -#else -import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, - mkTyCon3 - ) -#endif -import Data.Data ( Data(..) ) -import GHC.Exts ( Down(..) ) - --- Data.Vector.Internal.Check is unused -#define NOT_VECTOR_MODULE -#include "vector.h" - -data family MVector s a -data family Vector a - -type IOVector = MVector RealWorld -type STVector s = MVector s - -type instance G.Mutable Vector = MVector - -class (G.Vector Vector a, M.MVector MVector a) => Unbox a - -instance NFData (Vector a) where rnf !_ = () -instance NFData (MVector s a) where rnf !_ = () - -#if MIN_VERSION_deepseq(1,4,3) --- | @since 0.12.1.0 -instance NFData1 Vector where - liftRnf _ !_ = () --- | @since 0.12.1.0 -instance NFData1 (MVector s) where - liftRnf _ !_ = () -#endif - --- ----------------- --- Data and Typeable --- ----------------- -#if __GLASGOW_HASKELL__ >= 707 -deriving instance Typeable Vector -deriving instance Typeable MVector -#else -vectorTyCon = mkTyCon3 "vector" - -instance Typeable1 Vector where - typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] - -instance Typeable2 MVector where - typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] -#endif - -instance (Data a, Unbox a) => Data (Vector a) where - gfoldl = G.gfoldl - toConstr _ = G.mkVecConstr "Data.Vector.Unboxed.Vector" - gunfold = G.gunfold - dataTypeOf _ = G.mkVecType "Data.Vector.Unboxed.Vector" - dataCast1 = G.dataCast - --- ---- --- Unit --- ---- - -newtype instance MVector s () = MV_Unit Int -newtype instance Vector () = V_Unit Int - -instance Unbox () - -instance M.MVector MVector () where - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicOverlaps #-} - {-# INLINE basicUnsafeNew #-} - {-# INLINE basicInitialize #-} - {-# INLINE basicUnsafeRead #-} - {-# INLINE basicUnsafeWrite #-} - {-# INLINE basicClear #-} - {-# INLINE basicSet #-} - {-# INLINE basicUnsafeCopy #-} - {-# INLINE basicUnsafeGrow #-} - - basicLength (MV_Unit n) = n - - 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 () - - basicClear _ = return () - - basicSet (MV_Unit _) () = return () - - basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return () - - basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m) - -instance G.Vector Vector () where - {-# INLINE basicUnsafeFreeze #-} - basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n - - {-# INLINE basicUnsafeThaw #-} - basicUnsafeThaw (V_Unit n) = return $ MV_Unit n - - {-# INLINE basicLength #-} - basicLength (V_Unit n) = n - - {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice _ m (V_Unit _) = V_Unit m - - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_Unit _) _ = return () - - {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () - - {-# INLINE elemseq #-} - elemseq _ = seq - - --- --------------- --- Primitive types --- --------------- - -#define primMVector(ty,con) \ -instance M.MVector MVector ty where { \ - {-# INLINE basicLength #-} \ -; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicOverlaps #-} \ -; {-# INLINE basicUnsafeNew #-} \ -; {-# INLINE basicInitialize #-} \ -; {-# INLINE basicUnsafeReplicate #-} \ -; {-# INLINE basicUnsafeRead #-} \ -; {-# INLINE basicUnsafeWrite #-} \ -; {-# INLINE basicClear #-} \ -; {-# INLINE basicSet #-} \ -; {-# INLINE basicUnsafeCopy #-} \ -; {-# INLINE basicUnsafeGrow #-} \ -; basicLength (con v) = M.basicLength v \ -; 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 \ -; basicClear (con v) = M.basicClear v \ -; basicSet (con v) x = M.basicSet v x \ -; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ -; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ -; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n } - -#define primVector(ty,con,mcon) \ -instance G.Vector Vector ty where { \ - {-# INLINE basicUnsafeFreeze #-} \ -; {-# INLINE basicUnsafeThaw #-} \ -; {-# INLINE basicLength #-} \ -; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicUnsafeIndexM #-} \ -; {-# INLINE elemseq #-} \ -; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ -; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ -; basicLength (con v) = G.basicLength v \ -; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ -; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \ -; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ -; elemseq _ = seq } - -newtype instance MVector s Int = MV_Int (P.MVector s Int) -newtype instance Vector Int = V_Int (P.Vector Int) -instance Unbox Int -primMVector(Int, MV_Int) -primVector(Int, V_Int, MV_Int) - -newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8) -newtype instance Vector Int8 = V_Int8 (P.Vector Int8) -instance Unbox Int8 -primMVector(Int8, MV_Int8) -primVector(Int8, V_Int8, MV_Int8) - -newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16) -newtype instance Vector Int16 = V_Int16 (P.Vector Int16) -instance Unbox Int16 -primMVector(Int16, MV_Int16) -primVector(Int16, V_Int16, MV_Int16) - -newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32) -newtype instance Vector Int32 = V_Int32 (P.Vector Int32) -instance Unbox Int32 -primMVector(Int32, MV_Int32) -primVector(Int32, V_Int32, MV_Int32) - -newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64) -newtype instance Vector Int64 = V_Int64 (P.Vector Int64) -instance Unbox Int64 -primMVector(Int64, MV_Int64) -primVector(Int64, V_Int64, MV_Int64) - - -newtype instance MVector s Word = MV_Word (P.MVector s Word) -newtype instance Vector Word = V_Word (P.Vector Word) -instance Unbox Word -primMVector(Word, MV_Word) -primVector(Word, V_Word, MV_Word) - -newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8) -newtype instance Vector Word8 = V_Word8 (P.Vector Word8) -instance Unbox Word8 -primMVector(Word8, MV_Word8) -primVector(Word8, V_Word8, MV_Word8) - -newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16) -newtype instance Vector Word16 = V_Word16 (P.Vector Word16) -instance Unbox Word16 -primMVector(Word16, MV_Word16) -primVector(Word16, V_Word16, MV_Word16) - -newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32) -newtype instance Vector Word32 = V_Word32 (P.Vector Word32) -instance Unbox Word32 -primMVector(Word32, MV_Word32) -primVector(Word32, V_Word32, MV_Word32) - -newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64) -newtype instance Vector Word64 = V_Word64 (P.Vector Word64) -instance Unbox Word64 -primMVector(Word64, MV_Word64) -primVector(Word64, V_Word64, MV_Word64) - - -newtype instance MVector s Float = MV_Float (P.MVector s Float) -newtype instance Vector Float = V_Float (P.Vector Float) -instance Unbox Float -primMVector(Float, MV_Float) -primVector(Float, V_Float, MV_Float) - -newtype instance MVector s Double = MV_Double (P.MVector s Double) -newtype instance Vector Double = V_Double (P.Vector Double) -instance Unbox Double -primMVector(Double, MV_Double) -primVector(Double, V_Double, MV_Double) - - -newtype instance MVector s Char = MV_Char (P.MVector s Char) -newtype instance Vector Char = V_Char (P.Vector Char) -instance Unbox Char -primMVector(Char, MV_Char) -primVector(Char, V_Char, MV_Char) - --- ---- --- Bool --- ---- - -fromBool :: Bool -> Word8 -{-# INLINE fromBool #-} -fromBool True = 1 -fromBool False = 0 - -toBool :: Word8 -> Bool -{-# INLINE toBool #-} -toBool 0 = False -toBool _ = True - -newtype instance MVector s Bool = MV_Bool (P.MVector s Word8) -newtype instance Vector Bool = V_Bool (P.Vector Word8) - -instance Unbox Bool - -instance M.MVector MVector Bool where - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicOverlaps #-} - {-# INLINE basicUnsafeNew #-} - {-# INLINE basicInitialize #-} - {-# INLINE basicUnsafeReplicate #-} - {-# INLINE basicUnsafeRead #-} - {-# INLINE basicUnsafeWrite #-} - {-# INLINE basicClear #-} - {-# INLINE basicSet #-} - {-# INLINE basicUnsafeCopy #-} - {-# INLINE basicUnsafeGrow #-} - basicLength (MV_Bool v) = M.basicLength v - 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) - basicClear (MV_Bool v) = M.basicClear v - basicSet (MV_Bool v) x = M.basicSet v (fromBool x) - basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2 - basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2 - basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n - -instance G.Vector Vector Bool where - {-# INLINE basicUnsafeFreeze #-} - {-# INLINE basicUnsafeThaw #-} - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} - {-# INLINE elemseq #-} - basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v - basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v - basicLength (V_Bool v) = G.basicLength v - basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v - basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i - basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v - elemseq _ = seq - --- ------- --- Complex --- ------- - -newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) -newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) - -instance (Unbox a) => Unbox (Complex a) - -instance (Unbox a) => M.MVector MVector (Complex a) where - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicOverlaps #-} - {-# INLINE basicUnsafeNew #-} - {-# INLINE basicInitialize #-} - {-# INLINE basicUnsafeReplicate #-} - {-# INLINE basicUnsafeRead #-} - {-# INLINE basicUnsafeWrite #-} - {-# INLINE basicClear #-} - {-# INLINE basicSet #-} - {-# INLINE basicUnsafeCopy #-} - {-# INLINE basicUnsafeGrow #-} - basicLength (MV_Complex v) = M.basicLength v - 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) - basicClear (MV_Complex v) = M.basicClear v - basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y) - basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2 - basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2 - basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n - -instance (Unbox a) => G.Vector Vector (Complex a) where - {-# INLINE basicUnsafeFreeze #-} - {-# INLINE basicUnsafeThaw #-} - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} - {-# INLINE elemseq #-} - basicUnsafeFreeze (MV_Complex v) = V_Complex `liftM` G.basicUnsafeFreeze v - basicUnsafeThaw (V_Complex v) = MV_Complex `liftM` G.basicUnsafeThaw v - basicLength (V_Complex v) = G.basicLength v - basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v - basicUnsafeIndexM (V_Complex v) i - = uncurry (:+) `liftM` G.basicUnsafeIndexM v i - basicUnsafeCopy (MV_Complex mv) (V_Complex v) - = G.basicUnsafeCopy mv v - elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x - $ G.elemseq (undefined :: Vector a) y z - --- ------- --- Identity --- ------- -#define newtypeMVector(inst_ctxt,inst_head,tyC,con) \ -instance inst_ctxt => M.MVector MVector (inst_head) where { \ -; {-# INLINE basicLength #-} \ -; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicOverlaps #-} \ -; {-# INLINE basicUnsafeNew #-} \ -; {-# INLINE basicInitialize #-} \ -; {-# INLINE basicUnsafeReplicate #-} \ -; {-# INLINE basicUnsafeRead #-} \ -; {-# INLINE basicUnsafeWrite #-} \ -; {-# INLINE basicClear #-} \ -; {-# INLINE basicSet #-} \ -; {-# INLINE basicUnsafeCopy #-} \ -; {-# INLINE basicUnsafeGrow #-} \ -; basicLength (con v) = M.basicLength v \ -; 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 (tyC x) = con `liftM` M.basicUnsafeReplicate n x \ -; basicUnsafeRead (con v) i = tyC `liftM` M.basicUnsafeRead v i \ -; basicUnsafeWrite (con v) i (tyC x) = M.basicUnsafeWrite v i x \ -; basicClear (con v) = M.basicClear v \ -; basicSet (con v) (tyC x) = M.basicSet v x \ -; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ -; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ -; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n \ -} -#define newtypeVector(inst_ctxt,inst_head,tyC,con,mcon) \ -instance inst_ctxt => G.Vector Vector (inst_head) where { \ -; {-# INLINE basicUnsafeFreeze #-} \ -; {-# INLINE basicUnsafeThaw #-} \ -; {-# INLINE basicLength #-} \ -; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicUnsafeIndexM #-} \ -; {-# INLINE elemseq #-} \ -; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ -; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ -; basicLength (con v) = G.basicLength v \ -; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ -; basicUnsafeIndexM (con v) i = tyC `liftM` G.basicUnsafeIndexM v i \ -; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ -; elemseq _ (tyC a) = G.elemseq (undefined :: Vector a) a \ -} -#define deriveNewtypeInstances(inst_ctxt,inst_head,rep,tyC,con,mcon) \ -newtype instance MVector s (inst_head) = mcon (MVector s (rep)) ;\ -newtype instance Vector (inst_head) = con (Vector (rep)) ;\ -instance inst_ctxt => Unbox (inst_head) ;\ -newtypeMVector(inst_ctxt, inst_head, tyC, mcon) ;\ -newtypeVector(inst_ctxt, inst_head, tyC, con, mcon) - -#if MIN_VERSION_base(4,8,0) -deriveNewtypeInstances(Unbox a, Identity a, a, Identity, V_Identity, MV_Identity) -#endif - -deriveNewtypeInstances(Unbox a, Down a, a, Down, V_Down, MV_Down) -deriveNewtypeInstances(Unbox a, Dual a, a, Dual, V_Dual, MV_Dual) -deriveNewtypeInstances(Unbox a, Sum a, a, Sum, V_Sum, MV_Sum) -deriveNewtypeInstances(Unbox a, Product a, a, Product, V_Product, MV_Product) - - --- -------------- --- Data.Semigroup --- -------------- - -#if MIN_VERSION_base(4,9,0) -deriveNewtypeInstances(Unbox a, Min a, a, Min, V_Min, MV_Min) -deriveNewtypeInstances(Unbox a, Max a, a, Max, V_Max, MV_Max) -deriveNewtypeInstances(Unbox a, First a, a, First, V_First, MV_First) -deriveNewtypeInstances(Unbox a, Last a, a, Last, V_Last, MV_Last) -deriveNewtypeInstances(Unbox a, WrappedMonoid a, a, WrapMonoid, V_WrappedMonoid, MV_WrappedMonoid) - --- ------------------ --- Data.Semigroup.Arg --- ------------------ - -newtype instance MVector s (Arg a b) = MV_Arg (MVector s (a,b)) -newtype instance Vector (Arg a b) = V_Arg (Vector (a,b)) - -instance (Unbox a, Unbox b) => Unbox (Arg a b) - -instance (Unbox a, Unbox b) => M.MVector MVector (Arg a b) where - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicOverlaps #-} - {-# INLINE basicUnsafeNew #-} - {-# INLINE basicInitialize #-} - {-# INLINE basicUnsafeReplicate #-} - {-# INLINE basicUnsafeRead #-} - {-# INLINE basicUnsafeWrite #-} - {-# INLINE basicClear #-} - {-# INLINE basicSet #-} - {-# INLINE basicUnsafeCopy #-} - {-# INLINE basicUnsafeGrow #-} - basicLength (MV_Arg v) = M.basicLength v - basicUnsafeSlice i n (MV_Arg v) = MV_Arg $ M.basicUnsafeSlice i n v - basicOverlaps (MV_Arg v1) (MV_Arg v2) = M.basicOverlaps v1 v2 - basicUnsafeNew n = MV_Arg `liftM` M.basicUnsafeNew n - basicInitialize (MV_Arg v) = M.basicInitialize v - basicUnsafeReplicate n (Arg x y) = MV_Arg `liftM` M.basicUnsafeReplicate n (x,y) - basicUnsafeRead (MV_Arg v) i = uncurry Arg `liftM` M.basicUnsafeRead v i - basicUnsafeWrite (MV_Arg v) i (Arg x y) = M.basicUnsafeWrite v i (x,y) - basicClear (MV_Arg v) = M.basicClear v - basicSet (MV_Arg v) (Arg x y) = M.basicSet v (x,y) - basicUnsafeCopy (MV_Arg v1) (MV_Arg v2) = M.basicUnsafeCopy v1 v2 - basicUnsafeMove (MV_Arg v1) (MV_Arg v2) = M.basicUnsafeMove v1 v2 - basicUnsafeGrow (MV_Arg v) n = MV_Arg `liftM` M.basicUnsafeGrow v n - -instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where - {-# INLINE basicUnsafeFreeze #-} - {-# INLINE basicUnsafeThaw #-} - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} - {-# INLINE elemseq #-} - basicUnsafeFreeze (MV_Arg v) = V_Arg `liftM` G.basicUnsafeFreeze v - basicUnsafeThaw (V_Arg v) = MV_Arg `liftM` G.basicUnsafeThaw v - basicLength (V_Arg v) = G.basicLength v - basicUnsafeSlice i n (V_Arg v) = V_Arg $ G.basicUnsafeSlice i n v - basicUnsafeIndexM (V_Arg v) i = uncurry Arg `liftM` G.basicUnsafeIndexM v i - basicUnsafeCopy (MV_Arg mv) (V_Arg v) - = G.basicUnsafeCopy mv v - elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x - $ G.elemseq (undefined :: Vector b) y z -#endif - -deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any) -deriveNewtypeInstances((), All, Bool, All, V_All, MV_All) - --- ------- --- Const --- ------- - -deriveNewtypeInstances(Unbox a, Const a b, a, Const, V_Const, MV_Const) - --- --- --- Alt --- --- - -#if MIN_VERSION_base(4,8,0) -deriveNewtypeInstances(Unbox (f a), Alt f a, f a, Alt, V_Alt, MV_Alt) -#endif - --- ------- --- Compose --- ------- - -#if MIN_VERSION_base(4,9,0) -deriveNewtypeInstances(Unbox (f (g a)), Compose f g a, f (g a), Compose, V_Compose, MV_Compose) -#endif - --- ------ --- Tuples --- ------ - -#define DEFINE_INSTANCES -#include "unbox-tuple-instances" diff --git a/Data/Vector/Unboxed/Mutable.hs b/Data/Vector/Unboxed/Mutable.hs deleted file mode 100644 --- a/Data/Vector/Unboxed/Mutable.hs +++ /dev/null @@ -1,314 +0,0 @@ -{-# LANGUAGE CPP #-} - --- | --- Module : Data.Vector.Unboxed.Mutable --- Copyright : (c) Roman Leshchinskiy 2009-2010 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy --- Stability : experimental --- Portability : non-portable --- --- Mutable adaptive unboxed vectors --- - -module Data.Vector.Unboxed.Mutable ( - -- * Mutable vectors of primitive types - MVector(..), IOVector, STVector, Unbox, - - -- * Accessors - - -- ** Length information - length, null, - - -- ** Extracting subvectors - slice, init, tail, take, drop, splitAt, - unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, - - -- ** Overlapping - overlaps, - - -- * Construction - - -- ** Initialisation - new, unsafeNew, replicate, replicateM, clone, - - -- ** Growing - grow, unsafeGrow, - - -- ** Restricting memory usage - clear, - - -- * Zipping and unzipping - zip, zip3, zip4, zip5, zip6, - unzip, unzip3, unzip4, unzip5, unzip6, - - -- * Accessing individual elements - read, write, modify, swap, - unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, - - -- * Modifying vectors - nextPermutation, - - -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove -) where - -import Data.Vector.Unboxed.Base -import qualified Data.Vector.Generic.Mutable as G -import Data.Vector.Fusion.Util ( delayed_min ) -import Control.Monad.Primitive - -import Prelude hiding ( length, null, replicate, reverse, map, read, - 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 --- ------------------ - --- | Length of the mutable vector. -length :: Unbox a => MVector s a -> Int -{-# INLINE length #-} -length = G.length - --- | Check whether the vector is empty -null :: Unbox a => MVector s a -> Bool -{-# INLINE null #-} -null = G.null - --- Extracting subvectors --- --------------------- - --- | Yield a part of the mutable vector without copying it. The vector must --- contain at least @i+n@ elements. -slice :: Unbox a - => Int -- ^ @i@ starting index - -> Int -- ^ @n@ length - -> MVector s a - -> MVector s a -{-# INLINE slice #-} -slice = G.slice - -take :: Unbox a => Int -> MVector s a -> MVector s a -{-# INLINE take #-} -take = G.take - -drop :: Unbox a => Int -> MVector s a -> MVector s a -{-# INLINE drop #-} -drop = G.drop - -splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) -{-# INLINE splitAt #-} -splitAt = G.splitAt - -init :: Unbox a => MVector s a -> MVector s a -{-# INLINE init #-} -init = G.init - -tail :: Unbox a => MVector s a -> MVector s a -{-# INLINE tail #-} -tail = G.tail - --- | Yield a part of the mutable vector without copying it. No bounds checks --- are performed. -unsafeSlice :: Unbox a - => Int -- ^ starting index - -> Int -- ^ length of the slice - -> MVector s a - -> MVector s a -{-# INLINE unsafeSlice #-} -unsafeSlice = G.unsafeSlice - -unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeTake #-} -unsafeTake = G.unsafeTake - -unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a -{-# INLINE unsafeDrop #-} -unsafeDrop = G.unsafeDrop - -unsafeInit :: Unbox a => MVector s a -> MVector s a -{-# INLINE unsafeInit #-} -unsafeInit = G.unsafeInit - -unsafeTail :: Unbox a => MVector s a -> MVector s a -{-# INLINE unsafeTail #-} -unsafeTail = G.unsafeTail - --- Overlapping --- ----------- - --- | Check whether two vectors overlap. -overlaps :: Unbox a => MVector s a -> MVector s a -> Bool -{-# INLINE overlaps #-} -overlaps = G.overlaps - --- Initialisation --- -------------- - --- | Create a mutable vector of the given length. -new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) -{-# INLINE new #-} -new = G.new - --- | Create a mutable vector of the given length. The memory is not initialized. -unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeNew #-} -unsafeNew = G.unsafeNew - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with an initial value. -replicate :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE replicate #-} -replicate = G.replicate - --- | Create a mutable vector of the given length (0 if the length is negative) --- and fill it with values produced by repeatedly executing the monadic action. -replicateM :: (PrimMonad m, Unbox a) => Int -> m a -> m (MVector (PrimState m) a) -{-# INLINE replicateM #-} -replicateM = G.replicateM - --- | Create a copy of a mutable vector. -clone :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -> m (MVector (PrimState m) a) -{-# INLINE clone #-} -clone = G.clone - --- Growing --- ------- - --- | Grow a vector by the given number of elements. The number must be --- positive. -grow :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE grow #-} -grow = G.grow - --- | Grow a vector by the given number of elements. The number must be --- positive but this is not checked. -unsafeGrow :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) -{-# INLINE unsafeGrow #-} -unsafeGrow = G.unsafeGrow - --- Restricting memory usage --- ------------------------ - --- | Reset all elements of the vector to some undefined value, clearing all --- 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 - --- Accessing individual elements --- ----------------------------- - --- | Yield the element at the given position. -read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE read #-} -read = G.read - --- | Replace the element at the given position. -write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 #-} -swap = G.swap - - --- | Yield the element at the given position. No bounds checks are performed. -unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a -{-# INLINE unsafeRead #-} -unsafeRead = G.unsafeRead - --- | Replace the element at the given position. No bounds checks are performed. -unsafeWrite - :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () -{-# 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 () -{-# INLINE unsafeSwap #-} -unsafeSwap = G.unsafeSwap - --- Filling and copying --- ------------------- - --- | Set all elements of the vector to the given value. -set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () -{-# INLINE set #-} -set = G.set - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. -copy :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE copy #-} -copy = G.copy - --- | Copy a vector. The two vectors must have the same length and may not --- overlap. This is not checked. -unsafeCopy :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeCopy #-} -unsafeCopy = G.unsafeCopy - --- | 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 --- to the target vector. -move :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE move #-} -move = G.move - --- | 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 --- to the target vector. -unsafeMove :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () -{-# INLINE unsafeMove #-} -unsafeMove = G.unsafeMove - --- | Compute the next (lexicographically) permutation of given vector in-place. --- Returns False when input is the last permutation -nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool -{-# INLINE nextPermutation #-} -nextPermutation = G.nextPermutation - -#define DEFINE_MUTABLE -#include "unbox-tuple-instances" diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,7 @@ Copyright (c) 2008-2012, Roman Leshchinskiy + 2020-2022, Alexey Kuleshevich + 2020-2022, Aleksey Khudyakov + 2020-2022, Andrew Lelechenko All rights reserved. Redistribution and use in source and binary forms, with or without @@ -6,14 +9,14 @@ - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without -specific prior written permission. +specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, @@ -27,4 +30,3 @@ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,69 @@ -The `vector` package [![Build Status](https://travis-ci.org/haskell/vector.png?branch=master)](https://travis-ci.org/haskell/vector) +The `vector` package [![Build Status](https://github.com/haskell/vector/workflows/CI/badge.svg)](https://github.com/haskell/vector/actions?query=branch%3Amaster) ==================== -An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework. +Vector is a collection of efficient `Int`-indexed array implementations: +[boxed, unboxed, storable, and primitive vectors](#vectors-available-in-the-package) +(all can be mutable or immutable). The package features a generic API, +polymorphic in vector type, and implements [*stream fusion*](#stream-fusion), +a powerful optimisation framework that can help eliminate intermediate data structures. -See [`vector` on Hackage](http://hackage.haskell.org/package/vector) for more information. +## Table of Contents + + +- [Tutorial](#tutorial) +- [Vector vs Array](#vector-vs-array) +- [Vectors Available in the Package](#vectors-available-in-the-package) +- [Stream Fusion](#stream-fusion) + +## Tutorial + +A beginner-friendly tutorial for vectors can be found on +[MMHaskell](https://mmhaskell.com/data-structures/vector). + + +If you have already started your adventure with vectors, +the tutorial on [Haskell Wiki](https://wiki.haskell.org/Numeric_Haskell:_A_Vector_Tutorial) +covers more ground. + +## Vector vs Array + +Arrays are data structures that can store a multitude of elements +and allow immediate access to every one of them. However, they are +often seen as legacy constructs that are rarely used in modern Haskell. +Even though Haskell has a built-in [Data.Array module](https://hackage.haskell.org/package/array-0.5.7.0), +arrays might be a bit overwhelming to use due to their complex API. +Conversely, vectors incorporate the array’s *O(1)* access to elements +with a much friendlier API of lists. Since they allow for framework +optimisation via loop fusion, vectors emphasise efficiency and keep +a rich interface. Unless you’re confident with arrays, it’s +well-advised to use vectors when looking for a similar functionality. + +## Vectors Available in the Package + +**Lazy boxed vectors** (`Data.Vector`) store each of their elements as a +pointer to a heap-allocated value. Because of indirection, lazy boxed vectors +are slower in comparison to unboxed vectors. + +**Strict boxed vectors** (`Data.Vector.Strict`) contain elements that are +[strictly evaluated](https://tech.fpcomplete.com/haskell/tutorial/all-about-strictness/). + +**Unboxed vectors** (`Data.Vector.Unboxed`) determine an array's representation +from its elements' type. For example, vector of primitive types (e.g. `Int`) will be +backed by primitive array while vector of product types by structure of arrays. +They are quite efficient due to the unboxed representation they use. + +**Storable vectors** (`Data.Vector.Storable`) are backed by pinned memory, i.e., +they cannot be moved by the garbage collector. Their primary use case is C FFI. + +**Primitive vectors** (`Data.Vector.Primitive`) are backed by simple byte array and +can store only data types that are represented in memory as a sequence of bytes without +a pointer, i.e., they belong to the `Prim` type class, e.g., `Int`, `Double`, etc. +It's advised to use unboxed vectors if you're looking for the performance of primitive vectors, +but more versality. + +## Stream Fusion + +An optimisation framework used by vectors, stream fusion is a technique that merges +several functions into one and prevents creation of intermediate data structures. For example, +the expression `sum . filter g . map f` won't allocate temporary vectors if +compiled with optimisations. diff --git a/benchlib/Bench/Vector/Algo/AwShCC.hs b/benchlib/Bench/Vector/Algo/AwShCC.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/AwShCC.hs @@ -0,0 +1,38 @@ +{-# OPTIONS -fno-spec-constr-count #-} +module Bench.Vector.Algo.AwShCC (awshcc) where + +import Data.Vector.Unboxed as V + +awshcc :: (Int, Vector Int, Vector Int) -> Vector Int +{-# NOINLINE awshcc #-} +awshcc (n, es1, es2) = concomp ds es1' es2' + where + ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1) + es1' = es1 V.++ es2 + es2' = es2 V.++ es1 + + starCheck ds = V.backpermute st' gs + where + gs = V.backpermute ds ds + st = V.zipWith (==) ds gs + st' = V.update st . V.filter (not . snd) + $ V.zip gs st + + concomp ds es1 es2 + | V.and (starCheck ds'') = ds'' + | otherwise = concomp (V.backpermute ds'' ds'') es1 es2 + where + ds' = V.update ds + . V.map (\(di, dj, gi) -> (di, dj)) + . V.filter (\(di, dj, gi) -> gi == di && di > dj) + $ V.zip3 (V.backpermute ds es1) + (V.backpermute ds es2) + (V.backpermute ds (V.backpermute ds es1)) + + ds'' = V.update ds' + . V.map (\(di, dj, st) -> (di, dj)) + . V.filter (\(di, dj, st) -> st && di /= dj) + $ V.zip3 (V.backpermute ds' es1) + (V.backpermute ds' es2) + (V.backpermute (starCheck ds') es1) + diff --git a/benchlib/Bench/Vector/Algo/FindIndexR.hs b/benchlib/Bench/Vector/Algo/FindIndexR.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/FindIndexR.hs @@ -0,0 +1,24 @@ +module Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual) +where + +import Data.Vector.Unboxed (Vector) +import qualified Data.Vector.Generic as V + +findIndexR :: (Double -> Bool, Vector Double) -> Maybe Int +{-# NOINLINE findIndexR #-} +findIndexR = uncurry V.findIndexR + +findIndexR_naive :: (Double -> Bool, Vector Double) -> Maybe Int +{-# NOINLINE findIndexR_naive #-} +findIndexR_naive (pred, v) = fmap (V.length v - 1 -) + $ V.foldl (\a x -> if pred x + then Just 1 + else succ<$>a) Nothing v + +findIndexR_manual :: (Double -> Bool, Vector Double) -> Maybe Int +{-# NOINLINE findIndexR_manual #-} +findIndexR_manual (pred, v) = go $ V.length v - 1 + where go i | i < 0 = Nothing + | pred (V.unsafeIndex v i) = Just i + | otherwise = go $ i-1 + diff --git a/benchlib/Bench/Vector/Algo/HybCC.hs b/benchlib/Bench/Vector/Algo/HybCC.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/HybCC.hs @@ -0,0 +1,42 @@ +module Bench.Vector.Algo.HybCC (hybcc) where + +import Data.Vector.Unboxed as V + +hybcc :: (Int, Vector Int, Vector Int) -> Vector Int +{-# NOINLINE hybcc #-} +hybcc (n, e1, e2) = concomp (V.zip e1 e2) n + where + concomp es n + | V.null es = V.enumFromTo 0 (n-1) + | otherwise = V.backpermute ins ins + where + p = shortcut_all + $ V.update (V.enumFromTo 0 (n-1)) es + + (es',i) = compress p es + r = concomp es' (V.length i) + ins = V.update_ p i + $ V.backpermute i r + + enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs + + pack_index bs = V.map fst + . V.filter snd + $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs + + shortcut_all p | p == pp = pp + | otherwise = shortcut_all pp + where + pp = V.backpermute p p + + compress p es = (new_es, pack_index roots) + where + (e1,e2) = V.unzip es + es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y)) + . V.filter (\(x,y) -> x /= y) + $ V.zip (V.backpermute p e1) (V.backpermute p e2) + + roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1)) + labels = enumerate roots + (e1',e2') = V.unzip es' + new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2') diff --git a/benchlib/Bench/Vector/Algo/Leaffix.hs b/benchlib/Bench/Vector/Algo/Leaffix.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/Leaffix.hs @@ -0,0 +1,16 @@ +module Bench.Vector.Algo.Leaffix where + +import Data.Vector.Unboxed as V + +leaffix :: (Vector Int, Vector Int) -> Vector Int +{-# NOINLINE leaffix #-} +leaffix (ls,rs) + = leaffix (V.replicate (V.length ls) 1) ls rs + where + leaffix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ zs ls xs + sums = V.prescanl' (+) 0 vs + in + V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs) + diff --git a/benchlib/Bench/Vector/Algo/ListRank.hs b/benchlib/Bench/Vector/Algo/ListRank.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/ListRank.hs @@ -0,0 +1,21 @@ +module Bench.Vector.Algo.ListRank +where + +import Data.Vector.Unboxed as V + +listRank :: Int -> Vector Int +{-# NOINLINE listRank #-} +listRank n = pointer_jump xs val + where + xs = 0 `V.cons` V.enumFromTo 0 (n-2) + + val = V.zipWith (\i j -> if i == j then 0 else 1) + xs (V.enumFromTo 0 (n-1)) + + pointer_jump pt val + | npt == pt = val + | otherwise = pointer_jump npt nval + where + npt = V.backpermute pt pt + nval = V.zipWith (+) val (V.backpermute val pt) + diff --git a/benchlib/Bench/Vector/Algo/MutableSet.hs b/benchlib/Bench/Vector/Algo/MutableSet.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/MutableSet.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE BangPatterns #-} + +module Bench.Vector.Algo.MutableSet +where + +import Prelude hiding(length, read) + +import Data.Vector.Mutable + +mutableSet :: IOVector Int -> IO Int +{-# NOINLINE mutableSet #-} +mutableSet v = do + let repetitions = 100 -- we repeat to reduce the standard deviation in measurements. + l = length v + + -- This function is tail recursive. + f :: Int -> Int -> IO Int + f i !curSum = + if i == 0 + then + return curSum + else do + -- 'set' is what we want to benchmark. + set v i + -- In order to make it difficult for ghc to optimize the 'set' call + -- away, we read the value of one element and add it to a running sum + -- which is returned by the function. + val <- read v (l-1) + f (i-1) (curSum+val) + f repetitions 0 diff --git a/benchlib/Bench/Vector/Algo/NextPermutation.hs b/benchlib/Bench/Vector/Algo/NextPermutation.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/NextPermutation.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +module Bench.Vector.Algo.NextPermutation (generatePermTests) where + +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Unboxed.Mutable as M +import qualified Data.Vector.Generic.Mutable as G +import System.Random.Stateful + ( StatefulGen, UniformRange(uniformRM) ) + +-- | Generate a list of benchmarks for permutation algorithms. +-- The list contains pairs of benchmark names and corresponding actions. +-- The actions are to be executed by the benchmarking framework. +-- +-- The list contains the following benchmarks: +-- - @(next|prev)Permutation@ on a small vector repeated until the end of the permutation cycle +-- - Bijective versions of @(next|prev)Permutation@ on a vector of size @n@, repeated @n@ times +-- - ascending permutation +-- - descending permutation +-- - random permutation +-- - Baseline for bijective versions: just copying a vector of size @n@. Note that the tests for +-- bijective versions begins with copying a vector. +generatePermTests :: StatefulGen g IO => g -> Int -> IO [(String, IO ())] +generatePermTests gen useSize = do + let !k = useSizeToPermLen useSize + let !vasc = V.generate useSize id + !vdesc = V.generate useSize (useSize-1-) + !vrnd <- randomPermutationWith gen useSize + return + [ ("nextPermutation (small vector, until end)", loopPermutations k) + , ("nextPermutationBijective (ascending perm of size n, n times)", repeatNextPermutation vasc useSize) + , ("nextPermutationBijective (descending perm of size n, n times)", repeatNextPermutation vdesc useSize) + , ("nextPermutationBijective (random perm of size n, n times)", repeatNextPermutation vrnd useSize) + , ("prevPermutation (small vector, until end)", loopRevPermutations k) + , ("prevPermutationBijective (ascending perm of size n, n times)", repeatPrevPermutation vasc useSize) + , ("prevPermutationBijective (descending perm of size n, n times)", repeatPrevPermutation vdesc useSize) + , ("prevPermutationBijective (random perm of size n, n times)", repeatPrevPermutation vrnd useSize) + , ("baseline for *Bijective (just copying the vector of size n)", V.thaw vrnd >> return ()) + ] + +-- | Given a PRNG and a length @n@, generate a random permutation of @[0..n-1]@. +randomPermutationWith :: (StatefulGen g IO) => g -> Int -> IO (V.Vector Int) +randomPermutationWith gen n = do + v <- M.generate n id + V.forM_ (V.generate (n-1) id) $ \ !i -> do + j <- uniformRM (i,n-1) gen + M.swap v i j + V.unsafeFreeze v + +-- | Given @useSize@ benchmark option, compute the largest @n <= 12@ such that @n! <= useSize@. +-- Repeat-nextPermutation-until-end benchmark will use @n@ as the length of the vector. +-- Note that 12 is the largest @n@ such that @n!@ can be represented as an 'Int32'. +useSizeToPermLen :: Int -> Int +useSizeToPermLen us = case V.findIndex (> max 0 us) $ V.scanl' (*) 1 $ V.generate 12 (+1) of + Just i -> i-1 + Nothing -> 12 + +-- | A bijective version of @G.nextPermutation@ that reverses the vector +-- if it is already in descending order. +-- "Bijective" here means that the function forms a cycle over all permutations +-- of the vector's elements. +-- +-- This has a nice property that should be benchmarked: +-- this function takes amortized constant time each call, +-- if successively called either Omega(n) times on a single vector having distinct elements, +-- or arbitrary times on a single vector initially in strictly ascending order. +nextPermutationBijective :: (G.MVector v a, Ord a) => v G.RealWorld a -> IO Bool +nextPermutationBijective v = do + res <- G.nextPermutation v + if res then return True else G.reverse v >> return False + +-- | A bijective version of @G.prevPermutation@ that reverses the vector +-- if it is already in ascending order. +-- "Bijective" here means that the function forms a cycle over all permutations +-- of the vector's elements. +-- +-- This has a nice property that should be benchmarked: +-- this function takes amortized constant time each call, +-- if successively called either Omega(n) times on a single vector having distinct elements, +-- or arbitrary times on a single vector initially in strictly descending order. +prevPermutationBijective :: (G.MVector v a, Ord a) => v G.RealWorld a -> IO Bool +prevPermutationBijective v = do + res <- G.prevPermutation v + if res then return True else G.reverse v >> return False + +-- | Repeat @nextPermutation@ on @[0..n-1]@ until the end. +loopPermutations :: Int -> IO () +loopPermutations n = do + v <- M.generate n id + let loop = do + res <- M.nextPermutation v + if res then loop else return () + loop + +-- | Repeat @prevPermutation@ on @[n-1,n-2..0]@ until the end. +loopRevPermutations :: Int -> IO () +loopRevPermutations n = do + v <- M.generate n (n-1-) + let loop = do + res <- M.prevPermutation v + if res then loop else return () + loop + +-- | Repeat @nextPermutationBijective@ on a given vector given times. +repeatNextPermutation :: V.Vector Int -> Int -> IO () +repeatNextPermutation !v !n = do + !mv <- V.thaw v + let loop !i | i <= 0 = return () + loop !i = do + _ <- nextPermutationBijective mv + loop (i-1) + loop n + +-- | Repeat @prevPermutationBijective@ on a given vector given times. +repeatPrevPermutation :: V.Vector Int -> Int -> IO () +repeatPrevPermutation !v !n = do + !mv <- V.thaw v + let loop !i | i <= 0 = return () + loop !i = do + _ <- prevPermutationBijective mv + loop (i-1) + loop n diff --git a/benchlib/Bench/Vector/Algo/Quickhull.hs b/benchlib/Bench/Vector/Algo/Quickhull.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/Quickhull.hs @@ -0,0 +1,32 @@ +module Bench.Vector.Algo.Quickhull (quickhull) where + +import Data.Vector.Unboxed as V + +quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double) +{-# NOINLINE quickhull #-} +quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys') + where + (xs',ys') = V.unzip + $ hsplit points pmin pmax V.++ hsplit points pmax pmin + + imin = V.minIndex xs + imax = V.maxIndex xs + + points = V.zip xs ys + pmin = points V.! imin + pmax = points V.! imax + + + hsplit points p1 p2 + | V.length packed < 2 = p1 `V.cons` packed + | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2 + where + cs = V.map (\p -> cross p p1 p2) points + packed = V.map fst + $ V.filter (\t -> snd t > 0) + $ V.zip points cs + + pm = points V.! V.maxIndex cs + + cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x) + diff --git a/benchlib/Bench/Vector/Algo/Rootfix.hs b/benchlib/Bench/Vector/Algo/Rootfix.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/Rootfix.hs @@ -0,0 +1,15 @@ +module Bench.Vector.Algo.Rootfix where + +import Data.Vector.Unboxed as V + +rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int +{-# NOINLINE rootfix #-} +rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs + where + rootfix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ (V.update_ zs ls xs) rs (V.map negate xs) + sums = V.prescanl' (+) 0 vs + in + V.backpermute sums ls + diff --git a/benchlib/Bench/Vector/Algo/Spectral.hs b/benchlib/Bench/Vector/Algo/Spectral.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/Spectral.hs @@ -0,0 +1,21 @@ +module Bench.Vector.Algo.Spectral ( spectral ) where + +import Data.Vector.Unboxed as V + +import Data.Bits + +spectral :: Vector Double -> Vector Double +{-# NOINLINE spectral #-} +spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1)) + where + n = V.length us + + row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us) + + eval_A i j = 1 / fromIntegral r + where + r = u + (i+1) + u = t `shiftR` 1 + t = n * (n+1) + n = i+j + diff --git a/benchlib/Bench/Vector/Algo/Tridiag.hs b/benchlib/Bench/Vector/Algo/Tridiag.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Algo/Tridiag.hs @@ -0,0 +1,16 @@ +module Bench.Vector.Algo.Tridiag ( tridiag ) where + +import Data.Vector.Unboxed as V + +tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double) + -> Vector Double +{-# NOINLINE tridiag #-} +tridiag (as,bs,cs,ds) = V.prescanr' (\(c,d) x' -> d - c*x') 0 + $ V.prescanl' modify (0,0) + $ V.zip (V.zip as bs) (V.zip cs ds) + where + modify (c',d') ((a,b),(c,d)) = + let id = 1 / (b - c'*a) + in + id `seq` (c*id, (d-d'*a)*id) + diff --git a/benchlib/Bench/Vector/Tasty.hs b/benchlib/Bench/Vector/Tasty.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/Tasty.hs @@ -0,0 +1,27 @@ +-- | +-- Tasty integration for vector benchmarks. +module Bench.Vector.Tasty + ( VectorSize(..) + , RandomSeed(..) + ) where + +import Test.Tasty.Options + + +-- | Size of vector used in benchmarks +newtype VectorSize = VectorSize Int + +instance IsOption VectorSize where + defaultValue = VectorSize 2000000 + parseValue = fmap VectorSize . safeRead + optionName = pure "size" + optionHelp = pure "Size of vectors used in benchmarks" + +-- | Random seed used for generation of the test data +newtype RandomSeed = RandomSeed Int + +instance IsOption RandomSeed where + defaultValue = RandomSeed 42 + parseValue = fmap RandomSeed . safeRead + optionName = pure "seed" + optionHelp = pure "Random seed used for generation of the test data" diff --git a/benchlib/Bench/Vector/TestData/Graph.hs b/benchlib/Bench/Vector/TestData/Graph.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/TestData/Graph.hs @@ -0,0 +1,41 @@ +module Bench.Vector.TestData.Graph + ( randomGraph + ) where + +import System.Random.Stateful +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import qualified Data.Vector.Unboxed as U + +randomGraph + :: (StatefulGen g m, MV.PrimMonad m) + => g + -> Int + -> m (Int, U.Vector Int, U.Vector Int) +randomGraph g edges = do + let vertices = edges `div` 10 + marr <- MV.replicate vertices [] + addRandomEdges g vertices marr edges + arr <- V.unsafeFreeze marr + let (as, bs) = unzip [ (i, j) | i <- [0 .. vertices - 1], j <- arr V.! i ] + return (vertices, U.fromList as, U.fromList bs) + +addRandomEdges + :: (StatefulGen g m, MV.PrimMonad m) + => g + -> Int + -> MV.MVector (MV.PrimState m) [Int] + -> Int + -> m () +addRandomEdges g vertices arr = fill + where + fill 0 = return () + fill e = do + m1 <- uniformRM (0, vertices - 1) g + m2 <- uniformRM (0, vertices - 1) g + let lo = min m1 m2 + hi = max m1 m2 + ns <- MV.read arr lo + if lo == hi || hi `elem` ns + then fill e + else MV.write arr lo (hi : ns) >> fill (e - 1) diff --git a/benchlib/Bench/Vector/TestData/ParenTree.hs b/benchlib/Bench/Vector/TestData/ParenTree.hs new file mode 100644 --- /dev/null +++ b/benchlib/Bench/Vector/TestData/ParenTree.hs @@ -0,0 +1,20 @@ +module Bench.Vector.TestData.ParenTree where + +import qualified Data.Vector.Unboxed as V + +parenTree :: Int -> (V.Vector Int, V.Vector Int) +parenTree n = case go ([],[]) 0 (if even n then n else n+1) of + (ls,rs) -> (V.fromListN (length ls) (reverse ls), + V.fromListN (length rs) (reverse rs)) + where + go (ls,rs) i j = case j-i of + 0 -> (ls,rs) + 2 -> (ls',rs') + d -> let k = ((d-2) `div` 4) * 2 + in + go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1) + where + ls' = i:ls + rs' = j-1:rs + + diff --git a/benchmarks/Algo/AwShCC.hs b/benchmarks/Algo/AwShCC.hs deleted file mode 100644 --- a/benchmarks/Algo/AwShCC.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# OPTIONS -fno-spec-constr-count #-} -module Algo.AwShCC (awshcc) where - -import Data.Vector.Unboxed as V - -awshcc :: (Int, Vector Int, Vector Int) -> Vector Int -{-# NOINLINE awshcc #-} -awshcc (n, es1, es2) = concomp ds es1' es2' - where - ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1) - es1' = es1 V.++ es2 - es2' = es2 V.++ es1 - - starCheck ds = V.backpermute st' gs - where - gs = V.backpermute ds ds - st = V.zipWith (==) ds gs - st' = V.update st . V.filter (not . snd) - $ V.zip gs st - - concomp ds es1 es2 - | V.and (starCheck ds'') = ds'' - | otherwise = concomp (V.backpermute ds'' ds'') es1 es2 - where - ds' = V.update ds - . V.map (\(di, dj, gi) -> (di, dj)) - . V.filter (\(di, dj, gi) -> gi == di && di > dj) - $ V.zip3 (V.backpermute ds es1) - (V.backpermute ds es2) - (V.backpermute ds (V.backpermute ds es1)) - - ds'' = V.update ds' - . V.map (\(di, dj, st) -> (di, dj)) - . V.filter (\(di, dj, st) -> st && di /= dj) - $ V.zip3 (V.backpermute ds' es1) - (V.backpermute ds' es2) - (V.backpermute (starCheck ds') es1) - diff --git a/benchmarks/Algo/HybCC.hs b/benchmarks/Algo/HybCC.hs deleted file mode 100644 --- a/benchmarks/Algo/HybCC.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Algo.HybCC (hybcc) where - -import Data.Vector.Unboxed as V - -hybcc :: (Int, Vector Int, Vector Int) -> Vector Int -{-# NOINLINE hybcc #-} -hybcc (n, e1, e2) = concomp (V.zip e1 e2) n - where - concomp es n - | V.null es = V.enumFromTo 0 (n-1) - | otherwise = V.backpermute ins ins - where - p = shortcut_all - $ V.update (V.enumFromTo 0 (n-1)) es - - (es',i) = compress p es - r = concomp es' (V.length i) - ins = V.update_ p i - $ V.backpermute i r - - enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs - - pack_index bs = V.map fst - . V.filter snd - $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs - - shortcut_all p | p == pp = pp - | otherwise = shortcut_all pp - where - pp = V.backpermute p p - - compress p es = (new_es, pack_index roots) - where - (e1,e2) = V.unzip es - es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y)) - . V.filter (\(x,y) -> x /= y) - $ V.zip (V.backpermute p e1) (V.backpermute p e2) - - roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1)) - labels = enumerate roots - (e1',e2') = V.unzip es' - new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2') diff --git a/benchmarks/Algo/Leaffix.hs b/benchmarks/Algo/Leaffix.hs deleted file mode 100644 --- a/benchmarks/Algo/Leaffix.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Algo.Leaffix where - -import Data.Vector.Unboxed as V - -leaffix :: (Vector Int, Vector Int) -> Vector Int -{-# NOINLINE leaffix #-} -leaffix (ls,rs) - = leaffix (V.replicate (V.length ls) 1) ls rs - where - leaffix xs ls rs - = let zs = V.replicate (V.length ls * 2) 0 - vs = V.update_ zs ls xs - sums = V.prescanl' (+) 0 vs - in - V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs) - diff --git a/benchmarks/Algo/ListRank.hs b/benchmarks/Algo/ListRank.hs deleted file mode 100644 --- a/benchmarks/Algo/ListRank.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Algo.ListRank -where - -import Data.Vector.Unboxed as V - -listRank :: Int -> Vector Int -{-# NOINLINE listRank #-} -listRank n = pointer_jump xs val - where - xs = 0 `V.cons` V.enumFromTo 0 (n-2) - - val = V.zipWith (\i j -> if i == j then 0 else 1) - xs (V.enumFromTo 0 (n-1)) - - pointer_jump pt val - | npt == pt = val - | otherwise = pointer_jump npt nval - where - npt = V.backpermute pt pt - nval = V.zipWith (+) val (V.backpermute val pt) - diff --git a/benchmarks/Algo/Quickhull.hs b/benchmarks/Algo/Quickhull.hs deleted file mode 100644 --- a/benchmarks/Algo/Quickhull.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Algo.Quickhull (quickhull) where - -import Data.Vector.Unboxed as V - -quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double) -{-# NOINLINE quickhull #-} -quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys') - where - (xs',ys') = V.unzip - $ hsplit points pmin pmax V.++ hsplit points pmax pmin - - imin = V.minIndex xs - imax = V.maxIndex xs - - points = V.zip xs ys - pmin = points V.! imin - pmax = points V.! imax - - - hsplit points p1 p2 - | V.length packed < 2 = p1 `V.cons` packed - | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2 - where - cs = V.map (\p -> cross p p1 p2) points - packed = V.map fst - $ V.filter (\t -> snd t > 0) - $ V.zip points cs - - pm = points V.! V.maxIndex cs - - cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x) - diff --git a/benchmarks/Algo/Rootfix.hs b/benchmarks/Algo/Rootfix.hs deleted file mode 100644 --- a/benchmarks/Algo/Rootfix.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Algo.Rootfix where - -import Data.Vector.Unboxed as V - -rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int -{-# NOINLINE rootfix #-} -rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs - where - rootfix xs ls rs - = let zs = V.replicate (V.length ls * 2) 0 - vs = V.update_ (V.update_ zs ls xs) rs (V.map negate xs) - sums = V.prescanl' (+) 0 vs - in - V.backpermute sums ls - diff --git a/benchmarks/Algo/Spectral.hs b/benchmarks/Algo/Spectral.hs deleted file mode 100644 --- a/benchmarks/Algo/Spectral.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Algo.Spectral ( spectral ) where - -import Data.Vector.Unboxed as V - -import Data.Bits - -spectral :: Vector Double -> Vector Double -{-# NOINLINE spectral #-} -spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1)) - where - n = V.length us - - row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us) - - eval_A i j = 1 / fromIntegral r - where - r = u + (i+1) - u = t `shiftR` 1 - t = n * (n+1) - n = i+j - diff --git a/benchmarks/Algo/Tridiag.hs b/benchmarks/Algo/Tridiag.hs deleted file mode 100644 --- a/benchmarks/Algo/Tridiag.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Algo.Tridiag ( tridiag ) where - -import Data.Vector.Unboxed as V - -tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double) - -> Vector Double -{-# NOINLINE tridiag #-} -tridiag (as,bs,cs,ds) = V.prescanr' (\(c,d) x' -> d - c*x') 0 - $ V.prescanl' modify (0,0) - $ V.zip (V.zip as bs) (V.zip cs ds) - where - modify (c',d') ((a,b),(c,d)) = - let id = 1 / (b - c'*a) - in - id `seq` (c*id, (d-d'*a)*id) - diff --git a/benchmarks/LICENSE b/benchmarks/LICENSE deleted file mode 100644 --- a/benchmarks/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2008-2009, Roman Leshchinskiy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. - diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -1,82 +1,72 @@ +{-# LANGUAGE BangPatterns #-} module Main where -import Criterion.Main -import Criterion.Main.Options -import Options.Applicative - -import Algo.ListRank (listRank) -import Algo.Rootfix (rootfix) -import Algo.Leaffix (leaffix) -import Algo.AwShCC (awshcc) -import Algo.HybCC (hybcc) -import Algo.Quickhull (quickhull) -import Algo.Spectral ( spectral ) -import Algo.Tridiag ( tridiag ) - -import TestData.ParenTree ( parenTree ) -import TestData.Graph ( randomGraph ) -import TestData.Random ( randomVector ) +import Bench.Vector.Algo.MutableSet (mutableSet) +import Bench.Vector.Algo.ListRank (listRank) +import Bench.Vector.Algo.Rootfix (rootfix) +import Bench.Vector.Algo.Leaffix (leaffix) +import Bench.Vector.Algo.AwShCC (awshcc) +import Bench.Vector.Algo.HybCC (hybcc) +import Bench.Vector.Algo.Quickhull (quickhull) +import Bench.Vector.Algo.Spectral (spectral) +import Bench.Vector.Algo.Tridiag (tridiag) +import Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual) +import Bench.Vector.Algo.NextPermutation (generatePermTests) -import Data.Vector.Unboxed ( Vector ) +import Bench.Vector.TestData.ParenTree (parenTree) +import Bench.Vector.TestData.Graph (randomGraph) +import Bench.Vector.Tasty -import System.Environment +import Data.Proxy +import qualified Data.Vector.Mutable as MV +import qualified Data.Vector.Unboxed as U import Data.Word +import System.Random.Stateful +import Test.Tasty +import Test.Tasty.Bench +import Test.Tasty.Options +import Test.Tasty.Runners -import Data.Word -data BenchArgs = BenchArgs - { seed :: Word32 - , size :: Int - , otherArgs :: Mode - } - -defaultSize :: Int -defaultSize = 2000000 - -defaultSeed :: Word32 -defaultSeed = 42 - -parseBenchArgs :: Parser BenchArgs -parseBenchArgs = BenchArgs - <$> option auto - ( long "seed" - <> metavar "NUM" - <> value defaultSeed - <> help "A value with which to initialize the PRNG" ) - <*> option auto - ( long "size" - <> metavar "NUM" - <> value defaultSize - <> help "A value to use as the default entries in data structures. Benchmarks are broken for very small numbers." ) - <*> parseWith defaultConfig +indexFindThreshold :: Double +indexFindThreshold = 2e-5 main :: IO () main = do - args <- execParser $ describeWith parseBenchArgs + let ourOpts = [Option (Proxy :: Proxy VectorSize), Option (Proxy :: Proxy RandomSeed)] + ingredients = includingOptions ourOpts : benchIngredients + opts <- parseOptions ingredients (bench "Fake" (nf id ())) + let VectorSize useSize = lookupOption opts + RandomSeed useSeed = lookupOption opts - let useSeed = seed args - let useSize = size args + gen <- newIOGenM (mkStdGen useSeed) - let (lparens, rparens) = parenTree useSize - let (nodes, edges1, edges2) = randomGraph useSeed useSize - lparens `seq` rparens `seq` - nodes `seq` edges1 `seq` edges2 `seq` return () + let (!lparens, !rparens) = parenTree useSize + (!nodes, !edges1, !edges2) <- randomGraph gen useSize - as <- randomVector useSeed useSize :: IO (Vector Double) - bs <- randomVector useSeed useSize :: IO (Vector Double) - cs <- randomVector useSeed useSize :: IO (Vector Double) - ds <- randomVector useSeed useSize :: IO (Vector Double) - sp <- randomVector useSeed (floor $ sqrt $ fromIntegral useSize) - :: IO (Vector Double) - as `seq` bs `seq` cs `seq` ds `seq` sp `seq` return () - putStrLn "foo" - runMode (otherArgs args) - [ bench "listRank" $ whnf listRank useSize - , bench "rootfix" $ whnf rootfix (lparens, rparens) - , bench "leaffix" $ whnf leaffix (lparens, rparens) - , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2) - , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2) - , bench "quickhull" $ whnf quickhull (as,bs) - , bench "spectral" $ whnf spectral sp - , bench "tridiag" $ whnf tridiag (as,bs,cs,ds) - ] + let randomVector l = U.replicateM l (uniformDoublePositive01M gen) + !as <- randomVector useSize + !bs <- randomVector useSize + !cs <- randomVector useSize + !ds <- randomVector useSize + !sp <- randomVector (floor $ sqrt $ fromIntegral useSize) + vi <- MV.new useSize + permTests <- generatePermTests gen useSize + + defaultMainWithIngredients ingredients $ bgroup "All" + [ bench "listRank" $ whnf listRank useSize + , bench "rootfix" $ whnf rootfix (lparens, rparens) + , bench "leaffix" $ whnf leaffix (lparens, rparens) + , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2) + , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2) + , bench "quickhull" $ whnf quickhull (as,bs) + , bench "spectral" $ whnf spectral sp + , bench "tridiag" $ whnf tridiag (as,bs,cs,ds) + , bench "mutableSet" $ nfIO $ mutableSet vi + , bench "findIndexR" $ whnf findIndexR (( x*x*x)) as + , bench "maximumOn" $ whnf (U.maximumOn (\x -> x*x*x)) as + , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests + ] diff --git a/benchmarks/Setup.hs b/benchmarks/Setup.hs deleted file mode 100644 --- a/benchmarks/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Distribution.Simple -main = defaultMain - diff --git a/benchmarks/TestData/Graph.hs b/benchmarks/TestData/Graph.hs deleted file mode 100644 --- a/benchmarks/TestData/Graph.hs +++ /dev/null @@ -1,47 +0,0 @@ -module TestData.Graph ( randomGraph ) -where - -import System.Random.MWC -import qualified Data.Array.ST as STA -import qualified Data.Vector.Unboxed as V - -import Control.Monad.ST ( ST, runST ) - -import Data.Word - -randomGraph :: Word32 -> Int -> (Int, V.Vector Int, V.Vector Int) -randomGraph seed e - = runST ( - do - g <- initialize (V.singleton seed) - arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int]) - addRandomEdges n g arr e - xs <- STA.getAssocs arr - let (as,bs) = unzip [(i,j) | (i,js) <- xs, j <- js ] - return (n, V.fromListN (length as) as, V.fromListN (length bs) bs) - ) - where - n = e `div` 10 - -addRandomEdges :: Int -> Gen s -> STA.STArray s Int [Int] -> Int -> ST s () -addRandomEdges n g arr = fill - where - fill 0 = return () - fill e - = do - m <- random_index - n <- random_index - let lo = min m n - hi = max m n - ns <- STA.readArray arr lo - if lo == hi || hi `elem` ns - then fill e - else do - STA.writeArray arr lo (hi:ns) - fill (e-1) - - random_index = do - x <- uniform g - let i = floor ((x::Double) * toEnum n) - if i == n then return 0 else return i - diff --git a/benchmarks/TestData/ParenTree.hs b/benchmarks/TestData/ParenTree.hs deleted file mode 100644 --- a/benchmarks/TestData/ParenTree.hs +++ /dev/null @@ -1,20 +0,0 @@ -module TestData.ParenTree where - -import qualified Data.Vector.Unboxed as V - -parenTree :: Int -> (V.Vector Int, V.Vector Int) -parenTree n = case go ([],[]) 0 (if even n then n else n+1) of - (ls,rs) -> (V.fromListN (length ls) (reverse ls), - V.fromListN (length rs) (reverse rs)) - where - go (ls,rs) i j = case j-i of - 0 -> (ls,rs) - 2 -> (ls',rs') - d -> let k = ((d-2) `div` 4) * 2 - in - go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1) - where - ls' = i:ls - rs' = j-1:rs - - diff --git a/benchmarks/TestData/Random.hs b/benchmarks/TestData/Random.hs deleted file mode 100644 --- a/benchmarks/TestData/Random.hs +++ /dev/null @@ -1,17 +0,0 @@ -module TestData.Random ( randomVector ) where - -import qualified Data.Vector.Unboxed as V - -import System.Random.MWC -import Control.Monad.ST ( runST ) -import Data.Word - -randomVector :: (Variate a, V.Unbox a) => Word32 -> Int -> IO (V.Vector a) -randomVector seed n = do - g <- initialize (V.singleton seed) - xs <- sequence $ replicate n $ uniform g - io (return $ V.fromListN n xs) - where - io :: IO a -> IO a - io = id - diff --git a/benchmarks/vector-benchmarks.cabal b/benchmarks/vector-benchmarks.cabal deleted file mode 100644 --- a/benchmarks/vector-benchmarks.cabal +++ /dev/null @@ -1,37 +0,0 @@ -Name: vector-benchmarks -Version: 0.10.10 -License: BSD3 -License-File: LICENSE -Author: Roman Leshchinskiy -Maintainer: Roman Leshchinskiy -Copyright: (c) Roman Leshchinskiy 2010-2012 -Cabal-Version: >= 1.2 -Build-Type: Simple - -Executable algorithms - Main-Is: Main.hs - - Build-Depends: base >= 2 && < 5, array, - criterion >= 1.5.4.0 && < 1.6, - mwc-random >= 0.5 && < 0.15, - vector, optparse-applicative - - if impl(ghc<6.13) - Ghc-Options: -finline-if-enough-args -fno-method-sharing - - Ghc-Options: -O2 - - Other-Modules: - Algo.ListRank - Algo.Rootfix - Algo.Leaffix - Algo.AwShCC - Algo.HybCC - Algo.Quickhull - Algo.Spectral - Algo.Tridiag - - TestData.ParenTree - TestData.Graph - TestData.Random - diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,146 @@ +# Changes in version 0.13.2.0 + + * Strict boxed vector `Data.Vector.Strict` and `Data.Vector.Strict.Mutable` is + added (#488). it ensures that all values in the vector are evaluated to WHNF. + * `DoNotUnboxStrict`, `DoNotUnboxLazy`, and `DoNotUnboxNormalForm` wrapper are + added for defining unbox instances for types that contain not unboxable fields. + [#503](https://github.com/haskell/vector/issues/506), + [#508](https://github.com/haskell/vector/pull/508) + * `spanR` and `breakR` were added [#476](https://github.com/haskell/vector/pull/476). + They allow parsing vector from the right. + * We had some improvements on `*.Mutable.{next,prev}Permutation{,By}` + [#498](https://github.com/haskell/vector/pull/498): + * Add `*.Mutable.prevPermutation{,By}` and `*.Mutable.nextPermutationBy` + * Improve time performance. We may now expect good specialization supported by inlining. + The implementation has also been algorithmically updated: in the previous implementation + the full enumeration of all the permutations of `[1..n]` took Omega(n*n!), but it now takes O(n!). + * Add tests for `{next,prev}Permutation` + * Add benchmarks for `{next,prev}Permutation` + * Cabal >= 3.0 is now required for building package (#481). + * `vector:benchmarks-O2` public sublibrary containing benchmarks is added (#481). + * Type family `Mutable` provides instances for arrays from `primitive`. + * Various documentation improvements. + +# Changes in version 0.13.1.0 + + * Specialized variants of `findIndexR` are reexported for all vector + types. [#469](https://github.com/haskell/vector/pull/469) + * `UnboxViaPrim` could be used for deriving `Unbox` instances (`V_UnboxViaPrim` + constructor is exported) [#450](https://github.com/haskell/vector/pull/450) + * Fields of `Data.Vector.Fusion.Bundle.Size` are now strict + [#456](https://github.com/haskell/vector/pull/456) + * Compatibility with future GHC 9.10 release + [#462](https://github.com/haskell/vector/pull/462) + * Test suite no longer fails when built with QuickCheck-2.14 + [#461](https://github.com/haskell/vector/pull/461) + * Doctests now work with current versions of GHC + [#465](https://github.com/haskell/vector/pull/466) + * Various documentation improvements + + +# Changes in version 0.13.0.0 + + * `mkType` from `Data.Vector.Generic` is deprecated in favor of + `Data.Data.mkNoRepType` + * The role signatures on several `Vector` types were too permissive, so they + have been tightened up: + * The role signature for `Data.Vector.Mutable.MVector` is now + `type role MVector nominal representational` (previously, both arguments + were `phantom`). [#224](https://github.com/haskell/vector/pull/224) + * The role signature for `Data.Vector.Primitive.Vector` is now + `type role Vector nominal` (previously, it was `phantom`). + The role signature for `Data.Vector.Primitive.Mutable.MVector` is now + `type role MVector nominal nominal` (previously, both arguments were + `phantom`). [#316](https://github.com/haskell/vector/pull/316) + * The role signature for `Data.Vector.Storable.Vector` is now + `type role Vector nominal` (previous, it was `phantom`), and the signature + for `Data.Vector.Storable.Mutable.MVector` is now + `type role MVector nominal nominal` (previous, both arguments were + `phantom`). [#235](https://github.com/haskell/vector/pull/235) + + We pick `nominal` for the role of the last argument instead of + `representational` since the internal structure of a `Storable` vector is + determined by the `Storable` instance of the element type, and it is not + guaranteed that the `Storable` instances between two representationally + equal types will preserve this internal structure. One consequence of this + choice is that it is no longer possible to `coerce` between + `Storable.Vector a` and `Storable.Vector b` if `a` and `b` are nominally + distinct but representationally equal types. We now provide + `unsafeCoerce{M}Vector` and `unsafeCast` functions to allow this (the onus + is on the user to ensure that no `Storable` invariants are broken when + using these functions). + * Methods of type classes `Data.Vector.Generic.Mutable.MVector` and + `Data.Vector.Generic.Vector` use concrete monads (`ST`, etc) istead of being + polymorphic (`PrimMonad`, etc). [#335](https://github.com/haskell/vector/pull/335). + This makes it possible to derive `Unbox` with: + * `GeneralizedNewtypeDeriving` + * via `UnboxViaPrim` and `Prim` instance + * via `As` and `IsoUnbox` instance: [#378](https://github.com/haskell/vector/pull/378) + * Add `MonadFix` instance for boxed vectors: [#312](https://github.com/haskell/vector/pull/312) + * Re-export `PrimMonad` and `RealWorld` from mutable vectors: + [#320](https://github.com/haskell/vector/pull/320) + * Add `maximumOn` and `minimumOn`: [#356](https://github.com/haskell/vector/pull/356) + * The functions `scanl1`, `scanl1'`, `scanr1`, and `scanr1'` for immutable + vectors are now defined when given empty vectors as arguments, + in which case they return empty vectors. This new behavior is consistent + with the one of the corresponding functions in `Data.List`. + Prior to this change, applying an empty vector to any of those functions + resulted in an error. This change was introduced in: + [#382](https://github.com/haskell/vector/pull/382) + * Change allocation strategy for `unfoldrN`: [#387](https://github.com/haskell/vector/pull/387) + * Remove `CPP` driven error reporting in favor of `HasCallStack`: + [#397](https://github.com/haskell/vector/pull/397) + * Remove redundant `Storable` constraints on to/from `ForeignPtr` conversions: + [#394](https://github.com/haskell/vector/pull/394) + * Add `unsafeCast` to `Primitive` vectors: [#401](https://github.com/haskell/vector/pull/401) + * Make `(!?)` operator strict: [#402](https://github.com/haskell/vector/pull/402) + * Add `readMaybe`: [#425](https://github.com/haskell/vector/pull/425) + * Add `groupBy` and `group` for `Data.Vector.Generic` and the specialized + version in `Data.Vector`, `Data.Vector.Unboxed`, `Data.Vector.Storable` and + `Data.Vector.Primitive`. [#427](https://github.com/haskell/vector/pull/427) + * Add `toArraySlice` and `unsafeFromArraySlice` functions for conversion to and + from the underlying boxed `Array`: [#434](https://github.com/haskell/vector/pull/434) + +# Changes in version 0.12.3.1 + + * Bugfix for ghcjs and `Double` memset for `Storable` vector: + [#410](https://github.com/haskell/vector/issues/410) + * Avoid haddock bug: [#383](https://github.com/haskell/vector/issues/383) + * Improve haddock and doctests + * Disable problematic tests with -boundschecks [#407](https://github.com/haskell/vector/pull/407) + +# Changes in version 0.12.3.0 + + * Fix performance regression due to introduction of `keepAlive#` primop in ghc-9.0: [#372](https://github.com/haskell/vector/pull/372) + + * Add monadic functions for mutable vectors: [#338](https://github.com/haskell/vector/pull/338) + + * Added folds for monadic functions: `mapM_`, `imapM_`, `forM_`, `iforM_`, + `foldl`, `foldl'`, `foldM`, `foldM'`, `ifoldl`, `ifoldl'`, `ifoldM`, + `ifoldM'` + * Added `modifyM` and `unsafeModifyM` for mutable vectors + * Added `generate` and `generateM` for mutable vectors + +# Changes in version 0.12.2.0 + + * Add `MINIMAL` pragma to `Vector` & `MVector` type classes: [#11](https://github.com/haskell/vector/issues/11) + * Export `unstreamM` from`from Data.Vector.Generic`: [#70](https://github.com/haskell/vector/issues/70) + * Added `unfoldrExactN` and `unfoldrExactNM`: [#140](https://github.com/haskell/vector/issues/140) + * Added `iforM` and `iforM_`: [#262](https://github.com/haskell/vector/issues/262) + * Added `MonadFix` instance for boxed vectors: [#178](https://github.com/haskell/vector/issues/178) + * Added `uncons` and `unsnoc`: [#212](https://github.com/haskell/vector/issues/212) + * Added `foldMap` and `foldMap'`: [#263](https://github.com/haskell/vector/issues/263) + * Added `isSameVector` for storable vectors + * Added `toArray`, `fromArray`, `toMutableArray` and `fromMutableArray` + * Added `iscanl`, `iscanl'`, `iscanr`, `iscanr'` to `Primitive`, `Storable` and `Unboxed` + * Added `izipWithM`, `izipWithM_`, `imapM` and `imapM_` to `Primitive` and `Storable` + * Added `ifoldM`, `ifoldM'`, `ifoldM_` and `ifoldM'_` to `Primitive` and `Storable` + * Added `eqBy` and `cmpBy` + * Added `findIndexR` to `Generic`: [#172](https://github.com/haskell/vector/issues/172) + * Added `catMaybes`: [#329](https://github.com/haskell/vector/issues/329) + * Added `mapMaybeM` and `imapMaybeM`: [#183](https://github.com/haskell/vector/issues/183) + + # Changes in version 0.12.1.2 * Fix for lost function `Data.Vector.Generic.mkType`: [#287](https://github.com/haskell/vector/issues/287) diff --git a/include/vector.h b/include/vector.h --- a/include/vector.h +++ b/include/vector.h @@ -4,17 +4,5 @@ #define INLINE_FUSED INLINE PHASE_FUSED #define INLINE_INNER INLINE PHASE_INNER -#ifndef NOT_VECTOR_MODULE -import qualified Data.Vector.Internal.Check as Ck -#endif - -#define ERROR (Ck.error __FILE__ __LINE__) -#define INTERNAL_ERROR (Ck.internalError __FILE__ __LINE__) - -#define CHECK(f) (Ck.f __FILE__ __LINE__) -#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds) -#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 @@ -1,4 +1,5 @@ {-# LANGUAGE ParallelListComp #-} + module Main where import Text.PrettyPrint @@ -52,7 +53,7 @@ define_zip ty c - = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors" + = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors." ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" @@ -90,10 +91,10 @@ where name s | n == 2 = text s | otherwise = text s <> int n - + define_unzip ty c - = sep [text "-- | /O(1)/ Unzip" <+> int n <+> text "vectors" + = sep [text "-- | /O(1)/ Unzip" <+> int n <+> text "vectors." ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" @@ -214,7 +215,7 @@ $$ hang (text s <+> p) 4 (char '=' <+> e) - + methods_MVector = [("basicLength", gen_length "MV") ,("basicUnsafeSlice", gen_unsafeSlice "M" "MV") diff --git a/internal/unbox-tuple-instances b/internal/unbox-tuple-instances --- a/internal/unbox-tuple-instances +++ b/internal/unbox-tuple-instances @@ -107,20 +107,20 @@ . G.elemseq (undefined :: Vector b) b #endif #ifdef DEFINE_MUTABLE --- | /O(1)/ Zip 2 vectors +-- | /O(1)/ Zip 2 vectors. zip :: (Unbox a, Unbox b) => MVector s a -> MVector s b -> MVector s (a, b) {-# 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 +-- | /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 _ as bs) = (as, bs) #endif #ifdef DEFINE_IMMUTABLE --- | /O(1)/ Zip 2 vectors +-- | /O(1)/ Zip 2 vectors. zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) {-# INLINE_FUSED zip #-} zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) @@ -129,7 +129,7 @@ G.stream (zip as bs) = Bundle.zipWith (,) (G.stream as) (G.stream bs) #-} --- | /O(1)/ Unzip 2 vectors +-- | /O(1)/ Unzip 2 vectors. unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} @@ -268,7 +268,7 @@ . G.elemseq (undefined :: Vector c) c #endif #ifdef DEFINE_MUTABLE --- | /O(1)/ Zip 3 vectors +-- | /O(1)/ Zip 3 vectors. zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a -> MVector s b -> MVector s c -> MVector s (a, b, c) @@ -278,7 +278,7 @@ (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs --- | /O(1)/ Unzip 3 vectors +-- | /O(1)/ Unzip 3 vectors. unzip3 :: (Unbox a, Unbox b, Unbox c) => MVector s (a, b, c) -> (MVector s a, @@ -288,7 +288,7 @@ unzip3 (MV_3 _ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_IMMUTABLE --- | /O(1)/ Zip 3 vectors +-- | /O(1)/ Zip 3 vectors. zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c) @@ -303,7 +303,7 @@ (G.stream bs) (G.stream cs) #-} --- | /O(1)/ Unzip 3 vectors +-- | /O(1)/ Unzip 3 vectors. unzip3 :: (Unbox a, Unbox b, Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) @@ -474,7 +474,7 @@ . G.elemseq (undefined :: Vector d) d #endif #ifdef DEFINE_MUTABLE --- | /O(1)/ Zip 4 vectors +-- | /O(1)/ Zip 4 vectors. zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a -> MVector s b -> MVector s c -> @@ -489,7 +489,7 @@ length bs `delayed_min` length cs `delayed_min` length ds --- | /O(1)/ Unzip 4 vectors +-- | /O(1)/ Unzip 4 vectors. unzip4 :: (Unbox a, Unbox b, Unbox c, @@ -501,7 +501,7 @@ unzip4 (MV_4 _ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_IMMUTABLE --- | /O(1)/ Zip 4 vectors +-- | /O(1)/ Zip 4 vectors. zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector a -> Vector b -> Vector c -> @@ -522,7 +522,7 @@ (G.stream cs) (G.stream ds) #-} --- | /O(1)/ Unzip 4 vectors +-- | /O(1)/ Unzip 4 vectors. unzip4 :: (Unbox a, Unbox b, Unbox c, @@ -730,7 +730,7 @@ . G.elemseq (undefined :: Vector e) e #endif #ifdef DEFINE_MUTABLE --- | /O(1)/ Zip 5 vectors +-- | /O(1)/ Zip 5 vectors. zip5 :: (Unbox a, Unbox b, Unbox c, @@ -752,7 +752,7 @@ length cs `delayed_min` length ds `delayed_min` length es --- | /O(1)/ Unzip 5 vectors +-- | /O(1)/ Unzip 5 vectors. unzip5 :: (Unbox a, Unbox b, Unbox c, @@ -766,7 +766,7 @@ unzip5 (MV_5 _ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_IMMUTABLE --- | /O(1)/ Zip 5 vectors +-- | /O(1)/ Zip 5 vectors. zip5 :: (Unbox a, Unbox b, Unbox c, @@ -799,7 +799,7 @@ (G.stream ds) (G.stream es) #-} --- | /O(1)/ Unzip 5 vectors +-- | /O(1)/ Unzip 5 vectors. unzip5 :: (Unbox a, Unbox b, Unbox c, @@ -1036,7 +1036,7 @@ . G.elemseq (undefined :: Vector f) f #endif #ifdef DEFINE_MUTABLE --- | /O(1)/ Zip 6 vectors +-- | /O(1)/ Zip 6 vectors. zip6 :: (Unbox a, Unbox b, Unbox c, @@ -1062,7 +1062,7 @@ length ds `delayed_min` length es `delayed_min` length fs --- | /O(1)/ Unzip 6 vectors +-- | /O(1)/ Unzip 6 vectors. unzip6 :: (Unbox a, Unbox b, Unbox c, @@ -1078,7 +1078,7 @@ unzip6 (MV_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif #ifdef DEFINE_IMMUTABLE --- | /O(1)/ Zip 6 vectors +-- | /O(1)/ Zip 6 vectors. zip6 :: (Unbox a, Unbox b, Unbox c, @@ -1117,7 +1117,7 @@ (G.stream es) (G.stream fs) #-} --- | /O(1)/ Unzip 6 vectors +-- | /O(1)/ Unzip 6 vectors. unzip6 :: (Unbox a, Unbox b, Unbox c, diff --git a/src/Data/Vector.hs b/src/Data/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector.hs @@ -0,0 +1,2309 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Data.Vector +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- 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: +-- +-- * mutable +-- +-- * immutable +-- +-- They support a rich interface of both list-like operations and bulk +-- array operations. +-- +-- For unboxed arrays, use "Data.Vector.Unboxed". + +module Data.Vector ( + -- * Boxed vectors + Vector, MVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + catMaybes, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, partitionWith, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M',foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- ** Comparisons + eqBy, cmpBy, + + -- * Conversions + + -- ** Lists + toList, Data.Vector.fromList, Data.Vector.fromListN, + + -- ** Arrays + toArray, fromArray, toArraySlice, unsafeFromArraySlice, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import Data.Vector.Mutable ( MVector(..) ) +import Data.Primitive.Array +import qualified Data.Vector.Fusion.Bundle as Bundle +import qualified Data.Vector.Generic as G + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import Control.Monad ( MonadPlus(..), liftM, ap ) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad (fail) +#endif +import Control.Monad.ST ( ST, runST ) +import Control.Monad.Primitive +import qualified Control.Monad.Fail as Fail +import Control.Monad.Fix ( MonadFix (mfix) ) +import Control.Monad.Zip +import Data.Function ( fix ) + +import Prelude + ( Eq, Ord, Num, Enum, Monoid, Functor, Monad, Show, Bool, Ordering(..), Int, Maybe, Either + , compare, mempty, mappend, mconcat, return, showsPrec, fmap, otherwise, id, flip, const + , (>>=), (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($) ) + +import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +import qualified Control.Applicative as Applicative +import qualified Data.Foldable as Foldable +import qualified Data.Traversable as Traversable + +import qualified GHC.Exts as Exts (IsList(..)) + + +-- | Boxed vectors, supporting efficient slicing. +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(Array a) + deriving ( Typeable ) + +liftRnfV :: (a -> ()) -> Vector a -> () +liftRnfV elemRnf = foldl' (\_ -> elemRnf) () + +instance NFData a => NFData (Vector a) where + rnf = liftRnfV rnf + {-# INLINEABLE rnf #-} + +#if MIN_VERSION_deepseq(1,4,3) +-- | @since 0.12.1.0 +instance NFData1 Vector where + liftRnf = liftRnfV + {-# INLINEABLE liftRnf #-} +#endif + +instance Show a => Show (Vector a) where + showsPrec = G.showsPrec + +instance Read a => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance Show1 Vector where + liftShowsPrec = G.liftShowsPrec + +instance Read1 Vector where + liftReadsPrec = G.liftReadsPrec + +instance Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = Data.Vector.fromList + fromListN = Data.Vector.fromListN + toList = toList + +instance Data a => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = G.mkVecConstr "Data.Vector.Vector" + gunfold = G.gunfold + dataTypeOf _ = G.mkVecType "Data.Vector.Vector" + dataCast1 = G.dataCast + +type instance G.Mutable Vector = MVector + +instance G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector i n marr) + = Vector i n `liftM` unsafeFreezeArray marr + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector i n arr) + = MVector i n `liftM` unsafeThawArray arr + + {-# INLINE basicLength #-} + basicLength (Vector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (Vector j _ src) + = copyArray dst i src j n + +-- See http://trac.haskell.org/vector/ticket/12 +instance Eq a => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = 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 = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Eq1 Vector where + liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) + +instance Ord1 Vector where + liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys) + +instance Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (<>) + + {-# INLINE mconcat #-} + mconcat = concat + +instance Functor Vector where + {-# INLINE fmap #-} + fmap = map + + {-# INLINE (<$) #-} + (<$) = map . const + +instance Monad Vector where + {-# INLINE return #-} + return = Applicative.pure + + {-# INLINE (>>=) #-} + (>>=) = flip concatMap + +#if !(MIN_VERSION_base(4,13,0)) + {-# INLINE fail #-} + fail = Fail.fail -- == \ _str -> empty +#endif + +-- | @since 0.12.1.0 +instance Fail.MonadFail Vector where + {-# INLINE fail #-} + fail _ = empty + +instance MonadPlus Vector where + {-# INLINE mzero #-} + mzero = empty + + {-# INLINE mplus #-} + mplus = (++) + +instance MonadZip Vector where + {-# INLINE mzip #-} + mzip = zip + + {-# INLINE mzipWith #-} + mzipWith = zipWith + + {-# INLINE munzip #-} + munzip = unzip + +-- | This instance has the same semantics as the one for lists. +-- +-- @since 0.12.2.0 +instance MonadFix Vector where + -- We take care to dispose of v0 as soon as possible (see headM docs). + -- + -- It's perfectly safe to use non-monadic indexing within generate + -- call since intermediate vector won't be created until result's + -- value is demanded. + {-# INLINE mfix #-} + mfix f + | null v0 = empty + -- We take first element of resulting vector from v0 and create + -- rest using generate. Note that cons should fuse with generate + | otherwise = runST $ do + h <- headM v0 + return $ cons h $ + generate (lv0 - 1) $ + \i -> fix (\a -> f a ! (i + 1)) + where + -- Used to calculate size of resulting vector + v0 = fix (f . head) + !lv0 = length v0 + +instance Applicative.Applicative Vector where + {-# INLINE pure #-} + pure = singleton + + {-# INLINE (<*>) #-} + (<*>) = ap + +instance Applicative.Alternative Vector where + {-# INLINE empty #-} + empty = empty + + {-# INLINE (<|>) #-} + (<|>) = (++) + +instance Foldable.Foldable Vector where + {-# INLINE foldr #-} + foldr = foldr + + {-# INLINE foldl #-} + foldl = foldl + + {-# INLINE foldr1 #-} + foldr1 = foldr1 + + {-# INLINE foldl1 #-} + foldl1 = foldl1 + + {-# INLINE foldr' #-} + foldr' = foldr' + + {-# INLINE foldl' #-} + foldl' = foldl' + + {-# INLINE toList #-} + toList = toList + + {-# INLINE length #-} + length = length + + {-# INLINE null #-} + null = null + + {-# INLINE elem #-} + elem = elem + + {-# INLINE maximum #-} + maximum = maximum + + {-# INLINE minimum #-} + minimum = minimum + + {-# INLINE sum #-} + sum = sum + + {-# INLINE product #-} + product = product + +instance Traversable.Traversable Vector where + {-# INLINE traverse #-} + traverse f xs = + -- Get the length of the vector in /O(1)/ time + let !n = G.length xs + -- Use fromListN to be more efficient in construction of resulting vector + -- Also behaves better with compact regions, preventing runtime exceptions + in Data.Vector.fromListN n Applicative.<$> Traversable.traverse f (toList xs) + + {-# INLINE mapM #-} + mapM = mapM + + {-# INLINE sequence #-} + sequence = sequence + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector. +length :: Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty. +null :: Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing. +(!) :: Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing. +(!?) :: Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element. +head :: Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element. +last :: Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking. +unsafeIndex :: Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element, without checking if the vector is empty. +unsafeHead :: Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element, without checking if the vector is empty. +unsafeLast :: Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +indexM :: Monad m => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: Monad m => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: Monad m => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: Monad m => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: Monad m => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: Monad m => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements, in which case it is returned unchanged. +take :: Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /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 :: Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.7.1 +splitAt :: Int -> Vector a -> (Vector a, Vector a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +uncons :: Vector a -> Maybe (a, Vector a) +{-# INLINE uncons #-} +uncons = G.uncons + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +unsnoc :: Vector a -> Maybe (Vector a, a) +{-# INLINE unsnoc #-} +unsnoc = G.unsnoc + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +unsafeSlice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty, but this is not checked. +unsafeInit :: Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty, but this is not checked. +unsafeTail :: Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +unsafeTake :: Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +unsafeDrop :: Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +empty :: Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ A vector with exactly one element. +singleton :: a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ A vector of the given length with the same value in each position. +replicate :: Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +generate :: Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- ===__Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.iterateN 0 undefined undefined :: V.Vector String +-- [] +-- >>> V.iterateN 4 (\x -> x <> x) "Hi" +-- ["Hi","HiHi","HiHiHiHi","HiHiHiHiHiHiHiHi"] +-- +-- @since 0.7.1 +iterateN :: Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.12.2.0 +unfoldrExactN :: Int -> (b -> (a, b)) -> b -> Vector a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = G.unfoldrExactN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: (Monad m) => Int -> (b -> m (a, b)) -> b -> m (Vector a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM = G.unfoldrExactNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +constructN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +constructrN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: Num a => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +enumFromStepN :: Num a => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +enumFromTo :: Enum a => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: Enum a => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +cons :: a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element. +snoc :: Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors. +(++) :: Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list. +concat :: [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: Monad m => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index. +generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.12.0.0 +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: Traversable.Traversable f => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + + + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <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@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//'), but without bounds checking. +unsafeUpd :: Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update', but without bounds checking. +unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_', but without bounds checking. +unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.accum (+) (V.fromList [1000,2000,3000]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +accum :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /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@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.accumulate (+) (V.fromList [1000,2000,3000]) (V.fromList [(2,4),(1,6),(0,3),(1,10)]) +-- [1003,2016,3004] +accumulate :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum', but without bounds checking. +unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate', but without bounds checking. +unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_', but without bounds checking. +unsafeAccumulate_ + :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +reverse :: Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +backpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute', but without bounds checking. +unsafeBackpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> V.modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a' +-- "xaaa" +modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index. +indexed :: Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector. +map :: (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index. +imap :: (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. +mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) +{-# 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. Equivalent to @flip 'mapM'@. +forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: Monad m => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.12.2.0 +iforM :: Monad m => Vector a -> (Int -> a -> m b) -> m (Vector b) +{-# INLINE iforM #-} +iforM = G.iforM + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.12.2.0 +iforM_ :: Monad m => Vector a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- | /O(min(m,n))/ Zip two vectors. +zip :: Vector a -> Vector b -> Vector (a, b) +{-# INLINE zip #-} +zip = G.zip + +-- | Zip together three vectors into a vector of triples. +zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) +{-# INLINE zip3 #-} +zip3 = G.zip3 + +zip4 :: Vector a -> Vector b -> Vector c -> Vector d + -> Vector (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = G.zip4 + +zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = G.zip5 + +zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f + -> Vector (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = G.zip6 + +-- Unzipping +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +unzip :: Vector (a, b) -> (Vector a, Vector b) +{-# INLINE unzip #-} +unzip = G.unzip + +unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) +{-# INLINE unzip3 #-} +unzip3 = G.unzip3 + +unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) +{-# INLINE unzip4 #-} +unzip4 = G.unzip4 + +unzip5 :: Vector (a, b, c, d, e) + -> (Vector a, Vector b, Vector c, Vector d, Vector e) +{-# INLINE unzip5 #-} +unzip5 = G.unzip5 + +unzip6 :: Vector (a, b, c, d, e, f) + -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) +{-# INLINE unzip6 #-} +unzip6 = G.unzip6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# 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 +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +filter :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.uniq $ V.fromList [1,3,3,200,3] +-- [1,3,200,3] +-- >>> import Data.Semigroup +-- >>> V.uniq $ V.fromList [ Arg 1 'a', Arg 1 'b', Arg 1 'c'] +-- [Arg 1 'a'] +uniq :: (Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Map the values and collect the 'Just' results. +mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Return a Vector of all the 'Just' values. +-- +-- @since 0.12.2.0 +catMaybes :: Vector (Maybe a) -> Vector a +{-# INLINE catMaybes #-} +catMaybes = mapMaybe id + +-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. +filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE mapMaybeM #-} +mapMaybeM = G.mapMaybeM + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +imapMaybeM :: Monad m => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE imapMaybeM #-} +imapMaybeM = G.imapMaybeM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +takeWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.12.1.0 +partitionWith :: (a -> Either b c) -> Vector a -> (Vector b, Vector c) +{-# INLINE partitionWith #-} +partitionWith = G.partitionWith + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.span (<4) $ V.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.break (>4) $ V.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +break :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.spanR (>4) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +spanR :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE spanR #-} +spanR = G.spanR + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since NEXT_VERSION +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.breakR (<5) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +breakR :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE breakR #-} +breakR = G.breakR + +-- | /O(n)/ Split a vector into a list of slices, using a predicate function. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- Does not fuse. +-- +-- >>> import qualified Data.Vector as V +-- >>> import Data.Char (isUpper) +-- >>> V.groupBy (\a b -> isUpper a == isUpper b) (V.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy', 'group'. +-- +-- @since 0.13.0.1 +groupBy :: (a -> a -> Bool) -> Vector a -> [Vector a] +{-# INLINE groupBy #-} +groupBy = G.groupBy + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- Does not fuse. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector as V +-- >>> V.group (V.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.0.1 +group :: Eq a => Vector a -> [Vector a] +{-# INLINE group #-} +group = G.groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +elem :: Eq a => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). +notElem :: Eq a => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +findIndexR :: (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR = G.findIndexR + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: Eq a => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: Eq a => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +foldl :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors. +foldl1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator. +foldl' :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. +foldl1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold. +foldr :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors. +foldr1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator. +foldr' :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. +foldr1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold using a function applied to each element and its index. +ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator using a function applied to each element +-- and its index. +ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold using a function applied to each element and its index. +ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator using a function applied to each +-- element and its index. +ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type class. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.12.2.0 +foldMap :: (Monoid m) => (a -> m) -> Vector a -> m +{-# INLINE foldMap #-} +foldMap = G.foldMap + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.12.2.0 +foldMap' :: (Monoid m) => (a -> m) -> Vector a -> m +{-# INLINE foldMap' #-} +foldMap' = G.foldMap' + + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.all even $ V.fromList [2, 4, 12] +-- True +-- >>> V.all even $ V.fromList [2, 4, 13] +-- False +-- >>> V.all even (V.empty :: V.Vector Int) +-- True +all :: (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.any even $ V.fromList [1, 3, 7] +-- False +-- >>> V.any even $ V.fromList [3, 2, 13] +-- True +-- >>> V.any even (V.empty :: V.Vector Int) +-- False +any :: (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.and $ V.fromList [True, False] +-- False +-- >>> V.and V.empty +-- True +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.or $ V.fromList [True, False] +-- True +-- >>> V.or V.empty +-- False +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.sum $ V.fromList [300,20,1] +-- 321 +-- >>> V.sum (V.empty :: V.Vector Int) +-- 0 +sum :: Num a => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.product $ V.fromList [1,2,3,4] +-- 24 +-- >>> V.product (V.empty :: V.Vector Int) +-- 1 +product :: Num a => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.maximum $ V.fromList [2, 1] +-- 2 +-- >>> import Data.Semigroup +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 2 'b'] +-- Arg 2 'b' +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +maximum :: Ord a => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.maximumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +maximumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.maximumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +maximumOn :: Ord b => (a -> b) -> Vector a -> a +{-# INLINE maximumOn #-} +maximumOn = G.maximumOn + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.minimum $ V.fromList [2, 1] +-- 1 +-- >>> import Data.Semigroup +-- >>> V.minimum $ V.fromList [Arg 2 'a', Arg 1 'b'] +-- Arg 1 'b' +-- >>> V.minimum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +minimum :: Ord a => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.minimumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +minimumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.minimumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +minimumOn :: Ord b => (a -> b) -> Vector a -> a +{-# INLINE minimumOn #-} +minimumOn = G.minimumOn + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: Ord a => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 0 +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: Ord a => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 1 +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold using a function 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 #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator. +foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator using a function 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' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result. +foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result using a function 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_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result. +foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function 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 () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results. +sequence :: Monad m => Vector (m a) -> m (Vector a) +{-# INLINE sequence #-} +sequence = G.sequence + +-- | Evaluate each action and discard the results. +sequence_ :: Monad m => Vector (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = G.sequence_ + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.prescanl (+) 0 (V.fromList [1,2,3,4]) +-- [0,1,3,6] +prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Left-to-right prescan with strict accumulator. +prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.postscanl (+) 0 (V.fromList [1,2,3,4]) +-- [1,3,6,10] +postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Left-to-right postscan with strict accumulator. +postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.scanl (+) 0 (V.fromList [1,2,3,4]) +-- [0,1,3,6,10] +scanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Left-to-right scan with strict accumulator. +scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Left-to-right scan over a vector with its index. +-- +-- @since 0.12.0.0 +iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +-- +-- @since 0.12.0.0 +iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanl1 min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1 max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1 min (V.empty :: V.Vector Int) +-- [] +scanl1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanl1' min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1' max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1' min (V.empty :: V.Vector Int) +-- [] +scanl1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator. +prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left postscan. +postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left postscan with strict accumulator. +postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left scan. +scanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left scan with strict accumulator. +scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index. +-- +-- @since 0.12.0.0 +iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +-- +-- @since 0.12.0.0 +iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanr1 min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1 max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1 min (V.empty :: V.Vector Int) +-- [] +scanr1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanr1' min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1' max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1' min (V.empty :: V.Vector Int) +-- [] +scanr1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Comparisons +-- ------------------------ + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +-- +-- @since 0.12.2.0 +eqBy :: (a -> b -> Bool) -> Vector a -> Vector b -> Bool +{-# INLINE eqBy #-} +eqBy = G.eqBy + +-- | /O(n)/ Compare two vectors using the supplied comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == compare +-- +-- @since 0.12.2.0 +cmpBy :: (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering +cmpBy = G.cmpBy + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +toList :: Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.3 +fromList :: [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Arrays +-- ----------------------------- + +-- | /O(1)/ Convert an array to a vector. +-- +-- @since 0.12.2.0 +fromArray :: Array a -> Vector a +{-# INLINE fromArray #-} +fromArray arr = Vector 0 (sizeofArray arr) arr + +-- | /O(n)/ Convert a vector to an array. +-- +-- @since 0.12.2.0 +toArray :: Vector a -> Array a +{-# INLINE toArray #-} +toArray (Vector offset len arr) + | offset == 0 && len == sizeofArray arr = arr + | otherwise = cloneArray arr offset len + +-- | /O(1)/ Extract the underlying `Array`, offset where vector starts and the +-- total number of elements in the vector. Below property always holds: +-- +-- > let (array, offset, len) = toArraySlice v +-- > v === unsafeFromArraySlice len offset array +-- +-- @since 0.13.0.0 +toArraySlice :: Vector a -> (Array a, Int, Int) +{-# INLINE toArraySlice #-} +toArraySlice (Vector offset len arr) = (arr, offset, len) + + +-- | /O(1)/ Convert an array slice to a vector. This function is very unsafe, +-- because constructing an invalid vector can yield almost all other safe +-- functions in this module unsafe. These are equivalent: +-- +-- > unsafeFromArraySlice len offset === unsafeTake len . unsafeDrop offset . fromArray +-- +-- @since 0.13.0.0 +unsafeFromArraySlice :: + Array a -- ^ Immutable boxed array. + -> Int -- ^ Offset + -> Int -- ^ Length + -> Vector a +{-# INLINE unsafeFromArraySlice #-} +unsafeFromArraySlice arr offset len = Vector offset len arr + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +unsafeThaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +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 () +{-# INLINE copy #-} +copy = G.copy + +-- $setup +-- >>> :set -Wno-type-defaults +-- >>> import Prelude (Char, String, Bool(True, False), min, max, fst, even, undefined, Ord(..)) diff --git a/src/Data/Vector/Fusion/Bundle.hs b/src/Data/Vector/Fusion/Bundle.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Fusion/Bundle.hs @@ -0,0 +1,654 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +-- | +-- Module : Data.Vector.Fusion.Bundle +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- 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, unfoldrExactN, 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, mapMaybeM, foldM, fold1M, foldM', fold1M', + + eq, cmp, eqBy, cmpBy +) 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(..), lift ) +import qualified Data.Vector.Fusion.Bundle.Monadic as M +import qualified Data.Vector.Fusion.Stream.Monadic as S + +import Prelude + ( Eq, Ord, Num, Enum, Monad, Bool, Ordering, Int, Maybe + , compare, return, seq + , (==), (.) ) + +import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +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 #-} + + +-- | '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 + +-- | Unfold exactly @n@ elements +-- +-- @since 0.12.2.0 +unfoldrExactN :: Int -> (s -> (a, s)) -> s -> Bundle v a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = M.unfoldrExactN + +-- | /O(n)/ Apply function \(\max(n - 1, 0)\) times to an initial value, producing a pure +-- bundle of exact length \(\max(n, 0)\). Zeroth element will contain the initial 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' + +-- | Initial-value free scan over a 'Bundle' +scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a +{-# INLINE scanl1 #-} +scanl1 = M.scanl1 + +-- | Initial-value free scan over a '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 = eqBy (==) + +eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool +{-# INLINE eqBy #-} +eqBy e x y = unId (M.eqBy e x y) + +-- | Lexicographically compare two 'Bundle's +cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering +{-# INLINE cmp #-} +cmp = cmpBy compare + +cmpBy :: (a -> b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering +{-# INLINE cmpBy #-} +cmpBy c x y = unId (M.cmpBy c 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 + +instance Eq1 (M.Bundle Id v) where + {-# INLINE liftEq #-} + liftEq = eqBy + +instance Ord1 (M.Bundle Id v) where + {-# INLINE liftCompare #-} + liftCompare = cmpBy + +-- 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 + +-- | /O(n)/ Apply monadic function to each element of a bundle and +-- discard elements returning Nothing. +-- +-- @since 0.12.2.0 +mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Bundle v a -> M.Bundle m v b +{-# INLINE mapMaybeM #-} +mapMaybeM f = M.mapMaybeM 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/src/Data/Vector/Fusion/Bundle/Monadic.hs b/src/Data/Vector/Fusion/Bundle/Monadic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Fusion/Bundle/Monadic.hs @@ -0,0 +1,1177 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Fusion.Bundle.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic bundles. +-- + +module Data.Vector.Fusion.Bundle.Monadic ( + Bundle(..), Chunk(..), lift, + + -- * 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 + eqBy, cmpBy, + + -- * Filtering + filter, filterM, mapMaybeM, 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, + unfoldrExactN, unfoldrExactNM, + 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, Id(..) ) +import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) +import qualified Data.Vector.Fusion.Stream.Monadic as S +import Data.Vector.Internal.Check (check, Checks(..), HasCallStack) +import Control.Monad.Primitive + +import qualified Data.List as List +import Data.Char ( ord ) +import GHC.Base ( unsafeChr ) +import Control.Monad ( liftM ) +import Prelude + ( Eq, Ord, Num, Enum, Functor, Monad, Bool(..), Ordering, Char, Int, Word, Integer, Float, Double, Maybe(..), Either(..), Integral, RealFrac + , return, fmap, otherwise, id, const, seq, max, maxBound, fromIntegral, truncate + , (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($), (<$), (/) ) + +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#include "vector.h" +#include "MachDeps.h" + +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + +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 + } + +-- | Convert a pure stream to a monadic stream +lift :: Monad m => Bundle Id v a -> Bundle m v a +{-# INLINE_FUSED lift #-} +lift (Bundle (Stream step s) (Stream vstep t) v sz) + = Bundle (Stream (return . unId . step) s) + (Stream (return . unId . vstep) t) v sz + +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 -> stToPrim $ 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 -> stToPrim $ 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) (smallerThan 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 + {-# INLINE (<$) #-} + (<$) = map . const + +-- | 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 (lift xs) (lift xs) = mapM (\x -> f x x) (lift 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 +eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq x y + | sizesAreDifferent (sSize x) (sSize y) = return False + | otherwise = S.eqBy eq (sElems x) (sElems y) + where + sizesAreDifferent :: Size -> Size -> Bool + sizesAreDifferent (Exact a) (Exact b) = a /= b + sizesAreDifferent (Exact a) (Max b) = a > b + sizesAreDifferent (Max a) (Exact b) = a < b + sizesAreDifferent _ _ = False + +-- | Lexicographically compare two 'Bundle's +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp x y = S.cmpBy cmp (sElems x) (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) + +-- | Apply monadic function to each element and drop all Nothings +-- +-- @since 0.12.2.0 +mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED mapMaybeM #-} +mapMaybeM f Bundle{sElems = s, sSize = n} = fromStream (S.mapMaybeM 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 function. +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) Unknown + +-- | Unfold exactly @n@ elements +-- +-- @since 0.12.2.0 +unfoldrExactN :: Monad m => Int -> (s -> (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrExactN #-} +unfoldrExactN n f = unfoldrExactNM n (return . f) + +-- | Unfold exactly @n@ elements with a monadic function. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: Monad m => Int -> (s -> m (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrExactNM #-} +unfoldrExactNM n f s = fromStream (S.unfoldrExactNM n f s) (Max (delay_inline max n 0)) + +-- | /O(n)/ Apply monadic function \(\max(n - 1, 0)\) times to an initial value, producing +-- a monadic bundle of exact length \(\max(n, 0)\). Zeroth element will contain the initial +-- 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)) + +-- | /O(n)/ Apply function \(\max(n - 1, 0)\) times to an initial value, producing a +-- monadic bundle of exact length \(\max(n, 0)\). Zeroth element will contain the initial +-- 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 accumulator 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) + +-- | Initial-value free scan over a '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)) + +-- | Initial-value free scan over a '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 + +-- | Initial-value free scan over a '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)) + +-- | Initial-value free scan over a '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 (Just x)) (Exact n) + where + n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 + + {-# INLINE_INNER step #-} + step Nothing = return $ Done + step (Just z) | z == y = return $ Yield z Nothing + | z < y = return $ Yield z (Just (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. (HasCallStack, Monad m) => Int -> Int -> Bundle m v Int +{-# INLINE_FUSED enumFromTo_int #-} +enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: HasCallStack => Int -> Int -> Int + len u v | u > v = 0 + | otherwise = check Bounds "vector too large" (n > 0) n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step Nothing = return $ Done + step (Just z) | z == y = return $ Yield z Nothing + | z < y = return $ Yield z (Just (z+1)) + | otherwise = return $ Done + +enumFromTo_intlike :: forall m v a. (HasCallStack, 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 (Just x)) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: HasCallStack => a -> a -> Int + len u v | u > v = 0 + | otherwise = check Bounds "vector too large" + (n > 0) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step Nothing = return $ Done + step (Just z) | z == y = return $ Yield z Nothing + | z < y = return $ Yield z (Just (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 :: forall m v a. (HasCallStack, 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 (Just x)) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: HasCallStack => a -> a -> Int + len u v | u > v = 0 + | otherwise = check Bounds "vector too large" + (n < fromIntegral (maxBound :: Int)) + $ fromIntegral (n+1) + where + n = v-u + + {-# INLINE_INNER step #-} + step Nothing = return $ Done + step (Just z) | z == y = return $ Yield z Nothing + | z < y = return $ Yield z (Just (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 #-} + + +#if WORD_SIZE_IN_BITS > 32 + +-- FIXME: the "too large" test is totally wrong +enumFromTo_big_int :: forall m v a. (HasCallStack, 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 (Just x)) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: HasCallStack => a -> a -> Int + len u v | u > v = 0 + | otherwise = check Bounds "vector too large" + (n > 0 && n <= fromIntegral (maxBound :: Int)) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step Nothing = return $ Done + step (Just z) | z == y = return $ Yield z Nothing + | z < y = return $ Yield z (Just (z+1)) + | otherwise = return $ Done + + +{-# 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 :: forall m v a. (HasCallStack, 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 ini) (Max (len n lim)) + where + lim = m + 1/2 -- important to float out + + {-# INLINE [0] len #-} + len :: HasCallStack => a -> a -> Int + len x y | x > y = 0 + | otherwise = check Bounds "vector too large" (l > 0) $ fromIntegral l + where + l :: Integer + l = truncate (y-x)+2 + + {-# INLINE_INNER step #-} +-- GHC changed definition of Enum for Double in GHC8.6 so we have to +-- accommodate both definitions in order to preserve validity of +-- rewrite rule +-- +-- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081 +-- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f +#if MIN_VERSION_base(4,12,0) + ini = 0 + step x | x' <= lim = return $ Yield x' (x+1) + | otherwise = return $ Done + where + x' = x + n +#else + ini = n + step x | x <= lim = return $ Yield x (x+1) + | otherwise = return $ Done +#endif + +{-# 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 -> stToPrim $ 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 :: HasCallStack => [v a] -> m (Step [v a] (Chunk v a)) + vstep [] = return Done + vstep (v:vs) = return $ Yield (Chunk (basicLength v) + (\mv -> check + Internal + "length mismatch" + (M.basicLength mv == basicLength v) + $ stToPrim $ 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 -> check + Internal + "length mismatch" + (M.basicLength mv == basicLength v) + $ stToPrim $ 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/src/Data/Vector/Fusion/Bundle/Size.hs b/src/Data/Vector/Fusion/Bundle/Size.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Fusion/Bundle/Size.hs @@ -0,0 +1,132 @@ +-- | +-- Module : Data.Vector.Fusion.Bundle.Size +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : portable +-- +-- Size hints for streams. +-- + +module Data.Vector.Fusion.Bundle.Size ( + Size(..), clampedSubtract, smaller, smallerThan, larger, toMax, upperBound, lowerBound +) where + +import Data.Vector.Fusion.Util ( delay_inline ) + +-- | Size hint +data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size + | Max {-# UNPACK #-} !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 + +-- | Select a safe smaller than known size. +smallerThan :: Int -> Size -> Size +{-# INLINE smallerThan #-} +smallerThan m (Exact n) = Exact (delay_inline min m n) +smallerThan m (Max n) = Max (delay_inline min m n) +smallerThan _ 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/src/Data/Vector/Fusion/Stream/Monadic.hs b/src/Data/Vector/Fusion/Stream/Monadic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Fusion/Stream/Monadic.hs @@ -0,0 +1,20 @@ +-- | +-- Module : Data.Vector.Fusion.Stream.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic stream combinators. +-- + +module Data.Vector.Fusion.Stream.Monadic + ( module Data.Stream.Monadic + ) where + +import Data.Stream.Monadic diff --git a/src/Data/Vector/Fusion/Util.hs b/src/Data/Vector/Fusion/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Fusion/Util.hs @@ -0,0 +1,46 @@ +-- | +-- Module : Data.Vector.Fusion.Util +-- Copyright : (c) Roman Leshchinskiy 2009 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : portable +-- +-- Fusion-related utility types +-- + +module Data.Vector.Fusion.Util ( + Id(..), Box(..), liftBox, + + delay_inline, delayed_min +) where + +import Data.Stream.Monadic (Box(..), liftBox) + +-- | Identity monad +newtype Id a = Id { unId :: a } + +instance Functor Id where + fmap f (Id x) = Id (f x) + +instance Applicative Id where + pure = Id + Id f <*> Id x = Id (f x) + +instance Monad Id where + return = pure + Id x >>= f = f x + +-- | Delay inlining a function until late in the game (simplifier phase 0). +delay_inline :: (a -> b) -> a -> b +{-# INLINE [0] delay_inline #-} +delay_inline f = f + +-- | `min` inlined in phase 0 +delayed_min :: Int -> Int -> Int +{-# INLINE [0] delayed_min #-} +delayed_min m n = min m n diff --git a/src/Data/Vector/Generic.hs b/src/Data/Vector/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Generic.hs @@ -0,0 +1,2740 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Generic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to immutable vectors. + +module Data.Vector.Generic ( + -- * Immutable vectors + Vector(..), Mutable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, concatNE, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, partitionWith, unstablePartition, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Different vector types + convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Fusion support + + -- ** Conversion to/from Bundles + stream, unstream, unstreamM, streamR, unstreamR, + + -- ** Recycling support + new, clone, + + -- * Utilities + + -- ** Comparisons + eq, cmp, + eqBy, cmpBy, + + -- ** Show and Read + showsPrec, readPrec, + liftShowsPrec, liftReadsPrec, + + -- ** @Data@ and @Typeable@ + gfoldl, gunfold, dataCast, mkVecType, mkVecConstr, mkType +) where + +import Data.Vector.Generic.Base + +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.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 Data.Vector.Internal.Check + +import Control.Monad.ST ( ST, runST ) +import Control.Monad.Primitive +import Prelude + ( Eq, Ord, Num, Enum, Monoid, Monad, Read, Show, Bool, Ordering(..), Int, Maybe(..), Either, IO, ShowS, ReadS, String + , compare, mempty, mappend, return, fmap, otherwise, id, flip, seq, error, undefined, uncurry, shows, fst, snd, min, max, not + , (>>=), (+), (-), (*), (<), (==), (.), ($), (=<<), (>>), (<$>) ) + +import qualified Text.Read as Read +import qualified Data.List.NonEmpty as NonEmpty + +import Data.Typeable ( Typeable, gcast1 ) + +#include "vector.h" + +import Data.Data ( Data, DataType, Constr, Fixity(Prefix), + mkDataType, mkConstr, constrIndex, mkNoRepType ) +import qualified Data.Traversable as T (Traversable(mapM)) + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector. +length :: Vector v a => v a -> Int +{-# INLINE length #-} +length = Bundle.length . stream + +-- | /O(1)/ Test whether a vector is empty. +null :: Vector v a => v a -> Bool +{-# INLINE null #-} +null = Bundle.null . stream + +-- Indexing +-- -------- + +-- NOTE: [Strict indexing] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Why index parameters are strict in indexing ((!), (!?)) functions +-- and functions for accessing elements in mutable arrays ('unsafeRead', +-- 'unsafeWrite', 'unsafeModify'), and slice functions? +-- +-- These function call class methods ('basicUnsafeIndexM', +-- 'basicUnsafeRead', etc) and, unless (!) was already specialised to +-- a specific v, GHC has no clue that i is most certainly to be used +-- eagerly. Bang before i hints this vital for optimizer information. + + +infixl 9 ! +-- | O(1) Indexing. +(!) :: (HasCallStack, Vector v a) => v a -> Int -> a +{-# INLINE_FUSED (!) #-} +-- See NOTE: [Strict indexing] +(!) v !i = checkIndex Bounds i (length v) $ unBox (basicUnsafeIndexM v i) + +infixl 9 !? +-- | O(1) Safe indexing. +(!?) :: Vector v a => v a -> Int -> Maybe a +{-# INLINE_FUSED (!?) #-} +-- See NOTE: [Strict indexing] +-- Use basicUnsafeIndexM @Box to perform the indexing eagerly. +v !? (!i) + | i `inRange` length v = case basicUnsafeIndexM v i of Box a -> Just a + | otherwise = Nothing + + +-- | /O(1)/ First element. +head :: Vector v a => v a -> a +{-# INLINE_FUSED head #-} +head v = v ! 0 + +-- | /O(1)/ Last element. +last :: Vector v a => v a -> a +{-# 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_FUSED unsafeIndex #-} +-- See NOTE: [Strict indexing] +unsafeIndex v !i = checkIndex Unsafe i (length v) $ unBox (basicUnsafeIndexM v i) + +-- | /O(1)/ First element, without checking if the vector is empty. +unsafeHead :: Vector v a => v a -> a +{-# 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_FUSED unsafeLast #-} +unsafeLast v = unsafeIndex v (length v - 1) + +{-# RULES + +"(!)/unstream [Vector]" forall i s. + new (New.unstream s) ! i = s Bundle.!! i + +"(!?)/unstream [Vector]" forall i s. + new (New.unstream s) !? i = s Bundle.!? i + +"head/unstream [Vector]" forall s. + head (new (New.unstream s)) = Bundle.head s + +"last/unstream [Vector]" forall s. + last (new (New.unstream s)) = Bundle.last s + +"unsafeIndex/unstream [Vector]" forall i s. + unsafeIndex (new (New.unstream s)) i = s Bundle.!! i + +"unsafeHead/unstream [Vector]" forall s. + unsafeHead (new (New.unstream s)) = Bundle.head s + +"unsafeLast/unstream [Vector]" forall s. + unsafeLast (new (New.unstream s)) = Bundle.last s #-} + + + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +indexM :: (HasCallStack, Vector v a, Monad m) => v a -> Int -> m a +{-# INLINE_FUSED indexM #-} +indexM v !i = checkIndex Bounds i (length v) $ liftBox $ 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_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_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_FUSED unsafeIndexM #-} +unsafeIndexM v !i = checkIndex Unsafe i (length v) + $ liftBox + $ 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_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_FUSED unsafeLastM #-} +unsafeLastM v = unsafeIndexM v (length v - 1) + +{-# RULES + +"indexM/unstream [Vector]" forall s i. + indexM (new (New.unstream s)) i = lift s MBundle.!! i + +"headM/unstream [Vector]" forall s. + headM (new (New.unstream s)) = MBundle.head (lift s) + +"lastM/unstream [Vector]" forall s. + lastM (new (New.unstream s)) = MBundle.last (lift s) + +"unsafeIndexM/unstream [Vector]" forall s i. + unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i + +"unsafeHeadM/unstream [Vector]" forall s. + unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s) + +"unsafeLastM/unstream [Vector]" forall s. + unsafeLastM (new (New.unstream s)) = MBundle.last (lift s) #-} + + + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: (HasCallStack, Vector v a) + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED slice #-} +slice i n v = checkSlice Bounds 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_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_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_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_FUSED drop #-} +drop n v = unsafeSlice (delay_inline min n' len) + (delay_inline max 0 (len - n')) v + where n' = max n 0 + len = length v + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.7.1 +splitAt :: Vector v a => Int -> v a -> (v a, v a) +{-# INLINE_FUSED splitAt #-} +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (delay_inline max 0 (len - n')) v + ) + where + m = delay_inline min n' len + n' = max n 0 + len = length v + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +uncons :: Vector v a => v a -> Maybe (a, v a) +{-# INLINE_FUSED uncons #-} +uncons xs = flip (,) (unsafeTail xs) <$> xs !? 0 + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +unsnoc :: Vector v a => v a -> Maybe (v a, a) +{-# INLINE_FUSED unsnoc #-} +unsnoc xs = (,) (unsafeInit xs) <$> xs !? (length xs - 1) + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +unsafeSlice :: Vector v a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED unsafeSlice #-} +-- See NOTE: [Strict indexing] +unsafeSlice !i !n v = checkSlice Unsafe 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_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_FUSED unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +unsafeTake :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +unsafeDrop :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + + +-- Turned off due to: https://github.com/haskell/vector/issues/257 +-- "slice/new [Vector]" forall i n p. +-- slice i n (new p) = new (New.slice i n p) + +{-# RULES + +"init/new [Vector]" forall p. + init (new p) = new (New.init p) + +"tail/new [Vector]" forall p. + tail (new p) = new (New.tail p) + +"take/new [Vector]" forall n p. + take n (new p) = new (New.take n p) + +"drop/new [Vector]" forall n p. + drop n (new p) = new (New.drop n p) + +"unsafeSlice/new [Vector]" forall i n p. + unsafeSlice i n (new p) = new (New.unsafeSlice i n p) + +"unsafeInit/new [Vector]" forall p. + unsafeInit (new p) = new (New.unsafeInit p) + +"unsafeTail/new [Vector]" forall p. + unsafeTail (new p) = new (New.unsafeTail p) #-} + + + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +empty :: Vector v a => v a +{-# INLINE empty #-} +empty = unstream Bundle.empty + +-- | /O(1)/ A 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 (Bundle.singleton x) + +-- | /O(n)/ A 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 + $ 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 (Bundle.generate n f) + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- @since 0.7.1 +iterateN :: Vector v a => Int -> (a -> a) -> a -> v a +{-# INLINE iterateN #-} +iterateN n f x = unstream (Bundle.iterateN n f x) + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <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 . Bundle.unfoldr f + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > 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 . Bundle.unfoldrN n f + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.12.2.0 +unfoldrExactN :: Vector v a => Int -> (b -> (a, b)) -> b -> v a +{-# INLINE unfoldrExactN #-} +unfoldrExactN n f = unstream . Bundle.unfoldrExactN n f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Vector v a) => (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrM #-} +unfoldrM f = unstreamM . MBundle.unfoldrM f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Vector v a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrNM #-} +unfoldrNM n f = unstreamM . MBundle.unfoldrNM n f + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: (Monad m, Vector v a) => Int -> (b -> m (a, b)) -> b -> m (v a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM n f = unstreamM . MBundle.unfoldrExactNM n f + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructN !n f = runST ( + do + v <- M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeTake i v) + in elemseq v x $ do + v' <- unsafeThaw v + M.unsafeWrite v' i x + v'' <- unsafeFreeze v' + fill v'' (i+1) + 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 +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructrN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructrN !n f = runST ( + do + v <- n `seq` M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) + in elemseq v x $ do + v' <- unsafeThaw v + M.unsafeWrite v' (n-i-1) x + v'' <- unsafeFreeze v' + fill v'' (i+1) + fill v _ = return v + + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Vector v a, Num a) => a -> Int -> v a +{-# INLINE enumFromN #-} +enumFromN x n = enumFromStepN x 1 n + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +enumFromStepN :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a +{-# INLINE enumFromStepN #-} +enumFromStepN x y n = elemseq (undefined :: v a) x + $ elemseq (undefined :: v a) y + $ unstream + $ Bundle.enumFromStepN x y n + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +enumFromTo :: (Vector v a, Enum a) => a -> a -> v a +{-# INLINE enumFromTo #-} +enumFromTo x y = unstream (Bundle.enumFromTo x y) + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a +{-# INLINE enumFromThenTo #-} +enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z) + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +cons :: forall v a. Vector v a => a -> v a -> v a +{-# INLINE cons #-} +cons x v = elemseq (undefined :: v a) x + $ unstream + $ Bundle.cons x + $ stream v + +-- | /O(n)/ Append an element. +snoc :: forall v a. Vector v a => v a -> a -> v a +{-# INLINE snoc #-} +snoc v x = elemseq (undefined :: v a) x + $ unstream + $ 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 Bundle.++ stream w) + +-- | /O(n)/ Concatenate all vectors in the list. +concat :: Vector v a => [v a] -> v a +{-# INLINE concat #-} +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 -> Bundle.Yield x (v,i+1,k) + | otherwise = Bundle.Done + + {-# INLINE mk #-} + mk v = let k = length v + in + k `seq` (v,0,k) +-} + +-- | /O(n)/ Concatenate all vectors in the non-empty list. +concatNE :: Vector v a => NonEmpty.NonEmpty (v a) -> v a +concatNE = concat . NonEmpty.toList + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) +{-# INLINE replicateM #-} +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 (MBundle.generateM n f) + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.12.0.0 +iterateNM :: (Monad m, Vector v a) => Int -> (a -> m a) -> a -> m (v a) +{-# INLINE iterateNM #-} +iterateNM n f x = unstreamM (MBundle.iterateNM n f x) + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- 'M.new' 2; 'M.write' v 0 \'a\'; 'M.write' v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a +{-# INLINE create #-} +create p = new (New.create p) + +-- | Execute the monadic action and freeze the resulting vectors. +createT + :: (T.Traversable f, Vector v a) + => (forall s. ST s (f (Mutable v s a))) -> f (v a) +{-# INLINE createT #-} +createT p = runST (p >>= T.mapM unsafeFreeze) + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Vector v a => v a -> v a +-- FIXME: we probably ought to inline this later as the rules still might fire +-- otherwise +{-# INLINE_FUSED force #-} +force v = new (clone v) + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Vector v a => v a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE (//) #-} +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@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: (Vector v a, Vector v (Int, a)) + => v a -- ^ initial vector (of length @m@) + -> v (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE update #-} +update v w = update_stream v (stream w) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'update' is probably more convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: (Vector v a, Vector v Int) + => v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v a -- ^ value vector (of length @n2@) + -> v a +{-# INLINE update_ #-} +update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE update_stream #-} +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 (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 +{-# INLINE unsafeUpdate #-} +unsafeUpdate v w = unsafeUpdate_stream v (stream w) + +-- | Same as 'update_', but without bounds checking. +unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ v is w + = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE unsafeUpdate_stream #-} +unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.accum (+) (V.fromList [1000,2000,3000]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +accum :: Vector v a + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE accum #-} +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@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.accumulate (+) (V.fromList [1000,2000,3000]) (V.fromList [(2,4),(1,6),(0,3),(1,10)]) +-- [1003,2016,3004] +accumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE accumulate #-} +accumulate f v us = accum_stream f v (stream us) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'accumulate' is probably more convenient: +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v b -- ^ value vector (of length @n2@) + -> v a +{-# INLINE accumulate_ #-} +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 -> Bundle u (Int,b) -> v a +{-# INLINE accum_stream #-} +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 (Bundle.fromList us) + +-- | Same as 'accumulate', but without bounds checking. +unsafeAccumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -> v a -> v (Int,b) -> v a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate f v us = unsafeAccum_stream f v (stream us) + +-- | Same as 'accumulate_', but without bounds checking. +unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -> v a -> v Int -> v b -> v a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ f v is xs + = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs)) + +unsafeAccum_stream + :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a +{-# INLINE unsafeAccum_stream #-} +unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f) + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +reverse :: (Vector v a) => v a -> v a +{-# INLINE reverse #-} +-- FIXME: make this fuse better, add support for recycling +reverse = unstream . streamR + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +backpermute :: forall v a. (HasCallStack, Vector v a, Vector v Int) + => v a -- ^ @xs@ value vector + -> v Int -- ^ @is@ index vector (of length @n@) + -> v a +{-# INLINE backpermute #-} +-- This somewhat non-intuitive definition ensures that the resulting vector +-- does not retain references to the original one even if it is lazy in its +-- elements. This would not be the case if we simply used map (v!) +backpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index :: HasCallStack => Int -> Box a + index !i = checkIndex Bounds i n $ basicUnsafeIndexM v i + +-- | Same as 'backpermute', but without bounds checking. +unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index !i = checkIndex Unsafe i n $ basicUnsafeIndexM v i + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> import qualified Data.Vector.Strict.Mutable as MV +-- >>> V.modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a' +-- "xaaa" +modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a +{-# INLINE modify #-} +modify p = new . New.modify p . clone + +-- 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. +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 +-- -------- + +-- | /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 . Bundle.indexed . stream + +-- Mapping +-- ------- + +-- | /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 (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 (S.map (uncurry f) . S.indexed) id + . stream + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b +{-# INLINE concatMap #-} +-- NOTE: We can't fuse concatMap anyway so don't pretend we do. +-- This seems to be slightly slower +-- concatMap f = concat . Bundle.toList . Bundle.map f . stream + +-- Slowest +-- concatMap f = unstream . Bundle.concatMap (stream . f) . stream + +-- Used to be fastest +{- +concatMap f = unstream + . Bundle.flatten mk step Unknown + . stream + where + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + 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 +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- 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 . 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 = 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. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) +{-# INLINE forM #-} +forM as f = mapM f as + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ as f = mapM_ f as + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.12.2.0 +iforM :: (Monad m, Vector v a, Vector v b) => v a -> (Int -> a -> m b) -> m (v b) +{-# INLINE iforM #-} +iforM as f = imapM f as + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.12.2.0 +iforM_ :: (Monad m, Vector v a) => v a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ as f = imapM_ f as + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +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 (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 (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 (Bundle.zipWith4 f (stream as) + (stream bs) + (stream cs) + (stream ds)) + +zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (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 (Bundle.zipWith5 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (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 (Bundle.zipWith6 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +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 (Bundle.zipWith (uncurry f) (Bundle.indexed (stream xs)) + (stream ys)) + +-- | Zip three vectors and their indices with the given function. +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 (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 (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds)) + +izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (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 (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (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 (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors. +zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) +{-# INLINE zip #-} +zip = zipWith (,) + +-- | Zip together three vectors into a vector of triples. +zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) + => v a -> v b -> v c -> v (a, b, c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) + => v a -> v b -> v c -> v d -> v (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v (a, b, c, d, e)) + => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: (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 -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) + => (a -> b -> m c) -> v a -> v b -> m (v c) +-- FIXME: specialise for ST and IO? +{-# INLINE zipWithM #-} +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 -> 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 +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) +{-# INLINE unzip #-} +unzip xs = (map fst xs, map snd xs) + +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, _, _) -> 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, _, _, _) -> 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, _, _, _, _) -> 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, _, _, _, _, _) -> a) xs, + map (\(_, b, _, _, _, _) -> b) xs, + map (\(_, _, c, _, _, _) -> c) xs, + map (\(_, _, _, d, _, _) -> d) xs, + map (\(_, _, _, _, e, _) -> e) xs, + map (\(_, _, _, _, _, f) -> f) xs) + +-- Filtering +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +filter :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE filter #-} +filter f = unstream . inplace (S.filter f) toMax . stream + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a +{-# INLINE ifilter #-} +ifilter f = unstream + . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax + . stream + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.uniq $ V.fromList [1,3,3,200,3] +-- [1,3,200,3] +-- >>> import Data.Semigroup +-- >>> V.uniq $ V.fromList [ Arg 1 'a', Arg 1 'b', Arg 1 'c'] +-- [Arg 1 'a'] +uniq :: (Vector v a, Eq a) => v a -> v a +{-# INLINE uniq #-} +uniq = unstream . inplace S.uniq toMax . stream + +-- | /O(n)/ Map the values and collect the 'Just' results. +mapMaybe :: (Vector v a, Vector v b) => (a -> Maybe b) -> v a -> v b +{-# INLINE mapMaybe #-} +mapMaybe f = unstream . inplace (S.mapMaybe f) toMax . stream + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +imapMaybe :: (Vector v a, Vector v b) => (Int -> a -> Maybe b) -> v a -> v b +{-# INLINE imapMaybe #-} +imapMaybe f = unstream + . inplace (S.mapMaybe (uncurry f) . S.indexed) toMax + . stream + + +-- | /O(n)/ Drop all 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 . Bundle.filterM f . stream + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +mapMaybeM :: (Monad m, Vector v a, Vector v b) => (a -> m (Maybe b)) -> v a -> m (v b) +{-# INLINE mapMaybeM #-} +mapMaybeM f = unstreamM . Bundle.mapMaybeM f . stream + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +imapMaybeM :: (Monad m, Vector v a, Vector v b) + => (Int -> a -> m (Maybe b)) -> v a -> m (v b) +{-# INLINE imapMaybeM #-} +imapMaybeM f = unstreamM . Bundle.mapMaybeM (\(i, a) -> f i a) . Bundle.indexed . stream + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +takeWhile :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE takeWhile #-} +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_FUSED dropWhile #-} +-- In the case that the argument is an actual vector, +-- this is a faster solution than stream fusion. +dropWhile f xs = case findIndex (not . f) xs of + Just i -> unsafeDrop i xs + Nothing -> empty + +-- If we have optimization turned on +-- and the argument to 'dropWhile' comes from a stream, +-- we never allocate the argument vector, and +-- whenever possible, we avoid creating the resulting vector actually in heap. +-- +-- Also note that @'new' . 'New.unstream'@ +-- is the definition (to be @INLINE@d) of 'unstream'. +{-# RULES +"dropWhile/unstream [Vector]" forall f p. + dropWhile f (new (New.unstream p)) = new (New.unstream (Bundle.dropWhile f p)) + #-} + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE partition #-} +partition f = partition_stream f . stream + +-- FIXME: Make this inplace-fusible (look at how stable_partition is +-- implemented in C++) + +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.partitionBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.12.1.0 +partitionWith :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> v a -> (v b, v c) +{-# INLINE partitionWith #-} +partitionWith f = partition_with_stream f . stream + +partition_with_stream :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> Bundle u a -> (v b, v c) +{-# INLINE_FUSED partition_with_stream #-} +partition_with_stream f s = s `seq` runST ( + do + (mv1,mv2) <- M.partitionWithBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE unstablePartition #-} +unstablePartition f = unstablePartition_stream f . 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.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_FUSED unstablePartition_new #-} +unstablePartition_new f (New.New p) = runST ( + do + mv <- p + i <- M.unstablePartition f mv + v <- unsafeFreeze mv + return (unsafeTake i v, unsafeDrop i v)) + +{-# RULES + +"unstablePartition" forall f p. + unstablePartition_stream f (stream (new p)) + = unstablePartition_new f p #-} + + + + +-- FIXME: make span and break fusible + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.span (<4) $ V.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +span :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE span #-} +span f = break (not . f) + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.break (>4) $ V.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +break :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE break #-} +break f xs = case findIndex f xs of + Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs) + Nothing -> (xs, empty) + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.spanR (>4) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +spanR :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE spanR #-} +spanR f = breakR (not . f) + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since NEXT_VERSION +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.breakR (<5) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +breakR :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE breakR #-} +breakR f xs = case findIndexR f xs of + Just i -> ( unsafeSlice (i+1) (length xs - i - 1) xs + , unsafeSlice 0 (i+1) xs) + Nothing -> (xs, empty) + + + + +-- | /O(n)/ Split a vector into a list of slices. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> import Data.Char (isUpper) +-- >>> V.groupBy (\a b -> isUpper a == isUpper b) (V.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy'. +-- +-- @since 0.13.0.1 +{-# INLINE groupBy #-} +groupBy :: (Vector v a) => (a -> a -> Bool) -> v a -> [v a] +groupBy _ v | null v = [] +groupBy f v = + let h = unsafeHead v + tl = unsafeTail v + in case findIndex (not . f h) tl of + Nothing -> [v] + Just n -> unsafeTake (n + 1) v : groupBy f (unsafeDrop (n + 1) v) + +-- | /O(n)/ Split a vector into a list of slices. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.group (V.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.0.1 +group :: (Vector v a , Eq a) => v a -> [v a] +{-# INLINE group #-} +group = groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +elem :: (Vector v a, Eq a) => a -> v a -> Bool +{-# INLINE elem #-} +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 = 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 = 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 = Bundle.findIndex f . stream + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +-- +-- @since 0.12.2.0 +findIndexR :: Vector v a => (a -> Bool) -> v a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR f v = fmap (length v - 1 -) . Bundle.findIndex f $ streamR v + +-- | /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 (S.map fst . S.filter (f . snd) . S.indexed) toMax + . stream + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex x = findIndex (x ==) + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int +{-# INLINE elemIndices #-} +elemIndices x = findIndices (x ==) + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a +{-# INLINE foldl #-} +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 = 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 = 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 = Bundle.foldl1' f . stream + +-- | /O(n)/ Right fold. +foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b +{-# INLINE foldr #-} +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 = 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 = 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 = Bundle.foldl1' (flip f) . streamR + +-- | /O(n)/ Left fold using a 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 = Bundle.foldl (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Left fold with strict accumulator using a 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 = Bundle.foldl' (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold using a 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 = Bundle.foldr (uncurry f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold with strict accumulator using a 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 = Bundle.foldl' (flip (uncurry f)) z + $ Bundle.indexedR (length xs) $ streamR xs + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type cless. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.12.2.0 +foldMap :: (Monoid m, Vector v a) => (a -> m) -> v a -> m +{-# INLINE foldMap #-} +foldMap f = foldr (mappend . f) mempty + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.12.2.0 +foldMap' :: (Monoid m, Vector v a) => (a -> m) -> v a -> m +{-# INLINE foldMap' #-} +foldMap' f = foldl' (\acc a -> acc `mappend` f a) mempty + + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.all even $ V.fromList [2, 4, 12] +-- True +-- >>> V.all even $ V.fromList [2, 4, 13] +-- False +-- >>> V.all even (V.empty :: V.Vector Int) +-- True +all :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE all #-} +all f = Bundle.and . Bundle.map f . stream + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.any even $ V.fromList [1, 3, 7] +-- False +-- >>> V.any even $ V.fromList [3, 2, 13] +-- True +-- >>> V.any even (V.empty :: V.Vector Int) +-- False +any :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE any #-} +any f = Bundle.or . Bundle.map f . stream + +-- | /O(n)/ Check if all elements are 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.and $ V.fromList [True, False] +-- False +-- >>> V.and V.empty +-- True +and :: Vector v Bool => v Bool -> Bool +{-# INLINE and #-} +and = Bundle.and . stream + +-- | /O(n)/ Check if any element is 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.or $ V.fromList [True, False] +-- True +-- >>> V.or V.empty +-- False +or :: Vector v Bool => v Bool -> Bool +{-# INLINE or #-} +or = Bundle.or . stream + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.sum $ V.fromList [300,20,1] +-- 321 +-- >>> V.sum (V.empty :: V.Vector Int) +-- 0 +sum :: (Vector v a, Num a) => v a -> a +{-# INLINE sum #-} +sum = Bundle.foldl' (+) 0 . stream + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.product $ V.fromList [1,2,3,4] +-- 24 +-- >>> V.product (V.empty :: V.Vector Int) +-- 1 +product :: (Vector v a, Num a) => v a -> a +{-# INLINE product #-} +product = Bundle.foldl' (*) 1 . stream + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.maximum $ V.fromList [2, 1] +-- 2 +-- >>> import Data.Semigroup +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 2 'b'] +-- Arg 2 'b' +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +maximum :: (Vector v a, Ord a) => v a -> a +{-# INLINE maximum #-} +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. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.maximumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE maximumBy #-} +maximumBy cmpr = Bundle.foldl1' maxBy . stream + where + {-# INLINE maxBy #-} + maxBy x y = case cmpr x y of + LT -> y + _ -> x + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.maximumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +maximumOn :: (Ord b, Vector v a) => (a -> b) -> v a -> a +{-# INLINE maximumOn #-} +maximumOn f = fst . Bundle.foldl1' maxBy . Bundle.map (\a -> (a, f a)) . stream + where + {-# INLINE maxBy #-} + maxBy x y = case compare (snd x) (snd y) of + LT -> y + _ -> x + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.minimum $ V.fromList [2, 1] +-- 1 +-- >>> import Data.Semigroup +-- >>> V.minimum $ V.fromList [Arg 2 'a', Arg 1 'b'] +-- Arg 1 'b' +-- >>> V.minimum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +minimum :: (Vector v a, Ord a) => v a -> a +{-# INLINE minimum #-} +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. In case of +-- a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.minimumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE minimumBy #-} +minimumBy cmpr = Bundle.foldl1' minBy . stream + where + {-# INLINE minBy #-} + minBy x y = case cmpr x y of + GT -> y + _ -> x + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.minimumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +minimumOn :: (Ord b, Vector v a) => (a -> b) -> v a -> a +{-# INLINE minimumOn #-} +minimumOn f = fst . Bundle.foldl1' minBy . Bundle.map (\a -> (a, f a)) . stream + where + {-# INLINE minBy #-} + minBy x y = case compare (snd x) (snd y) of + GT -> y + _ -> x + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE maxIndex #-} +maxIndex = maxIndexBy compare + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 0 +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream + where + imax (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + LT -> (j,y) + _ -> (i,x) + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE minIndex #-} +minIndex = minIndexBy compare + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 1 +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE minIndexBy #-} +minIndexBy cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream + where + imin (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + GT -> (j,y) + _ -> (i,x) + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a +{-# INLINE foldM #-} +foldM m z = Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold using a function 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 = 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 = Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator using a function 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 = Bundle.fold1M' m . stream + +discard :: Monad m => m a -> m () +{-# INLINE discard #-} +discard m = m >> return () + +-- | /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 . Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold that discards the result using a function 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 . 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 . Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function 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 . Bundle.fold1M' m . stream + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results. +sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) +{-# INLINE sequence #-} +sequence = mapM id + +-- | Evaluate each action and discard the results. +sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = mapM_ id + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.prescanl (+) 0 (V.fromList [1,2,3,4]) +-- [0,1,3,6] +prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE prescanl #-} +prescanl f z = unstream . inplace (S.prescanl f z) id . stream + +-- | /O(n)/ Left-to-right 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 (S.prescanl' f z) id . stream + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.postscanl (+) 0 (V.fromList [1,2,3,4]) +-- [1,3,6,10] +postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE postscanl #-} +postscanl f z = unstream . inplace (S.postscanl f z) id . stream + +-- | /O(n)/ Left-to-right postscan 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 (S.postscanl' f z) id . stream + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.scanl (+) 0 (V.fromList [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 . Bundle.scanl f z . stream + +-- | /O(n)/ Left-to-right 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 . Bundle.scanl' f z . stream + +-- | /O(n)/ Left-to-right scan over a vector with its index. +iscanl :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl #-} +iscanl f z = + unstream + . inplace (S.scanl (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +iscanl' :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl' #-} +iscanl' f z = + unstream + . inplace (S.scanl' (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.scanl1 min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1 max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1 min (V.empty :: V.Vector Int) +-- [] +scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1 #-} +scanl1 f = unstream . inplace (S.scanl1 f) id . stream + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.scanl1' min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1' max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1' min (V.empty :: V.Vector Int) +-- [] +scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1' #-} +scanl1' f = unstream . inplace (S.scanl1' f) id . stream + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE prescanr #-} +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 (S.prescanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left postscan. +postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE postscanr #-} +postscanr f z = unstreamR . inplace (S.postscanl (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left postscan 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 (S.postscanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left scan. +scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE scanr #-} +scanr f z = unstreamR . Bundle.scanl (flip f) z . streamR + +-- | /O(n)/ Right-to-left 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 . Bundle.scanl' (flip f) z . streamR + +-- | /O(n)/ Right-to-left scan over a vector with its index. +iscanr :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr #-} +iscanr f z v = + unstreamR + . inplace (S.scanl (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +iscanr' :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr' #-} +iscanr' f z v = + unstreamR + . inplace (S.scanl' (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.scanr1 min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1 max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1 min (V.empty :: V.Vector Int) +-- [] +scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1 #-} +scanr1 f = unstreamR . inplace (S.scanl1 (flip f)) id . streamR + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.scanr1' min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1' max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1' min (V.empty :: V.Vector Int) +-- [] +scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1' #-} +scanr1' f = unstreamR . inplace (S.scanl1' (flip f)) id . streamR + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +toList :: Vector v a => v a -> [a] +{-# INLINE toList #-} +toList = Bundle.toList . stream + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.4 +fromList :: Vector v a => [a] -> v a +{-# INLINE fromList #-} +fromList = unstream . Bundle.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict as V +-- >>> V.fromListN 3 [1,2,3,4,5] +-- [1,2,3] +-- >>> V.fromListN 3 [1] +-- [1] +fromListN :: Vector v a => Int -> [a] -> v a +{-# INLINE fromListN #-} +fromListN n = unstream . Bundle.fromListN n + +-- Conversions - Immutable vectors +-- ------------------------------- + +-- | /O(n)/ Convert between different vector types. +convert :: (Vector v a, Vector w a) => v a -> w a +{-# INLINE convert #-} +convert = unstream . Bundle.reVector . stream + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = stToPrim . basicUnsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE freeze #-} +freeze mv = unsafeFreeze =<< M.clone mv + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED unsafeThaw #-} +unsafeThaw = stToPrim . basicUnsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED thaw #-} +thaw v = do + mv <- M.unsafeNew (length v) + unsafeCopy mv v + return mv + +{-# RULES + +"unsafeThaw/new [Vector]" forall p. + unsafeThaw (new p) = New.runPrim p + +"thaw/new [Vector]" forall 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_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. +thawMany vs = do + mv <- M.new n + thaw_loop mv vs + return mv + where + n = List.foldl' (\k v -> k + length v) 0 vs + + thaw_loop mv [] = mv `seq` return () + thaw_loop mv (v:vs) + = do + let n = length v + unsafeCopy (M.unsafeTake n mv) v + thaw_loop (M.unsafeDrop n mv) vs +-} + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = check Unsafe "length mismatch" (M.length dst == basicLength src) + $ (dst `seq` src `seq` stToPrim (basicUnsafeCopy dst src)) + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (HasCallStack, PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE copy #-} +copy dst src = check Bounds "length mismatch" (M.length dst == basicLength src) + $ unsafeCopy dst src + +-- Conversions to/from Bundles +-- --------------------------- + +-- | /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 + + -- NOTE: the False case comes first in Core so making it the recursive one + -- makes the code easier to read + {-# 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 'Bundle'. +unstream :: Vector v a => Bundle v a -> v a +{-# INLINE unstream #-} +unstream s = new (New.unstream s) + +{-# RULES + +"stream/unstream [Vector]" forall s. + stream (new (New.unstream s)) = s + +"New.unstream/stream [Vector]" forall v. + New.unstream (stream v) = clone v + +"clone/new [Vector]" forall p. + clone (new p) = p + +"inplace [Vector]" + 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 => 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 '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 + + {-# INLINE get #-} + get 0 = Nothing + get i = let !i' = i-1 + in + case basicUnsafeIndexM v i' of Box x -> Just (x, i') + +-- | /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) + +{-# RULES + +"streamR/unstreamR [Vector]" forall s. + streamR (new (New.unstreamR s)) = s + +"New.unstreamR/streamR/new [Vector]" forall p. + New.unstreamR (streamR (new p)) = p + +"New.unstream/streamR/new [Vector]" forall p. + New.unstream (streamR (new p)) = New.modify M.reverse p + +"New.unstreamR/stream/new [Vector]" forall p. + New.unstreamR (stream (new p)) = New.modify M.reverse p + +"inplace right [Vector]" + 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 => Stream m a -> Stream m a) g m. + streamR (new (New.transformR f g m)) = inplace f g (streamR (new m)) #-} + + +-- | Load a monadic stream bundle into a newly allocated vector. This function goes through +-- a list, so prefer using `unstream`, unless you need to be in a monad. +-- +-- @since 0.12.2.0 +unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a) +{-# INLINE_FUSED unstreamM #-} +unstreamM s = do + xs <- MBundle.toList s + return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs + +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 => MBundle IO u a -> IO (v a) +{-# INLINE unstreamPrimM_IO #-} +unstreamPrimM_IO = unstreamPrimM + +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 #-} + + + + +-- Recycling support +-- ----------------- + +-- | Construct a vector from a monadic initialiser. +new :: Vector v a => New v a -> v a +{-# 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_FUSED clone #-} +clone v = v `seq` New.create ( + do + mv <- M.new (basicLength v) + unsafeCopy mv v + return mv) + +-- Comparisons +-- ----------- + +-- | /O(n)/ Check if two vectors are equal. All 'Vector' instances are also +-- instances of 'Eq' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Eq' instances for new +-- vector types. +eq :: (Vector v a, Eq a) => v a -> v a -> Bool +{-# INLINE eq #-} +xs `eq` ys = stream xs == stream ys + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool +{-# INLINE eqBy #-} +eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys) + +-- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are +-- also instances of 'Ord' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Ord' instances for new +-- vector types. +cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering +{-# INLINE cmp #-} +cmp xs ys = compare (stream xs) (stream ys) + +-- | /O(n)/ Compare two vectors using the supplied comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == cmp +cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering +cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys) + +-- Show +-- ---- + +-- | Generic definition of 'Prelude.showsPrec'. +showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS +{-# INLINE showsPrec #-} +showsPrec _ = shows . toList + +liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS +{-# INLINE liftShowsPrec #-} +liftShowsPrec _ s _ = s . toList + +-- | Generic definition of 'Text.Read.readPrec'. +readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) +{-# INLINE readPrec #-} +readPrec = do + xs <- Read.readPrec + return (fromList xs) + +-- | /Note:/ uses 'ReadS'. +liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a) +liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ] + +-- Data and Typeable +-- ----------------- + +-- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a list. +gfoldl :: (Vector v a, Data a) + => (forall d b. Data d => c (d -> b) -> d -> c b) + -> (forall g. g -> c g) + -> v a + -> c (v a) +{-# INLINE gfoldl #-} +gfoldl f z v = z fromList `f` toList v + +mkVecConstr :: String -> Constr +{-# INLINE mkVecConstr #-} +mkVecConstr name = mkConstr (mkVecType name) "fromList" [] Prefix + +mkVecType :: String -> DataType +{-# INLINE mkVecType #-} +mkVecType name = mkDataType name [mkVecConstr name] + +mkType :: String -> DataType +{-# INLINE mkType #-} +{-# DEPRECATED mkType "Use Data.Data.mkNoRepType" #-} +mkType = mkNoRepType + +gunfold :: (Vector v a, Data a, HasCallStack) + => (forall b r. Data b => c (b -> r) -> c r) + -> (forall r. r -> c r) + -> Constr -> c (v a) +gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + +dataCast :: (Vector v a, Data a, Typeable v, Typeable t) + => (forall d. Data d => c (t d)) -> Maybe (c (v a)) +{-# INLINE dataCast #-} +dataCast f = gcast1 f + +-- $setup +-- >>> :set -XFlexibleContexts +-- >>> :set -Wno-type-defaults +-- >>> import Prelude (Bool(True, False), even, Ord(..)) diff --git a/src/Data/Vector/Generic/Base.hs b/src/Data/Vector/Generic/Base.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Generic/Base.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Generic.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of immutable vectors. + +module Data.Vector.Generic.Base ( + Vector(..), Mutable +) where + +import Data.Vector.Generic.Mutable.Base ( MVector ) +import qualified Data.Vector.Generic.Mutable.Base as M +import Data.Vector.Fusion.Util (Box(..), liftBox) +import qualified Data.Primitive.Array as Prim +import qualified Data.Primitive.SmallArray as Prim +import qualified Data.Primitive.PrimArray as Prim + +import Control.Monad.ST +import Data.Kind (Type) + +-- | @Mutable v s a@ is the mutable version of the immutable vector type @v a@ with +-- the state token @s@. It is injective on GHC 8 and newer. +type family Mutable (v :: Type -> Type) = (mv :: Type -> Type -> Type) | mv -> v + +type instance Mutable Prim.Array = Prim.MutableArray +type instance Mutable Prim.SmallArray = Prim.SmallMutableArray +type instance Mutable Prim.PrimArray = Prim.MutablePrimArray + + +-- | Class of immutable vectors. Every immutable vector is associated with its +-- mutable version through the 'Mutable' type family. Methods of this class +-- should not be used directly. Instead, "Data.Vector.Generic" and other +-- @Data.Vector@ modules provide safe and fusible wrappers. +-- +-- Minimum complete implementation: +-- +-- * 'basicUnsafeFreeze' +-- +-- * 'basicUnsafeThaw' +-- +-- * 'basicLength' +-- +-- * 'basicUnsafeSlice' +-- +-- * 'basicUnsafeIndexM' +-- +class MVector (Mutable v) a => Vector v a where + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert a mutable vector to its immutable version + -- without copying. The mutable vector may not be used after + -- this operation. + basicUnsafeFreeze :: Mutable v s a -> ST s (v a) + + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert an immutable vector to its mutable version without + -- copying. The immutable vector may not be used after this operation. + basicUnsafeThaw :: v a -> ST s (Mutable v s a) + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the length of the vector. + basicLength :: v a -> Int + + -- | /Assumed complexity: O(1)/ + -- + -- Yield a slice of the vector without copying it. No range checks are + -- performed. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length + -> v a -> v a + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the element at the given position in a monad. No range checks are + -- performed. + -- + -- The monad allows us to be strict in the vector if we want. Suppose we had + -- + -- > unsafeIndex :: v a -> Int -> a + -- + -- instead. Now, if we wanted to copy a vector, we'd do something like + -- + -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ... + -- + -- For lazy vectors, the indexing would not be evaluated, which means that we + -- would retain a reference to the original vector in each element we write. + -- This is not what we want! + -- + -- With 'basicUnsafeIndexM', we can do + -- + -- > copy mv v ... = ... case basicUnsafeIndexM v i of + -- > Box x -> unsafeWrite mv i x ... + -- + -- which does not have this problem, because indexing (but not the returned + -- element!) is evaluated immediately. + basicUnsafeIndexM :: v a -> Int -> Box a + + -- | /Assumed complexity: O(n)/ + -- + -- Copy an immutable vector into a mutable one. The two vectors must have + -- the same length, but this is not checked. + -- + -- Instances of 'Vector' should redefine this method if they wish to support + -- an efficient block copy operation. + -- + -- Default definition: copying based on 'basicUnsafeIndexM' and + -- 'basicUnsafeWrite'. + basicUnsafeCopy :: Mutable v s a -> v a -> ST s () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- liftBox $ basicUnsafeIndexM src i + M.basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + -- | Evaluate @a@ as far as storing it in a vector would and yield @b@. + -- The @v a@ argument only fixes the type and is not touched. This method is + -- only used for optimisation purposes. Thus, it is safe for instances of + -- 'Vector' to evaluate @a@ less than it would be when stored in a vector, + -- although this might result in suboptimal code. + -- + -- > elemseq v x y = (singleton x `asTypeOf` v) `seq` y + -- + -- Default definition: @a@ is not evaluated at all. + elemseq :: v a -> a -> b -> b + + {-# INLINE elemseq #-} + elemseq _ = \_ x -> x + + {-# MINIMAL basicUnsafeFreeze, basicUnsafeThaw, basicLength, + basicUnsafeSlice, basicUnsafeIndexM #-} diff --git a/src/Data/Vector/Generic/Mutable.hs b/src/Data/Vector/Generic/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Generic/Mutable.hs @@ -0,0 +1,1317 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Generic.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to mutable vectors. + +module Data.Vector.Generic.Mutable ( + -- * Class of mutable vector types + MVector(..), + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + growFront, unsafeGrowFront, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Internal operations + mstream, mstreamR, + unstream, unstreamR, vunstream, + munstream, munstreamR, + transform, transformR, + fill, fillR, + unsafeAccum, accum, unsafeUpdate, update, reverse, + unstablePartition, unstablePartitionBundle, partitionBundle, + partitionWithBundle, + -- * Re-exports + PrimMonad, PrimState, RealWorld +) where + +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 Data.Vector.Internal.Check + +import Control.Monad.Primitive ( PrimMonad(..), RealWorld, stToPrim ) + +import Prelude + ( Ord, Monad, Bool(..), Int, Maybe(..), Either(..), Ordering(..) + , return, otherwise, flip, const, seq, min, max, not, pure + , (>>=), (+), (-), (<), (<=), (>), (>=), (==), (/=), (.), ($), (=<<), (>>), (<$>) ) +import Data.Bits ( Bits(shiftR) ) + +#include "vector.h" + + +-- ------------------ +-- Internal functions +-- ------------------ + +unsafeAppend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a) +{-# INLINE_INNER unsafeAppend1 #-} + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. +unsafeAppend1 v i x + | i < length v = do + unsafeWrite v i x + return v + | otherwise = do + v' <- enlarge v + checkIndex Internal i (length v') $ unsafeWrite v' i x + return v' + +unsafePrepend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int) +{-# INLINE_INNER unsafePrepend1 #-} +unsafePrepend1 v i x + | i /= 0 = do + let i' = i-1 + unsafeWrite v i' x + return (v, i') + | otherwise = do + (v', j) <- enlargeFront v + let i' = j-1 + checkIndex Internal i' (length v') $ unsafeWrite v' i' x + return (v', i') + +mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a +{-# INLINE mstream #-} +mstream v = v `seq` n `seq` Stream.unfoldrM get 0 + where + n = length v + + {-# INLINE_INNER get #-} + get i | i < n = do x <- unsafeRead v i + return $ Just (x, i+1) + | otherwise = return Nothing + +fill :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fill #-} +fill v s = v `seq` do + n' <- Stream.foldM put 0 s + return $ unsafeSlice 0 n' v + where + {-# INLINE_INNER put #-} + put i x = do + checkIndex Internal i (length v) $ unsafeWrite v i x + return (i+1) + +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 -> Stream m a +{-# INLINE mstreamR #-} +mstreamR v = v `seq` n `seq` Stream.unfoldrM get n + where + n = length v + + {-# INLINE_INNER get #-} + get i | j >= 0 = do x <- unsafeRead v j + return $ Just (x,j) + | otherwise = return Nothing + where + j = i-1 + +fillR :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fillR #-} +fillR v s = v `seq` do + i <- Stream.foldM put n s + return $ unsafeSlice i (n-i) v + where + n = length v + + {-# INLINE_INNER put #-} + put i x = do + unsafeWrite v j x + return j + where + j = i-1 + +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 'Bundle'. +-- The vector will grow exponentially if the maximum size of the 'Bundle' is +-- unknown. +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) + => 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 + +munstreamMax :: (PrimMonad m, MVector v a) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamMax #-} +munstreamMax s n + = do + v <- checkLength Internal n $ unsafeNew n + let put i x = do + checkIndex Internal i n $ unsafeWrite v i x + return (i+1) + n' <- MBundle.foldM' put 0 s + return $ checkSlice Internal 0 n' n + $ unsafeSlice 0 n' v + +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) <- MBundle.foldM put (v, 0) s + return $ checkSlice Internal 0 n (length v') + $ unsafeSlice 0 n v' + where + {-# INLINE_INNER put #-} + put (v,i) x = do + v' <- unsafeAppend1 v i x + return (v',i+1) + + +-- | 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 + +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 <- checkLength Internal n $ unsafeNew n + let {-# INLINE_INNER copyChunk #-} + copyChunk i (Chunk m f) = + checkSlice Internal i m (length v) $ do + f (basicUnsafeSlice i m v) + return (i+m) + + n' <- Stream.foldlM' copyChunk 0 (MBundle.chunks s) + return $ checkSlice Internal 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 $ checkSlice Internal 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 + checkSlice Internal 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 '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) + => 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) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamRMax #-} +munstreamRMax s n + = do + v <- checkLength Internal n $ unsafeNew n + let put i x = do + let i' = i-1 + checkIndex Internal i' n + $ unsafeWrite v i' x + return i' + i <- MBundle.foldM' put n s + return $ checkSlice Internal i (n-i) n + $ unsafeSlice i (n-i) v + +munstreamRUnknown :: (HasCallStack, PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE munstreamRUnknown #-} +munstreamRUnknown s + = do + v <- unsafeNew 0 + (v', i) <- MBundle.foldM put (v, 0) s + let n = length v' + return $ checkSlice Internal i (n-i) n + $ unsafeSlice i (n-i) v' + where + {-# INLINE_INNER put #-} + put (v,i) x = unsafePrepend1 v i x + +-- Length +-- ------ + +-- | Length of the mutable vector. +length :: MVector v a => v s a -> Int +{-# INLINE length #-} +length = basicLength + +-- | Check whether the vector is empty. +null :: MVector v a => v s a -> Bool +{-# INLINE null #-} +null v = length v == 0 + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: (HasCallStack, MVector v a) + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v s a + -> v s a +{-# INLINE slice #-} +slice i n v = checkSlice Bounds i n (length v) $ unsafeSlice i n v + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +take :: MVector v a => Int -> v s a -> v s a +{-# INLINE take #-} +take n v = unsafeSlice 0 (min (max n 0) (length v)) v + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +drop :: MVector v a => Int -> v s a -> v s a +{-# INLINE drop #-} +drop n v = unsafeSlice (min m n') (max 0 (m - n')) v + where + n' = max n 0 + m = length v + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) +{-# INLINE splitAt #-} +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (max 0 (len - n')) v + ) + where + m = min n' len + n' = max n 0 + len = length v + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +init :: MVector v a => v s a -> v s a +{-# INLINE init #-} +init v = slice 0 (length v - 1) v + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +tail :: MVector v a => v s a -> v s a +{-# INLINE tail #-} +tail v = slice 1 (length v - 1) v + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: MVector v a => Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a +{-# INLINE unsafeSlice #-} +-- See NOTE: [Strict indexing] in D.V.Generic +unsafeSlice !i !n v = checkSlice Unsafe i n (length v) + $ basicUnsafeSlice i n v + +-- | Same as 'init', but doesn't do range checks. +unsafeInit :: MVector v a => v s a -> v s a +{-# INLINE unsafeInit #-} +unsafeInit v = unsafeSlice 0 (length v - 1) v + +-- | Same as 'tail', but doesn't do range checks. +unsafeTail :: MVector v a => v s a -> v s a +{-# INLINE unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeTake :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeDrop :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector v a => v s a -> v s a -> Bool +{-# INLINE overlaps #-} +overlaps = basicOverlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (HasCallStack, PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE new #-} +new n = checkLength Bounds n $ stToPrim + $ unsafeNew n >>= \v -> basicInitialize v >> return v + +-- | Create a mutable vector of the given length. The vector content +-- should be assumed to be uninitialized. However, the exact semantics depend +-- on the vector implementation. For example, unboxed and storable +-- vectors will create a vector filled with whatever the underlying memory +-- buffer happens to contain, while boxed vector's elements are +-- initialized to bottoms which will throw exception when evaluated. +-- +-- @since 0.4 +unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew n = checkLength Unsafe n $ stToPrim $ basicUnsafeNew n + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) +{-# INLINE replicate #-} +replicate n x = stToPrim $ basicUnsafeReplicate (delay_inline max 0 n) x + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- 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 (MBundle.replicateM n m) + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generate :: (PrimMonad m, MVector v a) => Int -> (Int -> a) -> m (v (PrimState m) a) +{-# INLINE generate #-} +generate n f = stToPrim $ generateM n (return . f) + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generateM :: (PrimMonad m, MVector v a) => Int -> (Int -> m a) -> m (v (PrimState m) a) +{-# INLINE generateM #-} +generateM n f = munstream (MBundle.generateM n f) + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE clone #-} +clone v = do + v' <- unsafeNew (length v) + unsafeCopy v' v + return v' + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must not be +-- negative, otherwise an exception is thrown. The semantics of this function +-- are exactly the same as of 'unsafeGrow', except that it will initialize the newly +-- allocated memory first. +-- +-- It is important to note that mutating the returned vector will not affect the +-- vector that was used as a source. In other words, it does not, nor will it +-- ever have the semantics of @realloc@ from C. +-- +-- > grow mv 0 === clone mv +-- +-- @since 0.4.0 +grow :: (HasCallStack, PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE grow #-} +grow v by = checkLength Bounds by + $ stToPrim + $ do vnew <- unsafeGrow v by + basicInitialize $ basicUnsafeSlice (length v) by vnew + return vnew + +-- | Same as 'grow', except that it copies data towards the end of the newly +-- allocated vector, making extra space available at the beginning. +-- +-- @since 0.11.0.0 +growFront :: (HasCallStack, PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE growFront #-} +growFront v by = checkLength Bounds by + $ stToPrim + $ 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 = stToPrim $ 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 = stToPrim $ do + v' <- unsafeGrowFront v by + basicInitialize $ basicUnsafeSlice 0 by v' + return (v', by) + where + by = enlarge_delta v + +-- | Grow a vector by allocating a new mutable vector of the same size plus the +-- the given number of elements and copying all the data over to the new vector, +-- starting at its beginning. The newly allocated memory is not initialized and +-- the extra space at the end will likely contain garbage data or bottoms. +-- Use 'unsafeGrowFront' to make the extra space available in the front +-- of the new vector. +-- +-- It is important to note that mutating the returned vector will not affect +-- elements of the vector that was used as a source. In other words, it does not, +-- nor will it ever have the semantics of @realloc@ from C. Keep in mind, +-- however, that values themselves can be of a mutable type +-- (eg. 'Foreign.Ptr.Ptr'), in which case it would be possible to affect values +-- stored in both vectors. +-- +-- > unsafeGrow mv 0 === clone mv +-- +-- @since 0.4.0 +unsafeGrow + :: (PrimMonad m, MVector v a) + => v (PrimState m) a + -- ^ mutable vector to copy from + -> Int + -- ^ number of elements to grow the vector by (must be non-negative, but + -- this is not checked) + -> m (v (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow v n = checkLength Unsafe n + $ stToPrim + $ basicUnsafeGrow v n + +-- | Same as 'unsafeGrow', except that it copies data towards the end of the +-- newly allocated vector, making extra space available at the beginning. +-- +-- @since 0.11.0.0 +unsafeGrowFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE unsafeGrowFront #-} +unsafeGrowFront v by = checkLength Unsafe by $ stToPrim $ do + let n = length v + v' <- basicUnsafeNew (by+n) + basicUnsafeCopy (basicUnsafeSlice by n v') v + return v' + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- 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 = stToPrim . basicClear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.read v 3 +-- 9 +read :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read v i = checkIndex Bounds i (length v) + $ unsafeRead v i + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Strict.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.readMaybe v 3 +-- Just 9 +-- >>> MV.readMaybe v 13 +-- Nothing +readMaybe :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe v i | i `inRange` (length v) = Just <$> unsafeRead v i + | otherwise = pure Nothing + +-- | Replace the element at the given position. +write :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write v i x = checkIndex Bounds i (length v) + $ unsafeWrite v i x + +-- | Modify the element at the given position. +modify :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify v f i = checkIndex Bounds i (length v) + $ unsafeModify v f i + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.12.3.0 +modifyM :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM v f i = checkIndex Bounds i (length v) + $ unsafeModifyM v f i + +-- | Swap the elements at the given positions. +swap :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap v i j = checkIndex Bounds i (length v) + $ checkIndex Bounds j (length v) + $ unsafeSwap v i j + +-- | Replace the element at the given position and return the old element. +exchange :: (HasCallStack, PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange v i x = checkIndex Bounds i (length v) $ unsafeExchange v i x + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +-- See NOTE: [Strict indexing] in D.V.Generic +unsafeRead v !i = checkIndex Unsafe i (length v) + $ stToPrim + $ basicUnsafeRead v i + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +-- See NOTE: [Strict indexing] in D.V.Generic +unsafeWrite v !i x = checkIndex Unsafe i (length v) + $ stToPrim + $ 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 #-} +-- See NOTE: [Strict indexing] in D.V.Generic +unsafeModify v f !i = checkIndex Unsafe i (length v) + $ stToPrim + $ basicUnsafeRead v i >>= \x -> + basicUnsafeWrite v i (f x) + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.12.3.0 +unsafeModifyM :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +-- See NOTE: [Strict indexing] in D.V.Generic +unsafeModifyM v f !i = checkIndex Unsafe i (length v) + $ stToPrim . basicUnsafeWrite v i =<< f =<< stToPrim (basicUnsafeRead v i) + +-- | 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 () +{-# INLINE unsafeSwap #-} +unsafeSwap v i j = checkIndex Unsafe i (length v) + $ checkIndex Unsafe j (length v) + $ stToPrim $ do + x <- unsafeRead v i + y <- unsafeRead v j + unsafeWrite v i y + unsafeWrite v j x + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange v i x = checkIndex Unsafe i (length v) $ stToPrim $ do + y <- unsafeRead v i + unsafeWrite v i x + return y + +-- Folds +-- ----- + +forI_ :: (Monad m, MVector v a) => v (PrimState m) a -> (Int -> m b) -> m () +{-# INLINE forI_ #-} +forI_ v f = loop 0 + where + loop i | i >= n = return () + | otherwise = f i >> loop (i + 1) + n = length v + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.12.3.0 +mapM_ :: (PrimMonad m, MVector v a) => (a -> m b) -> v (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ f v = forI_ v $ \i -> f =<< unsafeRead v i + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results. +-- +-- @since 0.12.3.0 +imapM_ :: (PrimMonad m, MVector v a) => (Int -> a -> m b) -> v (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ f v = forI_ v $ \i -> f i =<< unsafeRead v i + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.12.3.0 +forM_ :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = flip mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.12.3.0 +iforM_ :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = flip imapM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.12.3.0 +foldl :: (PrimMonad m, MVector v a) => (b -> a -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl f = ifoldl (\b _ -> f b) + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldl' :: (PrimMonad m, MVector v a) => (b -> a -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' f = ifoldl' (\b _ -> f b) + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl :: (PrimMonad m, MVector v a) => (b -> Int -> a -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl f b0 v = stToPrim $ ifoldM (\b i a -> return $ f b i a) b0 v + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl' :: (PrimMonad m, MVector v a) => (b -> Int -> a -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' f b0 v = stToPrim $ ifoldM' (\b i a -> return $ f b i a) b0 v + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.12.3.0 +foldr :: (PrimMonad m, MVector v a) => (a -> b -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr f = ifoldr (const f) + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldr' :: (PrimMonad m, MVector v a) => (a -> b -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' f = ifoldr' (const f) + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr :: (PrimMonad m, MVector v a) => (Int -> a -> b -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr f b0 v = stToPrim $ ifoldrM (\i a b -> return $ f i a b) b0 v + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr' :: (PrimMonad m, MVector v a) => (Int -> a -> b -> b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' f b0 v = stToPrim $ ifoldrM' (\i a b -> return $ f i a b) b0 v + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.12.3.0 +foldM :: (PrimMonad m, MVector v a) => (b -> a -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM f = ifoldM (\x _ -> f x) + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldM' :: (PrimMonad m, MVector v a) => (b -> a -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' f = ifoldM' (\x _ -> f x) + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM :: (PrimMonad m, MVector v a) => (b -> Int -> a -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM f b0 v = loop 0 b0 + where + loop i b | i >= n = return b + | otherwise = do a <- unsafeRead v i + loop (i + 1) =<< f b i a + n = length v + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM' :: (PrimMonad m, MVector v a) => (b -> Int -> a -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' f b0 v = loop 0 b0 + where + loop i !b | i >= n = return b + | otherwise = do a <- unsafeRead v i + loop (i + 1) =<< f b i a + n = length v + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.12.3.0 +foldrM :: (PrimMonad m, MVector v a) => (a -> b -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM f = ifoldrM (const f) + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldrM' :: (PrimMonad m, MVector v a) => (a -> b -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' f = ifoldrM' (const f) + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM :: (PrimMonad m, MVector v a) => (Int -> a -> b -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM f b0 v = loop (n-1) b0 + where + loop i b | i < 0 = return b + | otherwise = do a <- unsafeRead v i + loop (i - 1) =<< f i a b + n = length v + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM' :: (PrimMonad m, MVector v a) => (Int -> a -> b -> m b) -> b -> v (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' f b0 v = loop (n-1) b0 + where + loop i !b | i < 0 = return b + | otherwise = do a <- unsafeRead v i + loop (i - 1) =<< f i a b + n = length v + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () +{-# INLINE set #-} +set v = stToPrim . basicSet v + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (HasCallStack, PrimMonad m, MVector v a) + => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy dst src = check Bounds "overlapping vectors" (not (dst `overlaps` src)) + $ check Bounds "length mismatch" (length dst == length src) + $ unsafeCopy dst src + +-- | 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 +-- to the target vector. +move :: (HasCallStack, PrimMonad m, MVector v a) + => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move dst src = check Bounds "length mismatch" (length dst == length src) + $ unsafeMove dst src + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +unsafeCopy :: (PrimMonad m, MVector v a) + => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = check Unsafe "length mismatch" (length dst == length src) + $ check Unsafe "overlapping vectors" (not (dst `overlaps` src)) + $ dst `seq` src `seq` stToPrim (basicUnsafeCopy dst src) + +-- | 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 +-- to the target vector. +unsafeMove :: (PrimMonad m, MVector v a) + => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove dst src = check Unsafe "length mismatch" (length dst == length src) + $ dst `seq` src `seq` stToPrim (basicUnsafeMove dst src) + + +accum :: forall m v a b u. (HasCallStack, PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE accum #-} +accum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd :: HasCallStack => (Int, b) -> m () + upd (i,b) = do + a <- checkIndex Bounds i n $ unsafeRead v i + unsafeWrite v i (f a b) + !n = length v + +update :: forall m v a u. (HasCallStack, PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE update #-} +update !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd :: HasCallStack => (Int, a) -> m () + upd (i,b) = checkIndex Bounds i n $ unsafeWrite v i b + + !n = length v + +unsafeAccum :: (PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE unsafeAccum #-} +unsafeAccum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = do + a <- checkIndex Unsafe i n $ unsafeRead v i + unsafeWrite v i (f a b) + !n = length v + +unsafeUpdate :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE unsafeUpdate #-} +unsafeUpdate !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = checkIndex Unsafe i n $ unsafeWrite v i b + !n = length v + +reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () +{-# INLINE reverse #-} +reverse !v = reverse_loop 0 (length v - 1) + where + reverse_loop i j | i < j = do + unsafeSwap v i j + reverse_loop (i + 1) (j - 1) + reverse_loop _ _ = return () + +unstablePartition :: forall m v a. (PrimMonad m, MVector v a) + => (a -> Bool) -> v (PrimState m) a -> m Int +{-# INLINE unstablePartition #-} +unstablePartition f !v = from_left 0 (length v) + where + -- NOTE: GHC 6.10.4 panics without the signatures on from_left and + -- from_right + from_left :: Int -> Int -> m Int + from_left i j + | i == j = return i + | otherwise = do + x <- unsafeRead v i + if f x + then from_left (i+1) j + else from_right i (j-1) + + from_right :: Int -> Int -> m Int + from_right i j + | i == j = return i + | otherwise = do + x <- unsafeRead v j + if f x + then do + y <- unsafeRead v i + unsafeWrite v i x + unsafeWrite v j y + from_left (i+1) j + else from_right i (j-1) + +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) -> Bundle u a -> Int + -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE unstablePartitionMax #-} +unstablePartitionMax f s n + = do + v <- checkLength Internal n $ unsafeNew n + let {-# INLINE_INNER put #-} + put (i, j) x + | f x = do + unsafeWrite v i x + return (i+1, j) + | otherwise = do + unsafeWrite v (j-1) x + return (i, j-1) + + (i,j) <- Bundle.foldM' put (0, n) s + return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) + +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) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionMax #-} +partitionMax f s n + = do + v <- checkLength Internal n $ unsafeNew n + + let {-# INLINE_INNER put #-} + put (i,j) x + | f x = do + unsafeWrite v i x + return (i+1,j) + + | otherwise = let j' = j-1 in + do + unsafeWrite v j' x + return (i,j') + + (i,j) <- Bundle.foldM' put (0,n) s + check Internal "invalid indices" (i <= j) + $ return () + let l = unsafeSlice 0 i v + r = unsafeSlice j (n-j) v + reverse r + return (l,r) + +partitionUnknown :: (PrimMonad m, MVector v 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) <- Bundle.foldM' put (v1, 0, v2, 0) s + checkSlice Internal 0 n1 (length v1') + $ checkSlice Internal 0 n2 (length v2') + $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') + where + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. + {-# INLINE_INNER put #-} + put (v1, i1, v2, i2) x + | f x = do + v1' <- unsafeAppend1 v1 i1 x + return (v1', i1+1, v2, i2) + | otherwise = do + v2' <- unsafeAppend1 v2 i2 x + return (v1, i1, v2', i2+1) + + +partitionWithBundle :: (PrimMonad m, MVector v a, MVector v b, MVector v c) + => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c) +{-# INLINE partitionWithBundle #-} +partitionWithBundle f s + = case upperBound (Bundle.size s) of + Just n -> partitionWithMax f s n + Nothing -> partitionWithUnknown f s + +partitionWithMax :: (PrimMonad m, MVector v a, MVector v b, MVector v c) + => (a -> Either b c) -> Bundle u a -> Int -> m (v (PrimState m) b, v (PrimState m) c) +{-# INLINE partitionWithMax #-} +partitionWithMax f s n + = do + v1 <- unsafeNew n + v2 <- unsafeNew n + let {-# INLINE_INNER put #-} + put (i1, i2) x = case f x of + Left b -> do + unsafeWrite v1 i1 b + return (i1+1, i2) + Right c -> do + unsafeWrite v2 i2 c + return (i1, i2+1) + (n1, n2) <- Bundle.foldM' put (0, 0) s + checkSlice Internal 0 n1 (length v1) + $ checkSlice Internal 0 n2 (length v2) + $ return (unsafeSlice 0 n1 v1, unsafeSlice 0 n2 v2) + +partitionWithUnknown :: forall m v u a b c. + (PrimMonad m, MVector v a, MVector v b, MVector v c) + => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c) +{-# INLINE partitionWithUnknown #-} +partitionWithUnknown f s + = do + v1 <- unsafeNew 0 + v2 <- unsafeNew 0 + (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s + checkSlice Internal 0 n1 (length v1') + $ checkSlice Internal 0 n2 (length v2') + $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') + where + put :: (v (PrimState m) b, Int, v (PrimState m) c, Int) + -> a + -> m (v (PrimState m) b, Int, v (PrimState m) c, Int) + {-# INLINE_INNER put #-} + put (v1, i1, v2, i2) x = case f x of + Left b -> do + v1' <- unsafeAppend1 v1 i1 b + return (v1', i1+1, v2, i2) + Right c -> do + v2' <- unsafeAppend1 v2 i2 c + return (v1, i1, v2', i2+1) + +-- Modifying vectors +-- ----------------- + + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +nextPermutation :: (PrimMonad m, Ord e, MVector v e) => v (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = nextPermutationByLt (<) + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: (PrimMonad m, MVector v e) => (e -> e -> Ordering) -> v (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy cmp = nextPermutationByLt (\x y -> cmp x y == LT) + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m, Ord e, MVector v e) => v (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = nextPermutationByLt (>) + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: (PrimMonad m, MVector v e) => (e -> e -> Ordering) -> v (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy cmp = nextPermutationByLt (\x y -> cmp x y == GT) + +{- +http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations + +The following algorithm generates the next permutation lexicographically after +a given permutation. It changes the given permutation in-place. + +1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, + the permutation is the last permutation. +2. Find the largest index l greater than k such that a[k] < a[l]. +3. Swap the value of a[k] with that of a[l]. +4. Reverse the sequence from a[k + 1] up to and including the final element a[n] + +The algorithm has been updated to look up the k in Step 1 beginning from the +last of the vector; which renders the algorithm to achieve the average time +complexity of O(1) each call. The worst case time complexity is still O(n). +The orginal implementation, which scanned the vector from the left, had the +time complexity of O(n) on the best case. +-} + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Here, the first argument should be a less-than comparison function. +-- Returns False when the input is the last permutation; in this case the vector +-- will not get updated, as opposed to the behavior of the C++ function +-- @std::next_permutation@. +nextPermutationByLt :: (PrimMonad m, MVector v e) => (e -> e -> Bool) -> v (PrimState m) e -> m Bool +{-# INLINE nextPermutationByLt #-} +nextPermutationByLt lt v + | dim < 2 = return False + | otherwise = stToPrim $ do + !vlast <- unsafeRead v (dim - 1) + decrLoop (dim - 2) vlast + where + dim = length v + -- find the largest index k such that a[k] < a[k + 1], and then pass to the rest. + decrLoop !i !vi1 | i >= 0 = do + !vi <- unsafeRead v i + if vi `lt` vi1 then swapLoop i vi (i+1) vi1 dim else decrLoop (i-1) vi + decrLoop _ !_ = return False + -- find the largest index l greater than k such that a[k] < a[l], and do the rest. + swapLoop !k !vk = go + where + -- binary search. + go !l !vl !r | r - l <= 1 = do + -- Done; do the rest of the algorithm. + unsafeWrite v k vl + unsafeWrite v l vk + reverse $ unsafeSlice (k + 1) (dim - k - 1) v + return True + go !l !vl !r = do + !vmid <- unsafeRead v mid + if vk `lt` vmid + then go mid vmid r + else go l vl mid + where + !mid = l + (r - l) `shiftR` 1 + + +-- $setup +-- >>> import Prelude ((*)) diff --git a/src/Data/Vector/Generic/Mutable/Base.hs b/src/Data/Vector/Generic/Mutable/Base.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Generic/Mutable/Base.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Generic.Mutable.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2011 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of mutable vectors. + +module Data.Vector.Generic.Mutable.Base ( + MVector(..) +) where + +import Control.Monad.ST + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Class of mutable vectors parameterised 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 :: Int -> ST s (v s 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. + -- + -- @since 0.11.0.0 + basicInitialize :: v s a -> ST s () + + -- | 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 :: Int -> a -> ST s (v s a) + + -- | Yield the element at the given position. This method should not be + -- called directly, use 'unsafeRead' instead. + basicUnsafeRead :: v s a -> Int -> ST s a + + -- | Replace the element at the given position. This method should not be + -- called directly, use 'unsafeWrite' instead. + basicUnsafeWrite :: v s a -> Int -> a -> ST s () + + -- | 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 :: v s a -> ST s () + + -- | Set all elements of the vector to the given value. This method should + -- not be called directly, use 'set' instead. + basicSet :: v s a -> a -> ST s () + + -- | Copy a vector. The two vectors may not overlap. This method should not + -- be called directly, use 'unsafeCopy' instead. + basicUnsafeCopy :: v s a -- ^ target + -> v s a -- ^ source + -> ST s () + + -- | Move the contents of a vector. The two vectors may overlap. This method + -- should not be called directly, use 'unsafeMove' instead. + basicUnsafeMove :: v s a -- ^ target + -> v s a -- ^ source + -> ST s () + + -- | Grow a vector by the given number of elements. Allocates a new vector and + -- copies all of the elements over starting at 0 index. This method should not + -- be called directly, use 'grow'\/'unsafeGrow' instead. + basicUnsafeGrow :: v s a -> Int -> ST s (v s 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 + + {-# MINIMAL basicLength, basicUnsafeSlice, basicOverlaps, + basicUnsafeNew, basicInitialize, basicUnsafeRead, + basicUnsafeWrite #-} diff --git a/src/Data/Vector/Generic/New.hs b/src/Data/Vector/Generic/New.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Generic/New.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +-- | +-- Module : Data.Vector.Generic.New +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Purely functional interface to initialisation of mutable vectors +-- + +module Data.Vector.Generic.New ( + -- * Array recycling primitives + New(..), create, run, runPrim, apply, modify, modifyWithBundle, + unstream, transform, unstreamR, transformR, + slice, init, tail, take, drop, + unsafeSlice, unsafeInit, unsafeTail + -- * References + -- $references +) where + +import qualified Data.Vector.Generic.Mutable as MVector + +import Data.Vector.Generic.Base ( Vector, Mutable ) + +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 + ( Monad, Int + , return, seq + , (.), (=<<) ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | This data type is a wrapper around a monadic action which produces +-- a mutable vector. It's used by a number of rewrite rules in order to +-- facilitate the reuse of buffers allocated for vectors. See "Recycle +-- your arrays!" for a detailed explanation. +-- +-- Note that this data type must be declared as @data@ and not @newtype@ +-- since it's used for rewrite rules and rules won't fire with @newtype@. +data New v a = New (forall s. ST s (Mutable v s a)) + +create :: (forall s. ST s (Mutable v s a)) -> New v a +{-# INLINE create #-} +create p = New p + +run :: New v a -> ST s (Mutable v s a) +{-# INLINE run #-} +run (New p) = p + +runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) +{-# INLINE runPrim #-} +runPrim (New p) = primToPrim p + +apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a +{-# INLINE apply #-} +apply f (New p) = New (liftM f p) + +modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a +{-# INLINE modify #-} +modify f (New p) = New (do { v <- p; f v; 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 => 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 => 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 (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 => Stream m a -> Stream m a) + g s. + transform f g (unstream s) = unstream (Bundle.inplace f g s) #-} + + + + +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 => 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 (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 f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p + +"transformR/unstreamR [New]" + 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_FUSED slice #-} +slice i n m = apply (MVector.slice i n) m + +init :: Vector v a => New v a -> New v a +{-# INLINE_FUSED init #-} +init m = apply MVector.init m + +tail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED tail #-} +tail m = apply MVector.tail m + +take :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED take #-} +take n m = apply (MVector.take n) m + +drop :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED drop #-} +drop n m = apply (MVector.drop n) m + +unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a +{-# INLINE_FUSED unsafeSlice #-} +unsafeSlice i n m = apply (MVector.unsafeSlice i n) m + +unsafeInit :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeInit #-} +unsafeInit m = apply MVector.unsafeInit m + +unsafeTail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeTail #-} +unsafeTail m = apply MVector.unsafeTail m + +{-# RULES + +"slice/unstream [New]" forall i n s. + slice i n (unstream s) = unstream (Bundle.slice i n s) + +"init/unstream [New]" forall s. + init (unstream s) = unstream (Bundle.init s) + +"tail/unstream [New]" forall s. + tail (unstream s) = unstream (Bundle.tail s) + +"take/unstream [New]" forall n s. + take n (unstream s) = unstream (Bundle.take n s) + +"drop/unstream [New]" forall n s. + drop n (unstream s) = unstream (Bundle.drop n s) + +"unsafeSlice/unstream [New]" forall i n s. + unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s) + +"unsafeInit/unstream [New]" forall s. + unsafeInit (unstream s) = unstream (Bundle.init s) + +"unsafeTail/unstream [New]" forall s. + unsafeTail (unstream s) = unstream (Bundle.tail s) #-} + + +-- $references +-- +-- * Leshchinskiy, Roman. "Recycle your arrays!". Practical Aspects of +-- Declarative Languages: 11th International Symposium, PADL 2009, +-- Savannah, GA, USA, January 19-20, 2009. Proceedings 11. Springer +-- Berlin Heidelberg, 2009. diff --git a/src/Data/Vector/Internal/Check.hs b/src/Data/Vector/Internal/Check.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Internal/Check.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Internal.Check +-- Copyright : (c) Roman Leshchinskiy 2009 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Bounds checking infrastructure +-- +module Data.Vector.Internal.Check ( + HasCallStack, + Checks(..), doChecks, + + internalError, + check, checkIndex, checkLength, checkSlice, + inRange +) where + +import GHC.Exts (Int(..), Int#) +import Prelude + ( Eq, Bool(..), Word, String + , otherwise, fromIntegral, show, unlines + , (-), (<), (<=), (>=), ($), (++) ) +import qualified Prelude as P +import GHC.Stack (HasCallStack) + +-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline +-- these functions into unfoldings which makes the intermediate code size +-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. +infixr 2 || +infixr 3 && + +not :: Bool -> Bool +{-# INLINE not #-} +not True = False +not False = True + +(&&) :: Bool -> Bool -> Bool +{-# INLINE (&&) #-} +False && _ = False +True && x = x + +(||) :: Bool -> Bool -> Bool +{-# INLINE (||) #-} +True || _ = True +False || x = x + + +data Checks = Bounds | Unsafe | Internal deriving( Eq ) + +doBoundsChecks :: Bool +#ifdef VECTOR_BOUNDS_CHECKS +doBoundsChecks = True +#else +doBoundsChecks = False +#endif + +doUnsafeChecks :: Bool +#ifdef VECTOR_UNSAFE_CHECKS +doUnsafeChecks = True +#else +doUnsafeChecks = False +#endif + +doInternalChecks :: Bool +#ifdef VECTOR_INTERNAL_CHECKS +doInternalChecks = True +#else +doInternalChecks = False +#endif + + +doChecks :: Checks -> Bool +{-# INLINE doChecks #-} +doChecks Bounds = doBoundsChecks +doChecks Unsafe = doUnsafeChecks +doChecks Internal = doInternalChecks + +internalError :: HasCallStack => String -> a +{-# NOINLINE internalError #-} +internalError msg + = P.error $ unlines + ["*** Internal error in package vector ***" + ,"*** Please submit a bug report at http://github.com/haskell/vector" + ,msg] + + +checkError :: HasCallStack => Checks -> String -> a +{-# NOINLINE checkError #-} +checkError kind msg + = case kind of + Internal -> internalError msg + _ -> P.error msg + +check :: HasCallStack => Checks -> String -> Bool -> a -> a +{-# INLINE check #-} +check kind msg cond x + | not (doChecks kind) || cond = x + | otherwise = checkError kind msg + +checkIndex_msg :: Int -> Int -> String +{-# INLINE checkIndex_msg #-} +checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# + +checkIndex_msg# :: Int# -> Int# -> String +{-# NOINLINE checkIndex_msg# #-} +checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#) + +checkIndex :: HasCallStack => Checks -> Int -> Int -> a -> a +{-# INLINE checkIndex #-} +checkIndex kind i n x + = check kind (checkIndex_msg i n) (inRange i n) x + + +checkLength_msg :: Int -> String +{-# INLINE checkLength_msg #-} +checkLength_msg (I# n#) = checkLength_msg# n# + +checkLength_msg# :: Int# -> String +{-# NOINLINE checkLength_msg# #-} +checkLength_msg# n# = "negative length " ++ show (I# n#) + +checkLength :: HasCallStack => Checks -> Int -> a -> a +{-# INLINE checkLength #-} +checkLength kind n = check kind (checkLength_msg n) (n >= 0) + + +checkSlice_msg :: Int -> Int -> Int -> String +{-# INLINE checkSlice_msg #-} +checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n# + +checkSlice_msg# :: Int# -> Int# -> Int# -> String +{-# NOINLINE checkSlice_msg# #-} +checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) + +checkSlice :: HasCallStack => Checks -> Int -> Int -> Int -> a -> a +{-# INLINE checkSlice #-} +checkSlice kind i m n x + = check kind (checkSlice_msg i m n) (i >= 0 && m >= 0 && m <= n - i) x + +-- Lengths are never negative, so we can check @0 <= i < length v@ +-- using one unsigned comparison. +inRange :: Int -> Int -> Bool +{-# INLINE inRange #-} +inRange i n = (fromIntegral i :: Word) < (fromIntegral n :: Word) diff --git a/src/Data/Vector/Mutable.hs b/src/Data/Vector/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Mutable.hs @@ -0,0 +1,784 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable boxed vectors. + +module Data.Vector.Mutable ( + -- * Mutable boxed vectors + MVector(MVector), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- ** Arrays + fromMutableArray, toMutableArray, + + -- * Re-exports + PrimMonad, PrimState, RealWorld +) where + +import Control.Monad (when, liftM) +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Internal.Check +import Data.Primitive.Array +import Control.Monad.Primitive + +import Prelude + ( Ord, Monad, Bool, Ordering(..), Int, Maybe + , compare, return, otherwise, error + , (>>=), (+), (-), (*), (<), (>), (>=), (&&), (||), ($), (>>) ) + +import Data.Typeable ( Typeable ) + +#include "vector.h" + +type role MVector nominal representational + +-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). +data MVector s a = MVector { _offset :: {-# UNPACK #-} !Int + -- ^ Offset in underlying array + , _size :: {-# UNPACK #-} !Int + -- ^ Size of slice + , _array :: {-# UNPACK #-} !(MutableArray s a) + -- ^ Underlying array + } + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +-- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54 +{- +instance NFData a => NFData (MVector s a) where + rnf (MVector i n arr) = unsafeInlineST $ force i + where + force !ix | ix < n = do x <- readArray arr ix + rnf x `seq` force (ix+1) + | otherwise = return () +-} + +instance G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector i _ arr) = MVector (i+j) m arr + + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector i m arr1) (MVector j n arr2) + = sameMutableArray arr1 arr2 + && (between i j (j+n) || between j i (i+m)) + where + between x y z = x >= y && x < z + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + = do + 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 + arr <- newArray n x + return (MVector 0 n arr) + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j) + + {-# INLINE basicUnsafeWrite #-} + 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 () + 1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst + 2 -> do + x <- readArray arrSrc iSrc + y <- readArray arrSrc (iSrc + 1) + writeArray arrDst iDst x + writeArray arrDst (iDst + 1) y + _ + | overlaps dst src + -> case compare iDst iSrc of + LT -> moveBackwards arrDst iDst iSrc n + EQ -> return () + GT | (iDst - iSrc) * 2 < n + -> moveForwardsLargeOverlap arrDst iDst iSrc n + | otherwise + -> moveForwardsSmallOverlap arrDst iDst iSrc n + | otherwise -> G.basicUnsafeCopy dst src + + {-# INLINE basicClear #-} + basicClear v = G.set v uninitialised + +{-# INLINE moveBackwards #-} +moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveBackwards !arr !dstOff !srcOff !len = + check Internal "not a backwards move" (dstOff < srcOff) + $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + +{-# INLINE moveForwardsSmallOverlap #-} +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. +moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsSmallOverlap !arr !dstOff !srcOff !len = + check Internal "not a forward move" (dstOff > srcOff) + $ do + tmp <- newArray overlap uninitialised + loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i) + where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap + +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. +moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsLargeOverlap !arr !dstOff !srcOff !len = + check Internal "not a forward move" (dstOff > srcOff) + $ do + queue <- newArray nonOverlap uninitialised + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i + let mov !i !qTop = when (i < dstOff + len) $ do + x <- readArray arr i + y <- readArray queue qTop + writeArray arr i y + writeArray queue qTop x + mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1) + mov dstOff 0 + where nonOverlap = dstOff - srcOff + +{-# INLINE loopM #-} +loopM :: Monad m => Int -> (Int -> m a) -> m () +loopM !n k = let + go i = when (i < n) (k i >> go (i+1)) + in go 0 + +uninitialised :: a +uninitialised = error "Data.Vector.Mutable: uninitialised element. If you are trying to compact a vector, use the 'Data.Vector.force' function to remove uninitialised elements from the underlying array." + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty. +null :: MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> MVector s a + -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +take :: Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +drop :: Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +init :: MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +tail :: MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeTake :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeDrop :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- | Same as 'init', but doesn't do range checks. +unsafeInit :: MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | Same as 'tail', but doesn't do range checks. +unsafeTail :: MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The vector elements +-- are set to bottom, so accessing them will cause an exception. +-- +-- @since 0.5 +unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generate :: (PrimMonad m) => Int -> (Int -> a) -> m (MVector (PrimState m) a) +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generateM :: (PrimMonad m) => Int -> (Int -> m a) -> m (MVector (PrimState m) a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | Create a copy of a mutable vector. +clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a boxed vector by the given number of elements. The number must be +-- non-negative. This has the same semantics as 'G.grow' for generic vectors. It differs +-- from @grow@ functions for unpacked vectors, however, in that only pointers to +-- values are copied over, therefore the values themselves will be shared between the +-- two vectors. This is an important distinction to know about during memory +-- usage analysis and in case the values themselves are of a mutable type, e.g. +-- 'Data.IORef.IORef' or another mutable vector. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> mv <- V.thaw $ V.fromList ([10, 20, 30] :: [Integer]) +-- >>> mv' <- MV.grow mv 2 +-- +-- The two extra elements at the end of the newly allocated vector will be +-- uninitialized and will result in an error if evaluated, so me must overwrite +-- them with new values first: +-- +-- >>> MV.write mv' 3 999 +-- >>> MV.write mv' 4 777 +-- >>> V.freeze mv' +-- [10,20,30,999,777] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MV.write mv' 2 888 +-- >>> V.freeze mv' +-- [10,20,888,999,777] +-- >>> V.freeze mv +-- [10,20,30] +-- +-- @since 0.5 +grow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be non-negative, but +-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. +-- +-- @since 0.5 +unsafeGrow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. +clear :: PrimMonad m => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.read v 3 +-- 9 +read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.readMaybe v 3 +-- Just 9 +-- >>> MV.readMaybe v 13 +-- Nothing +readMaybe :: (PrimMonad m) => MVector (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe = G.readMaybe + +-- | Replace the element at the given position. +write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.12.3.0 +modifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM = G.modifyM + +-- | Swap the elements at the given positions. +swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + +-- | Replace the element at the given position and return the old element. +exchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange = G.exchange + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.12.3.0 +unsafeModifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +unsafeModifyM = G.unsafeModifyM + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange = G.unsafeExchange + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: PrimMonad m => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | 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 +-- to the target vector. +move :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move = G.move + +-- | 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 +-- to the target vector. +unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Modifying vectors +-- ----------------- + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +nextPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy = G.nextPermutationBy + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = G.prevPermutation + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy = G.prevPermutationBy + +-- Folds +-- ----- + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.12.3.0 +mapM_ :: (PrimMonad m) => (a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results. +-- +-- @since 0.12.3.0 +imapM_ :: (PrimMonad m) => (Int -> a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.12.3.0 +forM_ :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.12.3.0 +iforM_ :: (PrimMonad m) => MVector (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.12.3.0 +foldl :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldl' :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl' :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.12.3.0 +foldr :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldr' :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr' :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.12.3.0 +foldM :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldM' :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM' :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.12.3.0 +foldrM :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM = G.foldrM + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldrM' :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' = G.foldrM' + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM = G.ifoldrM + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM' :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' = G.ifoldrM' + +-- Conversions - Arrays +-- ----------------------------- + +-- | /O(n)/ Make a copy of a mutable array to a new mutable vector. +-- +-- @since 0.12.2.0 +fromMutableArray :: PrimMonad m => MutableArray (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE fromMutableArray #-} +fromMutableArray marr = + let size = sizeofMutableArray marr + in MVector 0 size `liftM` cloneMutableArray marr 0 size + +-- | /O(n)/ Make a copy of a mutable vector into a new mutable array. +-- +-- @since 0.12.2.0 +toMutableArray :: PrimMonad m => MVector (PrimState m) a -> m (MutableArray (PrimState m) a) +{-# INLINE toMutableArray #-} +toMutableArray (MVector offset size marr) = cloneMutableArray marr offset size + +-- $setup +-- >>> import Prelude (Integer) diff --git a/src/Data/Vector/Primitive.hs b/src/Data/Vector/Primitive.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Primitive.hs @@ -0,0 +1,1951 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Primitive +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- 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 +-- cost. + +module Data.Vector.Primitive ( + -- * Primitive vectors + Vector(..), MVector(..), + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, partitionWith, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- ** Comparisons + eqBy, cmpBy, + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, unsafeCast, + unsafeCoerceVector, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- ** Re-exports + Prim +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Primitive.Mutable ( MVector(..) ) +import Data.Vector.Internal.Check +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import Control.Monad ( liftM ) +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude + ( Eq, Ord, Num, Enum, Monoid, Traversable, Monad, Read, Show, Bool, Ordering(..), Int, Maybe, Either + , compare, mempty, mappend, mconcat, showsPrec, return, otherwise, seq, error, undefined + , (+), (*), (<), (<=), (>), (>=), (==), (/=), ($!) ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +import Data.Coerce +import Unsafe.Coerce +import qualified GHC.Exts as Exts + +type role Vector nominal + +-- | /O(1)/ Unsafely coerce an immutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- This is marginally safer than 'unsafeCast', since this function imposes an +-- extra 'Coercible' constraint. The constraint guarantees that the element types +-- are representationally equal. It however cannot guarantee +-- that their respective 'Prim' instances are compatible. +unsafeCoerceVector :: Coercible a b => Vector a -> Vector b +unsafeCoerceVector = unsafeCoerce + +-- | Unboxed vectors of primitive types. +data Vector a = Vector {-# UNPACK #-} !Int -- ^ offset + {-# UNPACK #-} !Int -- ^ length + {-# UNPACK #-} !ByteArray -- ^ underlying byte array + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _ _) = () + +#if MIN_VERSION_deepseq(1,4,3) +-- | @since 0.12.1.0 +instance NFData1 Vector where + liftRnf _ (Vector _ _ _) = () +#endif + +instance (Show a, Prim a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Prim a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Data a, Prim a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = G.mkVecConstr "Data.Vector.Primitive.Vector" + gunfold = G.gunfold + dataTypeOf _ = G.mkVecType "Data.Vector.Primitive.Vector" + dataCast1 = G.dataCast + + +type instance G.Mutable Vector = MVector + +instance Prim a => G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector i n marr) + = Vector i n `liftM` unsafeFreezeByteArray marr + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector i n arr) + = MVector i n `liftM` unsafeThawByteArray arr + + {-# INLINE basicLength #-} + basicLength (Vector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector i _ arr) j = return $! indexByteArray arr (i+j) + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (Vector j _ src) + = copyByteArray dst (i*sz) src (j*sz) (n*sz) + where + sz = sizeOf (undefined :: a) + + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Prim a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = 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 = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Prim a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Prim a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (<>) + + {-# INLINE mconcat #-} + mconcat = concat + +instance Prim a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + + +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector. +length :: Prim a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty. +null :: Prim a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing. +(!) :: Prim a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing. +(!?) :: Prim a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element. +head :: Prim a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element. +last :: Prim a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking. +unsafeIndex :: Prim a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element, without checking if the vector is empty. +unsafeHead :: Prim a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element, without checking if the vector is empty. +unsafeLast :: Prim a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +indexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Prim a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Prim a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Prim a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements, in which case it is returned unchanged. +take :: Prim a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /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 :: Prim a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.7.1 +splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +uncons :: Prim a => Vector a -> Maybe (a, Vector a) +{-# INLINE uncons #-} +uncons = G.uncons + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +unsnoc :: Prim a => Vector a -> Maybe (Vector a, a) +{-# INLINE unsnoc #-} +unsnoc = G.unsnoc + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +unsafeSlice :: Prim a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty, but this is not checked. +unsafeInit :: Prim a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty, but this is not checked. +unsafeTail :: Prim a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +unsafeTake :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +unsafeDrop :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +empty :: Prim a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ A vector with exactly one element. +singleton :: Prim a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ A vector of the given length with the same value in each position. +replicate :: Prim a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +generate :: Prim a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- ===__Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.iterateN 0 undefined undefined :: VP.Vector Int +-- [] +-- >>> VP.iterateN 26 succ 'a' +-- "abcdefghijklmnopqrstuvwxyz" +-- +-- @since 0.7.1 +iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.12.2.0 +unfoldrExactN :: (Prim a) => Int -> (b -> (a, b)) -> b -> Vector a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = G.unfoldrExactN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Prim a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Prim a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: (Monad m, Prim a) => Int -> (b -> m (a, b)) -> b -> m (Vector a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM = G.unfoldrExactNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +constructN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Prim a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +enumFromStepN :: (Prim a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +cons :: Prim a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element. +snoc :: Prim a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors. +(++) :: Prim a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list. +concat :: Prim a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index. +generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.12.0.0 +iterateNM :: (Monad m, Prim a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Prim a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Prim a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <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@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Prim a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//'), but without bounds checking. +unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_', but without bounds checking. +unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.accum (+) (VP.fromList [1000,2000,3000 :: Int]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +accum :: Prim a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Prim a, Prim b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum', but without bounds checking. +unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_', but without bounds checking. +unsafeAccumulate_ :: (Prim a, Prim b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +reverse :: Prim a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +backpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute', but without bounds checking. +unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> VP.modify (\v -> MVP.write v 0 'x') $ VP.replicate 4 'a' +-- "xaaa" +modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector. +map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index. +imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. +mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b) +{-# 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. +-- +-- @since 0.12.2.0 +imapM :: (Monad m, Prim a, Prim 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, Prim 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. +-- +-- @since 0.12.2.0 +imapM_ :: (Monad m, Prim 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. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.12.2.0 +iforM :: (Monad m, Prim a, Prim b) => Vector a -> (Int -> a -> m b) -> m (Vector b) +{-# INLINE iforM #-} +iforM = G.iforM + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.12.2.0 +iforM_ :: (Monad m, Prim a) => Vector a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Prim a, Prim b, Prim c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Prim a, Prim b, Prim c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +zipWithM :: (Monad m, Prim a, Prim b, Prim c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# 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. +-- +-- @since 0.12.2.0 +izipWithM :: (Monad m, Prim a, Prim b, Prim 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, Prim a, Prim b) + => (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. +-- +-- @since 0.12.2.0 +izipWithM_ :: (Monad m, Prim a, Prim b) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +filter :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.uniq $ VP.fromList [1,3,3,200,3 :: Int] +-- [1,3,200,3] +uniq :: (Prim a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Map the values and collect the 'Just' results. +mapMaybe :: (Prim a, Prim b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +imapMaybe :: (Prim a, Prim b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. +filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +mapMaybeM + :: (Monad m, Prim a, Prim b) + => (a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE mapMaybeM #-} +mapMaybeM = G.mapMaybeM + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +imapMaybeM + :: (Monad m, Prim a, Prim b) + => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE imapMaybeM #-} +imapMaybeM = G.imapMaybeM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.12.1.0 +partitionWith :: (Prim a, Prim b, Prim c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) +{-# INLINE partitionWith #-} +partitionWith = G.partitionWith + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.span (<4) $ VP.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.break (>4) $ VP.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.spanR (>4) $ VP.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +spanR :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE spanR #-} +spanR = G.spanR + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since NEXT_VERSION +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.breakR (<5) $ VP.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +breakR :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE breakR #-} +breakR = G.breakR + +-- | /O(n)/ Split a vector into a list of slices, using a predicate function. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- Does not fuse. +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import Data.Char (isUpper) +-- >>> VP.groupBy (\a b -> isUpper a == isUpper b) (VP.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy', 'group'. +-- +-- @since 0.13.0.1 +groupBy :: Prim a => (a -> a -> Bool) -> Vector a -> [Vector a] +{-# INLINE groupBy #-} +groupBy = G.groupBy + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- Does not fuse. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.group (VP.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.0.1 +group :: (Prim a, Eq a) => Vector a -> [Vector a] +{-# INLINE group #-} +group = G.groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +elem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). +notElem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Prim a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +findIndexR :: Prim a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR = G.findIndexR + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors. +foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator. +foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. +foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold. +foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors. +foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator. +foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. +foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold using a function applied to each element and its index. +ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator using a function applied to each element +-- and its index. +ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold using a function applied to each element and its index. +ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator using a function applied to each +-- element and its index. +ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type cless. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.12.2.0 +foldMap :: (Monoid m, Prim a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap #-} +foldMap = G.foldMap + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.12.2.0 +foldMap' :: (Monoid m, Prim a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap' #-} +foldMap' = G.foldMap' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.all even $ VP.fromList [2, 4, 12 :: Int] +-- True +-- >>> VP.all even $ VP.fromList [2, 4, 13 :: Int] +-- False +-- >>> VP.all even (VP.empty :: VP.Vector Int) +-- True +all :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.any even $ VP.fromList [1, 3, 7 :: Int] +-- False +-- >>> VP.any even $ VP.fromList [3, 2, 13 :: Int] +-- True +-- >>> VP.any even (VP.empty :: VP.Vector Int) +-- False +any :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.sum $ VP.fromList [300,20,1 :: Int] +-- 321 +-- >>> VP.sum (VP.empty :: VP.Vector Int) +-- 0 +sum :: (Prim a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.product $ VP.fromList [1,2,3,4 :: Int] +-- 24 +-- >>> VP.product (VP.empty :: VP.Vector Int) +-- 1 +product :: (Prim a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.maximum $ VP.fromList [2, 1 :: Int] +-- 2 +maximum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- @since 0.13.0.0 +maximumOn :: (Ord b, Prim a) => (a -> b) -> Vector a -> a +{-# INLINE maximumOn #-} +maximumOn = G.maximumOn + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.minimum $ VP.fromList [2, 1 :: Int] +-- 1 +minimum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. +minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- @since 0.13.0.0 +minimumOn :: (Ord b, Prim a) => (a -> b) -> Vector a -> a +{-# INLINE minimumOn #-} +minimumOn = G.minimumOn + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.2.0 +ifoldM :: (Monad m, Prim 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, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator. +foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each +-- element and its index. +-- +-- @since 0.12.2.0 +ifoldM' :: (Monad m, Prim 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, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result. +foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result using a function applied to +-- each element and its index. +-- +-- @since 0.12.2.0 +ifoldM_ :: (Monad m, Prim 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, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result. +foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function applied to each element and its index. +-- +-- @since 0.12.2.0 +ifoldM'_ :: (Monad m, Prim 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, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.prescanl (+) 0 (VP.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6] +prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Left-to-right prescan with strict accumulator. +prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.postscanl (+) 0 (VP.fromList [1,2,3,4 :: Int]) +-- [1,3,6,10] +postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Left-to-right postscan with strict accumulator. +postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.scanl (+) 0 (VP.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6,10] +scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Left-to-right scan with strict accumulator. +scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Left-to-right scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanl :: (Prim a, Prim b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +-- +-- @since 0.12.2.0 +iscanl' :: (Prim a, Prim b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.scanl1 min $ VP.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VP.scanl1 max $ VP.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VP.scanl1 min (VP.empty :: VP.Vector Int) +-- [] +scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.scanl1' min $ VP.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VP.scanl1' max $ VP.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VP.scanl1' min (VP.empty :: VP.Vector Int) +-- [] +scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator. +prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left postscan. +postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left postscan with strict accumulator. +postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left scan. +scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left scan with strict accumulator. +scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanr :: (Prim a, Prim b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +-- +-- @since 0.12.2.0 +iscanr' :: (Prim a, Prim b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.scanr1 min $ VP.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VP.scanr1 max $ VP.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VP.scanr1 min (VP.empty :: VP.Vector Int) +-- [] +scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.scanr1' min $ VP.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VP.scanr1' max $ VP.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VP.scanr1' min (VP.empty :: VP.Vector Int) +-- [] +scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Comparisons +-- ------------------------ + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +-- +-- @since 0.12.2.0 +eqBy :: (Prim a, Prim b) => (a -> b -> Bool) -> Vector a -> Vector b -> Bool +{-# INLINE eqBy #-} +eqBy = G.eqBy + +-- | /O(n)/ Compare two vectors using the supplied comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == compare +-- +-- @since 0.12.2.0 +cmpBy :: (Prim a, Prim b) => (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering +cmpBy = G.cmpBy + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +toList :: Prim a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.4 +fromList :: Prim a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> VP.fromListN 3 [1,2,3,4,5 :: Int] +-- [1,2,3] +-- >>> VP.fromListN 3 [1 :: Int] +-- [1] +fromListN :: Prim a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Unsafe casts +-- -------------------------- + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- This operation just changes the type of the vector and does not +-- modify the elements. +-- +-- This function will throw an error if elements are of mismatching sizes. +-- +-- | @since 0.13.0.0 +unsafeCast :: forall a b. (HasCallStack, Prim a, Prim b) => Vector a -> Vector b +{-# INLINE unsafeCast #-} +unsafeCast (Vector o n ba) + | sizeOf (undefined :: a) == sizeOf (undefined :: b) = Vector o n ba + | otherwise = error "Element size mismatch" + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +unsafeThaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (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 () +{-# INLINE copy #-} +copy = G.copy + +-- $setup +-- >>> import Prelude (($), min, even, max, succ, id, Ord(..)) diff --git a/src/Data/Vector/Primitive/Mutable.hs b/src/Data/Vector/Primitive/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Primitive/Mutable.hs @@ -0,0 +1,744 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Primitive.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable primitive vectors. + +module Data.Vector.Primitive.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Unsafe conversions + unsafeCoerceMVector, unsafeCast, + -- * Re-exports + Prim, PrimMonad, PrimState, RealWorld +) where + +import qualified Data.Vector.Generic.Mutable as G +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) +import Data.Vector.Internal.Check +import Data.Word ( Word8 ) +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import Prelude + ( Ord, Bool, Int, Maybe, Ordering(..) + , otherwise, error, undefined, div, show, maxBound + , (+), (*), (<), (>), (>=), (==), (&&), (||), ($), (++) ) + +import Data.Typeable ( Typeable ) +import Data.Coerce +import Unsafe.Coerce + +-- Data.Vector.Internal.Check is unnecessary +#define NOT_VECTOR_MODULE +#include "vector.h" + +type role MVector nominal nominal + +-- | /O(1)/ Unsafely coerce a mutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- Note that this function is unsafe. The @Coercible@ constraint guarantees +-- that the element types are representationally equal. It however cannot +-- guarantee that their respective 'Prim' instances are compatible. +unsafeCoerceMVector :: Coercible a b => MVector s a -> MVector s b +unsafeCoerceMVector = unsafeCoerce + +-- | Mutable vectors of primitive types. +data MVector s a = MVector {-# UNPACK #-} !Int -- ^ offset + {-# UNPACK #-} !Int -- ^ length + {-# UNPACK #-} !(MutableByteArray s) -- ^ underlying mutable byte array + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _ _) = () + +#if MIN_VERSION_deepseq(1,4,3) +instance NFData1 (MVector s) where + liftRnf _ (MVector _ _ _) = () +#endif + +instance Prim a => G.MVector MVector a where + basicLength (MVector _ n _) = n + basicUnsafeSlice j m (MVector i _ arr) + = MVector (i+j) m arr + + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector i m arr1) (MVector j n arr2) + = sameMutableByteArray arr1 arr2 + && (between i j (j+n) || between j i (i+m)) + where + between x y z = x >= y && x < z + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + | n < 0 = error $ "Primitive.basicUnsafeNew: negative length: " ++ show n + | n > mx = error $ "Primitive.basicUnsafeNew: length too 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 _ arr) j = readByteArray arr (i+j) + + {-# INLINE basicUnsafeWrite #-} + 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) + where + sz = sizeOf (undefined :: a) + + {-# INLINE basicSet #-} + basicSet (MVector i n arr) x = setByteArray arr i n x + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Prim a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty. +null :: Prim a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Prim a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> MVector s a + -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +take :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +drop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +init :: Prim a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +tail :: Prim a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Prim a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeTake :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- | Same as 'init', but doesn't do range checks. +unsafeInit :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | Same as 'tail', but doesn't do range checks. +unsafeTail :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Prim a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The vector content +-- is uninitialized, which means it is filled with whatever the +-- underlying memory buffer happens to contain. +-- +-- @since 0.5 +unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Prim a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generate :: (PrimMonad m, Prim a) => Int -> (Int -> a) -> m (MVector (PrimState m) a) +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generateM :: (PrimMonad m, Prim a) => Int -> (Int -> m a) -> m (MVector (PrimState m) a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a primitive vector by the given number of elements. The number must be +-- non-negative. This has the same semantics as 'G.grow' for generic vectors. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> mv <- VP.thaw $ VP.fromList ([10, 20, 30] :: [Int]) +-- >>> mv' <- MVP.grow mv 2 +-- +-- Extra memory at the end of the newly allocated vector is initialized to 0 +-- bytes, which for 'Prim' instances will usually correspond to some default +-- value for a particular type, e.g. @0@ for @Int@, @\NUL@ for @Char@, +-- etc. However, if 'unsafeGrow' was used instead, this would not have been +-- guaranteed and some garbage would be there instead. +-- +-- >>> VP.freeze mv' +-- [10,20,30,0,0] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVP.write mv' 3 999 +-- >>> VP.freeze mv' +-- [10,20,30,999,0] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVP.write mv' 2 888 +-- >>> VP.freeze mv' +-- [10,20,888,999,0] +-- >>> VP.freeze mv +-- [10,20,30] +-- +-- @since 0.5 +grow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be non-negative, but +-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. +-- +-- @since 0.5 +unsafeGrow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is a noop. +clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> v <- MVP.generate 10 (\x -> x*x) +-- >>> MVP.read v 3 +-- 9 +read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Primitive.Mutable as MVP +-- >>> v <- MVP.generate 10 (\x -> x*x) +-- >>> MVP.readMaybe v 3 +-- Just 9 +-- >>> MVP.readMaybe v 13 +-- Nothing +readMaybe :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe = G.readMaybe + +-- | Replace the element at the given position. +write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.12.3.0 +modifyM :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM = G.modifyM + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + +-- | Replace the element at the given position and return the old element. +exchange :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange = G.exchange + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.12.3.0 +unsafeModifyM :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +unsafeModifyM = G.unsafeModifyM + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange = G.unsafeExchange + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +unsafeCopy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | 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 +-- to the target vector. +move :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move = G.move + +-- | 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 +-- to the target vector. +unsafeMove :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Modifying vectors +-- ----------------- + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: (PrimMonad m,Prim e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy = G.nextPermutationBy + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = G.prevPermutation + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: (PrimMonad m,Prim e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy = G.prevPermutationBy + +-- Folds +-- ----- + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.12.3.0 +mapM_ :: (PrimMonad m, Prim a) => (a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results. +-- +-- @since 0.12.3.0 +imapM_ :: (PrimMonad m, Prim a) => (Int -> a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.12.3.0 +forM_ :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.12.3.0 +iforM_ :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.12.3.0 +foldl :: (PrimMonad m, Prim a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldl' :: (PrimMonad m, Prim a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl :: (PrimMonad m, Prim a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl' :: (PrimMonad m, Prim a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.12.3.0 +foldr :: (PrimMonad m, Prim a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldr' :: (PrimMonad m, Prim a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr :: (PrimMonad m, Prim a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr' :: (PrimMonad m, Prim a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.12.3.0 +foldM :: (PrimMonad m, Prim a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldM' :: (PrimMonad m, Prim a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM :: (PrimMonad m, Prim a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM' :: (PrimMonad m, Prim a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.12.3.0 +foldrM :: (PrimMonad m, Prim a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM = G.foldrM + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldrM' :: (PrimMonad m, Prim a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' = G.foldrM' + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM :: (PrimMonad m, Prim a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM = G.ifoldrM + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM' :: (PrimMonad m, Prim a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' = G.ifoldrM' + +-- Unsafe conversions +-- ------------------ + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- This operation just changes the type of the vector and does not +-- modify the elements. +-- +-- This function will throw an error if elements are of mismatching sizes. +-- +-- | @since 0.13.0.0 +unsafeCast :: forall a b s. (HasCallStack, Prim a, Prim b) => MVector s a -> MVector s b +{-# INLINE unsafeCast #-} +unsafeCast (MVector o n ba) + | sizeOf (undefined :: a) == sizeOf (undefined :: b) = MVector o n ba + | otherwise = error "Element size mismatch" diff --git a/src/Data/Vector/Storable.hs b/src/Data/Vector/Storable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Storable.hs @@ -0,0 +1,2055 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Storable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- 'Storable'-based vectors. + +module Data.Vector.Storable ( + -- * Storable vectors + Vector, MVector(..), + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, partitionWith, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- ** Comparisons + eqBy, cmpBy, + + -- * Utilities + -- ** Comparisons + isSameVector, + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, unsafeCast, + unsafeCoerceVector, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith, + + -- * Re-exports + Storable +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Storable.Mutable ( MVector(..) ) +import Data.Vector.Storable.Internal +import qualified Data.Vector.Fusion.Bundle as Bundle + +import Foreign.Storable +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Marshal.Array ( advancePtr, copyArray ) + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude + ( Eq, Ord, Num, Enum, Monoid, Traversable, Monad, Read, Show, Bool, Ordering(..), Int, Maybe, Either, IO + , compare, mempty, mappend, mconcat, showsPrec, return, seq, undefined, div + , (*), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($) ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) +import Data.Coerce +import qualified GHC.Exts as Exts +import Unsafe.Coerce + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +type role Vector nominal + +-- | /O(1)/ Unsafely coerce a mutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- This is marginally safer than 'unsafeCast', since this function imposes an +-- extra 'Coercible' constraint. This function is still not safe, however, +-- since it cannot guarantee that the two types have memory-compatible +-- 'Storable' instances. +unsafeCoerceVector :: Coercible a b => Vector a -> Vector b +unsafeCoerceVector = unsafeCoerce + +-- | 'Storable'-based vectors. +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _) = () + +#if MIN_VERSION_deepseq(1,4,3) +-- | @since 0.12.1.0 +instance NFData1 Vector where + liftRnf _ (Vector _ _) = () +#endif + +instance (Show a, Storable a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Storable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Data a, Storable a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = G.mkVecConstr "Data.Vector.Storable.Vector" + gunfold = G.gunfold + dataTypeOf _ = G.mkVecType "Data.Vector.Storable.Vector" + dataCast1 = G.dataCast + + +type instance G.Mutable Vector = MVector + +instance Storable a => G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector n fp) = return $ Vector n fp + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector n fp) = return $ MVector n fp + + {-# INLINE basicLength #-} + basicLength (Vector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector _ fp) i = return + . unsafeInlineIO + $ unsafeWithForeignPtr fp $ \p -> + peekElemOff p i + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (Vector _ fq) + = unsafePrimToPrim + $ unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Storable a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = 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 = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Storable a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Storable a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (<>) + + {-# INLINE mconcat #-} + mconcat = concat + +instance Storable a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector. +length :: Storable a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty. +null :: Storable a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing. +(!) :: Storable a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing. +(!?) :: Storable a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element. +head :: Storable a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element. +last :: Storable a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking. +unsafeIndex :: Storable a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element, without checking if the vector is empty. +unsafeHead :: Storable a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element, without checking if the vector is empty. +unsafeLast :: Storable a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +indexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Storable a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Storable a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Storable a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements, in which case it is returned unchanged. +take :: Storable a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /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 :: Storable a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.7.1 +splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +uncons :: Storable a => Vector a -> Maybe (a, Vector a) +{-# INLINE uncons #-} +uncons = G.uncons + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +unsnoc :: Storable a => Vector a -> Maybe (Vector a, a) +{-# INLINE unsnoc #-} +unsnoc = G.unsnoc + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +unsafeSlice :: Storable a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty, but this is not checked. +unsafeInit :: Storable a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty, but this is not checked. +unsafeTail :: Storable a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +unsafeTake :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +unsafeDrop :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +empty :: Storable a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ A vector with exactly one element. +singleton :: Storable a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ A vector of the given length with the same value in each position. +replicate :: Storable a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +generate :: Storable a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- ===__Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.iterateN 0 undefined undefined :: VS.Vector Int +-- [] +-- >>> VS.iterateN 26 succ 'a' +-- "abcdefghijklmnopqrstuvwxyz" +-- +-- @since 0.7.1 +iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.12.2.0 +unfoldrExactN :: (Storable a) => Int -> (b -> (a, b)) -> b -> Vector a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = G.unfoldrExactN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Storable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Storable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: (Monad m, Storable a) => Int -> (b -> m (a, b)) -> b -> m (Vector a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM = G.unfoldrExactNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +constructN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Storable a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +enumFromStepN :: (Storable a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +cons :: Storable a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element. +snoc :: Storable a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors. +(++) :: Storable a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list. +concat :: Storable a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index. +generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.12.0.0 +iterateNM :: (Monad m, Storable a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Storable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Storable a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <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@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Storable a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//'), but without bounds checking. +unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_', but without bounds checking. +unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.accum (+) (VS.fromList [1000,2000,3000 :: Int]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +accum :: Storable a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Storable a, Storable b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum', but without bounds checking. +unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_', but without bounds checking. +unsafeAccumulate_ :: (Storable a, Storable b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +reverse :: Storable a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +backpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute', but without bounds checking. +unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> VS.modify (\v -> MVS.write v 0 'x') $ VS.replicate 4 'a' +-- "xaaa" +modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector. +map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index. +imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. +mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b) +{-# 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. +-- +-- @since 0.12.2.0 +imapM :: (Monad m, Storable a, Storable 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, Storable 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. +-- +-- @since 0.12.2.0 +imapM_ :: (Monad m, Storable 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. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.12.2.0 +iforM :: (Monad m, Storable a, Storable b) => Vector a -> (Int -> a -> m b) -> m (Vector b) +{-# INLINE iforM #-} +iforM = G.iforM + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.12.2.0 +iforM_ :: (Monad m, Storable a) => Vector a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Storable a, Storable b, Storable c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Storable a, Storable b, Storable c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- | Checks whether two values are the same vector: they have same length +-- and share the same buffer. +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> let xs = VS.fromList [0/0::Double] in VS.isSameVector xs xs +-- True +isSameVector :: (Storable a) => Vector a -> Vector a -> Bool +{-# INLINE isSameVector #-} +isSameVector (Vector n1 ptr1) (Vector n2 ptr2) = n1 == n2 && ptr1 == ptr2 + + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +zipWithM :: (Monad m, Storable a, Storable b, Storable c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# 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. +-- +-- @since 0.12.2.0 +izipWithM :: (Monad m, Storable a, Storable b, Storable 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, Storable a, Storable b) + => (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. +-- +-- @since 0.12.2.0 +izipWithM_ :: (Monad m, Storable a, Storable b) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +filter :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.uniq $ VS.fromList [1,3,3,200,3 :: Int] +-- [1,3,200,3] +uniq :: (Storable a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Map the values and collect the 'Just' results. +mapMaybe :: (Storable a, Storable b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +imapMaybe :: (Storable a, Storable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. +filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +mapMaybeM + :: (Monad m, Storable a, Storable b) + => (a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE mapMaybeM #-} +mapMaybeM = G.mapMaybeM + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +imapMaybeM + :: (Monad m, Storable a, Storable b) + => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE imapMaybeM #-} +imapMaybeM = G.imapMaybeM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.12.1.0 +partitionWith :: (Storable a, Storable b, Storable c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) +{-# INLINE partitionWith #-} +partitionWith = G.partitionWith + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +unstablePartition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.span (<4) $ VS.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.break (>4) $ VS.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.spanR (>4) $ VS.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +spanR :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE spanR #-} +spanR = G.spanR + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since NEXT_VERSION +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.breakR (<5) $ VS.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +breakR :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE breakR #-} +breakR = G.breakR + +-- | /O(n)/ Split a vector into a list of slices, using a predicate function. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- Does not fuse. +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> import Data.Char (isUpper) +-- >>> VS.groupBy (\a b -> isUpper a == isUpper b) (VS.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy', 'group'. +-- +-- @since 0.13.0.1 +groupBy :: Storable a => (a -> a -> Bool) -> Vector a -> [Vector a] +{-# INLINE groupBy #-} +groupBy = G.groupBy + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- Does not fuse. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.group (VS.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.0.1 +group :: (Storable a, Eq a) => Vector a -> [Vector a] +{-# INLINE group #-} +group = G.groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +elem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). +notElem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Storable a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +findIndexR :: Storable a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR = G.findIndexR + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors. +foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator. +foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. +foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold. +foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors. +foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator. +foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. +foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold using a function applied to each element and its index. +ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator using a function applied to each element +-- and its index. +ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold using a function applied to each element and its index. +ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator using a function applied to each +-- element and its index. +ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type class. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.12.2.0 +foldMap :: (Monoid m, Storable a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap #-} +foldMap = G.foldMap + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.12.2.0 +foldMap' :: (Monoid m, Storable a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap' #-} +foldMap' = G.foldMap' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.all even $ VS.fromList [2, 4, 12 :: Int] +-- True +-- >>> VS.all even $ VS.fromList [2, 4, 13 :: Int] +-- False +-- >>> VS.all even (VS.empty :: VS.Vector Int) +-- True +all :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.any even $ VS.fromList [1, 3, 7 :: Int] +-- False +-- >>> VS.any even $ VS.fromList [3, 2, 13 :: Int] +-- True +-- >>> VS.any even (VS.empty :: VS.Vector Int) +-- False +any :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.and $ VS.fromList [True, False] +-- False +-- >>> VS.and VS.empty +-- True +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.or $ VS.fromList [True, False] +-- True +-- >>> VS.or VS.empty +-- False +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.sum $ VS.fromList [300,20,1 :: Int] +-- 321 +-- >>> VS.sum (VS.empty :: VS.Vector Int) +-- 0 +sum :: (Storable a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.product $ VS.fromList [1,2,3,4 :: Int] +-- 24 +-- >>> VS.product (VS.empty :: VS.Vector Int) +-- 1 +product :: (Storable a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.maximum $ VS.fromList [2, 1 :: Int] +-- 2 +maximum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- @since 0.13.0.0 +maximumOn :: (Ord b, Storable a) => (a -> b) -> Vector a -> a +{-# INLINE maximumOn #-} +maximumOn = G.maximumOn + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.minimum $ VS.fromList [2, 1 :: Int] +-- 1 +minimum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. +minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- @since 0.13.0.0 +minimumOn :: (Ord b, Storable a) => (a -> b) -> Vector a -> a +{-# INLINE minimumOn #-} +minimumOn = G.minimumOn + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.2.0 +ifoldM :: (Monad m, Storable 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, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator. +foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each +-- element and its index. +-- +-- @since 0.12.2.0 +ifoldM' :: (Monad m, Storable 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, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result. +foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result using a function applied to +-- each element and its index. +-- +-- @since 0.12.2.0 +ifoldM_ :: (Monad m, Storable 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, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result. +foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function applied to each element and its index. +-- +-- @since 0.12.2.0 +ifoldM'_ :: (Monad m, Storable 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, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.prescanl (+) 0 (VS.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6] +prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Left-to-right prescan with strict accumulator. +prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.postscanl (+) 0 (VS.fromList [1,2,3,4 :: Int]) +-- [1,3,6,10] +postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Left-to-right postscan with strict accumulator. +postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.scanl (+) 0 (VS.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6,10] +scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Left-to-right scan with strict accumulator. +scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Left-to-right scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanl :: (Storable a, Storable b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +-- +-- @since 0.12.2.0 +iscanl' :: (Storable a, Storable b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.scanl1 min $ VS.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VS.scanl1 max $ VS.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VS.scanl1 min (VS.empty :: VS.Vector Int) +-- [] +scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.scanl1' min $ VS.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VS.scanl1' max $ VS.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VS.scanl1' min (VS.empty :: VS.Vector Int) +-- [] +scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +prescanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator. +prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left postscan. +postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left postscan with strict accumulator. +postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left scan. +scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left scan with strict accumulator. +scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanr :: (Storable a, Storable b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +-- +-- @since 0.12.2.0 +iscanr' :: (Storable a, Storable b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.scanr1 min $ VS.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VS.scanr1 max $ VS.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VS.scanr1 min (VS.empty :: VS.Vector Int) +-- [] +scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.scanr1' min $ VS.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VS.scanr1' max $ VS.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VS.scanr1' min (VS.empty :: VS.Vector Int) +-- [] +scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Comparisons +-- ------------------------ + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +-- +-- @since 0.12.2.0 +eqBy :: (Storable a, Storable b) => (a -> b -> Bool) -> Vector a -> Vector b -> Bool +{-# INLINE eqBy #-} +eqBy = G.eqBy + +-- | /O(n)/ Compare two vectors using supplied the comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == compare +-- +-- @since 0.12.2.0 +cmpBy :: (Storable a, Storable b) => (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering +cmpBy = G.cmpBy + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +toList :: Storable a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.4 +fromList :: Storable a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> VS.fromListN 3 [1,2,3,4,5 :: Int] +-- [1,2,3] +-- >>> VS.fromListN 3 [1 :: Int] +-- [1] +fromListN :: Storable a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Unsafe casts +-- -------------------------- + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- This operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b +{-# INLINE unsafeCast #-} +unsafeCast (Vector n fp) + = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +unsafeThaw + :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (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 () +{-# INLINE copy #-} +copy = G.copy + +-- Conversions - Raw pointers +-- -------------------------- + +-- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length. +-- +-- The data may not be modified through the pointer afterwards. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> Vector a +{-# 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 #-} + + +-- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use 'unsafeFromForeignPtr' if you need to specify an offset. +-- +-- The data may not be modified through the pointer afterwards. +unsafeFromForeignPtr0 :: ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> Vector a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = Vector n fp + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the +-- data and its length. The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr :: Vector a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (Vector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume that the pointer points directly to the data (no offset). +-- +-- The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr0 :: Vector a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (Vector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. The data may not be +-- modified through the 'Ptr. +unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (Vector _ fp) = withForeignPtr fp + +-- $setup +-- >>> import Prelude (Bool(..), Double, ($), (+), (/), succ, even, min, max, id, Ord(..)) diff --git a/src/Data/Vector/Storable/Internal.hs b/src/Data/Vector/Storable/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Storable/Internal.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK hide #-} +-- | +-- Module : Data.Vector.Storable.Internal +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Ugly internal utility functions for implementing 'Storable'-based vectors. + +module Data.Vector.Storable.Internal ( + getPtr, setPtr, updPtr, unsafeWithForeignPtr +) where + +import Foreign.ForeignPtr () +import Foreign.Ptr () +import GHC.ForeignPtr ( ForeignPtr(..) ) +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr ( unsafeWithForeignPtr ) +#else +import Foreign.ForeignPtr ( withForeignPtr ) +#endif +import GHC.Ptr ( Ptr(..) ) + +getPtr :: ForeignPtr a -> Ptr a +{-# INLINE getPtr #-} +getPtr (ForeignPtr addr _) = Ptr addr + +setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a +{-# INLINE setPtr #-} +setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c + +updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a +{-# INLINE updPtr #-} +updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } + +#if !MIN_VERSION_base(4,15,0) +-- | A compatibility wrapper for 'GHC.ForeignPtr.unsafeWithForeignPtr' provided +-- by GHC 9.0.1 and later. +-- +-- Only to be used when the continuation is known not to +-- unconditionally diverge lest unsoundness can result. +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif diff --git a/src/Data/Vector/Storable/Mutable.hs b/src/Data/Vector/Storable/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Storable/Mutable.hs @@ -0,0 +1,906 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Storable.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable vectors based on Storable. + +module Data.Vector.Storable.Mutable( + -- * Mutable vectors of 'Storable' types + MVector(..), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Unsafe conversions + unsafeCast, + unsafeCoerceMVector, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith, + -- * Re-exports + Storable, PrimMonad, PrimState, RealWorld +) where + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Storable.Internal + +import Foreign.Storable +import Foreign.ForeignPtr + +import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) +import GHC.Base ( Int(..) ) + +import Foreign.Ptr (castPtr,plusPtr) +import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) + +import Control.Monad.Primitive +import Data.Primitive.Types (Prim) +import qualified Data.Primitive.Types as DPT + +import GHC.Word (Word8, Word16, Word32, Word64) +import GHC.Ptr (Ptr(..)) + +import Prelude + ( Ord, Bool, Maybe, IO, Ordering(..) + , return, otherwise, error, undefined, max, div, quot, maxBound, show + , (-), (*), (<), (>), (>=), (==), (&&), (||), (.), ($), (++) ) + +import Data.Typeable ( Typeable ) + +import Data.Coerce +import Unsafe.Coerce + +-- Data.Vector.Internal.Check is not needed +#define NOT_VECTOR_MODULE +#include "vector.h" + +type role MVector nominal nominal + +-- | /O(1)/ Unsafely coerce a mutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- This is marginally safer than 'unsafeCast', since this function imposes an +-- extra 'Coercible' constraint. This function is still not safe, however, +-- since it cannot guarantee that the two types have memory-compatible +-- 'Storable' instances. +unsafeCoerceMVector :: Coercible a b => MVector s a -> MVector s b +unsafeCoerceMVector = unsafeCoerce + +-- | Mutable 'Storable'-based vectors. +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _) = () + +#if MIN_VERSION_deepseq(1,4,3) +instance NFData1 (MVector s) where + liftRnf _ (MVector _ _) = () +#endif + +instance Storable a => G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector _ fp) = MVector m (updPtr (`advancePtr` j) fp) + + -- FIXME: this relies on non-portable pointer comparisons + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector m fp) (MVector n fq) + = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) + where + between x y z = x >= y && x < z + p = getPtr fp + q = getPtr fq + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + | 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) `max` 1 + mx = maxBound `quot` size :: Int + + {-# INLINE basicInitialize #-} + basicInitialize = storableZero + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector _ fp) i + = unsafePrimToPrim + $ unsafeWithForeignPtr fp (`peekElemOff` i) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector _ fp) i x + = unsafePrimToPrim + $ unsafeWithForeignPtr fp $ \p -> pokeElemOff p i x + + {-# INLINE basicSet #-} + basicSet = storableSet + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr 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 . unsafeWithForeignPtr fp $ \ptr-> do + memsetPrimPtr_vector (castPtr ptr) 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 (MVector n fp) x + | n == 0 = return () + | otherwise = unsafePrimToPrim $ + case sizeOf x of + 1 -> storableSetAsPrim n fp x (undefined :: Word8) + 2 -> storableSetAsPrim n fp x (undefined :: Word16) + 4 -> storableSetAsPrim n fp x (undefined :: Word32) +#if !defined(ghcjs_HOST_OS) + 8 -> storableSetAsPrim n fp x (undefined :: Word64) +#endif + _ -> unsafeWithForeignPtr fp $ \p -> do + poke p x + + let do_set i + | 2*i < n = do + copyArray (p `advancePtr` i) p i + do_set (2*i) + | otherwise = copyArray (p `advancePtr` i) p (n-i) + + do_set 1 + +storableSetAsPrim + :: forall a b . (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () +{-# INLINE [0] storableSetAsPrim #-} +storableSetAsPrim n fp x _y = unsafeWithForeignPtr fp $ \ ptr -> do + poke ptr x + -- we don't equate storable and prim reps, so we need to write to a slot + -- in storable + -- then read it back as a prim + w<- peakPrimPtr_vector (castPtr ptr :: Ptr b) 0 + memsetPrimPtr_vector (castPtr ptr `plusPtr` sizeOf x ) (n-1) w + + + +{- +AFTER primitive 0.7 is pretty old, move to using setPtr. which is really +a confusing misnomer for what's often called memset (initialize) +-} +-- Fill a memory block with the given value. The length is in +-- elements of type @a@ rather than in bytes. +memsetPrimPtr_vector :: forall a c m. (Prim c, PrimMonad m) => Ptr a -> Int -> c -> m () +memsetPrimPtr_vector (Ptr addr#) (I# n#) x = primitive_ (DPT.setOffAddr# addr# 0# n# x) +{-# INLINE memsetPrimPtr_vector #-} + + +-- Read a value from a memory position given by an address and an offset. +-- The offset is in elements of type @a@ rather than in bytes. +peakPrimPtr_vector :: (Prim a, PrimMonad m) => Ptr a -> Int -> m a +peakPrimPtr_vector (Ptr addr#) (I# i#) = primitive (DPT.readOffAddr# addr# i#) +{-# INLINE peakPrimPtr_vector #-} + +{-# INLINE mallocVector #-} +mallocVector :: Storable a => Int -> IO (ForeignPtr a) +mallocVector = + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = + mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy) + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Storable a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty. +null :: Storable a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Storable a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> MVector s a + -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +take :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +drop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +init :: Storable a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +tail :: Storable a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Storable a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeTake :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- | Same as 'init', but doesn't do range checks. +unsafeInit :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | Same as 'tail', but doesn't do range checks. +unsafeTail :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Storable a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The vector content +-- is uninitialized, which means it is filled with whatever the +-- underlying memory buffer happens to contain. +-- +-- @since 0.5 +unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generate :: (PrimMonad m, Storable a) => Int -> (Int -> a) -> m (MVector (PrimState m) a) +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generateM :: (PrimMonad m, Storable a) => Int -> (Int -> m a) -> m (MVector (PrimState m) a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a storable vector by the given number of elements. The number must be +-- non-negative. This has the same semantics as 'G.grow' for generic vectors. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable as VS +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> mv <- VS.thaw $ VS.fromList ([10, 20, 30] :: [Int]) +-- >>> mv' <- MVS.grow mv 2 +-- +-- Extra memory at the end of the newly allocated vector is initialized to 0 +-- bytes, which for 'Storable' instances will usually correspond to some default +-- value for a particular type, e.g. @0@ for @Int@, @False@ for @Bool@, +-- etc. However, if 'unsafeGrow' was used instead, this would not have been +-- guaranteed and some garbage would be there instead. +-- +-- >>> VS.freeze mv' +-- [10,20,30,0,0] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVS.write mv' 3 999 +-- >>> VS.freeze mv' +-- [10,20,30,999,0] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVS.write mv' 2 888 +-- >>> VS.freeze mv' +-- [10,20,888,999,0] +-- >>> VS.freeze mv +-- [10,20,30] +-- +-- @since 0.5 +grow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be non-negative, but +-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. +-- +-- @since 0.5 +unsafeGrow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is a noop. +clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> v <- MVS.generate 10 (\x -> x*x) +-- >>> MVS.read v 3 +-- 9 +read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Storable.Mutable as MVS +-- >>> v <- MVS.generate 10 (\x -> x*x) +-- >>> MVS.readMaybe v 3 +-- Just 9 +-- >>> MVS.readMaybe v 13 +-- Nothing +readMaybe :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe = G.readMaybe + +-- | Replace the element at the given position. +write + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.12.3.0 +modifyM :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM = G.modifyM + +-- | Swap the elements at the given positions. +swap + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + +-- | Replace the element at the given position and return the old element. +exchange :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange = G.exchange + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.12.3.0 +unsafeModifyM :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +unsafeModifyM = G.unsafeModifyM + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange = G.unsafeExchange + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +unsafeCopy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | 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 +-- to the target vector. +move :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move = G.move + +-- | 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 +-- to the target vector. +unsafeMove :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Modifying vectors +-- ----------------- + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +nextPermutation :: (PrimMonad m, Storable e, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: (PrimMonad m, Storable e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy = G.nextPermutationBy + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m, Storable e, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = G.prevPermutation + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: (PrimMonad m, Storable e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy = G.prevPermutationBy + +-- Folds +-- ----- + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.12.3.0 +mapM_ :: (PrimMonad m, Storable a) => (a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results. +-- +-- @since 0.12.3.0 +imapM_ :: (PrimMonad m, Storable a) => (Int -> a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.12.3.0 +forM_ :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.12.3.0 +iforM_ :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.12.3.0 +foldl :: (PrimMonad m, Storable a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldl' :: (PrimMonad m, Storable a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl :: (PrimMonad m, Storable a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl' :: (PrimMonad m, Storable a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.12.3.0 +foldr :: (PrimMonad m, Storable a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldr' :: (PrimMonad m, Storable a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr :: (PrimMonad m, Storable a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr' :: (PrimMonad m, Storable a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.12.3.0 +foldM :: (PrimMonad m, Storable a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldM' :: (PrimMonad m, Storable a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM :: (PrimMonad m, Storable a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM' :: (PrimMonad m, Storable a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.12.3.0 +foldrM :: (PrimMonad m, Storable a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM = G.foldrM + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldrM' :: (PrimMonad m, Storable a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' = G.foldrM' + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM :: (PrimMonad m, Storable a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM = G.ifoldrM + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM' :: (PrimMonad m, Storable a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' = G.ifoldrM' + +-- Unsafe conversions +-- ------------------ + +-- | /O(1)/ Unsafely cast a mutable vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +unsafeCast :: forall a b s. + (Storable a, Storable b) => MVector s a -> MVector s b +{-# INLINE unsafeCast #-} +unsafeCast (MVector n fp) + = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + +-- Raw pointers +-- ------------ + +-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' with an offset and a length. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +-- +-- If your offset is 0, it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> MVector s a +{-# 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 #-} + + +-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. +-- +-- It is assumed that the pointer points directly to the data (no offset). +-- Use 'unsafeFromForeignPtr' if you need to specify an offset. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +unsafeFromForeignPtr0 :: ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> MVector s a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = MVector n fp + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the data +-- and its length. Modifying the data through the 'ForeignPtr' is +-- unsafe if the vector could have been frozen before the modification. +unsafeToForeignPtr :: MVector s a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (MVector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume that the pointer points directly to the data (no offset). +-- +-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could +-- have been frozen before the modification. +unsafeToForeignPtr0 :: MVector s a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (MVector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. Modifying data +-- through the pointer is unsafe if the vector could have been frozen before +-- the modification. +unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (MVector _ fp) = withForeignPtr fp diff --git a/src/Data/Vector/Strict.hs b/src/Data/Vector/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Strict.hs @@ -0,0 +1,2611 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- | +-- Module : Data.Vector.Strict +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Immutable strict boxed vectors (that is, polymorphic arrays capable +-- of holding any Haskell value). Vectors created using API for +-- immutable vector will have all elements evaluated to WHNF. Note +-- it's possible to create vector containing bottoms using mutable API +-- ('Data.Vector.Strict.Mutable.new' initialize vector with ⊥) fill +-- but all subsequent writes will be evauated to WHNF. +-- +-- For unboxed arrays, use "Data.Vector.Unboxed". +module Data.Vector.Strict ( + -- * Boxed vectors + Vector, MVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + catMaybes, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, partitionWith, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M',foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- ** Comparisons + eqBy, cmpBy, + + -- * Conversions + + -- ** Lists + toList, Data.Vector.Strict.fromList, Data.Vector.Strict.fromListN, + -- ** Lazy vectors + toLazy, fromLazy, + -- ** Arrays + toArray, fromArray, toArraySlice, unsafeFromArraySlice, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import Data.Coerce +import Data.Vector.Strict.Mutable ( MVector(..) ) +import Data.Primitive.Array +import qualified Data.Vector.Fusion.Bundle as Bundle +import qualified Data.Vector.Generic as G +import qualified Data.Vector as V + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + ) + +import Control.Monad ( MonadPlus(..), ap ) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad (fail) +#endif +import Control.Monad.ST ( ST, runST ) +import Control.Monad.Primitive +import qualified Control.Monad.Fail as Fail +import Control.Monad.Fix ( MonadFix (mfix) ) +import Control.Monad.Zip +import Data.Function ( fix ) + +import Prelude + ( Eq(..), Ord(..), Num, Enum, Monoid, Functor, Monad, Show, Bool, Ordering(..), Int, Maybe, Either + , return, showsPrec, fmap, otherwise, id, flip, const + , (>>=), (+), (-), (.), ($), seq) + +import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +import qualified Control.Applicative as Applicative +import qualified Data.Foldable as Foldable +import qualified Data.Traversable as Traversable + +import qualified GHC.Exts as Exts (IsList(..)) + + +-- | Strict boxed vectors, supporting efficient slicing. +newtype Vector a = Vector (V.Vector a) + deriving (Typeable, Foldable.Foldable, Semigroup, Monoid) + +-- NOTE: [GND for strict vector] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Strict boxed vectors (both mutable an immutable) are newtypes over +-- lazy ones. This makes it possible to use GND to derive instances. +-- However one must take care to preserve strictness since Vector +-- instance for lazy vectors would be used. +-- +-- In general it's OK to derive instances where vectors are passed as +-- parameters (e.g. Eq, Ord) and not OK to derive ones where new +-- vector is created (e.g. Read, Functor) + +liftRnfV :: (a -> ()) -> Vector a -> () +liftRnfV elemRnf = foldl' (\_ -> elemRnf) () + +instance NFData a => NFData (Vector a) where + rnf = liftRnfV rnf + {-# INLINEABLE rnf #-} + +#if MIN_VERSION_deepseq(1,4,3) +-- | @since 0.13.2.0 +instance NFData1 Vector where + liftRnf = liftRnfV + {-# INLINEABLE liftRnf #-} +#endif + +instance Show a => Show (Vector a) where + showsPrec = G.showsPrec + +instance Read a => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance Show1 Vector where + liftShowsPrec = G.liftShowsPrec + +instance Read1 Vector where + liftReadsPrec = G.liftReadsPrec + +instance Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = Data.Vector.Strict.fromList + fromListN = Data.Vector.Strict.fromListN + toList = toList + +instance Data a => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = G.mkVecConstr "Data.Vector.Strict.Vector" + gunfold = G.gunfold + dataTypeOf _ = G.mkVecType "Data.Vector.Strict.Vector" + dataCast1 = G.dataCast + +type instance G.Mutable Vector = MVector + +instance G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze = coerce (G.basicUnsafeFreeze @V.Vector @a) + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw = coerce (G.basicUnsafeThaw @V.Vector @a) + {-# INLINE basicLength #-} + basicLength = coerce (G.basicLength @V.Vector @a) + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice = coerce (G.basicUnsafeSlice @V.Vector @a) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM = coerce (G.basicUnsafeIndexM @V.Vector @a) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy = coerce (G.basicUnsafeCopy @V.Vector @a) + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See NOTE: [GND for strict vector] +-- +-- Deriving strategies are only available since 8.2. So we can't use +-- deriving newtype until we drop support for 8.0 +instance Eq a => Eq (Vector a) where + {-# INLINE (==) #-} + (==) = coerce ((==) @(V.Vector a)) + +-- See NOTE: [GND for strict vector] +instance Ord a => Ord (Vector a) where + {-# INLINE compare #-} + compare = coerce (compare @(V.Vector a)) + {-# INLINE (<) #-} + (<) = coerce ((<) @(V.Vector a)) + {-# INLINE (<=) #-} + (<=) = coerce ((<=) @(V.Vector a)) + {-# INLINE (>) #-} + (>) = coerce ((>) @(V.Vector a)) + {-# INLINE (>=) #-} + (>=) = coerce ((>=) @(V.Vector a)) + +instance Eq1 Vector where + liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) + +instance Ord1 Vector where + liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys) + +instance Functor Vector where + {-# INLINE fmap #-} + fmap = map + + {-# INLINE (<$) #-} + (<$) = map . const + +instance Monad Vector where + {-# INLINE return #-} + return = Applicative.pure + + {-# INLINE (>>=) #-} + (>>=) = flip concatMap + +#if !(MIN_VERSION_base(4,13,0)) + {-# INLINE fail #-} + fail = Fail.fail -- == \ _str -> empty +#endif + +-- | @since 0.13.2.0 +instance Fail.MonadFail Vector where + {-# INLINE fail #-} + fail _ = empty + +instance MonadPlus Vector where + {-# INLINE mzero #-} + mzero = empty + + {-# INLINE mplus #-} + mplus = (++) + +instance MonadZip Vector where + {-# INLINE mzip #-} + mzip = zip + + {-# INLINE mzipWith #-} + mzipWith = zipWith + + {-# INLINE munzip #-} + munzip = unzip + +-- | This instance has the same semantics as the one for lists. +-- +-- @since 0.13.2.0 +instance MonadFix Vector where + -- We take care to dispose of v0 as soon as possible (see headM docs). + -- + -- It's perfectly safe to use non-monadic indexing within generate + -- call since intermediate vector won't be created until result's + -- value is demanded. + {-# INLINE mfix #-} + mfix f + | null v0 = empty + -- We take first element of resulting vector from v0 and create + -- rest using generate. Note that cons should fuse with generate + | otherwise = runST $ do + h <- headM v0 + return $ cons h $ + generate (lv0 - 1) $ + \i -> fix (\a -> f a ! (i + 1)) + where + -- Used to calculate size of resulting vector + v0 = fix (f . head) + !lv0 = length v0 + +instance Applicative.Applicative Vector where + {-# INLINE pure #-} + pure = singleton + + {-# INLINE (<*>) #-} + (<*>) = ap + +instance Applicative.Alternative Vector where + {-# INLINE empty #-} + empty = empty + + {-# INLINE (<|>) #-} + (<|>) = (++) + +instance Traversable.Traversable Vector where + {-# INLINE traverse #-} + traverse f xs = + -- Get the length of the vector in /O(1)/ time + let !n = G.length xs + -- Use fromListN to be more efficient in construction of resulting vector + -- Also behaves better with compact regions, preventing runtime exceptions + in Data.Vector.Strict.fromListN n Applicative.<$> Traversable.traverse f (toList xs) + + {-# INLINE mapM #-} + mapM = mapM + + {-# INLINE sequence #-} + sequence = sequence + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector. +-- +-- @since 0.13.2.0 +length :: Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty. +-- +-- @since 0.13.2.0 +null :: Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing. +-- +-- @since 0.13.2.0 +(!) :: Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing. +-- +-- @since 0.13.2.0 +(!?) :: Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element. +-- +-- @since 0.13.2.0 +head :: Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element. +-- +-- @since 0.13.2.0 +last :: Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking. +-- +-- @since 0.13.2.0 +unsafeIndex :: Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element, without checking if the vector is empty. +-- +-- @since 0.13.2.0 +unsafeHead :: Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element, without checking if the vector is empty. +-- +-- @since 0.13.2.0 +unsafeLast :: Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +-- +-- @since 0.13.2.0 +indexM :: Monad m => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +-- +-- @since 0.13.2.0 +headM :: Monad m => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +-- +-- @since 0.13.2.0 +lastM :: Monad m => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +-- +-- @since 0.13.2.0 +unsafeIndexM :: Monad m => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +-- +-- @since 0.13.2.0 +unsafeHeadM :: Monad m => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +-- +-- @since 0.13.2.0 +unsafeLastM :: Monad m => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +-- +-- @since 0.13.2.0 +slice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +-- +-- @since 0.13.2.0 +init :: Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +-- +-- @since 0.13.2.0 +tail :: Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements, in which case it is returned unchanged. +-- +-- @since 0.13.2.0 +take :: Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /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. +-- +-- @since 0.13.2.0 +drop :: Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.13.2.0 +splitAt :: Int -> Vector a -> (Vector a, Vector a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.13.2.0 +uncons :: Vector a -> Maybe (a, Vector a) +{-# INLINE uncons #-} +uncons = G.uncons + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.13.2.0 +unsnoc :: Vector a -> Maybe (Vector a, a) +{-# INLINE unsnoc #-} +unsnoc = G.unsnoc + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeSlice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeInit :: Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeTail :: Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeTake :: Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeDrop :: Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +-- +-- @since 0.13.2.0 +empty :: Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ A vector with exactly one element. +-- +-- @since 0.13.2.0 +singleton :: a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ A vector of the given length with the same value in each position. +-- +-- @since 0.13.2.0 +replicate :: Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +-- +-- @since 0.13.2.0 +generate :: Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- ===__Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.iterateN 0 undefined undefined :: V.Vector String +-- [] +-- >>> V.iterateN 4 (\x -> x <> x) "Hi" +-- ["Hi","HiHi","HiHiHiHi","HiHiHiHiHiHiHiHi"] +-- +-- @since 0.13.2.0 +iterateN :: Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +-- +-- @since 0.13.2.0 +unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.13.2.0 +unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.13.2.0 +unfoldrExactN :: Int -> (b -> (a, b)) -> b -> Vector a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = G.unfoldrExactN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +-- +-- @since 0.13.2.0 +unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +-- +-- @since 0.13.2.0 +unfoldrNM :: (Monad m) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.13.2.0 +unfoldrExactNM :: (Monad m) => Int -> (b -> m (a, b)) -> b -> m (Vector a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM = G.unfoldrExactNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +-- +-- @since 0.13.2.0 +constructN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +-- +-- @since 0.13.2.0 +constructrN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +-- +-- @since 0.13.2.0 +enumFromN :: Num a => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +-- +-- @since 0.13.2.0 +enumFromStepN :: Num a => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +-- +-- @since 0.13.2.0 +enumFromTo :: Enum a => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +-- +-- @since 0.13.2.0 +enumFromThenTo :: Enum a => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +-- +-- @since 0.13.2.0 +cons :: a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element. +-- +-- @since 0.13.2.0 +snoc :: Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors. +-- +-- @since 0.13.2.0 +(++) :: Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list. +-- +-- @since 0.13.2.0 +concat :: [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +-- +-- @since 0.13.2.0 +replicateM :: Monad m => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index. +-- +-- @since 0.13.2.0 +generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.13.2.0 +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +-- +-- @since 0.13.2.0 +create :: (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +-- +-- @since 0.13.2.0 +createT :: Traversable.Traversable f => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + + + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +-- +-- @since 0.13.2.0 +force :: Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +-- @since 0.13.2.0 +(//) :: Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +-- @since 0.13.2.0 +update :: Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +-- +-- @since 0.13.2.0 +update_ :: Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//'), but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeUpd :: Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.accum (+) (V.fromList [1000,2000,3000]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +-- +-- @since 0.13.2.0 +accum :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /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@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.accumulate (+) (V.fromList [1000,2000,3000]) (V.fromList [(2,4),(1,6),(0,3),(1,10)]) +-- [1003,2016,3004] +-- +-- @since 0.13.2.0 +accumulate :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +-- +-- @since 0.13.2.0 +accumulate_ :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeAccumulate_ + :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +-- +-- @since 0.13.2.0 +reverse :: Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +-- +-- @since 0.13.2.0 +backpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute', but without bounds checking. +-- +-- @since 0.13.2.0 +unsafeBackpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> V.modify (\v -> MV.write v 0 'x') $ V.replicate 4 'a' +-- "xaaa" +-- +-- @since 0.13.2.0 +modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index. +-- +-- @since 0.13.2.0 +indexed :: Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector. +-- +-- @since 0.13.2.0 +map :: (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index. +-- +-- @since 0.13.2.0 +imap :: (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +-- +-- @since 0.13.2.0 +concatMap :: (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since 0.13.2.0 +mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) +{-# 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. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +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. Equivalent to @flip 'mapM'@. +-- +-- @since 0.13.2.0 +forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +-- +-- @since 0.13.2.0 +forM_ :: Monad m => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.13.2.0 +iforM :: Monad m => Vector a -> (Int -> a -> m b) -> m (Vector b) +{-# INLINE iforM #-} +iforM = G.iforM + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.13.2.0 +iforM_ :: Monad m => Vector a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +-- +-- @since 0.13.2.0 +zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +-- +-- @since 0.13.2.0 +zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +-- +-- @since 0.13.2.0 +izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +-- +-- @since 0.13.2.0 +izipWith3 :: (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- | /O(min(m,n))/ Zip two vectors. +-- +-- @since 0.13.2.0 +zip :: Vector a -> Vector b -> Vector (a, b) +{-# INLINE zip #-} +zip = G.zip + +-- | Zip together three vectors into a vector of triples. +-- +-- @since 0.13.2.0 +zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) +{-# INLINE zip3 #-} +zip3 = G.zip3 + +zip4 :: Vector a -> Vector b -> Vector c -> Vector d + -> Vector (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = G.zip4 + +zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = G.zip5 + +zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f + -> Vector (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = G.zip6 + +-- Unzipping +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +-- +-- @since 0.13.2.0 +unzip :: Vector (a, b) -> (Vector a, Vector b) +{-# INLINE unzip #-} +unzip = G.unzip + +unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) +{-# INLINE unzip3 #-} +unzip3 = G.unzip3 + +unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) +{-# INLINE unzip4 #-} +unzip4 = G.unzip4 + +unzip5 :: Vector (a, b, c, d, e) + -> (Vector a, Vector b, Vector c, Vector d, Vector e) +{-# INLINE unzip5 #-} +unzip5 = G.unzip5 + +unzip6 :: Vector (a, b, c, d, e, f) + -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) +{-# INLINE unzip6 #-} +unzip6 = G.unzip6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +-- +-- @since 0.13.2.0 +zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# 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. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +izipWithM_ :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +-- +-- @since 0.13.2.0 +filter :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +-- +-- @since 0.13.2.0 +ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.uniq $ V.fromList [1,3,3,200,3] +-- [1,3,200,3] +-- >>> import Data.Semigroup +-- >>> V.uniq $ V.fromList [ Arg 1 'a', Arg 1 'b', Arg 1 'c'] +-- [Arg 1 'a'] +-- +-- @since 0.13.2.0 +uniq :: (Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Map the values and collect the 'Just' results. +-- +-- @since 0.13.2.0 +mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +-- +-- @since 0.13.2.0 +imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Return a Vector of all the 'Just' values. +-- +-- @since 0.13.2.0 +catMaybes :: Vector (Maybe a) -> Vector a +{-# INLINE catMaybes #-} +catMaybes = mapMaybe id + +-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. +-- +-- @since 0.13.2.0 +filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.13.2.0 +mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE mapMaybeM #-} +mapMaybeM = G.mapMaybeM + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.13.2.0 +imapMaybeM :: Monad m => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE imapMaybeM #-} +imapMaybeM = G.imapMaybeM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +-- +-- @since 0.13.2.0 +takeWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +-- +-- @since 0.13.2.0 +dropWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +-- +-- @since 0.13.2.0 +partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.13.2.0 +partitionWith :: (a -> Either b c) -> Vector a -> (Vector b, Vector c) +{-# INLINE partitionWith #-} +partitionWith = G.partitionWith + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +-- +-- @since 0.13.2.0 +unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.span (<4) $ V.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +-- +-- @since 0.13.2.0 +span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.break (>4) $ V.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +-- +-- @since 0.13.2.0 +break :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.spanR (>4) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +-- +-- @since 0.13.2.0 +spanR :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE spanR #-} +spanR = G.spanR + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since 0.13.2.0 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.breakR (<5) $ V.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +-- +-- @since 0.13.2.0 +breakR :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE breakR #-} +breakR = G.breakR + +-- | /O(n)/ Split a vector into a list of slices, using a predicate function. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- Does not fuse. +-- +-- >>> import qualified Data.Vector as V +-- >>> import Data.Char (isUpper) +-- >>> V.groupBy (\a b -> isUpper a == isUpper b) (V.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy', 'group'. +-- +-- @since 0.13.2.0 +groupBy :: (a -> a -> Bool) -> Vector a -> [Vector a] +{-# INLINE groupBy #-} +groupBy = G.groupBy + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- Does not fuse. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector as V +-- >>> V.group (V.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.2.0 +group :: Eq a => Vector a -> [Vector a] +{-# INLINE group #-} +group = G.groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +-- +-- @since 0.13.2.0 +elem :: Eq a => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). +-- +-- @since 0.13.2.0 +notElem :: Eq a => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +-- +-- @since 0.13.2.0 +find :: (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- @since 0.13.2.0 +findIndex :: (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +-- +-- @since 0.13.2.0 +findIndexR :: (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR = G.findIndexR + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +-- +-- @since 0.13.2.0 +findIndices :: (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +-- +-- @since 0.13.2.0 +elemIndex :: Eq a => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +-- +-- @since 0.13.2.0 +elemIndices :: Eq a => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +-- +-- @since 0.13.2.0 +foldl :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors. +-- +-- @since 0.13.2.0 +foldl1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldl' :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. +-- +-- @since 0.13.2.0 +foldl1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold. +-- +-- @since 0.13.2.0 +foldr :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors. +-- +-- @since 0.13.2.0 +foldr1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator. +-- +-- @since 0.13.2.0 +foldr' :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. +-- +-- @since 0.13.2.0 +foldr1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator using a function applied to each element +-- and its index. +-- +-- @since 0.13.2.0 +ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator using a function applied to each +-- element and its index. +-- +-- @since 0.13.2.0 +ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type class. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.13.2.0 +foldMap :: (Monoid m) => (a -> m) -> Vector a -> m +{-# INLINE foldMap #-} +foldMap = G.foldMap + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.13.2.0 +foldMap' :: (Monoid m) => (a -> m) -> Vector a -> m +{-# INLINE foldMap' #-} +foldMap' = G.foldMap' + + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.all even $ V.fromList [2, 4, 12] +-- True +-- >>> V.all even $ V.fromList [2, 4, 13] +-- False +-- >>> V.all even (V.empty :: V.Vector Int) +-- True +-- +-- @since 0.13.2.0 +all :: (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.any even $ V.fromList [1, 3, 7] +-- False +-- >>> V.any even $ V.fromList [3, 2, 13] +-- True +-- >>> V.any even (V.empty :: V.Vector Int) +-- False +-- +-- @since 0.13.2.0 +any :: (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.and $ V.fromList [True, False] +-- False +-- >>> V.and V.empty +-- True +-- +-- @since 0.13.2.0 +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.or $ V.fromList [True, False] +-- True +-- >>> V.or V.empty +-- False +-- +-- @since 0.13.2.0 +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.sum $ V.fromList [300,20,1] +-- 321 +-- >>> V.sum (V.empty :: V.Vector Int) +-- 0 +-- +-- @since 0.13.2.0 +sum :: Num a => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.product $ V.fromList [1,2,3,4] +-- 24 +-- >>> V.product (V.empty :: V.Vector Int) +-- 1 +-- +-- @since 0.13.2.0 +product :: Num a => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.maximum $ V.fromList [2, 1] +-- 2 +-- >>> import Data.Semigroup +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 2 'b'] +-- Arg 2 'b' +-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +-- +-- @since 0.13.2.0 +maximum :: Ord a => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.maximumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.2.0 +maximumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.maximumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (2,'a') +-- >>> V.maximumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.2.0 +maximumOn :: Ord b => (a -> b) -> Vector a -> a +{-# INLINE maximumOn #-} +maximumOn = G.maximumOn + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.minimum $ V.fromList [2, 1] +-- 1 +-- >>> import Data.Semigroup +-- >>> V.minimum $ V.fromList [Arg 2 'a', Arg 1 'b'] +-- Arg 1 'b' +-- >>> V.minimum $ V.fromList [Arg 1 'a', Arg 1 'b'] +-- Arg 1 'a' +-- +-- @since 0.13.2.0 +minimum :: Ord a => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.minimumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.2.0 +minimumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.minimumOn fst $ V.fromList [(2,'a'), (1,'b')] +-- (1,'b') +-- >>> V.minimumOn fst $ V.fromList [(1,'a'), (1,'b')] +-- (1,'a') +-- +-- @since 0.13.2.0 +minimumOn :: Ord b => (a -> b) -> Vector a -> a +{-# INLINE minimumOn #-} +minimumOn = G.minimumOn + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +-- +-- @since 0.13.2.0 +maxIndex :: Ord a => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 0 +-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +-- +-- @since 0.13.2.0 +maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +-- +-- @since 0.13.2.0 +minIndex :: Ord a => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector as V +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')] +-- 1 +-- >>> V.minIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')] +-- 0 +-- +-- @since 0.13.2.0 +minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.13.2.0 +foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each +-- element and its index. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result. +-- +-- @since 0.13.2.0 +foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result using a function applied to +-- each element and its index. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result. +-- +-- @since 0.13.2.0 +foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results. +-- +-- @since 0.13.2.0 +sequence :: Monad m => Vector (m a) -> m (Vector a) +{-# INLINE sequence #-} +sequence = G.sequence + +-- | Evaluate each action and discard the results. +-- +-- @since 0.13.2.0 +sequence_ :: Monad m => Vector (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = G.sequence_ + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.prescanl (+) 0 (V.fromList [1,2,3,4]) +-- [0,1,3,6] +-- +-- @since 0.13.2.0 +prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Left-to-right prescan with strict accumulator. +-- +-- @since 0.13.2.0 +prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.postscanl (+) 0 (V.fromList [1,2,3,4]) +-- [1,3,6,10] +-- +-- @since 0.13.2.0 +postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Left-to-right postscan with strict accumulator. +-- +-- @since 0.13.2.0 +postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> V.scanl (+) 0 (V.fromList [1,2,3,4]) +-- [0,1,3,6,10] +-- +-- @since 0.13.2.0 +scanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Left-to-right scan with strict accumulator. +-- +-- @since 0.13.2.0 +scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Left-to-right scan over a vector with its index. +-- +-- @since 0.13.2.0 +iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +-- +-- @since 0.13.2.0 +iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanl1 min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1 max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1 min (V.empty :: V.Vector Int) +-- [] +-- +-- @since 0.13.2.0 +scanl1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanl1' min $ V.fromListN 5 [4,2,4,1,3] +-- [4,2,2,1,1] +-- >>> V.scanl1' max $ V.fromListN 5 [1,3,2,5,4] +-- [1,3,3,5,5] +-- >>> V.scanl1' min (V.empty :: V.Vector Int) +-- [] +-- +-- @since 0.13.2.0 +scanl1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +-- @since 0.13.2.0 +prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator. +-- +-- @since 0.13.2.0 +prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left postscan. +-- +-- @since 0.13.2.0 +postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left postscan with strict accumulator. +-- +-- @since 0.13.2.0 +postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left scan. +-- +-- @since 0.13.2.0 +scanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left scan with strict accumulator. +-- +-- @since 0.13.2.0 +scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index. +-- +-- @since 0.13.2.0 +iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +-- +-- @since 0.13.2.0 +iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanr1 min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1 max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1 min (V.empty :: V.Vector Int) +-- [] +-- +-- @since 0.13.2.0 +scanr1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector as V +-- >>> V.scanr1' min $ V.fromListN 5 [3,1,4,2,4] +-- [1,1,2,2,4] +-- >>> V.scanr1' max $ V.fromListN 5 [4,5,2,3,1] +-- [5,5,3,3,1] +-- >>> V.scanr1' min (V.empty :: V.Vector Int) +-- [] +-- +-- @since 0.13.2.0 +scanr1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Comparisons +-- ------------------------ + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +-- +-- @since 0.13.2.0 +eqBy :: (a -> b -> Bool) -> Vector a -> Vector b -> Bool +{-# INLINE eqBy #-} +eqBy = G.eqBy + +-- | /O(n)/ Compare two vectors using the supplied comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == compare +-- +-- @since 0.13.2.0 +cmpBy :: (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering +cmpBy = G.cmpBy + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +-- +-- @since 0.13.2.0 +toList :: Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.13.2.0 +fromList :: [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +-- +-- @since 0.13.2.0 +fromListN :: Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Lazy vectors +-- ----------------------------- + +-- | /O(1)/ Convert strict array to lazy array +toLazy :: Vector a -> V.Vector a +toLazy (Vector v) = v + +-- | /O(n)/ Convert lazy array to strict array. This function reduces +-- each element of vector to WHNF. +fromLazy :: V.Vector a -> Vector a +fromLazy vec = liftRnfV (`seq` ()) v `seq` v where v = Vector vec + + +-- Conversions - Arrays +-- ----------------------------- + +-- | /O(n)/ Convert an array to a vector and reduce each element to WHNF. +-- +-- @since 0.13.2.0 +fromArray :: Array a -> Vector a +{-# INLINE fromArray #-} +fromArray arr = liftRnfV (`seq` ()) vec `seq` vec + where + vec = Vector $ V.fromArray arr + +-- | /O(n)/ Convert a vector to an array. +-- +-- @since 0.13.2.0 +toArray :: Vector a -> Array a +{-# INLINE toArray #-} +toArray (Vector v) = V.toArray v + +-- | /O(1)/ Extract the underlying `Array`, offset where vector starts and the +-- total number of elements in the vector. Below property always holds: +-- +-- > let (array, offset, len) = toArraySlice v +-- > v === unsafeFromArraySlice len offset array +-- +-- @since 0.13.2.0 +toArraySlice :: Vector a -> (Array a, Int, Int) +{-# INLINE toArraySlice #-} +toArraySlice (Vector v) = V.toArraySlice v + + +-- | /O(n)/ Convert an array slice to a vector and reduce each element to WHNF. +-- +-- This function is very unsafe, because constructing an invalid +-- vector can yield almost all other safe functions in this module +-- unsafe. These are equivalent: +-- +-- > unsafeFromArraySlice len offset === unsafeTake len . unsafeDrop offset . fromArray +-- +-- @since 0.13.2.0 +unsafeFromArraySlice :: + Array a -- ^ Immutable boxed array. + -> Int -- ^ Offset + -> Int -- ^ Length + -> Vector a +{-# INLINE unsafeFromArraySlice #-} +unsafeFromArraySlice arr offset len = liftRnfV (`seq` ()) vec `seq` vec + where vec = Vector (V.unsafeFromArraySlice arr offset len) + + + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +-- +-- @since 0.13.2.0 +unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +-- +-- @since 0.13.2.0 +freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +-- +-- @since 0.13.2.0 +unsafeThaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +-- +-- @since 0.13.2.0 +thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +-- +-- @since 0.13.2.0 +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. +-- +-- @since 0.13.2.0 +copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy + +-- $setup +-- >>> :set -Wno-type-defaults +-- >>> import Prelude (Char, String, Bool(True, False), min, max, fst, even, undefined, Ord(..)) diff --git a/src/Data/Vector/Strict/Mutable.hs b/src/Data/Vector/Strict/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Strict/Mutable.hs @@ -0,0 +1,787 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Strict.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable strict boxed vectors. Strict means that all writes to +-- vector are evaluated to WHNF. However vector may contain bottoms, +-- since all elements of vector allocated using 'new' or 'unsafeNew' +-- are set to ⊥. +module Data.Vector.Strict.Mutable ( + -- * Mutable boxed vectors + MVector(MVector), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + -- ** Lazy arrays + toLazy, fromLazy, + -- ** Arrays + fromMutableArray, toMutableArray, + + -- * Re-exports + PrimMonad, PrimState, RealWorld +) where + +import Data.Coerce +import qualified Data.Vector.Generic.Mutable as G +import qualified Data.Vector.Mutable as MV +import Data.Primitive.Array +import Control.Monad.Primitive + +import Prelude + ( Ord, Monad(..), Bool, Int, Maybe, Ordering(..) + , return, ($), (<$>) ) + +import Data.Typeable ( Typeable ) + +#include "vector.h" + +type role MVector nominal representational + +-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). +newtype MVector s a = MVector (MV.MVector s a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength = coerce (G.basicLength @MV.MVector @a) + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice = coerce (G.basicUnsafeSlice @MV.MVector @a) + {-# INLINE basicOverlaps #-} + basicOverlaps = coerce (G.basicOverlaps @MV.MVector @a) + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew = coerce (G.basicUnsafeNew @MV.MVector @a) + {-# INLINE basicInitialize #-} + -- initialization is unnecessary for boxed vectors + basicInitialize _ = return () + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n !x = coerce (G.basicUnsafeReplicate @MV.MVector @a) n x + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead = coerce (G.basicUnsafeRead @MV.MVector @a) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite vec j !x = (coerce (G.basicUnsafeWrite @MV.MVector @a)) vec j x + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy = coerce (G.basicUnsafeCopy @MV.MVector @a) + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove = coerce (G.basicUnsafeMove @MV.MVector @a) + {-# INLINE basicClear #-} + basicClear = coerce (G.basicClear @MV.MVector @a) + + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +-- +-- @since 0.13.2.0 +length :: MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty. +-- +-- @since 0.13.2.0 +null :: MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +-- +-- @since 0.13.2.0 +slice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> MVector s a + -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +-- +-- @since 0.13.2.0 +take :: Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +-- +-- @since 0.13.2.0 +drop :: Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.13.2.0 +splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +-- +-- @since 0.13.2.0 +init :: MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +-- +-- @since 0.13.2.0 +tail :: MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +-- +-- @since 0.13.2.0 +unsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +-- +-- @since 0.13.2.0 +unsafeTake :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +-- +-- @since 0.13.2.0 +unsafeDrop :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- | Same as 'init', but doesn't do range checks. +-- +-- @since 0.13.2.0 +unsafeInit :: MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | Same as 'tail', but doesn't do range checks. +-- +-- @since 0.13.2.0 +unsafeTail :: MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +-- +-- @since 0.13.2.0 +overlaps :: MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +-- +-- @since 0.13.2.0 +new :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The vector elements +-- are set to bottom, so accessing them will cause an exception. +-- +-- @since 0.13.2.0 +unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +-- +-- @since 0.13.2.0 +replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +-- +-- @since 0.13.2.0 +replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.13.2.0 +generate :: (PrimMonad m) => Int -> (Int -> a) -> m (MVector (PrimState m) a) +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.13.2.0 +generateM :: (PrimMonad m) => Int -> (Int -> m a) -> m (MVector (PrimState m) a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | Create a copy of a mutable vector. +-- +-- @since 0.13.2.0 +clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a boxed vector by the given number of elements. The number must be +-- non-negative. This has the same semantics as 'G.grow' for generic vectors. It differs +-- from @grow@ functions for unpacked vectors, however, in that only pointers to +-- values are copied over, therefore the values themselves will be shared between the +-- two vectors. This is an important distinction to know about during memory +-- usage analysis and in case the values themselves are of a mutable type, e.g. +-- 'Data.IORef.IORef' or another mutable vector. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as V +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> mv <- V.thaw $ V.fromList ([10, 20, 30] :: [Integer]) +-- >>> mv' <- MV.grow mv 2 +-- +-- The two extra elements at the end of the newly allocated vector will be +-- uninitialized and will result in an error if evaluated, so me must overwrite +-- them with new values first: +-- +-- >>> MV.write mv' 3 999 +-- >>> MV.write mv' 4 777 +-- >>> V.freeze mv' +-- [10,20,30,999,777] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MV.write mv' 2 888 +-- >>> V.freeze mv' +-- [10,20,888,999,777] +-- >>> V.freeze mv +-- [10,20,30] +-- +-- @since 0.13.2.0 +grow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be non-negative, but +-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. +-- +-- @since 0.13.2.0 +unsafeGrow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. +-- +-- @since 0.13.2.0 +clear :: PrimMonad m => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.read v 3 +-- 9 +-- +-- @since 0.13.2.0 +read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13.2.0 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Mutable as MV +-- >>> v <- MV.generate 10 (\x -> x*x) +-- >>> MV.readMaybe v 3 +-- Just 9 +-- >>> MV.readMaybe v 13 +-- Nothing +-- +-- @since 0.13.2.0 +readMaybe :: (PrimMonad m) => MVector (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe = G.readMaybe + +-- | Replace the element at the given position. +-- +-- @since 0.13.2.0 +write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +-- +-- @since 0.13.2.0 +modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.13.2.0 +modifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM = G.modifyM + +-- | Swap the elements at the given positions. +-- +-- @since 0.13.2.0 +swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + +-- | Replace the element at the given position and return the old element. +-- +-- @since 0.13.2.0 +exchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange = G.exchange + +-- | Yield the element at the given position. No bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeModifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +unsafeModifyM = G.unsafeModifyM + +-- | Swap the elements at the given positions. No bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +-- +-- @since 0.13.2.0 +unsafeExchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange = G.unsafeExchange + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +-- +-- @since 0.13.2.0 +set :: PrimMonad m => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +-- +-- @since 0.13.2.0 +copy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +-- +-- @since 0.13.2.0 +unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | 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 +-- to the target vector. +-- +-- @since 0.13.2.0 +move :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move = G.move + +-- | 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 +-- to the target vector. +-- +-- @since 0.13.2.0 +unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Modifying vectors +-- ----------------- + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy = G.nextPermutationBy + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = G.prevPermutation + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy = G.prevPermutationBy + + +-- Folds +-- ----- + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.13.2.0 +mapM_ :: (PrimMonad m) => (a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results. +-- +-- @since 0.13.2.0 +imapM_ :: (PrimMonad m) => (Int -> a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.13.2.0 +forM_ :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.13.2.0 +iforM_ :: (PrimMonad m) => MVector (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.13.2.0 +foldl :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldl' :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldl :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldl' :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.13.2.0 +foldr :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldr' :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldr :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.13.2.0 +ifoldr' :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.13.2.0 +foldM :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldM' :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldM :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldM' :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.13.2.0 +foldrM :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM = G.foldrM + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.13.2.0 +foldrM' :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' = G.foldrM' + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.13.2.0 +ifoldrM :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM = G.ifoldrM + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.13.2.0 +ifoldrM' :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' = G.ifoldrM' + +-- Conversions - Lazy vectors +-- ----------------------------- + +-- | /O(1)/ Convert strict mutable vector to lazy mutable +-- vector. Vectors will share mutable buffer +toLazy :: MVector s a -> MV.MVector s a +{-# INLINE toLazy #-} +toLazy (MVector vec) = vec + +-- | /O(n)/ Convert lazy mutable vector to strict mutable +-- vector. Vectors will share mutable buffer. This function evaluates +-- vector elements to WHNF. +fromLazy :: PrimMonad m => MV.MVector (PrimState m) a -> m (MVector (PrimState m) a) +fromLazy mvec = stToPrim $ do + G.foldM' (\_ !_ -> return ()) () mvec + return $ MVector mvec + + +-- Conversions - Arrays +-- ----------------------------- + +-- | /O(n)/ Make a copy of a mutable array to a new mutable +-- vector. All elements of a vector are evaluated to WHNF +-- +-- @since 0.13.2.0 +fromMutableArray :: PrimMonad m => MutableArray (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE fromMutableArray #-} +fromMutableArray marr = stToPrim $ do + mvec <- MVector <$> MV.fromMutableArray marr + foldM' (\_ !_ -> return ()) () mvec + return mvec + +-- | /O(n)/ Make a copy of a mutable vector into a new mutable array. +-- +-- @since 0.13.2.0 +toMutableArray :: PrimMonad m => MVector (PrimState m) a -> m (MutableArray (PrimState m) a) +{-# INLINE toMutableArray #-} +toMutableArray (MVector v) = MV.toMutableArray v + +-- $setup +-- >>> import Prelude (Integer,Num(..)) diff --git a/src/Data/Vector/Unboxed.hs b/src/Data/Vector/Unboxed.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxed.hs @@ -0,0 +1,2069 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module : Data.Vector.Unboxed +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors. The implementation is based on data families +-- and picks an efficient, specialised representation for every element type. +-- For example, vector of fixed size primitives are backed by +-- 'Data.Vector.Primitive.Vector', unboxed vectors of tuples are represented +-- as tuples of unboxed vectors (see 'zip'\/'unzip'). Note that vector is +-- only adaptive types could pick boxed representation for data type\/field +-- of record. However all library instances are backed by unboxed array(s). +-- +-- Defining new instances of unboxed vectors is somewhat complicated since +-- it requires defining two data family and two type class instances. Latter +-- two could be generated using @GeneralizedNewtypeDeriving@ or @DerivingVia@ +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving +-- >>> +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> +-- >>> newtype Foo = Foo Int +-- >>> +-- >>> newtype instance VU.MVector s Foo = MV_Int (VU.MVector s Int) +-- >>> newtype instance VU.Vector Foo = V_Int (VU.Vector Int) +-- >>> deriving instance VGM.MVector VU.MVector Foo +-- >>> deriving instance VG.Vector VU.Vector Foo +-- >>> instance VU.Unbox Foo +-- +-- For other data types we have several newtype wrappers for use with +-- @DerivingVia@. See documentation of 'As' and 'IsoUnbox' for defining +-- unboxed vector of product types. 'UnboxViaPrim' could be used to define +-- vector of instances of 'Data.Vector.Primitive.Prim'. Similarly +-- 'DoNotUnboxStrict'/'DoNotUnboxLazy'/'DoNotUnboxNormalForm' could be used +-- to represent polymorphic fields as boxed vectors. +-- +-- Or if everything else fails instances could be written by hand. +-- Here is how the library does this for 'Complex' by simply wrapping +-- vectors of pairs. +-- +-- @ +-- newtype instance 'MVector' s ('Complex' a) = MV_Complex ('MVector' s (a,a)) +-- newtype instance 'Vector' ('Complex' a) = V_Complex ('Vector' (a,a)) +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Data.Vector.Generic.Mutable.MVector' 'MVector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (MV_Complex v) = 'Data.Vector.Generic.Mutable.basicLength' v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => Data.Vector.Generic.Vector 'Vector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (V_Complex v) = Data.Vector.Generic.basicLength v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Unbox' ('Complex' a) +-- @ +module Data.Vector.Unboxed ( + -- * Unboxed vectors + Vector(V_UnboxAs, V_UnboxViaPrim), MVector(..), Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, uncons, unsnoc, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, unfoldrExactN, + unfoldrM, unfoldrNM, unfoldrExactNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + iforM, iforM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + -- *** Zipping tuples + -- $zip + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + -- $unzip + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, uniq, + mapMaybe, imapMaybe, + mapMaybeM, imapMaybeM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, partitionWith, span, break, spanR, breakR, groupBy, group, + + -- ** Searching + elem, notElem, find, findIndex, findIndexR, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + foldMap, foldMap', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, maximumOn, + minimum, minimumBy, minimumOn, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- ** Comparisons + eqBy, cmpBy, + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- ** Deriving via + UnboxViaPrim(..), + As(..), + IsoUnbox(..), + + -- *** /Lazy/ boxing + DoNotUnboxLazy(..), + + -- *** /Strict/ boxing + DoNotUnboxStrict(..), + DoNotUnboxNormalForm(..) +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Util ( delayed_min ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude + ( Eq, Ord, Num, Enum, Monoid, Traversable, Monad, Read, Show, Bool, Ordering(..), Int, Maybe, Either + , compare, mempty, mappend, mconcat, showsPrec + , (<), (<=), (>), (>=), (==), (/=) ) + +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +import qualified GHC.Exts as Exts (IsList(..)) + + +#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 = 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 = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Unbox a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Unbox a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (<>) + + {-# INLINE mconcat #-} + mconcat = concat + +instance (Show a, Unbox a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Unbox a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Unbox e) => Exts.IsList (Vector e) where + type Item (Vector e) = e + fromList = fromList + fromListN = fromListN + toList = toList + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector. +length :: Unbox a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty. +null :: Unbox a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing. +(!) :: Unbox a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing. +(!?) :: Unbox a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element. +head :: Unbox a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element. +last :: Unbox a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking. +unsafeIndex :: Unbox a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element, without checking if the vector is empty. +unsafeHead :: Unbox a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element, without checking if the vector is empty. +unsafeLast :: Unbox a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- element) is evaluated eagerly. +indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad, without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Unbox a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Unbox a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements, in which case it is returned unchanged. +take :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /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 :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +-- +-- @since 0.7.1 +splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +uncons :: Unbox a => Vector a -> Maybe (a, Vector a) +{-# INLINE uncons #-} +uncons = G.uncons + +-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if +-- the vector is empty. +-- +-- @since 0.12.2.0 +unsnoc :: Unbox a => Vector a -> Maybe (Vector a, a) +{-# INLINE unsnoc #-} +unsnoc = G.unsnoc + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements, but this is not checked. +unsafeSlice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty, but this is not checked. +unsafeInit :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty, but this is not checked. +unsafeTail :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements, but this is not checked. +unsafeTake :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements, but this is not checked. +unsafeDrop :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ The empty vector. +empty :: Unbox a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ A vector with exactly one element. +singleton :: Unbox a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ A vector of the given length with the same value in each position. +replicate :: Unbox a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +generate :: Unbox a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \) +-- +-- ===__Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.iterateN 0 undefined undefined :: VU.Vector Int +-- [] +-- >>> VU.iterateN 3 (\(i, c) -> (pred i, succ c)) (0 :: Int, 'a') +-- [(0,'a'),(-1,'b'),(-2,'c')] +-- +-- @since 0.7.1 +iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields the +-- next element and the new seed. +-- +-- > unfoldrExactN 3 (\n -> (n,n-1)) 10 = <10,9,8> +-- +-- @since 0.12.2.0 +unfoldrExactN :: Unbox a => Int -> (b -> (a, b)) -> b -> Vector a +{-# INLINE unfoldrExactN #-} +unfoldrExactN = G.unfoldrExactN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Unbox a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with exactly @n@ elements by repeatedly +-- applying the monadic generator function to a seed. The generator +-- function yields the next element and the new seed. +-- +-- @since 0.12.2.0 +unfoldrExactNM :: (Monad m, Unbox a) => Int -> (b -> m (a, b)) -> b -> m (Vector a) +{-# INLINE unfoldrExactNM #-} +unfoldrExactNM = G.unfoldrExactNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in +constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in +constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 2 5 = <1,3,5,7,9> +enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromN' instead. +enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element. +cons :: Unbox a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element. +snoc :: Unbox a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors. +(++) :: Unbox a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list. +concat :: Unbox a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index. +generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector +-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there +-- is one less function application than the number of elements in the produced vector. +-- +-- For a non-monadic version, see `iterateN`. +-- +-- @since 0.12.0.0 +iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Unbox a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, +-- by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 ) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Unbox a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list of idnex/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > <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@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//'), but without bounds checking. +unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update', but without bounds checking. +unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_', but without bounds checking. +unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.accum (+) (VU.fromList [1000,2000,3000 :: Int]) [(2,4),(1,6),(0,3),(1,10)] +-- [1003,2016,3004] +accum :: Unbox a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /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@. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.accumulate (+) (VU.fromList [1000,2000,3000 :: Int]) (VU.fromList [(2,4),(1,6),(0,3),(1,10)]) +-- [1003,2016,3004] +accumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum', but without bounds checking. +unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate', but without bounds checking. +unsafeAccumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_', but without bounds checking. +unsafeAccumulate_ :: (Unbox a, Unbox b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector. +reverse :: Unbox a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is +-- often much more efficient. +-- +-- > backpermute <0,3,2,3,1,0> = +backpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute', but without bounds checking. +unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation may be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise (see 'Data.Vector.Generic.New.New' for details). +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> VU.modify (\v -> MVU.write v 0 'x') $ VU.replicate 4 'a' +-- "xaaa" +modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index. +indexed :: Unbox a => Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector. +map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index. +imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. +mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b) +{-# 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. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a +-- vector of results. Equivalent to @'flip' 'imapM'@. +-- +-- @since 0.12.2.0 +iforM :: (Monad m, Unbox a, Unbox b) => Vector a -> (Int -> a -> m b) -> m (Vector b) +{-# INLINE iforM #-} +iforM = G.iforM + +-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices +-- and ignore the results. Equivalent to @'flip' 'imapM_'@. +-- +-- @since 0.12.2.0 +iforM_ :: (Monad m, Unbox a) => Vector a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- Zipping +-- ------- + +-- $zip +-- +-- Following functions could be used to construct vector of tuples +-- from tuple of vectors. This operation is done in /O(1)/ time and +-- will share underlying buffers. +-- +-- Note that variants from "Data.Vector.Generic" doesn't have this +-- property. + +-- $unzip +-- +-- Following functions could be used to access underlying +-- representation of array of tuples. They convert array to tuple of +-- arrays. This operation is done in /O(1)/ time and will share +-- underlying buffers. +-- +-- Note that variants from "Data.Vector.Generic" doesn't have this +-- property. + + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Unbox a, Unbox b, Unbox c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Unbox a, Unbox b, Unbox c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results. +zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# 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) + => (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, Unbox a, Unbox b) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop all elements that do not satisfy the predicate. +filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to +-- the values and their indices. +ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.uniq $ VU.fromList [1,3,3,200,3 :: Int] +-- [1,3,200,3] +-- >>> import Data.Semigroup +-- >>> VU.uniq $ VU.fromList [ Arg 1 'a', Arg 1 'b', Arg (1 :: Int) 'c'] +-- [Arg 1 'a'] +uniq :: (Unbox a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Map the values and collect the 'Just' results. +mapMaybe :: (Unbox a, Unbox b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Map the indices/values and collect the 'Just' results. +imapMaybe :: (Unbox a, Unbox b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. +filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Apply the monadic function to each element of the vector and +-- discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +mapMaybeM :: (Monad m, Unbox a, Unbox b) => (a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE mapMaybeM #-} +mapMaybeM = G.mapMaybeM + +-- | /O(n)/ Apply the monadic function to each element of the vector and its index. +-- Discard elements returning 'Nothing'. +-- +-- @since 0.12.2.0 +imapMaybeM :: (Monad m, Unbox a, Unbox b) => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b) +{-# INLINE imapMaybeM #-} +imapMaybeM = G.imapMaybeM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate. +-- The current implementation is not copy-free, unless the result vector is +-- fused away. +takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Partitioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector into two parts, the first one containing the +-- @`Left`@ elements and the second containing the @`Right`@ elements. +-- The relative order of the elements is preserved. +-- +-- @since 0.12.1.0 +partitionWith :: (Unbox a, Unbox b, Unbox c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c) +{-# INLINE partitionWith #-} +partitionWith = G.partitionWith + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved, but the operation is often +-- faster than 'partition'. +unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.span (<4) $ VU.generate 10 id +-- ([0,1,2,3],[4,5,6,7,8,9]) +span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.break (>4) $ VU.generate 10 id +-- ([0,1,2,3,4],[5,6,7,8,9]) +break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.spanR (>4) $ VU.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +spanR :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE spanR #-} +spanR = G.spanR + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- Does not fuse. +-- +-- @since NEXT_VERSION +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.breakR (<5) $ VU.generate 10 id +-- ([5,6,7,8,9],[0,1,2,3,4]) +breakR :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE breakR #-} +breakR = G.breakR + +-- | /O(n)/ Split a vector into a list of slices, using a predicate function. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- +-- Does not fuse. +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import Data.Char (isUpper) +-- >>> VU.groupBy (\a b -> isUpper a == isUpper b) (VU.fromList "Mississippi River") +-- ["M","ississippi ","R","iver"] +-- +-- See also 'Data.List.groupBy', 'group'. +-- +-- @since 0.13.0.1 +groupBy :: Unbox a => (a -> a -> Bool) -> Vector a -> [Vector a] +groupBy = G.groupBy + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. +-- +-- Does not fuse. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.group (VU.fromList "Mississippi") +-- ["M","i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.List.group'. +-- +-- @since 0.13.0.1 +group :: (Unbox a, Eq a) => Vector a -> [Vector a] +group = G.groupBy (==) + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element. +elem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). +notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield 'Just' the index of the /last/ element matching the predicate +-- or 'Nothing' if no such element exists. +-- +-- Does not fuse. +findIndexR :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndexR #-} +findIndexR = G.findIndexR + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurrences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold. +foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors. +foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator. +foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. +foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold. +foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors. +foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator. +foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. +foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold using a function applied to each element and its index. +ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator using a function applied to each element +-- and its index. +ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold using a function applied to each element and its index. +ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator using a function applied to each +-- element and its index. +ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Map each element of the structure to a monoid and combine +-- the results. It uses the same implementation as the corresponding method +-- of the 'Foldable' type cless. Note that it's implemented in terms of 'foldr' +-- and won't fuse with functions that traverse the vector from left to +-- right ('map', 'generate', etc.). +-- +-- @since 0.12.2.0 +foldMap :: (Monoid m, Unbox a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap #-} +foldMap = G.foldMap + +-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same +-- implementation as the corresponding method of the 'Foldable' type class. +-- Note that it's implemented in terms of 'foldl'', so it fuses in most +-- contexts. +-- +-- @since 0.12.2.0 +foldMap' :: (Monoid m, Unbox a) => (a -> m) -> Vector a -> m +{-# INLINE foldMap' #-} +foldMap' = G.foldMap' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.all even $ VU.fromList [2, 4, 12 :: Int] +-- True +-- >>> VU.all even $ VU.fromList [2, 4, 13 :: Int] +-- False +-- >>> VU.all even (VU.empty :: VU.Vector Int) +-- True +all :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.any even $ VU.fromList [1, 3, 7 :: Int] +-- False +-- >>> VU.any even $ VU.fromList [3, 2, 13 :: Int] +-- True +-- >>> VU.any even (VU.empty :: VU.Vector Int) +-- False +any :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.and $ VU.fromList [True, False] +-- False +-- >>> VU.and VU.empty +-- True +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True'. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.or $ VU.fromList [True, False] +-- True +-- >>> VU.or VU.empty +-- False +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.sum $ VU.fromList [300,20,1 :: Int] +-- 321 +-- >>> VU.sum (VU.empty :: VU.Vector Int) +-- 0 +sum :: (Unbox a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the product of the elements. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.product $ VU.fromList [1,2,3,4 :: Int] +-- 24 +-- >>> VU.product (VU.empty :: VU.Vector Int) +-- 1 +product :: (Unbox a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.maximum $ VU.fromList [2, 1 :: Int] +-- 2 +-- >>> import Data.Semigroup +-- >>> VU.maximum $ VU.fromList [Arg 1 'a', Arg (2 :: Int) 'b'] +-- Arg 2 'b' +-- >>> VU.maximum $ VU.fromList [Arg 1 'a', Arg (1 :: Int) 'b'] +-- Arg 1 'a' +maximum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. This behavior is different from +-- 'Data.List.maximumBy' which returns the last tie. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.maximumBy (comparing fst) $ VU.fromList [(2,'a'), (1 :: Int,'b')] +-- (2,'a') +-- >>> VU.maximumBy (comparing fst) $ VU.fromList [(1,'a'), (1 :: Int,'b')] +-- (1,'a') +maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the maximum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.maximumOn fst $ VU.fromList [(2,'a'), (1 :: Int,'b')] +-- (2,'a') +-- >>> VU.maximumOn fst $ VU.fromList [(1,'a'), (1 :: Int,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +maximumOn :: (Ord b, Unbox a) => (a -> b) -> Vector a -> a +{-# INLINE maximumOn #-} +maximumOn = G.maximumOn + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.minimum $ VU.fromList [2, 1 :: Int] +-- 1 +-- >>> import Data.Semigroup +-- >>> VU.minimum $ VU.fromList [Arg 2 'a', Arg (1 :: Int) 'b'] +-- Arg 1 'b' +-- >>> VU.minimum $ VU.fromList [Arg 1 'a', Arg (1 :: Int) 'b'] +-- Arg 1 'a' +minimum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the +-- given comparison function. The vector may not be empty. In case of +-- a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.minimumBy (comparing fst) $ VU.fromList [(2,'a'), (1 :: Int,'b')] +-- (1,'b') +-- >>> VU.minimumBy (comparing fst) $ VU.fromList [(1,'a'), (1 :: Int,'b')] +-- (1,'a') +minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the minimum element of the vector by comparing the results +-- of a key function on each element. In case of a tie, the first occurrence +-- wins. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.minimumOn fst $ VU.fromList [(2,'a'), (1 :: Int,'b')] +-- (1,'b') +-- >>> VU.minimumOn fst $ VU.fromList [(1,'a'), (1 :: Int,'b')] +-- (1,'a') +-- +-- @since 0.13.0.0 +minimumOn :: (Ord b, Unbox a) => (a -> b) -> Vector a -> a +{-# INLINE minimumOn #-} +minimumOn = G.minimumOn + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. The vector may not be +-- empty. In case of a tie, the first occurrence wins. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.maxIndexBy (comparing fst) $ VU.fromList [(2,'a'), (1,'b')] +-- 0 +-- >>> VU.maxIndexBy (comparing fst) $ VU.fromList [(1,'a'), (1,'b')] +-- 0 +maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Ord +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.minIndexBy (comparing fst) $ VU.fromList [(2,'a'), (1,'b')] +-- 1 +-- >>> VU.minIndexBy (comparing fst) $ VU.fromList [(1,'a'), (1,'b')] +-- 0 +minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold. +foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold using a function 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 #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator. +foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator using a function 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' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result. +foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result using a function 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_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result. +foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- using a function 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 () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Scans +-- ----- + +-- | /O(n)/ Left-to-right prescan. +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector as VU +-- >>> VU.prescanl (+) 0 (VU.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6] +prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Left-to-right prescan with strict accumulator. +prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Left-to-right postscan. +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.postscanl (+) 0 (VU.fromList [1,2,3,4 :: Int]) +-- [1,3,6,10] +postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Left-to-right postscan with strict accumulator. +postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Left-to-right scan. +-- +-- > scanl f z = +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.scanl (+) 0 (VU.fromList [1,2,3,4 :: Int]) +-- [0,1,3,6,10] +scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Left-to-right scan with strict accumulator. +scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Left-to-right scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanl :: (Unbox a, Unbox b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. +-- +-- @since 0.12.2.0 +iscanl' :: (Unbox a, Unbox b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + +-- | /O(n)/ Initial-value free left-to-right scan over a vector. +-- +-- > scanl f = +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.scanl1 min $ VU.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VU.scanl1 max $ VU.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VU.scanl1 min (VU.empty :: VU.Vector Int) +-- [] +scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.scanl1' min $ VU.fromListN 5 [4,2,4,1,3 :: Int] +-- [4,2,2,1,1] +-- >>> VU.scanl1' max $ VU.fromListN 5 [1,3,2,5,4 :: Int] +-- [1,3,3,5,5] +-- >>> VU.scanl1' min (VU.empty :: VU.Vector Int) +-- [] +scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan. +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator. +prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left postscan. +postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left postscan with strict accumulator. +postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left scan. +scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left scan with strict accumulator. +scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index. +-- +-- @since 0.12.2.0 +iscanr :: (Unbox a, Unbox b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. +-- +-- @sinqce 0.12.2.0 +iscanr' :: (Unbox a, Unbox b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.scanr1 min $ VU.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VU.scanr1 max $ VU.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VU.scanr1 min (VU.empty :: VU.Vector Int) +-- [] +scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict +-- accumulator. +-- +-- Note: Since 0.13, application of this to an empty vector no longer +-- results in an error; instead it produces an empty vector. +-- +-- ==== __Examples__ +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.scanr1' min $ VU.fromListN 5 [3,1,4,2,4 :: Int] +-- [1,1,2,2,4] +-- >>> VU.scanr1' max $ VU.fromListN 5 [4,5,2,3,1 :: Int] +-- [5,5,3,3,1] +-- >>> VU.scanr1' min (VU.empty :: VU.Vector Int) +-- [] +scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Comparisons +-- ------------------------ + +-- | /O(n)/ Check if two vectors are equal using the supplied equality +-- predicate. +-- +-- @since 0.12.2.0 +eqBy :: (Unbox a, Unbox b) => (a -> b -> Bool) -> Vector a -> Vector b -> Bool +{-# INLINE eqBy #-} +eqBy = G.eqBy + +-- | /O(n)/ Compare two vectors using the supplied comparison function for +-- vector elements. Comparison works the same as for lists. +-- +-- > cmpBy compare == compare +-- +-- @since 0.12.2.0 +cmpBy :: (Unbox a, Unbox b) => (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering +cmpBy = G.cmpBy + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list. +toList :: Unbox a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector. During the operation, the +-- vector’s capacity will be doubling until the list's contents are +-- in the vector. Depending on the list’s size, up to half of the vector’s +-- capacity might be empty. If you’d rather avoid this, you can use +-- 'fromListN', which will provide the exact space the list requires but will +-- prevent list fusion, or @'force' . 'fromList'@, which will create the +-- vector and then copy it without the superfluous space. +-- +-- @since 0.3 +fromList :: Unbox a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's +-- expected that the supplied list will be exactly @n@ elements long. As +-- an optimization, this function allocates a buffer for @n@ elements, which +-- could be used for DoS-attacks by exhausting the memory if an attacker controls +-- that parameter. +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> VU.fromListN 3 [1,2,3,4,5 :: Int] +-- [1,2,3] +-- >>> VU.fromListN 3 [1 :: Int] +-- [1] +fromListN :: Unbox a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one +-- without copying. Note that this is a very dangerous function and +-- generally it's only safe to read from the resulting vector. In this +-- case, the immutable vector could be used safely as well. +-- +-- Problems with mutation happen because GHC has a lot of freedom to +-- introduce sharing. As a result mutable vectors produced by +-- @unsafeThaw@ may or may not share the same underlying buffer. For +-- example: +-- +-- > foo = do +-- > let vec = V.generate 10 id +-- > mvec <- V.unsafeThaw vec +-- > do_something mvec +-- +-- Here GHC could lift @vec@ outside of foo which means that all calls to +-- @do_something@ will use same buffer with possibly disastrous +-- results. Whether such aliasing happens or not depends on the program in +-- question, optimization levels, and GHC flags. +-- +-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of +-- domain of software engineering and into realm of black magic, dark +-- rituals, and unspeakable horrors. The only advice that could be given +-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you +-- know how to prevent GHC from aliasing buffers accidentally. We don't." +unsafeThaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of an immutable vector. +thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (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 () +{-# INLINE copy #-} +copy = G.copy + + +#define DEFINE_IMMUTABLE +#include "unbox-tuple-instances" + +-- $setup +-- >>> import Prelude (Bool(True, False), ($), (+), min, max, even, fst, pred, id, succ, undefined, Ord(..)) diff --git a/src/Data/Vector/Unboxed/Base.hs b/src/Data/Vector/Unboxed/Base.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxed/Base.hs @@ -0,0 +1,1057 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_HADDOCK hide #-} +-- | +-- Module : Data.Vector.Unboxed.Base +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors: basic implementation. + +module Data.Vector.Unboxed.Base ( + MVector(..), IOVector, STVector, Vector(..), Unbox, + UnboxViaPrim(..), As(..), IsoUnbox(..), + DoNotUnboxLazy(..), DoNotUnboxNormalForm(..), DoNotUnboxStrict(..) +) where + +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M +import qualified Data.Vector as B +import qualified Data.Vector.Strict as S + +import qualified Data.Vector.Primitive as P + +import Control.Applicative (Const(..)) + +import Control.DeepSeq ( NFData(rnf) +#if MIN_VERSION_deepseq(1,4,3) + , NFData1(liftRnf) +#endif + , force + ) + +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Data.Functor.Identity +import Data.Functor.Compose +import Data.Word ( Word8, Word16, Word32, Word64 ) +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Complex +import Data.Monoid (Dual(..),Sum(..),Product(..),All(..),Any(..)) +import Data.Monoid (Alt(..)) +import Data.Semigroup (Min(..),Max(..),First(..),Last(..),WrappedMonoid(..),Arg(..)) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import GHC.Exts ( Down(..) ) +import GHC.Generics +import Data.Coerce +import Data.Kind (Type) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +data family MVector s a +data family Vector a + +type IOVector = MVector RealWorld +type STVector s = MVector s + +type instance G.Mutable Vector = MVector + +class (G.Vector Vector a, M.MVector MVector a) => Unbox a + +instance NFData (Vector a) where rnf !_ = () +instance NFData (MVector s a) where rnf !_ = () + +#if MIN_VERSION_deepseq(1,4,3) +-- | @since 0.12.1.0 +instance NFData1 Vector where + liftRnf _ !_ = () +-- | @since 0.12.1.0 +instance NFData1 (MVector s) where + liftRnf _ !_ = () +#endif + +-- ----------------- +-- Data and Typeable +-- ----------------- +deriving instance Typeable Vector +deriving instance Typeable MVector + +instance (Data a, Unbox a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = G.mkVecConstr "Data.Vector.Unboxed.Vector" + gunfold = G.gunfold + dataTypeOf _ = G.mkVecType "Data.Vector.Unboxed.Vector" + dataCast1 = G.dataCast + +-- ---- +-- Unit +-- ---- + +newtype instance MVector s () = MV_Unit Int +newtype instance Vector () = V_Unit Int + +instance Unbox () + +instance M.MVector MVector () where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + + basicLength (MV_Unit n) = n + + 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 () + + basicClear _ = return () + + basicSet (MV_Unit _) () = return () + + basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return () + + basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m) + +instance G.Vector Vector () where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_Unit n) = return $ MV_Unit n + + {-# INLINE basicLength #-} + basicLength (V_Unit n) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice _ m (V_Unit _) = V_Unit m + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_Unit _) _ = return () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () + + {-# INLINE elemseq #-} + elemseq _ = seq + + +-- --------------- +-- Primitive types +-- --------------- + +-- | Newtype wrapper which allows to derive unboxed vector in term of +-- primitive vectors using @DerivingVia@ mechanism. This is mostly +-- used as illustration of use of @DerivingVia@ for vector, see examples below. +-- +-- First is rather straightforward: we define newtype and use GND to +-- derive 'P.Prim' instance. Newtype instances should be defined +-- manually. Then we use deriving via to define necessary instances. +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses +-- >>> -- Needed to derive Prim +-- >>> :set -XGeneralizedNewtypeDeriving -XDataKinds -XUnboxedTuples -XPolyKinds +-- >>> +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> +-- >>> newtype Foo = Foo Int deriving VP.Prim +-- >>> +-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Foo) +-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Foo) +-- >>> deriving via (VU.UnboxViaPrim Foo) instance VGM.MVector VU.MVector Foo +-- >>> deriving via (VU.UnboxViaPrim Foo) instance VG.Vector VU.Vector Foo +-- >>> instance VU.Unbox Foo +-- +-- Second example is essentially same but with a twist. Instead of +-- using @Prim@ instance of data type, we use underlying instance of @Int@: +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses +-- >>> +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> import qualified Data.Vector.Primitive as VP +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> +-- >>> newtype Foo = Foo Int +-- >>> +-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Int) +-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Int) +-- >>> deriving via (VU.UnboxViaPrim Int) instance VGM.MVector VU.MVector Foo +-- >>> deriving via (VU.UnboxViaPrim Int) instance VG.Vector VU.Vector Foo +-- >>> instance VU.Unbox Foo +-- +-- @since 0.13.0.0 +newtype UnboxViaPrim a = UnboxViaPrim a + +newtype instance MVector s (UnboxViaPrim a) = MV_UnboxViaPrim (P.MVector s a) +newtype instance Vector (UnboxViaPrim a) = V_UnboxViaPrim (P.Vector a) + +instance P.Prim a => M.MVector MVector (UnboxViaPrim a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @P.MVector @a + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @P.MVector @a + basicOverlaps = coerce $ M.basicOverlaps @P.MVector @a + basicUnsafeNew = coerce $ M.basicUnsafeNew @P.MVector @a + basicInitialize = coerce $ M.basicInitialize @P.MVector @a + basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @P.MVector @a + basicUnsafeRead = coerce $ M.basicUnsafeRead @P.MVector @a + basicUnsafeWrite = coerce $ M.basicUnsafeWrite @P.MVector @a + basicClear = coerce $ M.basicClear @P.MVector @a + basicSet = coerce $ M.basicSet @P.MVector @a + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @P.MVector @a + basicUnsafeMove = coerce $ M.basicUnsafeMove @P.MVector @a + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @P.MVector @a + +instance P.Prim a => G.Vector Vector (UnboxViaPrim a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @P.Vector @a + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @P.Vector @a + basicLength = coerce $ G.basicLength @P.Vector @a + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @P.Vector @a + basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @P.Vector @a + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @P.Vector @a + elemseq _ = seq + +-- | Isomorphism between type @a@ and its representation in unboxed +-- vector @b@. Default instance coerces between generic +-- representations of @a@ and @b@ which means they have same shape and +-- corresponding fields could be coerced to each other. Note that this +-- means it's possible to have fields that have different types: +-- +-- >>> :set -XMultiParamTypeClasses -XDeriveGeneric -XFlexibleInstances +-- >>> import GHC.Generics (Generic) +-- >>> import Data.Monoid +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> :{ +-- data Foo a = Foo Int a +-- deriving (Show,Generic) +-- instance VU.IsoUnbox (Foo a) (Int, a) +-- instance VU.IsoUnbox (Foo a) (Sum Int, Product a) +-- :} +-- +-- @since 0.13.0.0 +class IsoUnbox a b where + -- | Convert value into it representation in unboxed vector. + toURepr :: a -> b + default toURepr :: (Generic a, Generic b, Coercible (Rep a ()) (Rep b ())) => a -> b + toURepr = to . idU . coerce . idU . from + -- | Convert value representation in unboxed vector back to value. + fromURepr :: b -> a + default fromURepr :: (Generic a, Generic b, Coercible (Rep b ()) (Rep a ())) => b -> a + fromURepr = to . idU . coerce . idU . from + +idU :: f () -> f () +idU = id + + +-- | Newtype which allows to derive unbox instances for type @a@ which +-- uses @b@ as underlying representation (usually tuple). Type @a@ and +-- its representation @b@ are connected by type class +-- 'IsoUnbox'. Here's example which uses explicit 'IsoUnbox' instance: +-- +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia +-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> :{ +-- data Foo a = Foo Int a +-- deriving Show +-- instance VU.IsoUnbox (Foo a) (Int,a) where +-- toURepr (Foo i a) = (i,a) +-- fromURepr (i,a) = Foo i a +-- {-# INLINE toURepr #-} +-- {-# INLINE fromURepr #-} +-- newtype instance VU.MVector s (Foo a) = MV_Foo (VU.MVector s (Int, a)) +-- newtype instance VU.Vector (Foo a) = V_Foo (VU.Vector (Int, a)) +-- deriving via (Foo a `VU.As` (Int, a)) instance VU.Unbox a => VGM.MVector MVU.MVector (Foo a) +-- deriving via (Foo a `VU.As` (Int, a)) instance VU.Unbox a => VG.Vector VU.Vector (Foo a) +-- instance VU.Unbox a => VU.Unbox (Foo a) +-- :} +-- +-- +-- It's also possible to use generic-based instance for 'IsoUnbox' +-- which should work for all product types. +-- +-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances -XDeriveGeneric +-- >>> :set -XDerivingVia +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> :{ +-- data Bar a = Bar Int a +-- deriving (Show,Generic) +-- instance VU.IsoUnbox (Bar a) (Int,a) where +-- newtype instance VU.MVector s (Bar a) = MV_Bar (VU.MVector s (Int, a)) +-- newtype instance VU.Vector (Bar a) = V_Bar (VU.Vector (Int, a)) +-- deriving via (Bar a `VU.As` (Int, a)) instance VU.Unbox a => VGM.MVector VU.MVector (Bar a) +-- deriving via (Bar a `VU.As` (Int, a)) instance VU.Unbox a => VG.Vector VU.Vector (Bar a) +-- instance VU.Unbox a => VU.Unbox (Bar a) +-- :} +-- +-- @since 0.13.0.0 +newtype As (a :: Type) (b :: Type) = As a + +newtype instance MVector s (As a b) = MV_UnboxAs (MVector s b) +newtype instance Vector (As a b) = V_UnboxAs (Vector b) + +instance (IsoUnbox a b, Unbox b) => M.MVector MVector (As a b) where + -- Methods that just use underlying vector + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeMove #-} + {-# INLINE basicUnsafeGrow #-} + {-# INLINE basicClear #-} + basicLength = coerce $ M.basicLength @MVector @b + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @MVector @b + basicOverlaps = coerce $ M.basicOverlaps @MVector @b + basicUnsafeNew = coerce $ M.basicUnsafeNew @MVector @b + basicInitialize = coerce $ M.basicInitialize @MVector @b + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @MVector @b + basicUnsafeMove = coerce $ M.basicUnsafeMove @MVector @b + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @MVector @b + basicClear = coerce $ M.basicClear @MVector @b + -- Conversion to/from underlying representation + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicSet #-} + basicUnsafeReplicate n (As x) = MV_UnboxAs <$> M.basicUnsafeReplicate n (toURepr x) + basicUnsafeRead (MV_UnboxAs v) i = As . fromURepr <$> M.basicUnsafeRead v i + basicUnsafeWrite (MV_UnboxAs v) i (As x) = M.basicUnsafeWrite v i (toURepr x) + basicSet (MV_UnboxAs v) (As x) = M.basicSet v (toURepr x) + +instance (IsoUnbox a b, Unbox b) => G.Vector Vector (As a b) where + -- Method that just use underlying vector + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @Vector @b + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @Vector @b + basicLength = coerce $ G.basicLength @Vector @b + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @Vector @b + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @b + elemseq _ = seq + -- Conversion to/from underlying representation + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_UnboxAs v) i = As . fromURepr <$> G.basicUnsafeIndexM v i + + +#define primMVector(ty,con) \ +instance M.MVector MVector ty where { \ + {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicOverlaps #-} \ +; {-# INLINE basicUnsafeNew #-} \ +; {-# INLINE basicInitialize #-} \ +; {-# INLINE basicUnsafeReplicate #-} \ +; {-# INLINE basicUnsafeRead #-} \ +; {-# INLINE basicUnsafeWrite #-} \ +; {-# INLINE basicClear #-} \ +; {-# INLINE basicSet #-} \ +; {-# INLINE basicUnsafeCopy #-} \ +; {-# INLINE basicUnsafeGrow #-} \ +; basicLength (con v) = M.basicLength v \ +; 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 \ +; basicClear (con v) = M.basicClear v \ +; basicSet (con v) x = M.basicSet v x \ +; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ +; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ +; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n } + +#define primVector(ty,con,mcon) \ +instance G.Vector Vector ty where { \ + {-# INLINE basicUnsafeFreeze #-} \ +; {-# INLINE basicUnsafeThaw #-} \ +; {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicUnsafeIndexM #-} \ +; {-# INLINE elemseq #-} \ +; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ +; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ +; basicLength (con v) = G.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ +; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \ +; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ +; elemseq _ = seq } + +newtype instance MVector s Int = MV_Int (P.MVector s Int) +newtype instance Vector Int = V_Int (P.Vector Int) +instance Unbox Int +primMVector(Int, MV_Int) +primVector(Int, V_Int, MV_Int) + +newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8) +newtype instance Vector Int8 = V_Int8 (P.Vector Int8) +instance Unbox Int8 +primMVector(Int8, MV_Int8) +primVector(Int8, V_Int8, MV_Int8) + +newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16) +newtype instance Vector Int16 = V_Int16 (P.Vector Int16) +instance Unbox Int16 +primMVector(Int16, MV_Int16) +primVector(Int16, V_Int16, MV_Int16) + +newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32) +newtype instance Vector Int32 = V_Int32 (P.Vector Int32) +instance Unbox Int32 +primMVector(Int32, MV_Int32) +primVector(Int32, V_Int32, MV_Int32) + +newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64) +newtype instance Vector Int64 = V_Int64 (P.Vector Int64) +instance Unbox Int64 +primMVector(Int64, MV_Int64) +primVector(Int64, V_Int64, MV_Int64) + + +newtype instance MVector s Word = MV_Word (P.MVector s Word) +newtype instance Vector Word = V_Word (P.Vector Word) +instance Unbox Word +primMVector(Word, MV_Word) +primVector(Word, V_Word, MV_Word) + +newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8) +newtype instance Vector Word8 = V_Word8 (P.Vector Word8) +instance Unbox Word8 +primMVector(Word8, MV_Word8) +primVector(Word8, V_Word8, MV_Word8) + +newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16) +newtype instance Vector Word16 = V_Word16 (P.Vector Word16) +instance Unbox Word16 +primMVector(Word16, MV_Word16) +primVector(Word16, V_Word16, MV_Word16) + +newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32) +newtype instance Vector Word32 = V_Word32 (P.Vector Word32) +instance Unbox Word32 +primMVector(Word32, MV_Word32) +primVector(Word32, V_Word32, MV_Word32) + +newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64) +newtype instance Vector Word64 = V_Word64 (P.Vector Word64) +instance Unbox Word64 +primMVector(Word64, MV_Word64) +primVector(Word64, V_Word64, MV_Word64) + + +newtype instance MVector s Float = MV_Float (P.MVector s Float) +newtype instance Vector Float = V_Float (P.Vector Float) +instance Unbox Float +primMVector(Float, MV_Float) +primVector(Float, V_Float, MV_Float) + +newtype instance MVector s Double = MV_Double (P.MVector s Double) +newtype instance Vector Double = V_Double (P.Vector Double) +instance Unbox Double +primMVector(Double, MV_Double) +primVector(Double, V_Double, MV_Double) + + +newtype instance MVector s Char = MV_Char (P.MVector s Char) +newtype instance Vector Char = V_Char (P.Vector Char) +instance Unbox Char +primMVector(Char, MV_Char) +primVector(Char, V_Char, MV_Char) + +-- ---- +-- Bool +-- ---- + +fromBool :: Bool -> Word8 +{-# INLINE fromBool #-} +fromBool True = 1 +fromBool False = 0 + +toBool :: Word8 -> Bool +{-# INLINE toBool #-} +toBool 0 = False +toBool _ = True + +newtype instance MVector s Bool = MV_Bool (P.MVector s Word8) +newtype instance Vector Bool = V_Bool (P.Vector Word8) + +instance Unbox Bool + +instance M.MVector MVector Bool where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength (MV_Bool v) = M.basicLength v + 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) + basicClear (MV_Bool v) = M.basicClear v + basicSet (MV_Bool v) x = M.basicSet v (fromBool x) + basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n + +instance G.Vector Vector Bool where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v + basicLength (V_Bool v) = G.basicLength v + basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v + elemseq _ = seq + +-- ------- +-- Complex +-- ------- + +newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) +newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) + +instance (Unbox a) => Unbox (Complex a) + +instance (Unbox a) => M.MVector MVector (Complex a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicClear #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeMove #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @MVector @(a,a) + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @MVector @(a,a) + basicOverlaps = coerce $ M.basicOverlaps @MVector @(a,a) + basicUnsafeNew = coerce $ M.basicUnsafeNew @MVector @(a,a) + basicInitialize = coerce $ M.basicInitialize @MVector @(a,a) + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @MVector @(a,a) + basicUnsafeMove = coerce $ M.basicUnsafeMove @MVector @(a,a) + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @MVector @(a,a) + basicClear = coerce $ M.basicClear @MVector @(a,a) + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicSet #-} + basicUnsafeReplicate n (x :+ y) = MV_Complex <$> M.basicUnsafeReplicate n (x,y) + basicUnsafeRead (MV_Complex v) i = uncurry (:+) <$> M.basicUnsafeRead v i + basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y) + basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y) + +instance (Unbox a) => G.Vector Vector (Complex a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeCopy #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @Vector @(a,a) + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @Vector @(a,a) + basicLength = coerce $ G.basicLength @Vector @(a,a) + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @Vector @(a,a) + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @(a,a) + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeIndexM (V_Complex v) i + = uncurry (:+) <$> G.basicUnsafeIndexM v i + elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x + $ G.elemseq (undefined :: Vector a) y z + +-- ------- +-- Identity +-- ------- +#define newtypeMVector(inst_ctxt,inst_head,tyC,con) \ +instance inst_ctxt => M.MVector MVector (inst_head) where { \ +; {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicOverlaps #-} \ +; {-# INLINE basicUnsafeNew #-} \ +; {-# INLINE basicInitialize #-} \ +; {-# INLINE basicUnsafeReplicate #-} \ +; {-# INLINE basicUnsafeRead #-} \ +; {-# INLINE basicUnsafeWrite #-} \ +; {-# INLINE basicClear #-} \ +; {-# INLINE basicSet #-} \ +; {-# INLINE basicUnsafeCopy #-} \ +; {-# INLINE basicUnsafeGrow #-} \ +; basicLength (con v) = M.basicLength v \ +; 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 (tyC x) = con `liftM` M.basicUnsafeReplicate n x \ +; basicUnsafeRead (con v) i = tyC `liftM` M.basicUnsafeRead v i \ +; basicUnsafeWrite (con v) i (tyC x) = M.basicUnsafeWrite v i x \ +; basicClear (con v) = M.basicClear v \ +; basicSet (con v) (tyC x) = M.basicSet v x \ +; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ +; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ +; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n \ +} +#define newtypeVector(inst_ctxt,inst_head,tyC,con,mcon) \ +instance inst_ctxt => G.Vector Vector (inst_head) where { \ +; {-# INLINE basicUnsafeFreeze #-} \ +; {-# INLINE basicUnsafeThaw #-} \ +; {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicUnsafeIndexM #-} \ +; {-# INLINE elemseq #-} \ +; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ +; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ +; basicLength (con v) = G.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ +; basicUnsafeIndexM (con v) i = tyC `liftM` G.basicUnsafeIndexM v i \ +; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ +; elemseq _ (tyC a) = G.elemseq (undefined :: Vector x) a \ +} +#define deriveNewtypeInstances(inst_ctxt,inst_head,rep,tyC,con,mcon) \ +newtype instance MVector s (inst_head) = mcon (MVector s (rep)) ;\ +newtype instance Vector (inst_head) = con (Vector (rep)) ;\ +instance inst_ctxt => Unbox (inst_head) ;\ +newtypeMVector(inst_ctxt, inst_head, tyC, mcon) ;\ +newtypeVector(inst_ctxt, inst_head, tyC, con, mcon) + +deriveNewtypeInstances(Unbox a, Identity a, a, Identity, V_Identity, MV_Identity) +deriveNewtypeInstances(Unbox a, Down a, a, Down, V_Down, MV_Down) +deriveNewtypeInstances(Unbox a, Dual a, a, Dual, V_Dual, MV_Dual) +deriveNewtypeInstances(Unbox a, Sum a, a, Sum, V_Sum, MV_Sum) +deriveNewtypeInstances(Unbox a, Product a, a, Product, V_Product, MV_Product) + + +-- -------------- +-- Data.Semigroup +-- -------------- + +deriveNewtypeInstances(Unbox a, Min a, a, Min, V_Min, MV_Min) +deriveNewtypeInstances(Unbox a, Max a, a, Max, V_Max, MV_Max) +deriveNewtypeInstances(Unbox a, First a, a, First, V_First, MV_First) +deriveNewtypeInstances(Unbox a, Last a, a, Last, V_Last, MV_Last) +deriveNewtypeInstances(Unbox a, WrappedMonoid a, a, WrapMonoid, V_WrappedMonoid, MV_WrappedMonoid) + +-- ------------------ +-- Data.Semigroup.Arg +-- ------------------ + +newtype instance MVector s (Arg a b) = MV_Arg (MVector s (a,b)) +newtype instance Vector (Arg a b) = V_Arg (Vector (a,b)) + +instance (Unbox a, Unbox b) => Unbox (Arg a b) + +instance (Unbox a, Unbox b) => M.MVector MVector (Arg a b) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicClear #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeMove #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @MVector @(a,b) + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @MVector @(a,b) + basicOverlaps = coerce $ M.basicOverlaps @MVector @(a,b) + basicUnsafeNew = coerce $ M.basicUnsafeNew @MVector @(a,b) + basicInitialize = coerce $ M.basicInitialize @MVector @(a,b) + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @MVector @(a,b) + basicUnsafeMove = coerce $ M.basicUnsafeMove @MVector @(a,b) + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @MVector @(a,b) + basicClear = coerce $ M.basicClear @MVector @(a,b) + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicSet #-} + basicUnsafeReplicate n (Arg x y) = MV_Arg <$> M.basicUnsafeReplicate n (x,y) + basicUnsafeRead (MV_Arg v) i = uncurry Arg <$> M.basicUnsafeRead v i + basicUnsafeWrite (MV_Arg v) i (Arg x y) = M.basicUnsafeWrite v i (x,y) + basicSet (MV_Arg v) (Arg x y) = M.basicSet v (x,y) + + +instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeCopy #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @Vector @(a,b) + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @Vector @(a,b) + basicLength = coerce $ G.basicLength @Vector @(a,b) + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @Vector @(a,b) + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @(a,b) + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeIndexM (V_Arg v) i = uncurry Arg `liftM` G.basicUnsafeIndexM v i + elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x + $ G.elemseq (undefined :: Vector b) y z + +-- ------- +-- Unboxing the boxed values +-- ------- + +-- | Newtype which allows to derive unbox instances for type @a@ which +-- is normally a "boxed" type. The newtype does not alter the strictness +-- semantics of the underlying type and inherits the laizness of said type. +-- For a strict newtype wrapper, see 'DoNotUnboxStrict'. +-- +-- 'DoNotUnboxLazy' is intended to be unsed in conjunction with the newtype 'As' +-- and the type class 'IsoUnbox'. Here's an example which uses the following +-- explicit 'IsoUnbox' instance: +-- +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia +-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> :{ +-- >>> data Foo a = Foo Int a +-- >>> deriving (Eq, Ord, Show) +-- >>> instance VU.IsoUnbox (Foo a) (Int, VU.DoNotUnboxLazy a) where +-- >>> toURepr (Foo i a) = (i, VU.DoNotUnboxLazy a) +-- >>> fromURepr (i, VU.DoNotUnboxLazy a) = Foo i a +-- >>> {-# INLINE toURepr #-} +-- >>> {-# INLINE fromURepr #-} +-- >>> newtype instance VU.MVector s (Foo a) = MV_Foo (VU.MVector s (Int, VU.DoNotUnboxLazy a)) +-- >>> newtype instance VU.Vector (Foo a) = V_Foo (VU.Vector (Int, VU.DoNotUnboxLazy a)) +-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VGM.MVector VUM.MVector (Foo a) +-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VG.Vector VU.Vector (Foo a) +-- >>> instance VU.Unbox (Foo a) +-- >>> :} +-- +-- >>> VU.fromListN 3 [ Foo 4 "Haskell's", Foo 8 "strong", Foo 16 "types" ] +-- [Foo 4 "Haskell's",Foo 8 "strong",Foo 16 "types"] +-- +-- @since 0.13.2.0 +newtype DoNotUnboxLazy a = DoNotUnboxLazy a + +newtype instance MVector s (DoNotUnboxLazy a) = MV_DoNotUnboxLazy (B.MVector s a) +newtype instance Vector (DoNotUnboxLazy a) = V_DoNotUnboxLazy (B.Vector a) + +instance M.MVector MVector (DoNotUnboxLazy a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @B.MVector @a + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @B.MVector @a + basicOverlaps = coerce $ M.basicOverlaps @B.MVector @a + basicUnsafeNew = coerce $ M.basicUnsafeNew @B.MVector @a + basicInitialize = coerce $ M.basicInitialize @B.MVector @a + basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @B.MVector @a + basicUnsafeRead = coerce $ M.basicUnsafeRead @B.MVector @a + basicUnsafeWrite = coerce $ M.basicUnsafeWrite @B.MVector @a + basicClear = coerce $ M.basicClear @B.MVector @a + basicSet = coerce $ M.basicSet @B.MVector @a + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @B.MVector @a + basicUnsafeMove = coerce $ M.basicUnsafeMove @B.MVector @a + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @B.MVector @a + +instance G.Vector Vector (DoNotUnboxLazy a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @B.Vector @a + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @B.Vector @a + basicLength = coerce $ G.basicLength @B.Vector @a + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @B.Vector @a + basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @B.Vector @a + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @B.Vector @a + elemseq _ = seq + +instance Unbox (DoNotUnboxLazy a) + +-- | Newtype which allows to derive unbox instances for type @a@ which +-- is normally a "boxed" type. The newtype stictly evaluates the wrapped values +-- ensuring that the unboxed vector contains no (direct) thunks. +-- For a less strict newtype wrapper, see 'DoNotUnboxLazy'. +-- For a more strict newtype wrapper, see 'DoNotUnboxNormalForm'. +-- +-- 'DoNotUnboxStrict' is intended to be unsed in conjunction with the newtype 'As' +-- and the type class 'IsoUnbox'. Here's an example which uses the following +-- explicit 'IsoUnbox' instance: +-- +-- +-- >>> :set -XBangPatterns -XTypeFamilies -XStandaloneDeriving -XDerivingVia +-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> :{ +-- >>> data Bar a = Bar Int a +-- >>> deriving Show +-- >>> instance VU.IsoUnbox (Bar a) (Int, VU.DoNotUnboxStrict a) where +-- >>> toURepr (Bar i !a) = (i, VU.DoNotUnboxStrict a) +-- >>> fromURepr (i, VU.DoNotUnboxStrict a) = Bar i a +-- >>> {-# INLINE toURepr #-} +-- >>> {-# INLINE fromURepr #-} +-- >>> newtype instance VU.MVector s (Bar a) = MV_Bar (VU.MVector s (Int, VU.DoNotUnboxStrict a)) +-- >>> newtype instance VU.Vector (Bar a) = V_Bar (VU.Vector (Int, VU.DoNotUnboxStrict a)) +-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VGM.MVector VUM.MVector (Bar a) +-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VG.Vector VU.Vector (Bar a) +-- >>> instance VU.Unbox (Bar a) +-- >>> :} +-- +-- >>> VU.fromListN 3 [ Bar 3 "Bye", Bar 2 "for", Bar 1 "now" ] +-- [Bar 3 "Bye",Bar 2 "for",Bar 1 "now"] +-- +-- @since 0.13.2.0 +newtype DoNotUnboxStrict a = DoNotUnboxStrict a + +newtype instance MVector s (DoNotUnboxStrict a) = MV_DoNotUnboxStrict (S.MVector s a) +newtype instance Vector (DoNotUnboxStrict a) = V_DoNotUnboxStrict (S.Vector a) + +instance M.MVector MVector (DoNotUnboxStrict a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @S.MVector @a + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @S.MVector @a + basicOverlaps = coerce $ M.basicOverlaps @S.MVector @a + basicUnsafeNew = coerce $ M.basicUnsafeNew @S.MVector @a + basicInitialize = coerce $ M.basicInitialize @S.MVector @a + basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @S.MVector @a + basicUnsafeRead = coerce $ M.basicUnsafeRead @S.MVector @a + basicUnsafeWrite = coerce $ M.basicUnsafeWrite @S.MVector @a + basicClear = coerce $ M.basicClear @S.MVector @a + basicSet = coerce $ M.basicSet @S.MVector @a + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @S.MVector @a + basicUnsafeMove = coerce $ M.basicUnsafeMove @S.MVector @a + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @S.MVector @a + +instance G.Vector Vector (DoNotUnboxStrict a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @S.Vector @a + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @S.Vector @a + basicLength = coerce $ G.basicLength @S.Vector @a + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @S.Vector @a + basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @S.Vector @a + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @S.Vector @a + elemseq _ = seq + +instance Unbox (DoNotUnboxStrict a) + +-- | Newtype which allows to derive unbox instances for type @a@ which +-- is normally a "boxed" type. The newtype stictly evaluates the wrapped values +-- via thier requisite 'NFData' instance, ensuring that the unboxed vector +-- contains only values reduced to normal form. +-- For a less strict newtype wrappers, see 'DoNotUnboxLazy' and 'DoNotUnboxStrict'. +-- +-- 'DoNotUnboxNormalForm' is intended to be unsed in conjunction with the newtype 'As' +-- and the type class 'IsoUnbox'. Here's an example which uses the following +-- explicit 'IsoUnbox' instance: +-- +-- +-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia +-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM +-- >>> import qualified Data.Vector.Generic as VG +-- >>> import qualified Data.Vector.Generic.Mutable as VGM +-- >>> import qualified Control.DeepSeq as NF +-- >>> :{ +-- >>> data Baz a = Baz Int a +-- >>> deriving Show +-- >>> instance NF.NFData a => VU.IsoUnbox (Baz a) (Int, VU.DoNotUnboxNormalForm a) where +-- >>> toURepr (Baz i a) = (i, VU.DoNotUnboxNormalForm $ NF.force a) +-- >>> fromURepr (i, VU.DoNotUnboxNormalForm a) = Baz i a +-- >>> {-# INLINE toURepr #-} +-- >>> {-# INLINE fromURepr #-} +-- >>> newtype instance VU.MVector s (Baz a) = MV_Baz (VU.MVector s (Int, VU.DoNotUnboxNormalForm a)) +-- >>> newtype instance VU.Vector (Baz a) = V_Baz (VU.Vector (Int, VU.DoNotUnboxNormalForm a)) +-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VGM.MVector VUM.MVector (Baz a) +-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VG.Vector VU.Vector (Baz a) +-- >>> instance NF.NFData a => VU.Unbox (Baz a) +-- >>> :} +-- +-- >>> VU.fromListN 3 [ Baz 3 "Fully", Baz 9 "evaluated", Baz 27 "data" ] +-- [Baz 3 "Fully",Baz 9 "evaluated",Baz 27 "data"] +-- +-- @since 0.13.2.0 +newtype DoNotUnboxNormalForm a = DoNotUnboxNormalForm a + +newtype instance MVector s (DoNotUnboxNormalForm a) = MV_DoNotUnboxNormalForm (S.MVector s a) +newtype instance Vector (DoNotUnboxNormalForm a) = V_DoNotUnboxNormalForm (S.Vector a) + +instance NFData a => M.MVector MVector (DoNotUnboxNormalForm a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength = coerce $ M.basicLength @S.MVector @a + basicUnsafeSlice = coerce $ M.basicUnsafeSlice @S.MVector @a + basicOverlaps = coerce $ M.basicOverlaps @S.MVector @a + basicUnsafeNew = coerce $ M.basicUnsafeNew @S.MVector @a + basicInitialize = coerce $ M.basicInitialize @S.MVector @a + basicUnsafeReplicate = coerce (\i x -> M.basicUnsafeReplicate @S.MVector @a i (force x)) + basicUnsafeRead = coerce $ M.basicUnsafeRead @S.MVector @a + basicUnsafeWrite = coerce (\v i x -> M.basicUnsafeWrite @S.MVector @a v i (force x)) + basicClear = coerce $ M.basicClear @S.MVector @a + basicSet = coerce (\v x -> M.basicSet @S.MVector @a v (force x)) + basicUnsafeCopy = coerce $ M.basicUnsafeCopy @S.MVector @a + basicUnsafeMove = coerce $ M.basicUnsafeMove @S.MVector @a + basicUnsafeGrow = coerce $ M.basicUnsafeGrow @S.MVector @a + +instance NFData a => G.Vector Vector (DoNotUnboxNormalForm a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @S.Vector @a + basicUnsafeThaw = coerce $ G.basicUnsafeThaw @S.Vector @a + basicLength = coerce $ G.basicLength @S.Vector @a + basicUnsafeSlice = coerce $ G.basicUnsafeSlice @S.Vector @a + basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @S.Vector @a + basicUnsafeCopy = coerce $ G.basicUnsafeCopy @S.Vector @a + elemseq _ x y = rnf (coerce x :: a) `seq` y + +instance NFData a => Unbox (DoNotUnboxNormalForm a) + + +deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any) +deriveNewtypeInstances((), All, Bool, All, V_All, MV_All) + +-- ------- +-- Const +-- ------- + +deriveNewtypeInstances(Unbox a, Const a b, a, Const, V_Const, MV_Const) + +-- --- +-- Alt +-- --- + +deriveNewtypeInstances(Unbox (f a), Alt f a, f a, Alt, V_Alt, MV_Alt) + +-- ------- +-- Compose +-- ------- + +deriveNewtypeInstances(Unbox (f (g a)), Compose f g a, f (g a), Compose, V_Compose, MV_Compose) + +-- ------ +-- Tuples +-- ------ + +#define DEFINE_INSTANCES +#include "unbox-tuple-instances" diff --git a/src/Data/Vector/Unboxed/Mutable.hs b/src/Data/Vector/Unboxed/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxed/Mutable.hs @@ -0,0 +1,647 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Data.Vector.Unboxed.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- Alexey Kuleshevich 2020-2022 +-- Aleksey Khudyakov 2020-2022 +-- Andrew Lelechenko 2020-2022 +-- License : BSD-style +-- +-- Maintainer : Haskell Libraries Team +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable adaptive unboxed vectors. + +module Data.Vector.Unboxed.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, generate, generateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Zipping and unzipping + -- $zip + zip, zip3, zip4, zip5, zip6, + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Accessing individual elements + read, readMaybe, write, modify, modifyM, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, + + -- * Folds + mapM_, imapM_, forM_, iforM_, + foldl, foldl', foldM, foldM', + foldr, foldr', foldrM, foldrM', + ifoldl, ifoldl', ifoldM, ifoldM', + ifoldr, ifoldr', ifoldrM, ifoldrM', + + -- * Modifying vectors + nextPermutation, nextPermutationBy, + prevPermutation, prevPermutationBy, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + -- * Re-exports + PrimMonad, PrimState, RealWorld +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Fusion.Util ( delayed_min ) +import Control.Monad.Primitive + +import Prelude ( Ord, Bool, Int, Maybe, Ordering(..) ) + +-- don't import an unused Data.Vector.Internal.Check +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Unbox a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty. +null :: Unbox a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Unbox a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> MVector s a + -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +-- | Take the @n@ first elements of the mutable vector without making a +-- copy. For negative @n@, the empty vector is returned. If @n@ is larger +-- than the vector's length, the vector is returned unchanged. +take :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +-- | Drop the @n@ first element of the mutable vector without making a +-- copy. For negative @n@, the vector is returned unchanged. If @n@ is +-- larger than the vector's length, the empty vector is returned. +drop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Split the mutable vector into the first @n@ elements +-- and the remainder, without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, +-- but slightly more efficient. +splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +-- | Drop the last element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +init :: Unbox a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +-- | Drop the first element of the mutable vector without making a copy. +-- If the vector is empty, an exception is thrown. +tail :: Unbox a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Unbox a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | Unsafe variant of 'take'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will +-- simply create an invalid slice that likely violate memory safety. +unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- | Same as 'init', but doesn't do range checks. +unsafeInit :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | Same as 'tail', but doesn't do range checks. +unsafeTail :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Unbox a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The vector content +-- is uninitialized, which means it is filled with whatever the +-- underlying memory buffer happens to contain. +-- +-- @since 0.5 +unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Unbox a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with the results of applying the function to each index. +-- Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generate :: (PrimMonad m, Unbox a) => Int -> (Int -> a) -> m (MVector (PrimState m) a) +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Create a mutable vector of the given length (0 if the length is +-- negative) and fill it with the results of applying the monadic function to each +-- index. Iteration starts at index 0. +-- +-- @since 0.12.3.0 +generateM :: (PrimMonad m, Unbox a) => Int -> (Int -> m a) -> m (MVector (PrimState m) a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow an unboxed vector by the given number of elements. The number must be +-- non-negative. It has the same semantics as 'G.grow' for generic vectors. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed as VU +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> mv <- VU.thaw $ VU.fromList ([('a', 10), ('b', 20), ('c', 30)] :: [(Char, Int)]) +-- >>> mv' <- MVU.grow mv 2 +-- +-- Extra memory at the end of the newly allocated vector is initialized to 0 +-- bytes, which for 'Unbox' instance will usually correspond to some default +-- value for a particular type, e.g. @0@ for @Int@, @False@ for @Bool@, +-- etc. However, if 'unsafeGrow' was used instead, this would not have been +-- guaranteed and some garbage would be there instead. +-- +-- >>> VU.freeze mv' +-- [('a',10),('b',20),('c',30),('\NUL',0),('\NUL',0)] +-- +-- Having the extra space we can write new values in there: +-- +-- >>> MVU.write mv' 3 ('d', 999) +-- >>> VU.freeze mv' +-- [('a',10),('b',20),('c',30),('d',999),('\NUL',0)] +-- +-- It is important to note that the source mutable vector is not affected when +-- the newly allocated one is mutated. +-- +-- >>> MVU.write mv' 2 ('X', 888) +-- >>> VU.freeze mv' +-- [('a',10),('b',20),('X',888),('d',999),('\NUL',0)] +-- >>> VU.freeze mv +-- [('a',10),('b',20),('c',30)] +-- +-- @since 0.5 +grow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be non-negative, but +-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. +-- +-- @since 0.5 +unsafeGrow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- 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 + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. Will throw an exception if +-- the index is out of range. +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> v <- MVU.generate 10 (\x -> x*x) +-- >>> MVU.read v 3 +-- 9 +read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Yield the element at the given position. Returns 'Nothing' if +-- the index is out of range. +-- +-- @since 0.13 +-- +-- ==== __Examples__ +-- +-- >>> import qualified Data.Vector.Unboxed.Mutable as MVU +-- >>> v <- MVU.generate 10 (\x -> x*x) +-- >>> MVU.readMaybe v 3 +-- Just 9 +-- >>> MVU.readMaybe v 13 +-- Nothing +readMaybe :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m (Maybe a) +{-# INLINE readMaybe #-} +readMaybe = G.readMaybe + +-- | Replace the element at the given position. +write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic function. +-- +-- @since 0.12.3.0 +modifyM :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE modifyM #-} +modifyM = G.modifyM + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + +-- | Replace the element at the given position and return the old element. +exchange :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange = G.exchange + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# 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 + +-- | Modify the element at the given position using a monadic +-- function. No bounds checks are performed. +-- +-- @since 0.12.3.0 +unsafeModifyM :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> m a) -> Int -> m () +{-# INLINE unsafeModifyM #-} +unsafeModifyM = G.unsafeModifyM + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- | Replace the element at the given position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange = G.unsafeExchange + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap, but this is not checked. +unsafeCopy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | 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 +-- to the target vector. +move :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE move #-} +move = G.move + +-- | 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 +-- to the target vector. +unsafeMove :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Modifying vectors +-- ----------------- + +-- | Compute the (lexicographically) next permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +-- | Compute the (lexicographically) next permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly descending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::next_permutation@. +-- +-- @since 0.13.2.0 +nextPermutationBy :: (PrimMonad m,Unbox e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutationBy #-} +nextPermutationBy = G.nextPermutationBy + +-- | Compute the (lexicographically) previous permutation of the given vector in-place. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutation #-} +prevPermutation = G.prevPermutation + +-- | Compute the (lexicographically) previous permutation of the given vector in-place, +-- using the provided comparison function. +-- Returns False when the input is the last item in the enumeration, i.e., if it is in +-- weakly ascending order. In this case the vector will not get updated, +-- as opposed to the behavior of the C++ function @std::prev_permutation@. +-- +-- @since 0.13.2.0 +prevPermutationBy :: (PrimMonad m,Unbox e) => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool +{-# INLINE prevPermutationBy #-} +prevPermutationBy = G.prevPermutationBy + +-- Folds +-- ----- + +-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results. +-- +-- @since 0.12.3.0 +mapM_ :: (PrimMonad m, Unbox a) => (a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector and its index, +-- discarding the results. +-- +-- @since 0.12.3.0 +imapM_ :: (PrimMonad m, Unbox a) => (Int -> a -> m b) -> MVector (PrimState m) a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector, +-- discarding the results. It's the same as @flip mapM_@. +-- +-- @since 0.12.3.0 +forM_ :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- | /O(n)/ Apply the monadic action to every element of the vector +-- and its index, discarding the results. It's the same as @flip imapM_@. +-- +-- @since 0.12.3.0 +iforM_ :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (Int -> a -> m b) -> m () +{-# INLINE iforM_ #-} +iforM_ = G.iforM_ + +-- | /O(n)/ Pure left fold. +-- +-- @since 0.12.3.0 +foldl :: (PrimMonad m, Unbox a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Pure left fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldl' :: (PrimMonad m, Unbox a) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Pure left fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl :: (PrimMonad m, Unbox a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldl' :: (PrimMonad m, Unbox a) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Pure right fold. +-- +-- @since 0.12.3.0 +foldr :: (PrimMonad m, Unbox a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Pure right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldr' :: (PrimMonad m, Unbox a) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Pure right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr :: (PrimMonad m, Unbox a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Pure right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldr' :: (PrimMonad m, Unbox a) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- | /O(n)/ Monadic fold. +-- +-- @since 0.12.3.0 +foldM :: (PrimMonad m, Unbox a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldM' :: (PrimMonad m, Unbox a) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM :: (PrimMonad m, Unbox a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldM' :: (PrimMonad m, Unbox a) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic right fold. +-- +-- @since 0.12.3.0 +foldrM :: (PrimMonad m, Unbox a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM #-} +foldrM = G.foldrM + +-- | /O(n)/ Monadic right fold with strict accumulator. +-- +-- @since 0.12.3.0 +foldrM' :: (PrimMonad m, Unbox a) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE foldrM' #-} +foldrM' = G.foldrM' + +-- | /O(n)/ Monadic right fold using a function applied to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM :: (PrimMonad m, Unbox a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM #-} +ifoldrM = G.ifoldrM + +-- | /O(n)/ Monadic right fold with strict accumulator using a function applied +-- to each element and its index. +-- +-- @since 0.12.3.0 +ifoldrM' :: (PrimMonad m, Unbox a) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b +{-# INLINE ifoldrM' #-} +ifoldrM' = G.ifoldrM' + + +-- $zip +-- +-- Following functions provide access to the representation of vector +-- of tuples. Internally it's product of vectors for each element of +-- tuple. Conversions are performed in /O(1)/ and produced vector will +-- share underlying buffers with parameter vectors. + +#define DEFINE_MUTABLE +#include "unbox-tuple-instances" + +-- $setup +-- >>> import Prelude (Char, (*), ($)) diff --git a/tests-inspect/Inspect.hs b/tests-inspect/Inspect.hs new file mode 100644 --- /dev/null +++ b/tests-inspect/Inspect.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin=Test.Tasty.Inspection.Plugin #-} +{-# OPTIONS_GHC -dsuppress-all #-} +{-# OPTIONS_GHC -dno-suppress-type-signatures #-} +-- | Most basic inspection tests +module Inspect where + +import Test.Tasty +import Test.Tasty.Inspection +import qualified Data.Vector as V + +simple_fusion :: Int -> Int +simple_fusion n = V.sum $ V.generate n id + + +tests :: TestTree +tests = testGroup "inspection" + [ $(inspectObligations [(`hasNoType` ''V.Vector), hasNoTypeClasses] 'simple_fusion) + ] diff --git a/tests-inspect/Inspect/DerivingVia.hs b/tests-inspect/Inspect/DerivingVia.hs new file mode 100644 --- /dev/null +++ b/tests-inspect/Inspect/DerivingVia.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -dno-suppress-type-signatures #-} +{-# OPTIONS_GHC -dsuppress-all #-} +{-# OPTIONS_GHC -fplugin=Test.Tasty.Inspection.Plugin #-} +-- | Most basic inspection tests +module Inspect.DerivingVia where + +import Test.Tasty +import Test.Tasty.Inspection +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as VGM +import qualified Data.Vector.Unboxed as VU +import GHC.Generics (Generic) + +import Inspect.DerivingVia.OtherFoo + + +-- | Simple product data type for which we derive Unbox instances +-- using generics and iso-deriving. This one is used in same module +-- where it's defined. It's used to check that there's no difference +-- between data type defined in same and different module (see +-- 'OtherFoo'). +data Foo a = Foo Int a + deriving (Show,Generic) + +instance VU.IsoUnbox (Foo a) (Int,a) where + +newtype instance VU.MVector s (Foo a) = MV_Int (VU.MVector s (Int, a)) +newtype instance VU.Vector (Foo a) = V_Int (VU.Vector (Int, a)) + +instance VU.Unbox a => VU.Unbox (Foo a) +deriving via (Foo a `VU.As` (Int, a)) instance VU.Unbox a => VGM.MVector VU.MVector (Foo a) +deriving via (Foo a `VU.As` (Int, a)) instance VU.Unbox a => VG.Vector VU.Vector (Foo a) + +map_Foo :: VU.Vector (Foo Double) -> VU.Vector (Foo Double) +map_Foo = VU.map (\(Foo a b) -> Foo (a*10) (b*100)) + +pipeline_Foo :: Int -> Double +pipeline_Foo n + = VU.foldl' (\acc (Foo a b) -> acc + b^^a) 0 + $ VU.filter (\(Foo a _) -> a < 4) + $ VU.map (\(Foo a b) -> Foo (a + 2) (log b)) + $ VU.generate n (\i -> Foo i (log (fromIntegral i))) + +map_OtherFoo :: VU.Vector (OtherFoo Double) -> VU.Vector (OtherFoo Double) +map_OtherFoo = VU.map (\(OtherFoo a b) -> OtherFoo (a*10) (b*100)) + +pipeline_OtherFoo :: Int -> Double +pipeline_OtherFoo n + = VU.foldl' (\acc (OtherFoo a b) -> acc + b^^a) 0 + $ VU.filter (\(OtherFoo a _) -> a < 4) + $ VU.map (\(OtherFoo a b) -> OtherFoo (a + 2) (log b)) + $ VU.generate n (\i -> OtherFoo i (log (fromIntegral i))) + + +-- | Here we test that optimizer successfully eliminated all generics +-- and even mentions of Foo data type. +tests :: TestTree +tests = testGroup "iso-deriving" + [ $(inspectObligations [(`doesNotUse` 'Foo), hasNoGenerics, hasNoTypeClasses] + 'map_Foo) + , $(inspectObligations [(`doesNotUse` 'OtherFoo), hasNoGenerics, hasNoTypeClasses] + 'pipeline_Foo) + , $(inspectObligations [(`doesNotUse` 'OtherFoo), hasNoGenerics, hasNoTypeClasses] + 'map_OtherFoo) + , $(inspectObligations [(`doesNotUse` 'OtherFoo), hasNoGenerics, hasNoTypeClasses] + 'pipeline_OtherFoo) + ] diff --git a/tests-inspect/Inspect/DerivingVia/OtherFoo.hs b/tests-inspect/Inspect/DerivingVia/OtherFoo.hs new file mode 100644 --- /dev/null +++ b/tests-inspect/Inspect/DerivingVia/OtherFoo.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module Inspect.DerivingVia.OtherFoo where + +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as VGM +import qualified Data.Vector.Unboxed as VU +import GHC.Generics (Generic) + + +-- | Simple product data type for which we derive Unbox instances +-- using generics and iso-deriving. It's defined in separate module in +-- order to test that it doesn't impede optimizer +data OtherFoo a = OtherFoo Int a + deriving (Show,Generic) + +instance VU.IsoUnbox (OtherFoo a) (Int,a) where + +newtype instance VU.MVector s (OtherFoo a) = MV_Int (VU.MVector s (Int, a)) +newtype instance VU.Vector (OtherFoo a) = V_Int (VU.Vector (Int, a)) + +instance VU.Unbox a => VU.Unbox (OtherFoo a) +deriving via (OtherFoo a `VU.As` (Int, a)) instance VU.Unbox a => VGM.MVector VU.MVector (OtherFoo a) +deriving via (OtherFoo a `VU.As` (Int, a)) instance VU.Unbox a => VG.Vector VU.Vector (OtherFoo a) diff --git a/tests-inspect/main.hs b/tests-inspect/main.hs new file mode 100644 --- /dev/null +++ b/tests-inspect/main.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} +module Main (main) where + +import qualified Inspect +#if MIN_VERSION_base(4,12,0) +import qualified Inspect.DerivingVia +#endif +import Test.Tasty (defaultMain,testGroup) + +main :: IO () +main = defaultMain $ testGroup "tests" + [ Inspect.tests +#if MIN_VERSION_base(4,12,0) + , Inspect.DerivingVia.tests +#endif + ] diff --git a/tests/Boilerplater.hs b/tests/Boilerplater.hs --- a/tests/Boilerplater.hs +++ b/tests/Boilerplater.hs @@ -1,5 +1,6 @@ module Boilerplater where +import Data.List (stripPrefix) import Test.Tasty.QuickCheck import Language.Haskell.TH @@ -8,20 +9,4 @@ testProperties :: [Name] -> Q Exp testProperties nms = fmap ListE $ sequence [[| testProperty $(stringE prop_name) $(varE nm) |] | nm <- nms - , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] - --- This nice clean solution doesn't quite work since I need to use lexically-scoped type --- variables, which aren't supported by Template Haskell. Argh! --- testProperties :: Q [Dec] -> Q Exp --- testProperties mdecs = do --- decs <- mdecs --- property_exprs <- sequence [[| testProperty "$prop_name" $(return $ VarE nm) |] --- | FunD nm _clauses <- decs --- , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] --- return $ LetE decs (ListE property_exprs) - -stripPrefix_maybe :: String -> String -> Maybe String -stripPrefix_maybe prefix what - | what_start == prefix = Just what_end - | otherwise = Nothing - where (what_start, what_end) = splitAt (length prefix) what + , Just prop_name <- [stripPrefix "prop_" (nameBase nm)]] diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,15 +1,25 @@ module Main (main) where -import qualified Tests.Vector import qualified Tests.Vector.UnitTests +import qualified Tests.Vector.Boxed +import qualified Tests.Vector.Primitive +import qualified Tests.Vector.Storable +import qualified Tests.Vector.Strict +import qualified Tests.Vector.Unboxed import qualified Tests.Bundle import qualified Tests.Move import Test.Tasty (defaultMain,testGroup) main :: IO () -main = defaultMain $ testGroup "toplevel" $ Tests.Bundle.tests - ++ Tests.Vector.tests - ++ Tests.Vector.UnitTests.tests - ++ Tests.Move.tests - +main = defaultMain $ testGroup "toplevel" $ concat + [ Tests.Bundle.tests + , [ testGroup "Tests.Vector.Boxed" Tests.Vector.Boxed.tests + , testGroup "Tests.Vector.Primitive" Tests.Vector.Primitive.tests + , testGroup "Tests.Vector.Storable" Tests.Vector.Storable.tests + , testGroup "Tests.Vector.Strict" Tests.Vector.Strict.tests + , testGroup "Tests.Vector.Unboxed" Tests.Vector.Unboxed.tests + ] + , Tests.Vector.UnitTests.tests + , Tests.Move.tests + ] diff --git a/tests/Setup.hs b/tests/Setup.hs deleted file mode 100644 --- a/tests/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Distribution.Simple -main = defaultMain - diff --git a/tests/Tests/Bundle.hs b/tests/Tests/Bundle.hs --- a/tests/Tests/Bundle.hs +++ b/tests/Tests/Bundle.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeOperators #-} module Tests.Bundle ( tests ) where import Boilerplater @@ -13,16 +15,11 @@ import Text.Show.Functions () import Data.List (foldl', foldl1', unfoldr, find, findIndex) --- migration from testframework to tasty -type Test = TestTree -#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 +type CommonContext 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 :: forall v a. (CommonContext a) => S.Bundle v a -> [TestTree] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList @@ -33,7 +30,7 @@ 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 :: forall v a. (CommonContext a) => S.Bundle v a -> [TestTree] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, @@ -151,7 +148,7 @@ = (\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 :: forall v. S.Bundle v Bool -> [TestTree] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) where prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and diff --git a/tests/Tests/Move.hs b/tests/Tests/Move.hs --- a/tests/Tests/Move.hs +++ b/tests/Tests/Move.hs @@ -7,8 +7,8 @@ import Utilities () import Control.Monad (replicateM) -import Control.Monad.ST (runST) -import Data.List (sort,permutations) +import Control.Monad.ST (ST, runST) +import Data.List (sort,sortBy,permutations) import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M @@ -41,9 +41,39 @@ testPermutations :: Bool testPermutations = all checkPermutations [1..7] +checkRevPermutations :: Int -> Bool +checkRevPermutations n = runST $ do + vec <- U.thaw (U.fromList [n,n-1..1]) + res <- replicateM (product [1..n]) $ M.prevPermutation vec >> U.freeze vec >>= return . U.toList + return $! ([n,n-1..1] : res) == sortBy (flip compare) (permutations [n,n-1..1]) ++ [[1..n]] + +testRevPermutations :: Bool +testRevPermutations = all checkRevPermutations [1..7] + +nextPermutationBijective :: (M.MVector v a, Ord a) => v s a -> ST s () +nextPermutationBijective v = do + res <- M.nextPermutation v + if res then return () else M.reverse v + +prevPermutationBijective :: (M.MVector v a, Ord a) => v s a -> ST s () +prevPermutationBijective v = do + res <- M.prevPermutation v + if res then return () else M.reverse v + +testNPPermutationIsId :: (G.Vector v a, Ord a, Show (v a), Eq (v a)) => v a -> Property +testNPPermutationIsId v = v === G.modify (\mv -> nextPermutationBijective mv >> prevPermutationBijective mv) v + +testPNPermutationIsId :: (G.Vector v a, Ord a, Show (v a), Eq (v a)) => v a -> Property +testPNPermutationIsId v = v === G.modify (\mv -> prevPermutationBijective mv >> nextPermutationBijective mv) v + tests = [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property), testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property), testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property), testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property), - testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations] + testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations, + testProperty "Data.Vector.Generic.Mutable (prevPermutation)" testRevPermutations, + testProperty "Data.Vector.Generic.Mutable (nextPermutation then prevPermutation = id)" + (testNPPermutationIsId :: U.Vector Int -> Property), + testProperty "Data.Vector.Generic.Mutable (prevPermutation then nextPermutation = id)" + (testPNPermutationIsId :: U.Vector Int -> Property)] diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs deleted file mode 100644 --- a/tests/Tests/Vector.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -module Tests.Vector (tests) where - -import Test.Tasty (testGroup) -import qualified Tests.Vector.Boxed -import qualified Tests.Vector.Primitive -import qualified Tests.Vector.Storable -import qualified Tests.Vector.Unboxed - -tests = - [ testGroup "Tests.Vector.Boxed" Tests.Vector.Boxed.tests - , testGroup "Tests.Vector.Primitive" Tests.Vector.Primitive.tests - , testGroup "Tests.Vector.Storable" Tests.Vector.Storable.tests - , testGroup "Tests.Vector.Unboxed" Tests.Vector.Unboxed.tests - ] diff --git a/tests/Tests/Vector/Boxed.hs b/tests/Tests/Vector/Boxed.hs --- a/tests/Tests/Vector/Boxed.hs +++ b/tests/Tests/Vector/Boxed.hs @@ -8,7 +8,9 @@ import GHC.Exts (inline) -testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Data a) => Data.Vector.Vector a -> [Test] +testGeneralBoxedVector + :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Data a) + => Data.Vector.Vector a -> [TestTree] testGeneralBoxedVector dummy = concatMap ($ dummy) [ testSanity @@ -21,6 +23,7 @@ , testMonadFunctions , testApplicativeFunctions , testAlternativeFunctions + , testSequenceFunctions , testDataFunctions ] @@ -30,7 +33,9 @@ , testBoolFunctions ] -testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Vector a -> [Test] +testNumericBoxedVector + :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a) + => Data.Vector.Vector a -> [TestTree] testNumericBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector @@ -43,4 +48,5 @@ testBoolBoxedVector (undefined :: Data.Vector.Vector Bool) , testGroup "Int" $ testNumericBoxedVector (undefined :: Data.Vector.Vector Int) + , testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Vector Int) ] diff --git a/tests/Tests/Vector/Primitive.hs b/tests/Tests/Vector/Primitive.hs --- a/tests/Tests/Vector/Primitive.hs +++ b/tests/Tests/Vector/Primitive.hs @@ -7,7 +7,10 @@ import GHC.Exts (inline) -testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Data a) => Data.Vector.Primitive.Vector a -> [Test] +testGeneralPrimitiveVector + :: forall a. ( CommonContext a Data.Vector.Primitive.Vector + , Data.Vector.Primitive.Prim a, Ord a, Data a) + => Data.Vector.Primitive.Vector a -> [TestTree] testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ testSanity @@ -17,7 +20,10 @@ , testDataFunctions ] -testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Primitive.Vector a -> [Test] +testNumericPrimitiveVector + :: forall a. ( CommonContext a Data.Vector.Primitive.Vector + , Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a, Data a) + => Data.Vector.Primitive.Vector a -> [TestTree] testNumericPrimitiveVector dummy = concatMap ($ dummy) [ testGeneralPrimitiveVector @@ -31,4 +37,5 @@ , testGroup "Double" $ testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double) + , testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Primitive.Vector Int) ] diff --git a/tests/Tests/Vector/Property.hs b/tests/Tests/Vector/Property.hs --- a/tests/Tests/Vector/Property.hs +++ b/tests/Tests/Vector/Property.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeOperators #-} module Tests.Vector.Property ( CommonContext , VanillaContext @@ -13,25 +14,28 @@ , testMonadFunctions , testApplicativeFunctions , testAlternativeFunctions + , testSequenceFunctions , testBoolFunctions , testNumFunctions , testNestedVectorFunctions , testDataFunctions + , testUnstream -- re-exports , Data , Random - ,Test ) where import Boilerplater import Utilities as Util hiding (limitUnfolds) -import Data.Functor.Identity +import Control.Monad +import Control.Monad.ST import qualified Data.Traversable as T (Traversable(..)) -import Data.Foldable (Foldable(foldMap)) import Data.Orphans () - +import Data.Maybe +import Data.Foldable (foldrM) import qualified Data.Vector.Generic as V +import qualified Data.Vector.Generic.Mutable as MV import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck @@ -42,7 +46,6 @@ import Text.Show.Functions () import Data.List -import Data.Monoid import qualified Control.Applicative as Applicative import System.Random (Random) @@ -63,42 +66,15 @@ type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) --- | migration hack for moving from TestFramework to Tasty -type Test = TestTree -- TODO: implement Vector equivalents of list functions for some of the commented out properties --- TODO: test and implement some of these other Prelude functions: --- mapM * --- mapM_ * --- sequence --- sequence_ --- sum * --- product * --- scanl * --- scanl1 * --- scanr * --- scanr1 * --- lookup * --- lines --- words --- unlines --- unwords --- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors. --- Ones with *s are the most plausible candidates. - -- TODO: add tests for the other extra functions -- IVector exports still needing tests: -- copy, --- slice, --- (//), update, bpermute, --- prescanl, prescanl', -- new, -- unsafeSlice, unsafeIndex, --- vlength, vnew --- TODO: test non-IVector stuff? - -testSanity :: forall a v. (CommonContext a v) => v a -> [Test] +testSanity :: forall a v. (CommonContext a v) => v a -> [TestTree] {-# INLINE testSanity #-} testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, @@ -112,7 +88,7 @@ prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s -testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test] +testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [TestTree] -- FIXME: inlining of unboxed properties blows up the memory during compilation. See #272 --{-# INLINE testPolymorphicFunctions #-} testPolymorphicFunctions _ = $(testProperties [ @@ -121,7 +97,7 @@ -- Length information 'prop_length, 'prop_null, - -- Indexing (FIXME) + -- Indexing 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, @@ -138,17 +114,16 @@ -- Initialisation (FIXME) 'prop_empty, 'prop_singleton, 'prop_replicate, 'prop_generate, 'prop_iterateN, 'prop_iterateNM, + 'prop_generateM, 'prop_replicateM, -- Monadic initialisation (FIXME) - 'prop_createT, - {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} + 'prop_create, 'prop_createT, -- Unfolding - 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, + 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrExactN, + 'prop_unfoldrM, 'prop_unfoldrNM, 'prop_unfoldrExactNM, 'prop_constructN, 'prop_constructrN, - -- Enumeration? (FIXME?) - -- Concatenation (FIXME) 'prop_cons, 'prop_snoc, 'prop_append, 'prop_concat, @@ -159,7 +134,7 @@ -- Bulk updates (FIXME) 'prop_upd, - {- 'prop_update, 'prop_update_, + {- 'prop_update_, 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} -- Accumulations (FIXME) @@ -171,30 +146,23 @@ 'prop_reverse, 'prop_backpermute, {- 'prop_unsafeBackpermute, -} - -- Elementwise indexing - {- 'prop_indexed, -} - -- Mapping 'prop_map, 'prop_imap, 'prop_concatMap, -- Monadic mapping - {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} + 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, 'prop_imapM, 'prop_imapM_, -- Zipping - 'prop_zipWith, 'prop_zipWith3, {- ... -} - 'prop_izipWith, 'prop_izipWith3, {- ... -} + 'prop_zipWith, 'prop_zipWith3, + 'prop_izipWith, 'prop_izipWith3, 'prop_izipWithM, 'prop_izipWithM_, - {- 'prop_zip, ... -} -- Monadic zipping - {- 'prop_zipWithM, 'prop_zipWithM_, -} - - -- Unzipping - {- 'prop_unzip, ... -} + 'prop_zipWithM, 'prop_zipWithM_, -- Filtering - 'prop_filter, 'prop_ifilter, {- prop_filterM, -} + 'prop_filter, 'prop_ifilter, 'prop_filterM, 'prop_uniq, 'prop_mapMaybe, 'prop_imapMaybe, 'prop_takeWhile, 'prop_dropWhile, @@ -203,10 +171,12 @@ 'prop_partition, {- 'prop_unstablePartition, -} 'prop_partitionWith, 'prop_span, 'prop_break, + 'prop_spanR, 'prop_breakR, + 'prop_groupBy, -- Searching 'prop_elem, 'prop_notElem, - 'prop_find, 'prop_findIndex, 'prop_findIndices, + 'prop_find, 'prop_findIndex, 'prop_findIndexR, 'prop_findIndices, 'prop_elemIndex, 'prop_elemIndices, -- Folding @@ -217,15 +187,7 @@ -- Specialised folds 'prop_all, 'prop_any, - {- 'prop_maximumBy, 'prop_minimumBy, - 'prop_maxIndexBy, 'prop_minIndexBy, -} - -- Monadic folds - {- ... -} - - -- Monadic sequencing - {- ... -} - -- Scans 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', @@ -235,7 +197,17 @@ 'prop_prescanr, 'prop_prescanr', 'prop_postscanr, 'prop_postscanr', 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', - 'prop_iscanr, 'prop_iscanr' + 'prop_iscanr, 'prop_iscanr', + + -- Mutable API + 'prop_mut_read, 'prop_mut_write, 'prop_mut_modify, + + 'prop_mut_generate, 'prop_mut_generateM, + 'prop_mut_mapM_, 'prop_mut_imapM_, 'prop_mut_forM_, 'prop_mut_iforM_, + 'prop_mut_foldr, 'prop_mut_foldr', 'prop_mut_foldl, 'prop_mut_foldl', + 'prop_mut_ifoldr, 'prop_mut_ifoldr', 'prop_mut_ifoldl, 'prop_mut_ifoldl', + 'prop_mut_foldM, 'prop_mut_foldM', 'prop_mut_foldrM, 'prop_mut_foldrM', + 'prop_mut_ifoldM, 'prop_mut_ifoldM', 'prop_mut_ifoldrM, 'prop_mut_ifoldrM' ]) where -- Prelude @@ -245,9 +217,11 @@ prop_null :: P (v a -> Bool) = V.null `eq` null prop_empty :: P (v a) = V.empty `eq` [] - prop_singleton :: P (a -> v a) = V.singleton `eq` singleton + prop_singleton :: P (a -> v a) = V.singleton `eq` Util.singleton prop_replicate :: P (Int -> a -> v a) = (\n _ -> n < 1000) ===> V.replicate `eq` replicate + prop_replicateM :: P (Int -> Writer [a] a -> Writer [a] (v a)) + = (\n _ -> n < 1000) ===> V.replicateM `eq` replicateM prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) @@ -255,10 +229,14 @@ prop_force :: P (v a -> v a) = V.force `eq` id prop_generate :: P (Int -> (Int -> a) -> v a) = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate + prop_generateM :: P (Int -> (Int -> Writer [a] a) -> Writer [a] (v a)) + = (\n _ -> n < 1000) ===> V.generateM `eq` Util.generateM prop_iterateN :: P (Int -> (a -> a) -> a -> v a) = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a)) = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM + prop_create :: P (v a -> v a) + prop_create = (\v -> V.create (V.thaw v)) `eq` id prop_createT :: P ((a, v a) -> (a, v a)) prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id @@ -319,6 +297,14 @@ prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map + prop_mapM :: P ((a -> Identity a) -> v a -> Identity (v a)) + = V.mapM `eq` mapM + prop_mapM_ :: P ((a -> Writer [a] ()) -> v a -> Writer [a] ()) + = V.mapM_ `eq` mapM_ + prop_forM :: P (v a -> (a -> Identity a) -> Identity (v a)) + = V.forM `eq` forM + prop_forM_ :: P (v a -> (a -> Writer [a] ()) -> Writer [a] ()) + = V.forM_ `eq` forM_ prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) = V.zipWith3 `eq` zipWith3 @@ -328,6 +314,10 @@ 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_zipWithM :: P ((a -> a -> Identity a) -> v a -> v a -> Identity (v a)) + = V.zipWithM `eq` zipWithM + prop_zipWithM_ :: P ((a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) + = V.zipWithM_ `eq` zipWithM_ 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] ()) @@ -337,6 +327,7 @@ prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter + prop_filterM :: P ((a -> Writer [a] Bool) -> v a -> Writer [a] (v a)) = V.filterM `eq` filterM prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile @@ -347,12 +338,19 @@ = V.partitionWith `eq` partitionWith prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break + prop_spanR :: P ((a -> Bool) -> v a -> (v a, v a)) = V.spanR `eq` spanR + prop_breakR :: P ((a -> Bool) -> v a -> (v a, v a)) = V.breakR `eq` breakR + prop_groupBy :: P ((a -> a -> Bool) -> v a -> [v a]) = V.groupBy `eq` groupBy prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) = V.findIndex `eq` findIndex + prop_findIndexR :: P ((a -> Bool) -> v a -> Maybe Int) + = V.findIndexR `eq` \p l -> case filter (p . snd) . reverse $ zip [0..] l of + (i,_):_ -> Just i + [] -> Nothing prop_findIndices :: P ((a -> Bool) -> v a -> v Int) = V.findIndices `eq` findIndices prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex @@ -402,10 +400,10 @@ = V.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanl' `eq` scanl - prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanl1 `eq` scanl1 - prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanl1' `eq` scanl1 + prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) + = V.scanl1 `eq` scanl1 + prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) + = V.scanl1' `eq` scanl1 prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) = V.iscanl `eq` iscanl prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) @@ -427,10 +425,10 @@ = V.iscanr `eq` iscanr prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) = V.iscanr' `eq` iscanr - prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanr1 `eq` scanr1 - prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanr1' `eq` scanr1 + prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) + = V.scanr1 `eq` scanr1 + prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) + = V.scanr1' `eq` scanr1 prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs @@ -439,18 +437,8 @@ prop_uniq :: P (v a -> v a) = V.uniq `eq` (map head . group) - --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span - --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break - --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt - --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all - --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any -- Data.List - --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int) - --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool) - --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int) - --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int) - -- --prop_mapAccumL = eq3 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) @@ -476,11 +464,15 @@ `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_unfoldrExactN :: P (Int -> (Int -> (a,Int)) -> Int -> v a) + = V.unfoldrExactN `eq` (\n f a -> unfoldr (limitUnfolds (Just . f)) (a, n)) prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n)) `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) + prop_unfoldrExactNM :: P (Int -> (Int -> Writer [Int] (a,Int)) -> Int -> Writer [Int] (v a)) + = V.unfoldrExactNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM (liftM Just . f)) (a, n)) prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where @@ -496,6 +488,110 @@ constructrN xs 0 _ = xs constructrN xs n f = constructrN (f xs : xs) (n-1) f + prop_mut_foldr :: P ((a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.foldr f z =<< V.thaw v) `eq` foldr + prop_mut_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.foldr' f z =<< V.thaw v) `eq` foldr + prop_mut_foldl :: P ((a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.foldl f z =<< V.thaw v) `eq` foldl + prop_mut_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.foldl' f z =<< V.thaw v) `eq` foldl' + prop_mut_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.ifoldr f z =<< V.thaw v) `eq` ifoldr + prop_mut_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.ifoldr' f z =<< V.thaw v) `eq` ifoldr + prop_mut_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.ifoldl f z =<< V.thaw v) `eq` ifoldl + prop_mut_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) = + (\f z v -> runST $ MV.ifoldl' f z =<< V.thaw v) `eq` ifoldl + + prop_mut_foldM :: P ((a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.foldM (\b -> pure . runIdentity . f b) z =<< V.thaw v) + `eq` foldM + prop_mut_foldM' :: P ((a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.foldM' (\b -> pure . runIdentity . f b) z =<< V.thaw v) + `eq` foldM + prop_mut_foldrM :: P ((a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.foldrM (\a -> pure . runIdentity . f a) z =<< V.thaw v) + `eq` + foldrM + prop_mut_foldrM' :: P ((a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.foldrM' (\a b -> pure $ runIdentity $ f a b) z =<< V.thaw v) + `eq` + foldrM + + prop_mut_read = \xs -> + not (V.null xs) ==> + forAll (choose (0, V.length xs-1)) $ \i -> + unP prop xs i + where + prop :: P (v a -> Int -> a) = (\v i -> runST $ do mv <- V.thaw v + MV.read mv i + ) `eq` (!!) + prop_mut_write = \xs -> + not (V.null xs) ==> + forAll (choose (0, V.length xs-1)) $ \i -> + unP prop xs i + where + prop :: P (v a -> Int -> a -> v a) = (\v i a -> runST $ do mv <- V.thaw v + MV.write mv i a + V.freeze mv + ) `eq` writeList + prop_mut_modify = \xs f -> + not (V.null xs) ==> + forAll (choose (0, V.length xs-1)) $ \i -> + unP prop xs f i + where + prop :: P (v a -> (a -> a) -> Int -> v a) + = (\v f i -> runST $ do mv <- V.thaw v + MV.modify mv f i + V.freeze mv + ) `eq` modifyList + + + + prop_mut_generate :: P (Int -> (Int -> a) -> v a) + = (\n _ -> n < 1000) ===> (\n f -> runST $ V.freeze =<< MV.generate n f) + `eq` Util.generate + prop_mut_generateM :: P (Int -> (Int -> Writer [a] a) -> Writer [a] (v a)) + = (\n _ -> n < 1000) ===> (\n f -> liftRunST $ V.freeze =<< MV.generateM n (hoistST . f)) + `eq` Util.generateM + + prop_mut_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.ifoldM (\b i -> pure . runIdentity . f b i) z =<< V.thaw v) + `eq` ifoldM + prop_mut_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.ifoldM' (\b i -> pure . runIdentity . f b i) z =<< V.thaw v) + `eq` ifoldM + prop_mut_ifoldrM :: P ((Int -> a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.ifoldrM (\i b -> pure . runIdentity . f i b) z =<< V.thaw v) + `eq` + ifoldrM + prop_mut_ifoldrM' :: P ((Int -> a -> a -> Identity a) -> a -> v a -> Identity a) + = (\f z v -> Identity $ runST $ MV.ifoldrM' (\i b -> pure . runIdentity . f i b) z =<< V.thaw v) + `eq` + ifoldrM + + prop_mut_forM_ :: P (v a -> (a -> Writer [a] ()) -> Writer [a] ()) + = (\v f -> liftRunST $ do mv <- V.thaw v + MV.forM_ mv (hoistST . f)) + `eq` flip mapM_ + prop_mut_iforM_ :: P (v a -> (Int -> a -> Writer [a] ()) -> Writer [a] ()) + = (\v f -> liftRunST $ do mv <- V.thaw v + MV.iforM_ mv (\i x -> hoistST $ f i x)) + `eq` flip imapM_ + prop_mut_mapM_ :: P ((a -> Writer [a] ()) -> v a -> Writer [a] ()) + = (\f v -> liftRunST $ MV.mapM_ (hoistST . f) =<< V.thaw v) `eq` mapM_ + prop_mut_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) + = (\f v -> liftRunST $ MV.imapM_ (\i x -> hoistST $ f i x) =<< V.thaw v) `eq` imapM_ + + +liftRunST :: (forall s. WriterT w (ST s) a) -> Writer w a +liftRunST m = WriterT $ Identity $ runST $ runWriterT m + +hoistST :: Writer w a -> WriterT w (ST s) a +hoistST = WriterT . pure . runWriter + -- copied from GHC source code partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) partitionWith _ [] = ([],[]) @@ -504,41 +600,59 @@ Right c -> (bs, c:cs) where (bs,cs) = partitionWith f xs -testTuplyFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test] +testTuplyFunctions + :: forall a v. ( CommonContext a v + , VectorContext (a, a) v + , VectorContext (a, a, a) v + , VectorContext (Int, a) v + ) + => v a -> [TestTree] {-# INLINE testTuplyFunctions #-} testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 , 'prop_unzip, 'prop_unzip3 + , 'prop_indexed + , 'prop_update ]) where - prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip - prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 - prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip - prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 + prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip + prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 + prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip + prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 + prop_indexed :: P (v a -> v (Int, a)) = V.indexed `eq` (\xs -> [0..] `zip` xs) + prop_update = \xs -> + forAll (index_value_pairs (V.length xs)) $ \ps -> + unP prop xs ps + where + prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) -testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] +testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [TestTree] {-# INLINE testOrdFunctions #-} testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum, 'prop_minIndex, 'prop_maxIndex, 'prop_maximumBy, 'prop_minimumBy, + 'prop_maximumOn, 'prop_minimumOn, 'prop_maxIndexBy, 'prop_minIndexBy, - 'prop_ListLastMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ]) + 'prop_ListFirstMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ]) where prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex - prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` listMaxIndexFMW + prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex prop_maximumBy :: P (v a -> a) = not . V.null ===> V.maximumBy compare `eq` maximum prop_minimumBy :: P (v a -> a) = not . V.null ===> V.minimumBy compare `eq` minimum + prop_maximumOn :: P (v a -> a) = + not . V.null ===> V.maximumOn id `eq` maximum + prop_minimumOn :: P (v a -> a) = + not . V.null ===> V.minimumOn id `eq` minimum prop_maxIndexBy :: P (v a -> Int) = - not . V.null ===> V.maxIndexBy compare `eq` listMaxIndexFMW - --- (maxIndex) - prop_ListLastMaxIndexWins :: P (v a -> Int) = - not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexLMW + not . V.null ===> V.maxIndexBy compare `eq` maxIndex + prop_ListFirstMaxIndexWins :: P (v a -> Int) = + not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexFMW prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) = (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW prop_FalseListFirstMaxIndexWins :: Property @@ -549,9 +663,6 @@ listMaxIndexFMW :: Ord a => [a] -> Int listMaxIndexFMW = ( fst . extractFMW . sconcat . DLE.fromList . fmap FMW . zip [0 :: Int ..]) -listMaxIndexLMW :: Ord a => [a] -> Int -listMaxIndexLMW = ( fst . extractLMW . sconcat . DLE.fromList . fmap LMW . zip [0 :: Int ..]) - newtype LastMaxWith a i = LMW {extractLMW:: (i,a)} deriving(Eq,Show,Read) instance (Ord a) => Semigroup (LastMaxWith a i) where @@ -566,7 +677,7 @@ | otherwise = x -testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] +testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [TestTree] {-# INLINE testEnumFunctions #-} testEnumFunctions _ = $(testProperties [ 'prop_enumFromN, 'prop_enumFromThenN, @@ -598,7 +709,7 @@ where d = abs (j-i) -testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] +testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [TestTree] {-# INLINE testMonoidFunctions #-} testMonoidFunctions _ = $(testProperties [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) @@ -607,24 +718,42 @@ prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat -testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test] +testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [TestTree] {-# INLINE testFunctorFunctions #-} testFunctorFunctions _ = $(testProperties [ 'prop_fmap ]) where prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap -testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [Test] +testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [TestTree] {-# INLINE testMonadFunctions #-} testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind - , 'prop_mzip, 'prop_munzip]) + , 'prop_mzip, 'prop_munzip + ]) where prop_return :: P (a -> v a) = return `eq` return prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) prop_mzip :: P (v a -> v a -> v (a, a)) = mzip `eq` zip prop_munzip :: P (v (a, a) -> (v a, v a)) = munzip `eq` unzip -testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] +testSequenceFunctions + :: forall a v. ( CommonContext a v + , Model (v (Writer [a] a)) ~ [Writer [a] a] + , V.Vector v (Writer [a] a) + , Arbitrary (v (Writer [a] a)) + , Show (v (Writer [a] a)) + , TestData (v (Writer [a] a)) + ) + => v a -> [TestTree] +testSequenceFunctions _ = $(testProperties [ 'prop_sequence, 'prop_sequence_ + ]) + where + prop_sequence :: P (v (Writer [a] a) -> Writer [a] (v a)) + = V.sequence `eq` sequence + prop_sequence_ :: P (v (Writer [a] a) -> Writer [a] ()) + = V.sequence_ `eq` sequence_ + +testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [TestTree] {-# INLINE testApplicativeFunctions #-} testApplicativeFunctions _ = $(testProperties [ 'prop_applicative_pure, 'prop_applicative_appl ]) @@ -634,7 +763,7 @@ prop_applicative_appl :: [a -> a] -> P (v a -> v a) = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs -testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test] +testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [TestTree] {-# INLINE testAlternativeFunctions #-} testAlternativeFunctions _ = $(testProperties [ 'prop_alternative_empty, 'prop_alternative_or ]) @@ -643,34 +772,29 @@ prop_alternative_or :: P (v a -> v a -> v a) = (Applicative.<|>) `eq` (Applicative.<|>) -testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] +testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [TestTree] {-# INLINE testBoolFunctions #-} testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) where prop_and :: P (v Bool -> Bool) = V.and `eq` and prop_or :: P (v Bool -> Bool) = V.or `eq` or -testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test] +testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [TestTree] {-# INLINE testNumFunctions #-} testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) where prop_sum :: P (v a -> a) = V.sum `eq` sum prop_product :: P (v a -> a) = V.product `eq` product -testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test] +testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [TestTree] {-# INLINE testNestedVectorFunctions #-} -testNestedVectorFunctions _ = $(testProperties []) +testNestedVectorFunctions _ = $(testProperties + [ 'prop_concat + ]) where - -- Prelude - --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat - - -- Data.List - --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a]) - --prop_group = V.group `eq1` (group :: v a -> [v a]) - --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) - --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) + prop_concat :: P ([v a] -> v a) = V.concat `eq` concat -testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test] +testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [TestTree] {-# INLINE testDataFunctions #-} testDataFunctions _ = $(testProperties ['prop_glength]) where @@ -681,3 +805,32 @@ toA :: Data b => b -> Int toA x = maybe (glength x) (const 1) (cast x :: Maybe a) + +testUnstream :: forall v. (CommonContext Int v) => v Int -> [TestTree] +{-# INLINE testUnstream #-} +testUnstream _ = + [ testProperty "unstream == vunstream (exact)" $ \(n :: Int) -> + let v1,v2 :: v Int + v1 = runST $ V.freeze =<< MV.unstream (streamExact n) + v2 = runST $ V.freeze =<< MV.vunstream (streamExact n) + in v1 == v2 + , testProperty "unstream == vunstream (unknown)" $ \(n :: Int) -> + let v1,v2 :: v Int + v1 = runST $ V.freeze =<< MV.unstream (streamUnknown n) + v2 = runST $ V.freeze =<< MV.vunstream (streamUnknown n) + in v1 == v2 + -- + , testProperty "unstreamR ~= vunstream (exact)" $ \(n :: Int) -> + let v1,v2 :: v Int + v1 = runST $ V.freeze =<< MV.unstreamR (streamExact n) + v2 = runST $ V.freeze =<< MV.vunstream (streamExact n) + in V.reverse v1 == v2 + , testProperty "unstreamR ~= vunstream (unknown)" $ \(n :: Int) -> + let v1,v2 :: v Int + v1 = runST $ V.freeze =<< MV.unstreamR (streamUnknown n) + v2 = runST $ V.freeze =<< MV.vunstream (streamUnknown n) + in V.reverse v1 == v2 + ] + where + streamExact n = S.generate (abs n) id + streamUnknown = S.unfoldr (\i -> if i > 0 then (Just (i-1,i-1)) else Nothing) . abs diff --git a/tests/Tests/Vector/Storable.hs b/tests/Tests/Vector/Storable.hs --- a/tests/Tests/Vector/Storable.hs +++ b/tests/Tests/Vector/Storable.hs @@ -7,7 +7,10 @@ import GHC.Exts (inline) -testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Data a) => Data.Vector.Storable.Vector a -> [Test] +testGeneralStorableVector + :: forall a. ( CommonContext a Data.Vector.Storable.Vector + , Data.Vector.Storable.Storable a, Ord a, Data a) + => Data.Vector.Storable.Vector a -> [TestTree] testGeneralStorableVector dummy = concatMap ($ dummy) [ testSanity @@ -17,7 +20,10 @@ , testDataFunctions ] -testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Storable.Vector a -> [Test] +testNumericStorableVector + :: forall a. ( CommonContext a Data.Vector.Storable.Vector + , Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a, Data a) + => Data.Vector.Storable.Vector a -> [TestTree] testNumericStorableVector dummy = concatMap ($ dummy) [ testGeneralStorableVector @@ -30,4 +36,5 @@ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int) , testGroup "Data.Vector.Storable.Vector (Double)" $ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double) + , testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Storable.Vector Int) ] diff --git a/tests/Tests/Vector/Strict.hs b/tests/Tests/Vector/Strict.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Vector/Strict.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ConstraintKinds #-} +module Tests.Vector.Strict (tests) where + +import Test.Tasty +import qualified Data.Vector.Strict +import Tests.Vector.Property + +import GHC.Exts (inline) + + +testGeneralBoxedVector + :: forall a. (CommonContext a Data.Vector.Strict.Vector, Ord a, Data a) + => Data.Vector.Strict.Vector a -> [TestTree] +testGeneralBoxedVector dummy = concatMap ($ dummy) + [ + testSanity + , inline testPolymorphicFunctions + , testOrdFunctions + , testTuplyFunctions + , testNestedVectorFunctions + , testMonoidFunctions + , testFunctorFunctions + , testMonadFunctions + , testApplicativeFunctions + , testAlternativeFunctions + , testSequenceFunctions + , testDataFunctions + ] + +testBoolBoxedVector dummy = concatMap ($ dummy) + [ + testGeneralBoxedVector + , testBoolFunctions + ] + +testNumericBoxedVector + :: forall a. (CommonContext a Data.Vector.Strict.Vector, Ord a, Num a, Enum a, Random a, Data a) + => Data.Vector.Strict.Vector a -> [TestTree] +testNumericBoxedVector dummy = concatMap ($ dummy) + [ + testGeneralBoxedVector + , testNumFunctions + , testEnumFunctions + ] + +tests = + [ testGroup "Bool" $ + testBoolBoxedVector (undefined :: Data.Vector.Strict.Vector Bool) + , testGroup "Int" $ + testNumericBoxedVector (undefined :: Data.Vector.Strict.Vector Int) + , testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Strict.Vector Int) + ] diff --git a/tests/Tests/Vector/Unboxed.hs b/tests/Tests/Vector/Unboxed.hs --- a/tests/Tests/Vector/Unboxed.hs +++ b/tests/Tests/Vector/Unboxed.hs @@ -7,12 +7,15 @@ -testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test] +testGeneralUnboxedVector + :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) + => Data.Vector.Unboxed.Vector a -> [TestTree] testGeneralUnboxedVector dummy = concatMap ($ dummy) [ testSanity , testPolymorphicFunctions , testOrdFunctions + , testTuplyFunctions , testMonoidFunctions , testDataFunctions ] @@ -28,7 +31,10 @@ , testBoolFunctions ] -testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Unboxed.Vector a -> [Test] +testNumericUnboxedVector + :: forall a. ( CommonContext a Data.Vector.Unboxed.Vector + , Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a, Data a) + => Data.Vector.Unboxed.Vector a -> [TestTree] testNumericUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector @@ -36,7 +42,9 @@ , testEnumFunctions ] -testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test] +testTupleUnboxedVector + :: forall a. ( CommonContext a Data.Vector.Unboxed.Vector + , Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [TestTree] testTupleUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector @@ -50,7 +58,7 @@ , testGroup "(Int)" $ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int) , testGroup "(Float)" $ - testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float) + testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float) , testGroup "(Double)" $ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double) , testGroup "(Int,Bool)" $ @@ -58,4 +66,5 @@ , testGroup "(Int,Bool,Int)" $ testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int, Bool, Int)) + , testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Unboxed.Vector Int) ] diff --git a/tests/Tests/Vector/UnitTests.hs b/tests/Tests/Vector/UnitTests.hs --- a/tests/Tests/Vector/UnitTests.hs +++ b/tests/Tests/Vector/UnitTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Tests.Vector.UnitTests (tests) where @@ -6,24 +5,26 @@ import Control.Applicative as Applicative import Control.Exception import Control.Monad.Primitive +import Control.Monad.Fix (mfix) import Data.Int import Data.Word import Data.Typeable import qualified Data.List as List import qualified Data.Vector.Generic as Generic import qualified Data.Vector as Boxed +import qualified Data.Vector.Internal.Check as Check +import qualified Data.Vector.Mutable as MBoxed import qualified Data.Vector.Primitive as Primitive import qualified Data.Vector.Storable as Storable import qualified Data.Vector.Unboxed as Unboxed -import qualified Data.Vector as Vector import Foreign.Ptr import Foreign.Storable import Text.Printf import Test.Tasty -import Test.Tasty.HUnit (testCase,Assertion, assertBool, (@=?), assertFailure) --- import Test.HUnit () +import Test.Tasty.HUnit (testCase, Assertion, assertBool, assertEqual, (@=?), assertFailure) + newtype Aligned a = Aligned { getAligned :: a } instance (Storable a) => Storable (Aligned a) where @@ -43,6 +44,12 @@ dummy :: a dummy = undefined +withBoundsChecksOnly :: [TestTree] -> [TestTree] +withBoundsChecksOnly ts = + if Check.doChecks Check.Bounds + then ts + else [] + tests :: [TestTree] tests = [ testGroup "Data.Vector.Storable.Vector Alignment" @@ -66,20 +73,28 @@ , regression188 ([] :: [Char]) ] ] - , testGroup "Negative tests" - [ testGroup "slice out of bounds #257" + , testGroup "Negative tests" $ + withBoundsChecksOnly [ testGroup "slice out of bounds #257" [ testGroup "Boxed" $ testsSliceOutOfBounds Boxed.slice , testGroup "Primitive" $ testsSliceOutOfBounds Primitive.slice , testGroup "Storable" $ testsSliceOutOfBounds Storable.slice , testGroup "Unboxed" $ testsSliceOutOfBounds Unboxed.slice - ] - , testGroup "take #282" + ]] + ++ + [ testGroup "take #282" [ testCase "Boxed" $ testTakeOutOfMemory Boxed.take , testCase "Primitive" $ testTakeOutOfMemory Primitive.take , testCase "Storable" $ testTakeOutOfMemory Storable.take , testCase "Unboxed" $ testTakeOutOfMemory Unboxed.take ] ] + , testGroup "Data.Vector" + [ testCase "MonadFix" checkMonadFix + , testCase "toFromArray" toFromArray + , testCase "toFromArraySlice" toFromArraySlice + , testCase "toFromArraySliceUnsafe" toFromArraySliceUnsafe + , testCase "toFromMutableArray" toFromMutableArray + ] ] testsSliceOutOfBounds :: @@ -124,7 +139,7 @@ in assertBool assertMsg (errSuffix `List.isSuffixOf` err) where errSuffix = - "(slice): invalid slice (" ++ + "invalid slice (" ++ show i ++ "," ++ show m ++ "," ++ show (List.length xs) ++ ")" {-# INLINE sliceTest #-} @@ -141,7 +156,7 @@ :: forall proxy a. (Typeable a, Enum a, Bounded a, Eq a, Show a) => proxy a -> TestTree regression188 _ = testCase (show (typeOf (undefined :: a))) - $ Vector.fromList [maxBound::a] @=? Vector.enumFromTo maxBound maxBound + $ Boxed.fromList [maxBound::a] @=? Boxed.enumFromTo maxBound maxBound {-# INLINE regression188 #-} alignedDoubleVec :: Storable.Vector (Aligned Double) @@ -150,10 +165,66 @@ alignedIntVec :: Storable.Vector (Aligned Int) alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] -#if __GLASGOW_HASKELL__ >= 800 -- Ensure that Mutable is really an injective type family by typechecking a -- function which relies on injectivity. _f :: (Generic.Vector v a, Generic.Vector w a, PrimMonad f) => Generic.Mutable v (PrimState f) a -> f (w a) _f v = Generic.convert `fmap` Generic.unsafeFreeze v -#endif + +checkMonadFix :: Assertion +checkMonadFix = assertBool "checkMonadFix" $ + Boxed.toList fewV == fewL && + Boxed.toList none == [] + where + facty _ 0 = 1; facty f n = n * f (n - 1) + fewV :: Boxed.Vector Int + fewV = fmap ($ 12) $ mfix (\i -> Boxed.fromList [facty i, facty (+1), facty (+2)]) + fewL :: [Int] + fewL = fmap ($ 12) $ mfix (\i -> [facty i, facty (+1), facty (+2)]) + none :: Boxed.Vector Int + none = mfix (const Boxed.empty) + +mkArrayRoundtrip :: (String -> Boxed.Vector Integer -> Assertion) -> Assertion +mkArrayRoundtrip mkAssertion = + sequence_ + [ mkAssertion name v + | (name, v) <- + [ ("full", vec) + , ("slicedTail", Boxed.slice 0 (n - 3) vec) + , ("slicedHead", Boxed.slice 2 (n - 2) vec) + , ("slicedBoth", Boxed.slice 2 (n - 4) vec) + ] + ] + where + vec = Boxed.fromList [0 .. 10] + n = Boxed.length vec + +toFromArray :: Assertion +toFromArray = + mkArrayRoundtrip $ \name v -> + assertEqual name v $ Boxed.fromArray (Boxed.toArray v) + +toFromArraySlice :: Assertion +toFromArraySlice = + mkArrayRoundtrip $ \name v -> + case Boxed.toArraySlice v of + (arr, off, n) -> + assertEqual name v $ + Boxed.take n (Boxed.drop off (Boxed.fromArray arr)) + +toFromArraySliceUnsafe :: Assertion +toFromArraySliceUnsafe = + mkArrayRoundtrip $ \name v -> + case Boxed.toArraySlice v of + (arr, off, n) -> + assertEqual name v $ + Boxed.unsafeFromArraySlice arr off n + +toFromMutableArray :: Assertion +toFromMutableArray = mkArrayRoundtrip assetRoundtrip + where + assetRoundtrip assertionName vec = do + mvec <- Boxed.unsafeThaw vec + mvec' <- MBoxed.fromMutableArray =<< MBoxed.toMutableArray mvec + vec' <- Boxed.unsafeFreeze mvec' + assertEqual assertionName vec vec' diff --git a/tests/Utilities.hs b/tests/Utilities.hs --- a/tests/Utilities.hs +++ b/tests/Utilities.hs @@ -1,21 +1,27 @@ -{-# LANGUAGE FlexibleInstances, GADTs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} module Utilities where import Test.QuickCheck +import Control.Arrow ((***)) +import Data.Foldable +import Data.Bifunctor import qualified Data.Vector as DV import qualified Data.Vector.Generic as DVG import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Strict as DVV import qualified Data.Vector.Unboxed as DVU 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 import Data.Maybe (catMaybes) instance Show a => Show (S.Bundle v a) where @@ -40,6 +46,12 @@ instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where coarbitrary = coarbitrary . DVS.toList +instance (Arbitrary a) => Arbitrary (DVV.Vector a) where + arbitrary = fmap DVV.fromList arbitrary + +instance (CoArbitrary a) => CoArbitrary (DVV.Vector a) where + coarbitrary = coarbitrary . DVV.toList + instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where arbitrary = fmap DVU.fromList arbitrary @@ -66,68 +78,67 @@ unmodel :: Model a -> a type EqTest a + type instance EqTest a = Property equal :: a -> a -> EqTest 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.Bundle v a) = Property + default equal :: (Eq a, EqTest a ~ Property) => a -> a -> EqTest a equal x y = property (x == y) -instance Eq a => TestData (DV.Vector a) where - type Model (DV.Vector a) = [a] - model = DV.toList - unmodel = DV.fromList - type EqTest (DV.Vector a) = Property - equal x y = property (x == y) - -instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where - type Model (DVP.Vector a) = [a] - model = DVP.toList - unmodel = DVP.fromList +instance (Eq a, TestData a) => TestData (S.Bundle v a) where + type Model (S.Bundle v a) = [Model a] + model = map model . S.toList + unmodel = S.fromList . map unmodel - type EqTest (DVP.Vector a) = Property - equal x y = property (x == y) +instance (Eq a, TestData a) => TestData (DV.Vector a) where + type Model (DV.Vector a) = [Model a] + model = map model . DV.toList + unmodel = DV.fromList . map unmodel -instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where - type Model (DVS.Vector a) = [a] - model = DVS.toList - unmodel = DVS.fromList +instance (Eq a, DVP.Prim a, TestData a) => TestData (DVP.Vector a) where + type Model (DVP.Vector a) = [Model a] + model = map model . DVP.toList + unmodel = DVP.fromList . map unmodel - type EqTest (DVS.Vector a) = Property - equal x y = property (x == y) +instance (Eq a, DVS.Storable a, TestData a) => TestData (DVS.Vector a) where + type Model (DVS.Vector a) = [Model a] + model = map model . DVS.toList + unmodel = DVS.fromList . map unmodel -instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where - type Model (DVU.Vector a) = [a] - model = DVU.toList - unmodel = DVU.fromList +instance (Eq a, TestData a) => TestData (DVV.Vector a) where + type Model (DVV.Vector a) = [Model a] + model = map model . DVV.toList + unmodel = DVV.fromList . map unmodel - type EqTest (DVU.Vector a) = Property - equal x y = property (x == y) +instance (Eq a, DVU.Unbox a, TestData a) => TestData (DVU.Vector a) where + type Model (DVU.Vector a) = [Model a] + model = map model . DVU.toList + unmodel = DVU.fromList . map unmodel #define id_TestData(ty) \ instance TestData ty where { \ type Model ty = ty; \ model = id; \ - unmodel = id; \ - \ - type EqTest ty = Property; \ - equal x y = property (x == y) } + unmodel = id } \ id_TestData(()) id_TestData(Bool) id_TestData(Int) -id_TestData(Float) -id_TestData(Double) id_TestData(Ordering) -bimapEither :: (a -> b) -> (c -> d) -> Either a c -> Either b d -bimapEither f _ (Left a) = Left (f a) -bimapEither _ g (Right c) = Right (g c) +instance TestData Float where + type Model Float = Float + model = id + unmodel = id + equal x y = property (x == y || (isNaN x && isNaN y)) + +instance TestData Double where + type Model Double = Double + model = id + unmodel = id + + equal x y = property (x == y || (isNaN x && isNaN y)) + -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well. instance (Eq a, TestData a) => TestData (Maybe a) where @@ -135,57 +146,36 @@ model = fmap model unmodel = fmap unmodel - type EqTest (Maybe a) = Property - equal x y = property (x == y) - instance (Eq a, TestData a, Eq b, TestData b) => TestData (Either a b) where type Model (Either a b) = Either (Model a) (Model b) - model = bimapEither model model - unmodel = bimapEither unmodel unmodel - - type EqTest (Either a b) = Property - equal x y = property (x == y) + model = bimap model model + unmodel = bimap unmodel unmodel instance (Eq a, TestData a) => TestData [a] where type Model [a] = [Model a] model = fmap model unmodel = fmap unmodel - 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, Eq b, TestData b, Monoid a) => TestData (Writer a b) where type Model (Writer a b) = Writer (Model a) (Model b) model = mapWriter model unmodel = mapWriter unmodel - type EqTest (Writer a b) = Property - equal = (property .) . on (==) runWriter - 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) unmodel (a,b) = (unmodel a, unmodel b) - type EqTest (a,b) = Property - equal x y = property (x == y) - instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where type Model (a,b,c) = (Model a, Model b, Model c) model (a,b,c) = (model a, model b, model c) unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c) - type EqTest (a,b,c) = Property - equal x y = property (x == y) - instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where type Model (a -> b) = Model a -> Model b model f = model . f . unmodel @@ -247,6 +237,7 @@ singleton x = [x] snoc xs x = xs ++ [x] generate n f = [f i | i <- [0 .. n-1]] +generateM n f = sequence [f i | i <- [0 .. n-1]] slice i n xs = take n (drop i xs) backpermute xs is = map (xs!!) is prescanl f z = init . scanl f z @@ -277,6 +268,15 @@ withIndexFirst m f = m (uncurry f) . zip [0..] +modifyList :: [a] -> (a -> a) -> Int -> [a] +modifyList xs f i = zipWith merge xs (replicate i Nothing ++ [Just f] ++ repeat Nothing) + where + merge x Nothing = x + merge x (Just g) = g x + +writeList :: [a] -> Int -> a -> [a] +writeList xs i a = modifyList xs (const a) i + imap :: (Int -> a -> a) -> [a] -> [a] imap = withIndexFirst map @@ -301,14 +301,17 @@ ifilter :: (Int -> a -> Bool) -> [a] -> [a] ifilter f = map snd . withIndexFirst filter f -mapMaybe :: (a -> Maybe b) -> [a] -> [b] -mapMaybe f = catMaybes . map f - imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b] imapMaybe f = catMaybes . withIndexFirst map f indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..] +spanR :: (a -> Bool) -> [a] -> ([a], [a]) +spanR f = (reverse *** reverse) . span f . reverse + +breakR :: (a -> Bool) -> [a] -> ([a], [a]) +breakR f = (reverse *** reverse) . break f . reverse + ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a ifoldl = indexedLeftFold foldl @@ -321,9 +324,12 @@ 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 :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m b ifoldM = indexedLeftFold foldM +ifoldrM :: Monad m => (Int -> a -> b -> m b) -> b -> [a] -> m b +ifoldrM f z xs = foldrM (\(i,a) b -> f i a b) z ([0..] `zip` xs) + ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m () ifoldM_ = indexedLeftFold foldM_ @@ -336,7 +342,7 @@ maxIndex :: Ord a => [a] -> Int maxIndex = fst . foldr1 imax . zip [0..] where - imax (i,x) (j,y) | x > y = (i,x) + imax (i,x) (j,y) | x >= y = (i,x) | otherwise = (j,y) iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a] diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,41 @@ +import Test.DocTest (doctest) + +-- Doctests are weirdly fragile. For example running tests for module +-- A (D.V.Unboxed.Base) could cause tests in unrelated woudle B +-- (D.V.Storable) to start failing with weird errors. +-- +-- In order to avoid this one would want to run doctests with +-- per-module granularity but this cause another sort of problems! +-- When we load only single module and use import doctests then some +-- data types may come from built library and some from ghci session. +-- +-- This could be remedied by running doctests for groups of modules. +-- This _is_ convoluted setup but doctests now works for GHC9.4 +main :: IO () +main = mapM_ run modGroups + where + run mods = do + mapM_ putStrLn mods + doctest $ ["-Iinclude", "-Iinternal", "-XHaskell2010"] ++ mods + -- + modGroups = + [ [ "src/Data/Vector/Storable/Mutable.hs" + , "src/Data/Vector/Storable.hs" + ] + , [ "src/Data/Vector.hs" + , "src/Data/Vector/Mutable.hs" + ] + , [ "src/Data/Vector/Strict.hs" + , "src/Data/Vector/Strict/Mutable.hs" + ] + , [ "src/Data/Vector/Generic.hs" + , "src/Data/Vector/Generic/Mutable.hs" + ] + , [ "src/Data/Vector/Primitive.hs" + , "src/Data/Vector/Primitive/Mutable.hs" + ] + , [ "src/Data/Vector/Unboxed.hs" + , "src/Data/Vector/Unboxed/Mutable.hs" + , "src/Data/Vector/Unboxed/Base.hs" + ] + ] diff --git a/vector.cabal b/vector.cabal --- a/vector.cabal +++ b/vector.cabal @@ -1,18 +1,27 @@ +Cabal-Version: 3.0 +Build-Type: Simple Name: vector -Version: 0.12.1.2 +Version: 0.13.2.0 -- don't forget to update the changelog file! -License: BSD3 +License: BSD-3-Clause License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Haskell Libraries Team -Copyright: (c) Roman Leshchinskiy 2008-2012 + Alexey Kuleshevich , + Aleksey Khudyakov , + Andrew Lelechenko +Copyright: (c) Roman Leshchinskiy 2008-2012, + Alexey Kuleshevich 2020-2022, + Aleksey Khudyakov 2020-2022, + Andrew Lelechenko 2020-2022 + Homepage: https://github.com/haskell/vector Bug-Reports: https://github.com/haskell/vector/issues Category: Data, Data Structures Synopsis: Efficient Arrays Description: . - An efficient implementation of Int-indexed arrays (both mutable + An efficient implementation of @Int@-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework . . It is structured as follows: @@ -35,46 +44,30 @@ * Tested-With: - GHC == 7.4.2, - GHC == 7.6.3, - GHC == 7.8.4, - GHC == 7.10.3, - GHC == 8.0.2, - GHC == 8.2.2, - GHC == 8.4.4, - GHC == 8.6.5, - GHC == 8.8.1, - GHC == 8.10.1 - - -Cabal-Version: >=1.10 -Build-Type: Simple + GHC == 8.0.2 + GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.8 + GHC == 9.4.8 + GHC == 9.6.4 + GHC == 9.8.2 -Extra-Source-Files: +Extra-doc-files: changelog.md README.md tests/LICENSE - tests/Setup.hs - tests/Main.hs - benchmarks/vector-benchmarks.cabal - benchmarks/LICENSE - benchmarks/Setup.hs - benchmarks/Main.hs - benchmarks/Algo/AwShCC.hs - benchmarks/Algo/HybCC.hs - benchmarks/Algo/Leaffix.hs - benchmarks/Algo/ListRank.hs - benchmarks/Algo/Quickhull.hs - benchmarks/Algo/Rootfix.hs - benchmarks/Algo/Spectral.hs - benchmarks/Algo/Tridiag.hs - benchmarks/TestData/Graph.hs - benchmarks/TestData/ParenTree.hs - benchmarks/TestData/Random.hs +Extra-Source-Files: internal/GenUnboxTuple.hs internal/unbox-tuple-instances - +source-repository head + type: git + location: https://github.com/haskell/vector.git + subdir: vector Flag BoundsChecks Description: Enable bounds checking @@ -98,8 +91,17 @@ Default: False Manual: True +-- This common sets warning flags passed to GHC as controlled by Wall cabal flag +common flag-Wall + Ghc-Options: -Wall + if !flag(Wall) + Ghc-Options: -fno-warn-orphans + if impl(ghc >= 8.0) && impl(ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + Library + import: flag-Wall Default-Language: Haskell2010 Other-Extensions: BangPatterns @@ -112,7 +114,7 @@ KindSignatures MagicHash MultiParamTypeClasses - Rank2Types + RankNTypes ScopedTypeVariables StandaloneDeriving TypeFamilies @@ -143,30 +145,27 @@ Data.Vector.Unboxed.Mutable Data.Vector.Unboxed + Data.Vector.Strict.Mutable + Data.Vector.Strict + Data.Vector.Mutable Data.Vector + Hs-Source-Dirs: + src + Include-Dirs: include, internal Install-Includes: vector.h - Build-Depends: base >= 4.5 && < 4.15 - , primitive >= 0.5.0.1 && < 0.8 - , ghc-prim >= 0.2 && < 0.7 - , deepseq >= 1.1 && < 1.5 - if !impl(ghc > 8.0) - Build-Depends: fail == 4.9.* - , semigroups >= 0.18 && < 0.20 - - Ghc-Options: -O2 -Wall - - if !flag(Wall) - Ghc-Options: -fno-warn-orphans + Build-Depends: base >= 4.9 && < 4.22 + , primitive >= 0.6.4.0 && < 0.10 + , deepseq >= 1.1 && < 1.6 + , vector-stream >= 0.1 && < 0.2 - if impl(ghc >= 8.0) && impl(ghc < 8.1) - Ghc-Options: -Wno-redundant-constraints + Ghc-Options: -O2 if flag(BoundsChecks) cpp-options: -DVECTOR_BOUNDS_CHECKS @@ -177,94 +176,133 @@ if flag(InternalChecks) cpp-options: -DVECTOR_INTERNAL_CHECKS -source-repository head - type: git - location: https://github.com/haskell/vector.git - - -test-suite vector-tests-O0 +-- We want to build test suite in two variants. One built with -O0 +-- and another with -O2 in order to catch bugs caused by invalid +-- rewrite rules +common tests-common Default-Language: Haskell2010 - type: exitcode-stdio-1.0 - Main-Is: Main.hs - - other-modules: Boilerplater - Tests.Bundle - Tests.Move - Tests.Vector - Tests.Vector.Property - Tests.Vector.Boxed - Tests.Vector.Storable - Tests.Vector.Primitive - Tests.Vector.Unboxed - Tests.Vector.UnitTests - Utilities - - hs-source-dirs: tests - Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector, - primitive, random, - QuickCheck >= 2.9 && < 2.14 , HUnit, tasty, - tasty-hunit, tasty-quickcheck, - transformers >= 0.2.0.0,semigroups + Ghc-Options: -fno-warn-missing-signatures + hs-source-dirs: tests + Build-Depends: base >= 4.5 && < 5 + , template-haskell + , base-orphans >= 0.6 + , vector + , primitive + , random + , QuickCheck >= 2.9 && < 2.15 + , tasty + , tasty-hunit + , tasty-quickcheck + , transformers >= 0.2.0.0 + Other-Modules: + Boilerplater + Tests.Bundle + Tests.Move + Tests.Vector.Property + Tests.Vector.Boxed + Tests.Vector.Strict + Tests.Vector.Storable + Tests.Vector.Primitive + Tests.Vector.Unboxed + Tests.Vector.UnitTests + Utilities - default-extensions: CPP, + default-extensions: ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, - Rank2Types, + RankNTypes, TypeSynonymInstances, TypeFamilies, TemplateHaskell - Ghc-Options: -O0 -threaded - Ghc-Options: -Wall - - if !flag(Wall) - Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures - if impl(ghc >= 8.0) && impl( ghc < 8.1) - Ghc-Options: -Wno-redundant-constraints - +test-suite vector-tests-O0 + import: flag-Wall, tests-common + type: exitcode-stdio-1.0 + Main-Is: Main.hs + Ghc-Options: -O0 -threaded test-suite vector-tests-O2 - Default-Language: Haskell2010 - type: exitcode-stdio-1.0 - Main-Is: Main.hs + import: flag-Wall, tests-common + type: exitcode-stdio-1.0 + Main-Is: Main.hs + Ghc-Options: -O2 -threaded - other-modules: Boilerplater - Tests.Bundle - Tests.Move - Tests.Vector - Tests.Vector.Property - Tests.Vector.Boxed - Tests.Vector.Storable - Tests.Vector.Primitive - Tests.Vector.Unboxed - Tests.Vector.UnitTests - Utilities +test-suite vector-doctest + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: tests + default-language: Haskell2010 + -- Older GHC don't support DerivingVia and doctests use them + if impl(ghc < 8.6) + buildable: False + -- Attempts to run doctests on macos on GHC8.10 and 9.0 cause linker errors: + -- > ld: warning: -undefined dynamic_lookup may not work with chained fixups + if os(darwin) && impl(ghc >= 8.10) && impl(ghc < 9.2) + buildable: False + build-depends: + base -any + , doctest >=0.15 && <0.23 + , primitive >= 0.6.4.0 && < 0.10 + , vector -any - hs-source-dirs: tests - Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector, - primitive, random, - QuickCheck >= 2.9 && < 2.14 , HUnit, tasty, - tasty-hunit, tasty-quickcheck, - transformers >= 0.2.0.0,semigroups +test-suite vector-inspection + import: flag-Wall + type: exitcode-stdio-1.0 + hs-source-dirs: tests-inspect + main-is: main.hs + default-language: Haskell2010 + Other-modules: Inspect + if impl(ghc >= 8.6) + Other-modules: Inspect.DerivingVia + Inspect.DerivingVia.OtherFoo + build-depends: + base -any + , primitive >= 0.6.4.0 && < 0.10 + , vector -any + , tasty + , tasty-inspection-testing >= 0.1 - default-extensions: CPP, - ScopedTypeVariables, - PatternGuards, - MultiParamTypeClasses, - FlexibleContexts, - Rank2Types, - TypeSynonymInstances, - TypeFamilies, - TemplateHaskell +library benchmarks-O2 + visibility: public + ghc-options: -O2 + hs-source-dirs: benchlib + Default-Language: Haskell2010 + build-depends: + base + , random >= 1.2 + , tasty + , vector + exposed-modules: + Bench.Vector.Algo.MutableSet + Bench.Vector.Algo.ListRank + Bench.Vector.Algo.Rootfix + Bench.Vector.Algo.Leaffix + Bench.Vector.Algo.AwShCC + Bench.Vector.Algo.HybCC + Bench.Vector.Algo.Quickhull + Bench.Vector.Algo.Spectral + Bench.Vector.Algo.Tridiag + Bench.Vector.Algo.FindIndexR + Bench.Vector.Algo.NextPermutation + Bench.Vector.TestData.ParenTree + Bench.Vector.TestData.Graph + Bench.Vector.Tasty +benchmark algorithms + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: benchmarks + default-language: Haskell2010 - Ghc-Options: -Wall - Ghc-Options: -O2 -threaded - if !flag(Wall) - Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures - if impl(ghc >= 8.0) && impl(ghc < 8.1) - Ghc-Options: -Wno-redundant-constraints + build-depends: + base >= 2 && < 5 + , random >= 1.2 + , tasty + , tasty-bench >= 0.2.1 + , vector + , vector:benchmarks-O2 + ghc-options: -O2