vector-0.12.1.2/0000755000000000000000000000000007346545000011426 5ustar0000000000000000vector-0.12.1.2/Data/0000755000000000000000000000000007346545000012277 5ustar0000000000000000vector-0.12.1.2/Data/Vector.hs0000644000000000000000000014272407346545000014107 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Fusion/0000755000000000000000000000000007346545000015004 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Fusion/Bundle.hs0000644000000000000000000004107507346545000016560 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Fusion/Bundle/0000755000000000000000000000000007346545000016215 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Fusion/Bundle/Monadic.hs0000644000000000000000000011274407346545000020134 0ustar0000000000000000{-# 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 #-} vector-0.12.1.2/Data/Vector/Fusion/Bundle/Size.hs0000644000000000000000000000765207346545000017475 0ustar0000000000000000-- | -- 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 vector-0.12.1.2/Data/Vector/Fusion/Stream/0000755000000000000000000000000007346545000016237 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Fusion/Stream/Monadic.hs0000644000000000000000000015354507346545000020162 0ustar0000000000000000{-# 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 #-} -} vector-0.12.1.2/Data/Vector/Fusion/Util.hs0000644000000000000000000000231407346545000016255 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/0000755000000000000000000000000007346545000013541 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Generic.hs0000644000000000000000000022321407346545000015455 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Generic/0000755000000000000000000000000007346545000015115 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Generic/Base.hs0000644000000000000000000001123107346545000016321 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Generic/Mutable.hs0000644000000000000000000011535607346545000017055 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Generic/Mutable/0000755000000000000000000000000007346545000016506 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Generic/Mutable/Base.hs0000644000000000000000000001244407346545000017721 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Generic/New.hs0000644000000000000000000001231607346545000016205 0ustar0000000000000000{-# 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) #-} vector-0.12.1.2/Data/Vector/Internal/0000755000000000000000000000000007346545000015315 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Internal/Check.hs0000644000000000000000000001005207346545000016664 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Mutable.hs0000644000000000000000000003263507346545000015477 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Primitive.hs0000644000000000000000000012543407346545000016056 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Primitive/0000755000000000000000000000000007346545000015511 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Primitive/Mutable.hs0000644000000000000000000002646207346545000017450 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Storable.hs0000644000000000000000000013537107346545000015662 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Storable/0000755000000000000000000000000007346545000015314 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Storable/Internal.hs0000644000000000000000000000163007346545000017424 0ustar0000000000000000-- | -- 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 } vector-0.12.1.2/Data/Vector/Storable/Mutable.hs0000644000000000000000000004427507346545000017255 0ustar0000000000000000{-# 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 vector-0.12.1.2/Data/Vector/Unboxed.hs0000644000000000000000000013433707346545000015514 0ustar0000000000000000{-# 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" vector-0.12.1.2/Data/Vector/Unboxed/0000755000000000000000000000000007346545000015145 5ustar0000000000000000vector-0.12.1.2/Data/Vector/Unboxed/Base.hs0000644000000000000000000005445207346545000016365 0ustar0000000000000000{-# 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" vector-0.12.1.2/Data/Vector/Unboxed/Mutable.hs0000644000000000000000000002225507346545000017100 0ustar0000000000000000{-# 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" vector-0.12.1.2/LICENSE0000644000000000000000000000301607346545000012433 0ustar0000000000000000Copyright (c) 2008-2012, 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. vector-0.12.1.2/README.md0000755000000000000000000000056407346545000012715 0ustar0000000000000000The `vector` package [![Build Status](https://travis-ci.org/haskell/vector.png?branch=master)](https://travis-ci.org/haskell/vector) ==================== An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework. See [`vector` on Hackage](http://hackage.haskell.org/package/vector) for more information. vector-0.12.1.2/Setup.hs0000644000000000000000000000005707346545000013064 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.12.1.2/benchmarks/Algo/0000755000000000000000000000000007346545000014425 5ustar0000000000000000vector-0.12.1.2/benchmarks/Algo/AwShCC.hs0000755000000000000000000000246507346545000016043 0ustar0000000000000000{-# 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) vector-0.12.1.2/benchmarks/Algo/HybCC.hs0000755000000000000000000000252507346545000015720 0ustar0000000000000000module 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') vector-0.12.1.2/benchmarks/Algo/Leaffix.hs0000755000000000000000000000070707346545000016346 0ustar0000000000000000module 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) vector-0.12.1.2/benchmarks/Algo/ListRank.hs0000755000000000000000000000075707346545000016524 0ustar0000000000000000module 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) vector-0.12.1.2/benchmarks/Algo/Quickhull.hs0000755000000000000000000000162707346545000016733 0ustar0000000000000000module 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) vector-0.12.1.2/benchmarks/Algo/Rootfix.hs0000755000000000000000000000070307346545000016416 0ustar0000000000000000module 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 vector-0.12.1.2/benchmarks/Algo/Spectral.hs0000755000000000000000000000071607346545000016545 0ustar0000000000000000module 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 vector-0.12.1.2/benchmarks/Algo/Tridiag.hs0000755000000000000000000000102107346545000016341 0ustar0000000000000000module 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) vector-0.12.1.2/benchmarks/0000755000000000000000000000000007346545000013543 5ustar0000000000000000vector-0.12.1.2/benchmarks/LICENSE0000755000000000000000000000301607346545000014553 0ustar0000000000000000Copyright (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. vector-0.12.1.2/benchmarks/Main.hs0000755000000000000000000000475207346545000014776 0ustar0000000000000000module 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 Data.Vector.Unboxed ( Vector ) import System.Environment import Data.Word 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 main :: IO () main = do args <- execParser $ describeWith parseBenchArgs let useSeed = seed args let useSize = size args let (lparens, rparens) = parenTree useSize let (nodes, edges1, edges2) = randomGraph useSeed useSize lparens `seq` rparens `seq` nodes `seq` edges1 `seq` edges2 `seq` return () 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) ] vector-0.12.1.2/benchmarks/Setup.hs0000755000000000000000000000005707346545000015204 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.12.1.2/benchmarks/TestData/0000755000000000000000000000000007346545000015254 5ustar0000000000000000vector-0.12.1.2/benchmarks/TestData/Graph.hs0000755000000000000000000000242107346545000016653 0ustar0000000000000000module 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 vector-0.12.1.2/benchmarks/TestData/ParenTree.hs0000755000000000000000000000121007346545000017472 0ustar0000000000000000module 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 vector-0.12.1.2/benchmarks/TestData/Random.hs0000755000000000000000000000065607346545000017042 0ustar0000000000000000module 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 vector-0.12.1.2/benchmarks/vector-benchmarks.cabal0000755000000000000000000000160407346545000020150 0ustar0000000000000000Name: 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 vector-0.12.1.2/changelog.md0000755000000000000000000000752007346545000013706 0ustar0000000000000000# Changes in version 0.12.1.2 * Fix for lost function `Data.Vector.Generic.mkType`: [#287](https://github.com/haskell/vector/issues/287) # Changes in version 0.12.1.1 (deprecated) * add semigrioups dep to test suite so CI actually runs again on GHC < 8 # Changes in version 0.12.1.0 (deprecated) * Fix integer overflows in specializations of Bundle/Stream enumFromTo on Integral types * Fix possibility of OutOfMemory with `take` and very large arguments. * Fix `slice` function causing segfault and not checking the bounds properly. * updated specialization rule for EnumFromTo on Float and Double to make sure it always matches the version in GHC Base (which changed as of 8.6) Thanks to Aleksey Khudyakov @Shimuuar for this fix. * fast rejection short circuiting in eqBy operations * the O2 test suite now has reasonable memory usage on every GHC version, special thanks to Alexey Kuleshevich (@lehins). * The `Mutable` type family is now injective on GHC 8.0 or later. * Using empty `Storable` vectors no longer results in division-by-zero errors. * The `Data` instances for `Vector` types now have well defined implementations for `toConstr`, `gunfold`, and `dataTypeOf`. * New function: `partitionWith`. * Add `Unbox` instances for `Identity`, `Const`, `Down`, `Dual`, `Sum`, `Product`, `Min`, `Max`, `First`, `Last`, `WrappedMonoid`, `Arg`, `Any`, `All`, `Alt`, and `Compose`. * Add `NFData1` instances for applicable `Vector` types. # Changes in version 0.12.0.3 * Monad Fail support # Changes in version 0.12.0.2 * Fixes issue #220, compact heap operations crashing on boxed vectors constructed using traverse. * backport injective type family support * Cleanup the memset code internal to storable vector modules to be compatible with future Primitive releases # Changes in version 0.12.0.1 * Make sure `length` can be inlined * Include modules that test-suites depend on in other-modules # Changes in version 0.12.0.0 * Documentation fixes/additions * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq * New instances for various vector types: Semigroup, MonadZip * Made `Storable` vectors respect memory alignment * Changed some macros to ConstraintKinds - Dropped compatibility with old GHCs to support this * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related helper functions. * Relax context for `Unbox (Complex a)`. # Changes in version 0.11.0.0 * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}` * Define non-bottom `fail` for `instance Monad Vector` * New generalized stream fusion framework * Various safety fixes - Various overflows due to vector size have been eliminated - Memory is initialized on creation of unboxed vectors * Changes to SPEC usage to allow building under more conditions # Changes in version 0.10.12.3 * Allow building with `primtive-0.6` # Changes in version 0.10.12.2 * Add support for `deepseq-1.4.0.0` # Changes in version 0.10.12.1 * Fixed compilation on non-head GHCs # Changes in version 0.10.12.0 * Export MVector constructor from Data.Vector.Primitive to match Vector's (which was already exported). * Fix building on GHC 7.9 by adding Applicative instances for Id and Box # Changes in version 0.10.11.0 * Support OverloadedLists for boxed Vector in GHC >= 7.8 # Changes in version 0.10.10.0 * Minor version bump to rectify PVP violation occured in 0.10.9.3 release # Changes in version 0.10.9.3 (deprecated) * Add support for OverloadedLists in GHC >= 7.8 # Changes in version 0.10.9.2 * Fix compilation with GHC 7.9 # Changes in version 0.10.9.1 * Implement poly-kinded Typeable # Changes in version 0.10.0.1 * Require `primitive` to include workaround for a GHC array copying bug # Changes in version 0.10 * `NFData` instances * More efficient block fills * Safe Haskell support removed vector-0.12.1.2/include/0000755000000000000000000000000007346545000013051 5ustar0000000000000000vector-0.12.1.2/include/vector.h0000644000000000000000000000115407346545000014525 0ustar0000000000000000#define PHASE_FUSED [1] #define PHASE_INNER [0] #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 vector-0.12.1.2/internal/0000755000000000000000000000000007346545000013242 5ustar0000000000000000vector-0.12.1.2/internal/GenUnboxTuple.hs0000755000000000000000000002204307346545000016341 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module Main where import Text.PrettyPrint import System.Environment ( getArgs ) main = do [s] <- getArgs let n = read s mapM_ (putStrLn . render . generate) [2..n] generate :: Int -> Doc generate n = vcat [ text "#ifdef DEFINE_INSTANCES" , data_instance "MVector s" "MV" , data_instance "Vector" "V" , class_instance "Unbox" , class_instance "M.MVector MVector" <+> text "where" , nest 2 $ vcat $ map method methods_MVector , class_instance "G.Vector Vector" <+> text "where" , nest 2 $ vcat $ map method methods_Vector , text "#endif" , text "#ifdef DEFINE_MUTABLE" , define_zip "MVector s" "MV" , define_unzip "MVector s" "MV" , text "#endif" , text "#ifdef DEFINE_IMMUTABLE" , define_zip "Vector" "V" , define_zip_rule , define_unzip "Vector" "V" , text "#endif" ] where vars = map (\c -> text ['_',c]) $ take n ['a'..] varss = map (<> char 's') vars tuple xs = parens $ hsep $ punctuate comma xs vtuple xs = parens $ sep $ punctuate comma xs con s = text s <> char '_' <> int n var c = text ('_' : c : "_") data_instance ty c = hang (hsep [text "data instance", text ty, tuple vars]) 4 (hsep [char '=', con c, text "{-# UNPACK #-} !Int" , vcat $ map (\v -> char '!' <> parens (text ty <+> v)) vars]) class_instance cls = text "instance" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> text cls <+> tuple vars define_zip ty c = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors" ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars]) <+> text "->" <+> text ty <+> tuple vars ,text "{-# INLINE_FUSED" <+> name <+> text "#-}" ,name <+> sep varss <+> text "=" <+> con c <+> text "len" <+> sep [parens $ text "unsafeSlice" <+> char '0' <+> text "len" <+> vs | vs <- varss] ,nest 2 $ hang (text "where") 2 $ text "len =" <+> sep (punctuate (text " `delayed_min`") [text "length" <+> vs | vs <- varss]) ] where name | n == 2 = text "zip" | otherwise = text "zip" <> int n define_zip_rule = hang (text "{-# RULES" <+> text "\"stream/" <> name "zip" <> text " [Vector.Unboxed]\" forall" <+> sep varss <+> char '.') 2 $ text "G.stream" <+> parens (name "zip" <+> sep varss) <+> char '=' <+> text "Bundle." <> name "zipWith" <+> tuple (replicate n empty) <+> sep [parens $ text "G.stream" <+> vs | vs <- varss] $$ text "#-}" 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" ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> text ty <+> tuple vars <+> text "->" <+> vtuple [text ty <+> v | v <- vars] ,text "{-# INLINE" <+> name <+> text "#-}" ,name <+> pat c <+> text "=" <+> vtuple varss ] where name | n == 2 = text "unzip" | otherwise = text "unzip" <> int n pat c = parens $ con c <+> var 'n' <+> sep varss patn c n = parens $ con c <+> (var 'n' <> int n) <+> sep [v <> int n | v <- varss] qM s = text "M." <> text s qG s = text "G." <> text s gen_length c _ = (pat c, var 'n') gen_unsafeSlice mod c rec = (var 'i' <+> var 'm' <+> pat c, con c <+> var 'm' <+> vcat [parens $ text mod <> char '.' <> text rec <+> var 'i' <+> var 'm' <+> vs | vs <- varss]) gen_overlaps rec = (patn "MV" 1 <+> patn "MV" 2, vcat $ r : [text "||" <+> r | r <- rs]) where r : rs = [qM rec <+> v <> char '1' <+> v <> char '2' | v <- varss] gen_unsafeNew rec = (var 'n', mk_do [v <+> text "<-" <+> qM rec <+> var 'n' | v <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) gen_unsafeReplicate rec = (var 'n' <+> tuple vars, mk_do [vs <+> text "<-" <+> qM rec <+> var 'n' <+> v | v <- vars | vs <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) gen_unsafeRead rec = (pat "MV" <+> var 'i', mk_do [v <+> text "<-" <+> qM rec <+> vs <+> var 'i' | v <- vars | vs <- varss] $ text "return" <+> tuple vars) gen_unsafeWrite rec = (pat "MV" <+> var 'i' <+> tuple vars, mk_do [qM rec <+> vs <+> var 'i' <+> v | v <- vars | vs <- varss] empty) gen_clear rec = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) gen_set rec = (pat "MV" <+> tuple vars, mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty) gen_unsafeCopy c q rec = (patn "MV" 1 <+> patn c 2, mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] empty) gen_unsafeMove rec = (patn "MV" 1 <+> patn "MV" 2, mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] empty) gen_unsafeGrow rec = (pat "MV" <+> var 'm', mk_do [vs <> char '\'' <+> text "<-" <+> qM rec <+> vs <+> var 'm' | vs <- varss] $ text "return $" <+> con "MV" <+> parens (var 'm' <> char '+' <> var 'n') <+> sep (map (<> char '\'') varss)) gen_initialize rec = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) gen_unsafeFreeze rec = (pat "MV", mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] $ text "return $" <+> con "V" <+> var 'n' <+> sep [vs <> char '\'' | vs <- varss]) gen_unsafeThaw rec = (pat "V", mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep [vs <> char '\'' | vs <- varss]) gen_basicUnsafeIndexM rec = (pat "V" <+> var 'i', mk_do [v <+> text "<-" <+> qG rec <+> vs <+> var 'i' | vs <- varss | v <- vars] $ text "return" <+> tuple vars) gen_elemseq rec = (char '_' <+> tuple vars, vcat $ r : [char '.' <+> r | r <- rs]) where r : rs = [qG rec <+> parens (text "undefined :: Vector" <+> v) <+> v | v <- vars] mk_do cmds ret = hang (text "do") 2 $ vcat $ cmds ++ [ret] method (s, f) = case f s of (p,e) -> text "{-# INLINE" <+> text s <+> text " #-}" $$ hang (text s <+> p) 4 (char '=' <+> e) methods_MVector = [("basicLength", gen_length "MV") ,("basicUnsafeSlice", gen_unsafeSlice "M" "MV") ,("basicOverlaps", gen_overlaps) ,("basicUnsafeNew", gen_unsafeNew) ,("basicUnsafeReplicate", gen_unsafeReplicate) ,("basicUnsafeRead", gen_unsafeRead) ,("basicUnsafeWrite", gen_unsafeWrite) ,("basicClear", gen_clear) ,("basicSet", gen_set) ,("basicUnsafeCopy", gen_unsafeCopy "MV" qM) ,("basicUnsafeMove", gen_unsafeMove) ,("basicUnsafeGrow", gen_unsafeGrow) ,("basicInitialize", gen_initialize)] methods_Vector = [("basicUnsafeFreeze", gen_unsafeFreeze) ,("basicUnsafeThaw", gen_unsafeThaw) ,("basicLength", gen_length "V") ,("basicUnsafeSlice", gen_unsafeSlice "G" "V") ,("basicUnsafeIndexM", gen_basicUnsafeIndexM) ,("basicUnsafeCopy", gen_unsafeCopy "V" qG) ,("elemseq", gen_elemseq)] vector-0.12.1.2/internal/unbox-tuple-instances0000755000000000000000000012162407346545000017445 0ustar0000000000000000#ifdef DEFINE_INSTANCES data instance MVector s (a, b) = MV_2 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) data instance Vector (a, b) = V_2 {-# UNPACK #-} !Int !(Vector a) !(Vector b) instance (Unbox a, Unbox b) => Unbox (a, b) instance (Unbox a, Unbox b) => M.MVector MVector (a, b) where {-# INLINE basicLength #-} basicLength (MV_2 n_ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_2 _ as bs) = MV_2 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ return $ MV_2 n_ as bs {-# INLINE basicInitialize #-} basicInitialize (MV_2 _ as bs) = do M.basicInitialize as M.basicInitialize bs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b return $ MV_2 n_ as bs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_2 _ as bs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ return (a, b) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_2 _ as bs) i_ (a, b) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b {-# INLINE basicClear #-} basicClear (MV_2 _ as bs) = do M.basicClear as M.basicClear bs {-# INLINE basicSet #-} basicSet (MV_2 _ as bs) (a, b) = do M.basicSet as a M.basicSet bs b {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_2 n_ as bs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ return $ MV_2 (m_+n_) as' bs' instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_2 n_ as bs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs return $ V_2 n_ as' bs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_2 n_ as bs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs return $ MV_2 n_ as' bs' {-# INLINE basicLength #-} basicLength (V_2 n_ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_2 _ as bs) = V_2 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_2 _ as bs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ return (a, b) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 _ as1 bs1) (V_2 _ as2 bs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 {-# INLINE elemseq #-} elemseq _ (a, b) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b #endif #ifdef DEFINE_MUTABLE -- | /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 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 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) where len = length as `delayed_min` length bs {-# RULES "stream/zip [Vector.Unboxed]" forall as bs . G.stream (zip as bs) = Bundle.zipWith (,) (G.stream as) (G.stream bs) #-} -- | /O(1)/ Unzip 2 vectors unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} unzip (V_2 _ as bs) = (as, bs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c) = MV_3 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) data instance Vector (a, b, c) = V_3 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) instance (Unbox a, Unbox b, Unbox c) => Unbox (a, b, c) instance (Unbox a, Unbox b, Unbox c) => M.MVector MVector (a, b, c) where {-# INLINE basicLength #-} basicLength (MV_3 n_ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_3 _ as bs cs) = MV_3 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ return $ MV_3 n_ as bs cs {-# INLINE basicInitialize #-} basicInitialize (MV_3 _ as bs cs) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c return $ MV_3 n_ as bs cs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_3 _ as bs cs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ return (a, b, c) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_3 _ as bs cs) i_ (a, b, c) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c {-# INLINE basicClear #-} basicClear (MV_3 _ as bs cs) = do M.basicClear as M.basicClear bs M.basicClear cs {-# INLINE basicSet #-} basicSet (MV_3 _ as bs cs) (a, b, c) = do M.basicSet as a M.basicSet bs b M.basicSet cs c {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_3 n_ as bs cs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ return $ MV_3 (m_+n_) as' bs' cs' instance (Unbox a, Unbox b, Unbox c) => G.Vector Vector (a, b, c) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_3 n_ as bs cs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs return $ V_3 n_ as' bs' cs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_3 n_ as bs cs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs return $ MV_3 n_ as' bs' cs' {-# INLINE basicLength #-} basicLength (V_3 n_ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_3 _ as bs cs) = V_3 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_3 _ as bs cs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ return (a, b, c) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (V_3 _ as2 bs2 cs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 {-# INLINE elemseq #-} elemseq _ (a, b, c) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c #endif #ifdef DEFINE_MUTABLE -- | /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) {-# INLINE_FUSED zip3 #-} zip3 as bs cs = MV_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs -- | /O(1)/ Unzip 3 vectors unzip3 :: (Unbox a, Unbox b, Unbox c) => MVector s (a, b, c) -> (MVector s a, MVector s b, MVector s c) {-# INLINE unzip3 #-} unzip3 (MV_3 _ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 3 vectors zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE_FUSED zip3 #-} zip3 as bs cs = V_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs {-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs . G.stream (zip3 as bs cs) = Bundle.zipWith3 (, ,) (G.stream as) (G.stream bs) (G.stream cs) #-} -- | /O(1)/ Unzip 3 vectors unzip3 :: (Unbox a, Unbox b, Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) {-# INLINE unzip3 #-} unzip3 (V_3 _ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d) = MV_4 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) data instance Vector (a, b, c, d) = V_4 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) instance (Unbox a, Unbox b, Unbox c, Unbox d) => Unbox (a, b, c, d) instance (Unbox a, Unbox b, Unbox c, Unbox d) => M.MVector MVector (a, b, c, d) where {-# INLINE basicLength #-} basicLength (MV_4 n_ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_4 _ as bs cs ds) = MV_4 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) {-# INLINE basicOverlaps #-} basicOverlaps (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 bs2 cs2 ds2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ return $ MV_4 n_ as bs cs ds {-# INLINE basicInitialize #-} basicInitialize (MV_4 _ as bs cs ds) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize ds {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d return $ MV_4 n_ as bs cs ds {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_4 _ as bs cs ds) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ return (a, b, c, d) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_4 _ as bs cs ds) i_ (a, b, c, d) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d {-# INLINE basicClear #-} basicClear (MV_4 _ as bs cs ds) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds {-# INLINE basicSet #-} basicSet (MV_4 _ as bs cs ds) (a, b, c, d) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 bs2 cs2 ds2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 bs2 cs2 ds2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_4 n_ as bs cs ds) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ return $ MV_4 (m_+n_) as' bs' cs' ds' instance (Unbox a, Unbox b, Unbox c, Unbox d) => G.Vector Vector (a, b, c, d) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_4 n_ as bs cs ds) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds return $ V_4 n_ as' bs' cs' ds' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_4 n_ as bs cs ds) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds return $ MV_4 n_ as' bs' cs' ds' {-# INLINE basicLength #-} basicLength (V_4 n_ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_4 _ as bs cs ds) = V_4 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_4 _ as bs cs ds) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ return (a, b, c, d) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (V_4 _ as2 bs2 cs2 ds2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 4 vectors zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s (a, b, c, d) {-# INLINE_FUSED zip4 #-} zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds -- | /O(1)/ Unzip 4 vectors unzip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s (a, b, c, d) -> (MVector s a, MVector s b, MVector s c, MVector s d) {-# INLINE unzip4 #-} unzip4 (MV_4 _ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 4 vectors zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d) {-# INLINE_FUSED zip4 #-} zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds {-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds . G.stream (zip4 as bs cs ds) = Bundle.zipWith4 (, , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) #-} -- | /O(1)/ Unzip 4 vectors unzip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) {-# INLINE unzip4 #-} unzip4 (V_4 _ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e) = MV_5 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) data instance Vector (a, b, c, d, e) = V_5 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Unbox (a, b, c, d, e) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => M.MVector MVector (a, b, c, d, e) where {-# INLINE basicLength #-} basicLength (MV_5 n_ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_5 _ as bs cs ds es) = MV_5 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) (M.basicUnsafeSlice i_ m_ es) {-# INLINE basicOverlaps #-} basicOverlaps (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 bs2 cs2 ds2 es2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 || M.basicOverlaps es1 es2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ es <- M.basicUnsafeNew n_ return $ MV_5 n_ as bs cs ds es {-# INLINE basicInitialize #-} basicInitialize (MV_5 _ as bs cs ds es) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize ds M.basicInitialize es {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d, e) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d es <- M.basicUnsafeReplicate n_ e return $ MV_5 n_ as bs cs ds es {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_5 _ as bs cs ds es) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ e <- M.basicUnsafeRead es i_ return (a, b, c, d, e) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_5 _ as bs cs ds es) i_ (a, b, c, d, e) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d M.basicUnsafeWrite es i_ e {-# INLINE basicClear #-} basicClear (MV_5 _ as bs cs ds es) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds M.basicClear es {-# INLINE basicSet #-} basicSet (MV_5 _ as bs cs ds es) (a, b, c, d, e) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d M.basicSet es e {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 bs2 cs2 ds2 es2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 M.basicUnsafeCopy es1 es2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 bs2 cs2 ds2 es2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 M.basicUnsafeMove es1 es2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_5 n_ as bs cs ds es) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ es' <- M.basicUnsafeGrow es m_ return $ MV_5 (m_+n_) as' bs' cs' ds' es' instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => G.Vector Vector (a, b, c, d, e) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_5 n_ as bs cs ds es) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds es' <- G.basicUnsafeFreeze es return $ V_5 n_ as' bs' cs' ds' es' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_5 n_ as bs cs ds es) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds es' <- G.basicUnsafeThaw es return $ MV_5 n_ as' bs' cs' ds' es' {-# INLINE basicLength #-} basicLength (V_5 n_ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_5 _ as bs cs ds es) = V_5 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_5 _ as bs cs ds es) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ e <- G.basicUnsafeIndexM es i_ return (a, b, c, d, e) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (V_5 _ as2 bs2 cs2 ds2 es2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 G.basicUnsafeCopy es1 es2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d, e) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d . G.elemseq (undefined :: Vector e) e #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 5 vectors zip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s e -> MVector s (a, b, c, d, e) {-# INLINE_FUSED zip5 #-} zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es -- | /O(1)/ Unzip 5 vectors unzip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => MVector s (a, b, c, d, e) -> (MVector s a, MVector s b, MVector s c, MVector s d, MVector s e) {-# INLINE unzip5 #-} unzip5 (MV_5 _ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 5 vectors zip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e) {-# INLINE_FUSED zip5 #-} zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es {-# RULES "stream/zip5 [Vector.Unboxed]" forall as bs cs ds es . G.stream (zip5 as bs cs ds es) = Bundle.zipWith5 (, , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) (G.stream es) #-} -- | /O(1)/ Unzip 5 vectors unzip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Vector (a, b, c, d, e) -> (Vector a, Vector b, Vector c, Vector d, Vector e) {-# INLINE unzip5 #-} unzip5 (V_5 _ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e, f) = MV_6 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) !(MVector s f) data instance Vector (a, b, c, d, e, f) = V_6 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) !(Vector f) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Unbox (a, b, c, d, e, f) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => M.MVector MVector (a, b, c, d, e, f) where {-# INLINE basicLength #-} basicLength (MV_6 n_ _ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_6 _ as bs cs ds es fs) = MV_6 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) (M.basicUnsafeSlice i_ m_ es) (M.basicUnsafeSlice i_ m_ fs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 bs2 cs2 ds2 es2 fs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 || M.basicOverlaps es1 es2 || M.basicOverlaps fs1 fs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ es <- M.basicUnsafeNew n_ fs <- M.basicUnsafeNew n_ return $ MV_6 n_ as bs cs ds es fs {-# INLINE basicInitialize #-} basicInitialize (MV_6 _ as bs cs ds es fs) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize ds M.basicInitialize es M.basicInitialize fs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d, e, f) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d es <- M.basicUnsafeReplicate n_ e fs <- M.basicUnsafeReplicate n_ f return $ MV_6 n_ as bs cs ds es fs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_6 _ as bs cs ds es fs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ e <- M.basicUnsafeRead es i_ f <- M.basicUnsafeRead fs i_ return (a, b, c, d, e, f) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_6 _ as bs cs ds es fs) i_ (a, b, c, d, e, f) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d M.basicUnsafeWrite es i_ e M.basicUnsafeWrite fs i_ f {-# INLINE basicClear #-} basicClear (MV_6 _ as bs cs ds es fs) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds M.basicClear es M.basicClear fs {-# INLINE basicSet #-} basicSet (MV_6 _ as bs cs ds es fs) (a, b, c, d, e, f) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d M.basicSet es e M.basicSet fs f {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 bs2 cs2 ds2 es2 fs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 M.basicUnsafeCopy es1 es2 M.basicUnsafeCopy fs1 fs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 bs2 cs2 ds2 es2 fs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 M.basicUnsafeMove es1 es2 M.basicUnsafeMove fs1 fs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_6 n_ as bs cs ds es fs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ es' <- M.basicUnsafeGrow es m_ fs' <- M.basicUnsafeGrow fs m_ return $ MV_6 (m_+n_) as' bs' cs' ds' es' fs' instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => G.Vector Vector (a, b, c, d, e, f) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_6 n_ as bs cs ds es fs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds es' <- G.basicUnsafeFreeze es fs' <- G.basicUnsafeFreeze fs return $ V_6 n_ as' bs' cs' ds' es' fs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_6 n_ as bs cs ds es fs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds es' <- G.basicUnsafeThaw es fs' <- G.basicUnsafeThaw fs return $ MV_6 n_ as' bs' cs' ds' es' fs' {-# INLINE basicLength #-} basicLength (V_6 n_ _ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_6 _ as bs cs ds es fs) = V_6 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) (G.basicUnsafeSlice i_ m_ fs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_6 _ as bs cs ds es fs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ e <- G.basicUnsafeIndexM es i_ f <- G.basicUnsafeIndexM fs i_ return (a, b, c, d, e, f) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (V_6 _ as2 bs2 cs2 ds2 es2 fs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 G.basicUnsafeCopy es1 es2 G.basicUnsafeCopy fs1 fs2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d, e, f) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d . G.elemseq (undefined :: Vector e) e . G.elemseq (undefined :: Vector f) f #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 6 vectors zip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s e -> MVector s f -> MVector s (a, b, c, d, e, f) {-# INLINE_FUSED zip6 #-} zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) (unsafeSlice 0 len fs) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es `delayed_min` length fs -- | /O(1)/ Unzip 6 vectors unzip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => MVector s (a, b, c, d, e, f) -> (MVector s a, MVector s b, MVector s c, MVector s d, MVector s e, MVector s f) {-# INLINE unzip6 #-} unzip6 (MV_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 6 vectors zip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f) {-# INLINE_FUSED zip6 #-} zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) (unsafeSlice 0 len fs) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es `delayed_min` length fs {-# RULES "stream/zip6 [Vector.Unboxed]" forall as bs cs ds es fs . G.stream (zip6 as bs cs ds es fs) = Bundle.zipWith6 (, , , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) (G.stream es) (G.stream fs) #-} -- | /O(1)/ Unzip 6 vectors unzip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Vector (a, b, c, d, e, f) -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) {-# INLINE unzip6 #-} unzip6 (V_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif vector-0.12.1.2/tests/0000755000000000000000000000000007346545000012570 5ustar0000000000000000vector-0.12.1.2/tests/Boilerplater.hs0000644000000000000000000000215707346545000015555 0ustar0000000000000000module Boilerplater where import Test.Tasty.QuickCheck import Language.Haskell.TH 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 vector-0.12.1.2/tests/LICENSE0000755000000000000000000000303507346545000013601 0ustar0000000000000000Copyright (c) 2009, Max Bolingbroke and 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. vector-0.12.1.2/tests/Main.hs0000644000000000000000000000062407346545000014012 0ustar0000000000000000module Main (main) where import qualified Tests.Vector import qualified Tests.Vector.UnitTests 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 vector-0.12.1.2/tests/Main.hs0000755000000000000000000000062407346545000014015 0ustar0000000000000000module Main (main) where import qualified Tests.Vector import qualified Tests.Vector.UnitTests 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 vector-0.12.1.2/tests/Setup.hs0000755000000000000000000000005707346545000014231 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.12.1.2/tests/Tests/0000755000000000000000000000000007346545000013672 5ustar0000000000000000vector-0.12.1.2/tests/Tests/Bundle.hs0000644000000000000000000001652407346545000015447 0ustar0000000000000000module Tests.Bundle ( tests ) where import Boilerplater import Utilities hiding (limitUnfolds) import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck hiding (testProperties) 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 testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList ] where prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a) = (S.fromList . S.toList) `eq` id prop_toList_fromList :: P ([a] -> [a]) = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, 'prop_length, 'prop_null, 'prop_empty, 'prop_singleton, 'prop_replicate, 'prop_cons, 'prop_snoc, 'prop_append, 'prop_head, 'prop_last, 'prop_index, 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, 'prop_map, 'prop_zipWith, 'prop_zipWith3, 'prop_filter, 'prop_takeWhile, 'prop_dropWhile, 'prop_elem, 'prop_notElem, 'prop_find, 'prop_findIndex, 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 'prop_foldr, 'prop_foldr1, 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 'prop_concatMap, 'prop_unfoldr ]) where -- Prelude prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==) prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null prop_empty :: P (S.Bundle v a) = S.empty `eq` [] prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton prop_replicate :: P (Int -> a -> S.Bundle v a) = (\n _ -> n < 1000) ===> S.replicate `eq` replicate prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:) prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++) prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head prop_last :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last prop_index = \xs -> not (S.null xs) ==> forAll (choose (0, S.length xs-1)) $ \i -> unP prop xs i where prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!) prop_extract = \xs -> forAll (choose (0, S.length xs)) $ \i -> forAll (choose (0, S.length xs - i)) $ \n -> unP prop i n xs where prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith3 `eq` zipWith3 prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int) = S.findIndex `eq` findIndex prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldl1 `eq` foldl1 prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl' prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldl1' `eq` foldl1' prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldr1 `eq` foldr1 prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.prescanl' `eq` prescanl prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.postscanl `eq` postscanl prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.postscanl' `eq` postscanl prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.scanl' `eq` scanl prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> S.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> S.scanl1' `eq` scanl1 prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs where prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap limitUnfolds f (theirs, ours) | ours >= 0 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) | otherwise = Nothing prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a) = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) testBoolFunctions :: forall v. S.Bundle v Bool -> [Test] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) where prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or testBundleFunctions = testSanity (undefined :: S.Bundle v Int) ++ testPolymorphicFunctions (undefined :: S.Bundle v Int) ++ testBoolFunctions (undefined :: S.Bundle v Bool) tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ] vector-0.12.1.2/tests/Tests/Move.hs0000644000000000000000000000375707346545000015150 0ustar0000000000000000module Tests.Move (tests) where import Test.QuickCheck import Test.Tasty.QuickCheck import Test.QuickCheck.Property (Property(..)) import Utilities () import Control.Monad (replicateM) import Control.Monad.ST (runST) import Data.List (sort,permutations) import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector as V import qualified Data.Vector.Primitive as P import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U basicMove :: G.Vector v a => v a -> Int -> Int -> Int -> v a basicMove v dstOff srcOff len | len > 0 = G.modify (\ mv -> G.copy (M.slice dstOff len mv) (G.slice srcOff len v)) v | otherwise = v testMove :: (G.Vector v a, Show (v a), Eq (v a)) => v a -> Property testMove v = G.length v > 0 ==> (MkProperty $ do dstOff <- choose (0, G.length v - 1) srcOff <- choose (0, G.length v - 1) len <- choose (1, G.length v - max dstOff srcOff) expected <- return $ basicMove v dstOff srcOff len actual <- return $ G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual)) checkPermutations :: Int -> Bool checkPermutations n = runST $ do vec <- U.thaw (U.fromList [1..n]) res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]] testPermutations :: Bool testPermutations = all checkPermutations [1..7] 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] vector-0.12.1.2/tests/Tests/Vector.hs0000644000000000000000000000101207346545000015462 0ustar0000000000000000{-# 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 ] vector-0.12.1.2/tests/Tests/Vector/0000755000000000000000000000000007346545000015134 5ustar0000000000000000vector-0.12.1.2/tests/Tests/Vector/Boxed.hs0000644000000000000000000000226507346545000016536 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Boxed (tests) where import Test.Tasty import qualified Data.Vector import Tests.Vector.Property import GHC.Exts (inline) testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Data a) => Data.Vector.Vector a -> [Test] testGeneralBoxedVector dummy = concatMap ($ dummy) [ testSanity , inline testPolymorphicFunctions , testOrdFunctions , testTuplyFunctions , testNestedVectorFunctions , testMonoidFunctions , testFunctorFunctions , testMonadFunctions , testApplicativeFunctions , testAlternativeFunctions , testDataFunctions ] testBoolBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector , 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 dummy = concatMap ($ dummy) [ testGeneralBoxedVector , testNumFunctions , testEnumFunctions ] tests = [ testGroup "Bool" $ testBoolBoxedVector (undefined :: Data.Vector.Vector Bool) , testGroup "Int" $ testNumericBoxedVector (undefined :: Data.Vector.Vector Int) ] vector-0.12.1.2/tests/Tests/Vector/Primitive.hs0000644000000000000000000000213207346545000017436 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Primitive (tests) where import Test.Tasty import qualified Data.Vector.Primitive import Tests.Vector.Property 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 dummy = concatMap ($ dummy) [ testSanity , inline testPolymorphicFunctions , testOrdFunctions , testMonoidFunctions , 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 dummy = concatMap ($ dummy) [ testGeneralPrimitiveVector , testNumFunctions , testEnumFunctions ] tests = [ testGroup "Int" $ testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int) , testGroup "Double" $ testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double) ] vector-0.12.1.2/tests/Tests/Vector/Property.hs0000644000000000000000000006771607346545000017335 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Property ( CommonContext , VanillaContext , VectorContext , testSanity , testPolymorphicFunctions , testTuplyFunctions , testOrdFunctions , testEnumFunctions , testMonoidFunctions , testFunctorFunctions , testMonadFunctions , testApplicativeFunctions , testAlternativeFunctions , testBoolFunctions , testNumFunctions , testNestedVectorFunctions , testDataFunctions -- re-exports , Data , Random ,Test ) where import Boilerplater import Utilities as Util hiding (limitUnfolds) import Data.Functor.Identity import qualified Data.Traversable as T (Traversable(..)) import Data.Foldable (Foldable(foldMap)) import Data.Orphans () import qualified Data.Vector.Generic as V import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck hiding (testProperties) import Text.Show.Functions () import Data.List import Data.Monoid import qualified Control.Applicative as Applicative import System.Random (Random) import Data.Functor.Identity import Control.Monad.Trans.Writer import Control.Monad.Zip import Data.Data import qualified Data.List.NonEmpty as DLE import Data.Semigroup (Semigroup(..)) type CommonContext a v = (VanillaContext a, VectorContext a v) type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a , TestData a, Model a ~ a, EqTest a ~ Property) 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] {-# INLINE testSanity #-} testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList, testProperty "unstream.stream == id" prop_unstream_stream, testProperty "stream.unstream == id" prop_stream_unstream ] where prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v prop_stream_unstream (s :: S.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] -- FIXME: inlining of unboxed properties blows up the memory during compilation. See #272 --{-# INLINE testPolymorphicFunctions #-} testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, -- Length information 'prop_length, 'prop_null, -- Indexing (FIXME) 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, -- Monadic indexing (FIXME) {- 'prop_indexM, 'prop_headM, 'prop_lastM, 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} -- Subvectors (FIXME) 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, 'prop_splitAt, {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, 'prop_unsafeTake, 'prop_unsafeDrop, -} -- Initialisation (FIXME) 'prop_empty, 'prop_singleton, 'prop_replicate, 'prop_generate, 'prop_iterateN, 'prop_iterateNM, -- Monadic initialisation (FIXME) 'prop_createT, {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} -- Unfolding 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, 'prop_constructN, 'prop_constructrN, -- Enumeration? (FIXME?) -- Concatenation (FIXME) 'prop_cons, 'prop_snoc, 'prop_append, 'prop_concat, -- Restricting memory usage 'prop_force, -- Bulk updates (FIXME) 'prop_upd, {- 'prop_update, 'prop_update_, 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} -- Accumulations (FIXME) 'prop_accum, {- 'prop_accumulate, 'prop_accumulate_, 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} -- Permutations '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_imapM, 'prop_imapM_, -- Zipping 'prop_zipWith, 'prop_zipWith3, {- ... -} 'prop_izipWith, 'prop_izipWith3, {- ... -} 'prop_izipWithM, 'prop_izipWithM_, {- 'prop_zip, ... -} -- Monadic zipping {- 'prop_zipWithM, 'prop_zipWithM_, -} -- Unzipping {- 'prop_unzip, ... -} -- Filtering 'prop_filter, 'prop_ifilter, {- prop_filterM, -} 'prop_uniq, 'prop_mapMaybe, 'prop_imapMaybe, 'prop_takeWhile, 'prop_dropWhile, -- Paritioning 'prop_partition, {- 'prop_unstablePartition, -} 'prop_partitionWith, 'prop_span, 'prop_break, -- Searching 'prop_elem, 'prop_notElem, 'prop_find, 'prop_findIndex, 'prop_findIndices, 'prop_elemIndex, 'prop_elemIndices, -- Folding 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_, -- Specialised folds 'prop_all, 'prop_any, {- 'prop_maximumBy, 'prop_minimumBy, 'prop_maxIndexBy, 'prop_minIndexBy, -} -- Monadic folds {- ... -} -- Monadic sequencing {- ... -} -- Scans 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 'prop_iscanl, 'prop_iscanl', 'prop_prescanr, 'prop_prescanr', 'prop_postscanr, 'prop_postscanr', 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', 'prop_iscanr, 'prop_iscanr' ]) where -- Prelude prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==) prop_length :: P (v a -> Int) = V.length `eq` length 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_replicate :: P (Int -> a -> v a) = (\n _ -> n < 1000) ===> V.replicate `eq` replicate 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` (++) prop_concat :: P ([v a] -> v a) = V.concat `eq` concat 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_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_createT :: P ((a, v a) -> (a, v a)) prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last prop_index = \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.!) `eq` (!!) prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn where fn xs i = case drop i xs of x:_ | i >= 0 -> Just x _ -> Nothing prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last prop_unsafeIndex = \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.unsafeIndex `eq` (!!) prop_slice = \xs -> forAll (choose (0, V.length xs)) $ \i -> forAll (choose (0, V.length xs - i)) $ \n -> unP prop i n xs where prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init prop_take :: P (Int -> v a -> v a) = V.take `eq` take prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt prop_accum = \f xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> unP prop f xs ps where prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) = V.accum `eq` accum prop_upd = \xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> unP prop xs ps where prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) prop_backpermute = \xs -> forAll (indices (V.length xs)) $ \is -> unP prop xs (V.fromList is) where prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute 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_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 prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a)) = V.imapM `eq` imapM prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) = V.imapM_ `eq` imapM_ prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a)) = V.izipWithM `eq` izipWithM prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) = V.izipWithM_ `eq` izipWithM_ prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a) = V.izipWith3 `eq` izipWith3 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_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 prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) = V.partition `eq` partition prop_partitionWith :: P ((a -> Either a a) -> v a -> (v a, v a)) = 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_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_findIndices :: P ((a -> Bool) -> v a -> v Int) = V.findIndices `eq` findIndices prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldl1 `eq` foldl1 prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl' prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldl1' `eq` foldl1' prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldr1 `eq` foldr1 prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldr1' `eq` foldr1 prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) = V.ifoldl `eq` ifoldl prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) = V.ifoldl' `eq` ifoldl prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) = V.ifoldr `eq` ifoldr prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) = V.ifoldr' `eq` ifoldr prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) = V.ifoldM `eq` ifoldM prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) = V.ifoldM' `eq` ifoldM prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) = V.ifoldM_ `eq` ifoldM_ prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) = V.ifoldM'_ `eq` ifoldM_ prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanl' `eq` prescanl prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanl `eq` postscanl prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanl' `eq` postscanl prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a) = 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_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) = V.iscanl' `eq` iscanl prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanr `eq` prescanr prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanr' `eq` prescanr prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanr `eq` postscanr prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanr' `eq` postscanr prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanr `eq` scanr prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanr' `eq` scanr prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a) = 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_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs where prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap 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])) -- --prop_mapAccumR = eq3 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B)) -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. limitUnfolds f (theirs, ours) | ours > 0 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) | otherwise = Nothing limitUnfoldsM f (theirs, ours) | ours > 0 = do r <- f theirs return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r | otherwise = return Nothing prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) `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_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_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] constructN xs 0 _ = xs constructN xs n f = constructN (xs ++ [f xs]) (n-1) f prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] constructrN xs 0 _ = xs constructrN xs n f = constructrN (f xs : xs) (n-1) f -- copied from GHC source code partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) partitionWith _ [] = ([],[]) partitionWith f (x:xs) = case f x of Left b -> (b:bs, cs) 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] {-# INLINE testTuplyFunctions #-} testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 , 'prop_unzip, 'prop_unzip3 ]) 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 testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] {-# INLINE testOrdFunctions #-} testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum, 'prop_minIndex, 'prop_maxIndex, 'prop_maximumBy, 'prop_minimumBy, 'prop_maxIndexBy, 'prop_minIndexBy, 'prop_ListLastMaxIndexWins, '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_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_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 prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) = (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW prop_FalseListFirstMaxIndexWins :: Property prop_FalseListFirstMaxIndexWins = expectFailure prop_FalseListFirstMaxIndexWinsDesc prop_minIndexBy :: P (v a -> Int) = not . V.null ===> V.minIndexBy compare `eq` minIndex 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 (<>) x y | snd (extractLMW x) > snd (extractLMW y) = x | snd (extractLMW x) < snd (extractLMW y) = y | otherwise = y newtype FirstMaxWith a i = FMW {extractFMW:: (i,a)} deriving(Eq,Show,Read) instance (Ord a) => Semigroup (FirstMaxWith a i) where (<>) x y | snd (extractFMW x) > snd (extractFMW y) = x | snd (extractFMW x) < snd (extractFMW y) = y | otherwise = x testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] {-# INLINE testEnumFunctions #-} testEnumFunctions _ = $(testProperties [ 'prop_enumFromN, 'prop_enumFromThenN, 'prop_enumFromTo, 'prop_enumFromThenTo]) where prop_enumFromN :: P (a -> Int -> v a) = (\_ n -> n < 1000) ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1) prop_enumFromThenN :: P (a -> a -> Int -> v a) = (\_ _ n -> n < 1000) ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y) prop_enumFromTo = \m -> forAll (choose (-2,100)) $ \n -> unP prop m (m+n) where prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo prop_enumFromThenTo = \i j -> j /= i ==> forAll (choose (ks i j)) $ \k -> unP prop i j k where prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo ks i j | j < i = (i-d*100, i+d*2) | otherwise = (i-d*2, i+d*100) where d = abs (j-i) testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] {-# INLINE testMonoidFunctions #-} testMonoidFunctions _ = $(testProperties [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) where prop_mempty :: P (v a) = mempty `eq` mempty 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] {-# 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] {-# INLINE testMonadFunctions #-} testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind , '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] {-# INLINE testApplicativeFunctions #-} testApplicativeFunctions _ = $(testProperties [ 'prop_applicative_pure, 'prop_applicative_appl ]) where prop_applicative_pure :: P (a -> v a) = Applicative.pure `eq` Applicative.pure 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] {-# INLINE testAlternativeFunctions #-} testAlternativeFunctions _ = $(testProperties [ 'prop_alternative_empty, 'prop_alternative_or ]) where prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty prop_alternative_or :: P (v a -> v a -> v a) = (Applicative.<|>) `eq` (Applicative.<|>) testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] {-# 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] {-# 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] {-# INLINE testNestedVectorFunctions #-} testNestedVectorFunctions _ = $(testProperties []) 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]) testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test] {-# INLINE testDataFunctions #-} testDataFunctions _ = $(testProperties ['prop_glength]) where prop_glength :: P (v a -> Int) = glength `eq` glength where glength :: Data b => b -> Int glength xs = gmapQl (+) 0 toA xs toA :: Data b => b -> Int toA x = maybe (glength x) (const 1) (cast x :: Maybe a) vector-0.12.1.2/tests/Tests/Vector/Storable.hs0000644000000000000000000000220707346545000017244 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Storable (tests) where import Test.Tasty import qualified Data.Vector.Storable import Tests.Vector.Property 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 dummy = concatMap ($ dummy) [ testSanity , inline testPolymorphicFunctions , testOrdFunctions , testMonoidFunctions , 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 dummy = concatMap ($ dummy) [ testGeneralStorableVector , testNumFunctions , testEnumFunctions ] tests = [ testGroup "Data.Vector.Storable.Vector (Int)" $ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int) , testGroup "Data.Vector.Storable.Vector (Double)" $ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double) ] vector-0.12.1.2/tests/Tests/Vector/Unboxed.hs0000644000000000000000000000375507346545000017106 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Unboxed (tests) where import Test.Tasty import qualified Data.Vector.Unboxed import Tests.Vector.Property 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 dummy = concatMap ($ dummy) [ testSanity , testPolymorphicFunctions , testOrdFunctions , testMonoidFunctions , testDataFunctions ] testUnitUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector ] testBoolUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector , 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 dummy = concatMap ($ dummy) [ testGeneralUnboxedVector , testNumFunctions , 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 dummy = concatMap ($ dummy) [ testGeneralUnboxedVector ] tests = [ testGroup "()" $ testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ()) , testGroup "(Bool)" $ testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool) , testGroup "(Int)" $ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int) , testGroup "(Float)" $ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float) , testGroup "(Double)" $ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double) , testGroup "(Int,Bool)" $ testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int, Bool)) , testGroup "(Int,Bool,Int)" $ testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int, Bool, Int)) ] vector-0.12.1.2/tests/Tests/Vector/UnitTests.hs0000644000000000000000000001304307346545000017433 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Tests.Vector.UnitTests (tests) where import Control.Applicative as Applicative import Control.Exception import Control.Monad.Primitive 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.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 () newtype Aligned a = Aligned { getAligned :: a } instance (Storable a) => Storable (Aligned a) where sizeOf _ = sizeOf (undefined :: a) alignment _ = 128 peek ptr = Aligned Applicative.<$> peek (castPtr ptr) poke ptr = poke (castPtr ptr) . getAligned checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do let ptr' = ptrToWordPtr ptr msg = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr') align :: WordPtr align = fromIntegral $ alignment dummy assertBool msg $ (ptr' `mod` align) == 0 where dummy :: a dummy = undefined tests :: [TestTree] tests = [ testGroup "Data.Vector.Storable.Vector Alignment" [ testCase "Aligned Double" $ checkAddressAlignment alignedDoubleVec , testCase "Aligned Int" $ checkAddressAlignment alignedIntVec ] , testGroup "Regression tests" [ testGroup "enumFromTo crash #188" [ regression188 ([] :: [Word8]) , regression188 ([] :: [Word16]) , regression188 ([] :: [Word32]) , regression188 ([] :: [Word64]) , regression188 ([] :: [Word]) , regression188 ([] :: [Int8]) , regression188 ([] :: [Int16]) , regression188 ([] :: [Int32]) , regression188 ([] :: [Int64]) , regression188 ([] :: [Int]) , regression188 ([] :: [Char]) ] ] , testGroup "Negative tests" [ 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" [ testCase "Boxed" $ testTakeOutOfMemory Boxed.take , testCase "Primitive" $ testTakeOutOfMemory Primitive.take , testCase "Storable" $ testTakeOutOfMemory Storable.take , testCase "Unboxed" $ testTakeOutOfMemory Unboxed.take ] ] ] testsSliceOutOfBounds :: (Show (v Int), Generic.Vector v Int) => (Int -> Int -> v Int -> v Int) -> [TestTree] testsSliceOutOfBounds sliceWith = [ testCase "Negative ix" $ sliceTest sliceWith (-2) 2 xs , testCase "Negative size" $ sliceTest sliceWith 2 (-2) xs , testCase "Negative ix and size" $ sliceTest sliceWith (-2) (-1) xs , testCase "Too large ix" $ sliceTest sliceWith 6 2 xs , testCase "Too large size" $ sliceTest sliceWith 2 6 xs , testCase "Too large ix and size" $ sliceTest sliceWith 6 6 xs , testCase "Overflow" $ sliceTest sliceWith 1 maxBound xs , testCase "OutOfMemory" $ sliceTest sliceWith 1 (maxBound `div` intSize) xs ] where intSize = sizeOf (undefined :: Int) xs = [1, 2, 3, 4, 5] :: [Int] {-# INLINE testsSliceOutOfBounds #-} sliceTest :: (Show (v Int), Generic.Vector v Int) => (Int -> Int -> v Int -> v Int) -> Int -> Int -> [Int] -> Assertion sliceTest sliceWith i m xs = do let vec = Generic.fromList xs eRes <- try (pure $! sliceWith i m vec) case eRes of Right v -> assertFailure $ "Data.Vector.Internal.Check.checkSlice failed to check: " ++ show v Left (ErrorCall err) -> let assertMsg = List.concat [ "Expected slice function to produce an 'error' ending with: \"" , errSuffix , "\" instead got: \"" , err ] in assertBool assertMsg (errSuffix `List.isSuffixOf` err) where errSuffix = "(slice): invalid slice (" ++ show i ++ "," ++ show m ++ "," ++ show (List.length xs) ++ ")" {-# INLINE sliceTest #-} testTakeOutOfMemory :: (Show (v Int), Eq (v Int), Generic.Vector v Int) => (Int -> v Int -> v Int) -> Assertion testTakeOutOfMemory takeWith = takeWith (maxBound `div` intSize) (Generic.fromList xs) @=? Generic.fromList xs where intSize = sizeOf (undefined :: Int) xs = [1, 2, 3, 4, 5] :: [Int] {-# INLINE testTakeOutOfMemory #-} regression188 :: 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 {-# INLINE regression188 #-} alignedDoubleVec :: Storable.Vector (Aligned Double) alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] 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 vector-0.12.1.2/tests/Utilities.hs0000644000000000000000000002432407346545000015104 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, GADTs #-} module Utilities where import Test.QuickCheck 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.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 show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s) instance Arbitrary a => Arbitrary (DV.Vector a) where arbitrary = fmap DV.fromList arbitrary instance CoArbitrary a => CoArbitrary (DV.Vector a) where coarbitrary = coarbitrary . DV.toList instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where arbitrary = fmap DVP.fromList arbitrary instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where coarbitrary = coarbitrary . DVP.toList instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where arbitrary = fmap DVS.fromList arbitrary instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where coarbitrary = coarbitrary . DVS.toList instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where arbitrary = fmap DVU.fromList arbitrary instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where coarbitrary = coarbitrary . DVU.toList instance Arbitrary a => Arbitrary (S.Bundle v a) where arbitrary = fmap S.fromList arbitrary instance CoArbitrary a => CoArbitrary (S.Bundle v a) where coarbitrary = coarbitrary . S.toList instance (Arbitrary a, Arbitrary b) => Arbitrary (Writer a b) where arbitrary = do b <- arbitrary a <- arbitrary return $ writer (b,a) instance CoArbitrary a => CoArbitrary (Writer a ()) where coarbitrary = coarbitrary . runWriter class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where type Model a model :: a -> Model a unmodel :: Model a -> a type EqTest a 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 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 type EqTest (DVP.Vector a) = Property equal x y = property (x == y) instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where type Model (DVS.Vector a) = [a] model = DVS.toList unmodel = DVS.fromList type EqTest (DVS.Vector a) = Property equal x y = property (x == y) instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where type Model (DVU.Vector a) = [a] model = DVU.toList unmodel = DVU.fromList type EqTest (DVU.Vector a) = Property equal x y = property (x == y) #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) } 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) -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well. instance (Eq a, TestData a) => TestData (Maybe a) where type Model (Maybe a) = Maybe (Model a) 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) 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 unmodel f = unmodel . f . model type EqTest (a -> b) = a -> EqTest b equal f g x = equal (f x) (g x) newtype P a = P { unP :: EqTest a } instance TestData a => Testable (P a) where property (P a) = property a infix 4 `eq` eq :: TestData a => a -> Model a -> P a eq x y = P (equal x (unmodel y)) class Conclusion p where type Predicate p predicate :: Predicate p -> p -> p instance Conclusion Property where type Predicate Property = Bool predicate = (==>) instance Conclusion p => Conclusion (a -> p) where type Predicate (a -> p) = a -> Predicate p predicate f p = \x -> predicate (f x) (p x) infixr 0 ===> (===>) :: TestData a => Predicate (EqTest a) -> P a -> P a p ===> P a = P (predicate p a) notNull2 _ xs = not $ DVG.null xs notNullS2 _ s = not $ S.null s -- Generators index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)] index_value_pairs 0 = return [] index_value_pairs m = sized $ \n -> do len <- choose (0,n) is <- sequence [choose (0,m-1) | _i <- [1..len]] xs <- vector len return $ zip is xs indices :: Int -> Gen [Int] indices 0 = return [] indices m = sized $ \n -> do len <- choose (0,n) sequence [choose (0,m-1) | _i <- [1..len]] -- Additional list functions singleton x = [x] snoc xs x = xs ++ [x] generate n f = [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 postscanl f z = tail . scanl f z prescanr f z = tail . scanr f z postscanr f z = init . scanr f z accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a] accum f xs ps = go xs ps' 0 where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps go (x:xxs) ((i,y) : pps) j | i == j = go (f x y : xxs) pps j go (x:xxs) pps j = x : go xxs pps (j+1) go [] _ _ = [] (//) :: [a] -> [(Int, a)] -> [a] xs // ps = go xs ps' 0 where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps go (_x:xxs) ((i,y) : pps) j | i == j = go (y:xxs) pps j go (x:xxs) pps j = x : go xxs pps (j+1) go [] _ _ = [] withIndexFirst m f = m (uncurry f) . zip [0..] imap :: (Int -> a -> a) -> [a] -> [a] imap = withIndexFirst map imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a] imapM = withIndexFirst mapM imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m () imapM_ = withIndexFirst mapM_ izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a] izipWith = withIndexFirst zipWith izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a] izipWithM = withIndexFirst zipWithM izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m () izipWithM_ = withIndexFirst zipWithM_ izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a] izipWith3 = withIndexFirst zipWith3 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..] ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a ifoldl = indexedLeftFold foldl iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a] iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..] iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b] iscanr f z = scanr (uncurry f) z . zip [0..] ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z = foldr (uncurry f) z . zip [0..] ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a ifoldM = indexedLeftFold foldM ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m () ifoldM_ = indexedLeftFold foldM_ minIndex :: Ord a => [a] -> Int minIndex = fst . foldr1 imin . zip [0..] where imin (i,x) (j,y) | x <= y = (i,x) | otherwise = (j,y) maxIndex :: Ord a => [a] -> Int maxIndex = fst . foldr1 imax . zip [0..] where imax (i,x) (j,y) | x > y = (i,x) | otherwise = (j,y) iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a] iterateNM n f x | n <= 0 = return [] | n == 1 = return [x] | otherwise = do x' <- f x xs <- iterateNM (n-1) f x' return (x : xs) unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a] unfoldrM step b0 = do r <- step b0 case r of Nothing -> return [] Just (a,b) -> do as <- unfoldrM step b return (a : as) limitUnfolds f (theirs, ours) | ours >= 0 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) | otherwise = Nothing vector-0.12.1.2/vector.cabal0000644000000000000000000001630407346545000013720 0ustar0000000000000000Name: vector Version: 0.12.1.2 -- don't forget to update the changelog file! License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Haskell Libraries Team Copyright: (c) Roman Leshchinskiy 2008-2012 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 and immutable), with a powerful loop optimisation framework . . It is structured as follows: . ["Data.Vector"] Boxed vectors of arbitrary types. . ["Data.Vector.Unboxed"] Unboxed vectors with an adaptive representation based on data type families. . ["Data.Vector.Storable"] Unboxed vectors of 'Storable' types. . ["Data.Vector.Primitive"] Unboxed vectors of primitive types as defined by the @primitive@ package. "Data.Vector.Unboxed" is more flexible at no performance cost. . ["Data.Vector.Generic"] Generic interface to the vector types. . There is also a (draft) tutorial on common uses of vector. . * 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 Extra-Source-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 internal/GenUnboxTuple.hs internal/unbox-tuple-instances Flag BoundsChecks Description: Enable bounds checking Default: True Manual: True Flag UnsafeChecks Description: Enable bounds checking in unsafe operations at the cost of a significant performance penalty Default: False Manual: True Flag InternalChecks Description: Enable internal consistency checks at the cost of a significant performance penalty Default: False Manual: True Flag Wall Description: Enable all -Wall warnings Default: False Manual: True Library Default-Language: Haskell2010 Other-Extensions: BangPatterns CPP DeriveDataTypeable ExistentialQuantification FlexibleContexts FlexibleInstances GADTs KindSignatures MagicHash MultiParamTypeClasses Rank2Types ScopedTypeVariables StandaloneDeriving TypeFamilies Exposed-Modules: Data.Vector.Internal.Check Data.Vector.Fusion.Util Data.Vector.Fusion.Stream.Monadic Data.Vector.Fusion.Bundle.Size Data.Vector.Fusion.Bundle.Monadic Data.Vector.Fusion.Bundle Data.Vector.Generic.Mutable.Base Data.Vector.Generic.Mutable Data.Vector.Generic.Base Data.Vector.Generic.New Data.Vector.Generic Data.Vector.Primitive.Mutable Data.Vector.Primitive Data.Vector.Storable.Internal Data.Vector.Storable.Mutable Data.Vector.Storable Data.Vector.Unboxed.Base Data.Vector.Unboxed.Mutable Data.Vector.Unboxed Data.Vector.Mutable Data.Vector 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 if impl(ghc >= 8.0) && impl(ghc < 8.1) Ghc-Options: -Wno-redundant-constraints if flag(BoundsChecks) cpp-options: -DVECTOR_BOUNDS_CHECKS if flag(UnsafeChecks) cpp-options: -DVECTOR_UNSAFE_CHECKS 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 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 default-extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, Rank2Types, 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-O2 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 default-extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, Rank2Types, TypeSynonymInstances, TypeFamilies, TemplateHaskell 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