-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Efficient Arrays -- -- An efficient implementation of Int-indexed arrays (both mutable and -- immutable), with a powerful loop optimisation framework . -- -- It is structured as follows: -- -- -- -- There is also a (draft) tutorial on common uses of vector. -- -- -- -- Please use the project trac to submit bug reports and feature -- requests. -- -- -- -- Changes in version 0.10.0.1 -- -- -- -- Changes in version 0.10 -- -- @package vector @version 0.10.0.1 -- | Ugly internal utility functions for implementing Storable-based -- vectors. module Data.Vector.Storable.Internal getPtr :: ForeignPtr a -> Ptr a setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a -- | Fusion-related utility types module Data.Vector.Fusion.Util -- | Identity monad newtype Id a Id :: a -> Id a unId :: Id a -> a -- | Box monad data Box a Box :: a -> Box a unBox :: Box a -> a -- | Delay inlining a function until late in the game (simplifier phase 0). delay_inline :: (a -> b) -> a -> b -- | min inlined in phase 0 delayed_min :: Int -> Int -> Int instance Monad Box instance Functor Box instance Monad Id instance Functor Id -- | Size hints for streams. module Data.Vector.Fusion.Stream.Size -- | Size hint data Size -- | Exact size Exact :: Int -> Size -- | Upper bound on the size Max :: Int -> Size -- | Unknown size Unknown :: Size -- | Minimum of two size hints smaller :: Size -> Size -> Size -- | Maximum of two size hints larger :: Size -> Size -> Size -- | Convert a size hint to an upper bound toMax :: Size -> Size -- | Compute the maximum size from a size hint if possible upperBound :: Size -> Maybe Int instance Eq Size instance Show Size instance Num Size -- | Bounds checking infrastructure module Data.Vector.Internal.Check data Checks Bounds :: Checks Unsafe :: Checks Internal :: Checks doChecks :: Checks -> Bool error :: String -> Int -> String -> String -> a internalError :: String -> Int -> String -> String -> a check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a checkLength :: String -> Int -> Checks -> String -> Int -> a -> a checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a instance Eq Checks -- | Monadic stream combinators. module Data.Vector.Fusion.Stream.Monadic -- | Monadic streams data Stream m a Stream :: (s -> m (Step s a)) -> s -> Size -> Stream m a -- | Result of taking a single step in a stream data Step s a -- | a new element and a new seed Yield :: a -> s -> Step s a -- | just a new seed Skip :: s -> Step s a -- | end of stream Done :: Step s a data SPEC SPEC :: SPEC SPEC2 :: SPEC -- | Size hint of a Stream size :: Stream m a -> Size -- | Attach a Size hint to a Stream sized :: Stream m a -> Size -> Stream m a -- | Length of a Stream length :: Monad m => Stream m a -> m Int -- | Check if a Stream is empty null :: Monad m => Stream m a -> m Bool -- | Empty Stream empty :: Monad m => Stream m a -- | Singleton Stream singleton :: Monad m => a -> Stream m a -- | Prepend an element cons :: Monad m => a -> Stream m a -> Stream m a -- | Append an element snoc :: Monad m => Stream m a -> a -> Stream m a -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a -- | 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 generate :: Monad m => Int -> (Int -> a) -> Stream m a -- | Generate a stream from its indices generateM :: Monad m => Int -> (Int -> m a) -> Stream m a -- | Concatenate two Streams (++) :: Monad m => Stream m a -> Stream m a -> Stream m a -- | First element of the Stream or error if empty head :: Monad m => Stream m a -> m a -- | Last element of the Stream or error if empty last :: Monad m => Stream m a -> m a -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a -- | Element at the given position or Nothing if out of bounds (!?) :: Monad m => Stream m a -> Int -> m (Maybe a) -- | Extract a substream of the given length starting at the given -- position. slice :: Monad m => Int -> Int -> Stream m a -> Stream m a -- | All but the last element init :: Monad m => Stream m a -> Stream m a -- | All but the first element tail :: Monad m => Stream m a -> Stream m a -- | The first n elements take :: Monad m => Int -> Stream m a -> Stream m a -- | All but the first n elements drop :: Monad m => Int -> Stream m a -> Stream m a -- | Map a function over a Stream map :: Monad m => (a -> b) -> Stream m a -> Stream m b -- | Map a monadic function over a Stream mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b -- | Execute a monadic action for each element of the Stream mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () -- | Transform a Stream to use a different monad trans :: (Monad m, Monad m') => (forall a. m a -> m' a) -> Stream m a -> Stream m' a unbox :: Monad m => Stream m (Box a) -> Stream m a concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b -- | Create a Stream of values from a Stream of streamable -- things flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size -> Stream m a -> Stream m b -- | Pair each element in a Stream with its index indexed :: Monad m => Stream m a -> Stream m (Int, a) -- | 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) zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m () -- | Zip two Streams with the given monadic function zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d zipWith4M :: Monad m => (a -> b -> c -> d -> m e) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e 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 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 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c zipWith3 :: Monad m => (a -> b -> c -> d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d zipWith4 :: Monad m => (a -> b -> c -> d -> e) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e 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 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 zip :: Monad m => Stream m a -> Stream m b -> Stream m (a, b) zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a, b, c) zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m (a, b, c, d) 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) 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) -- | Drop elements which do not satisfy the predicate filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -- | Drop elements which do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -- | Longest prefix of elements that satisfy the predicate takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -- | Longest prefix of elements that satisfy the monadic predicate takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a -- | Drop the longest prefix of elements that satisfy the monadic predicate dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a -- | Check whether the Stream contains an element elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool -- | Inverse of elem notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool -- | 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) -- | 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) -- | 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) -- | 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) -- | Left fold foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a -- | Left fold with a monadic operator foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -- | Left fold over a non-empty Stream foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a -- | Left fold over a non-empty Stream with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a -- | Same as foldlM foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -- | Same as foldl1M fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a -- | Left fold with a strict accumulator foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a -- | Left fold with a strict accumulator and a monadic operator foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -- | Left fold over a non-empty Stream with a strict accumulator foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a -- | 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 -- | Same as foldlM' foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a -- | Same as foldl1M' fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a -- | Right fold foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b -- | Right fold with a monadic operator foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b -- | Right fold over a non-empty stream foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a -- | Right fold over a non-empty stream with a monadic operator foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a and :: Monad m => Stream m Bool -> m Bool or :: Monad m => Stream m Bool -> m Bool concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b -- | Unfold unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a -- | Unfold at most n elements unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a -- | Unfold at most n elements with a monadic functions unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a -- | Apply function n times to value. Zeroth element is original value. iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a -- | Apply monadic function n times to value. Zeroth element is original -- value. iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a -- | Prefix scan prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Prefix scan with a monadic operator prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Prefix scan with strict accumulator prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Prefix scan with strict accumulator and a monadic operator prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Suffix scan postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Suffix scan with a monadic operator postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Suffix scan with strict accumulator postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Suffix scan with strict acccumulator and a monadic operator postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Haskell-style scan scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Haskell-style scan with a monadic operator scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Haskell-style scan with strict accumulator scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a -- | Haskell-style scan with strict accumulator and a monadic operator scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a -- | Scan over a non-empty Stream scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a -- | Scan over a non-empty Stream with a monadic operator scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a -- | Scan over a non-empty Stream with a strict accumulator scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a -- | 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 -- | 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 -- | 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 -- | 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 -- | Convert a Stream to a list toList :: Monad m => Stream m a -> m [a] -- | Convert a list to a Stream fromList :: Monad m => [a] -> Stream m a -- | Convert the first n elements of a list to a Stream fromListN :: Monad m => Int -> [a] -> Stream m a -- | Convert a list to a Stream with the given Size hint. unsafeFromList :: Monad m => Size -> [a] -> Stream m a instance Monad m => Functor (Stream m) -- | Streams for stream fusion module Data.Vector.Fusion.Stream -- | Result of taking a single step in a stream data Step s a -- | a new element and a new seed Yield :: a -> s -> Step s a -- | just a new seed Skip :: s -> Step s a -- | end of stream Done :: Step s a -- | The type of pure streams type Stream = Stream Id -- | Alternative name for monadic streams type MStream = Stream inplace :: (forall m. Monad m => Stream m a -> Stream m b) -> Stream a -> Stream b -- | Size hint of a Stream size :: Stream a -> Size -- | Attach a Size hint to a Stream sized :: Stream a -> Size -> Stream a -- | Length of a Stream length :: Stream a -> Int -- | Check if a Stream is empty null :: Stream a -> Bool -- | Empty Stream empty :: Stream a -- | Singleton Stream singleton :: a -> Stream a -- | Prepend an element cons :: a -> Stream a -> Stream a -- | Append an element snoc :: Stream a -> a -> Stream a -- | Replicate a value to a given length replicate :: Int -> a -> Stream a -- | Generate a stream from its indices generate :: Int -> (Int -> a) -> Stream a -- | Concatenate two Streams (++) :: Stream a -> Stream a -> Stream a -- | First element of the Stream or error if empty head :: Stream a -> a -- | Last element of the Stream or error if empty last :: Stream a -> a -- | Element at the given position (!!) :: Stream a -> Int -> a -- | Element at the given position or Nothing if out of bounds (!?) :: Stream a -> Int -> Maybe a -- | Extract a substream of the given length starting at the given -- position. slice :: Int -> Int -> Stream a -> Stream a -- | All but the last element init :: Stream a -> Stream a -- | All but the first element tail :: Stream a -> Stream a -- | The first n elements take :: Int -> Stream a -> Stream a -- | All but the first n elements drop :: Int -> Stream a -> Stream a -- | Map a function over a Stream map :: (a -> b) -> Stream a -> Stream b concatMap :: (a -> Stream b) -> Stream a -> Stream b -- | Create a Stream of values from a Stream of streamable -- things flatten :: (a -> s) -> (s -> Step s b) -> Size -> Stream a -> Stream b unbox :: Stream (Box a) -> Stream a -- | Pair each element in a Stream with its index indexed :: Stream a -> Stream (Int, a) -- | Pair each element in a Stream with its index, starting from the -- right and counting down indexedR :: Int -> Stream a -> Stream (Int, a) -- | Zip two Streams with the given function zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c -- | Zip three Streams with the given function zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d zipWith4 :: (a -> b -> c -> d -> e) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e zipWith5 :: (a -> b -> c -> d -> e -> f) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> Stream g zip :: Stream a -> Stream b -> Stream (a, b) zip3 :: Stream a -> Stream b -> Stream c -> Stream (a, b, c) zip4 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream (a, b, c, d) zip5 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream (a, b, c, d, e) zip6 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> Stream (a, b, c, d, e, f) -- | Drop elements which do not satisfy the predicate filter :: (a -> Bool) -> Stream a -> Stream a -- | Longest prefix of elements that satisfy the predicate takeWhile :: (a -> Bool) -> Stream a -> Stream a -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: (a -> Bool) -> Stream a -> Stream a -- | Check whether the Stream contains an element elem :: Eq a => a -> Stream a -> Bool -- | Inverse of elem notElem :: Eq a => a -> Stream a -> Bool -- | Yield Just the first element matching the predicate or -- Nothing if no such element exists. find :: (a -> Bool) -> Stream a -> Maybe a -- | Yield Just the index of the first element matching the -- predicate or Nothing if no such element exists. findIndex :: (a -> Bool) -> Stream a -> Maybe Int -- | Left fold foldl :: (a -> b -> a) -> a -> Stream b -> a -- | Left fold on non-empty Streams foldl1 :: (a -> a -> a) -> Stream a -> a -- | Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Stream b -> a -- | Left fold on non-empty Streams with strict accumulator foldl1' :: (a -> a -> a) -> Stream a -> a -- | Right fold foldr :: (a -> b -> b) -> b -> Stream a -> b -- | Right fold on non-empty Streams foldr1 :: (a -> a -> a) -> Stream a -> a and :: Stream Bool -> Bool or :: Stream Bool -> Bool -- | Unfold unfoldr :: (s -> Maybe (a, s)) -> s -> Stream a -- | Unfold at most n elements unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Stream a -- | Apply function n-1 times to value. Zeroth element is original value. iterateN :: Int -> (a -> a) -> a -> Stream a -- | Prefix scan prescanl :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Prefix scan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Suffix scan postscanl :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Suffix scan with strict accumulator postscanl' :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Haskell-style scan scanl :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Haskell-style scan with strict accumulator scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a -- | Scan over a non-empty Stream scanl1 :: (a -> a -> a) -> Stream a -> Stream a -- | Scan over a non-empty Stream with a strict accumulator scanl1' :: (a -> a -> a) -> Stream a -> Stream a -- | Yield a Stream of the given length containing the values -- x, x+y, x+y+y etc. enumFromStepN :: Num a => a -> a -> Int -> Stream a -- | Enumerate values -- -- WARNING: This operations can be very inefficient. If at all -- possible, use enumFromStepN instead. enumFromTo :: Enum a => a -> a -> Stream a -- | Enumerate values with a given step. -- -- WARNING: This operations is very inefficient. If at all -- possible, use enumFromStepN instead. enumFromThenTo :: Enum a => a -> a -> a -> Stream a -- | Convert a Stream to a list toList :: Stream a -> [a] -- | Create a Stream from a list fromList :: [a] -> Stream a -- | Create a Stream from the first n elements of a list -- --
--   fromListN n xs = fromList (take n xs)
--   
fromListN :: Int -> [a] -> Stream a unsafeFromList :: Size -> [a] -> Stream a -- | Convert a pure stream to a monadic stream liftStream :: Monad m => Stream a -> Stream m a -- | Apply a monadic action to each element of the stream, producing a -- monadic stream of results mapM :: Monad m => (a -> m b) -> Stream a -> Stream m b -- | Apply a monadic action to each element of the stream mapM_ :: Monad m => (a -> m b) -> Stream a -> m () zipWithM :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> Stream m c zipWithM_ :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> m () -- | Yield a monadic stream of elements that satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream a -> Stream m a -- | Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a -- | Monadic fold over non-empty stream fold1M :: Monad m => (a -> a -> m a) -> Stream a -> m a -- | Monadic fold with strict accumulator foldM' :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a -- | Monad fold over non-empty stream with strict accumulator fold1M' :: Monad m => (a -> a -> m a) -> Stream a -> m a -- | Check if two Streams are equal eq :: Eq a => Stream a -> Stream a -> Bool -- | Lexicographically compare two Streams cmp :: Ord a => Stream a -> Stream a -> Ordering instance Ord a => Ord (Stream Id a) instance Eq a => Eq (Stream Id a) -- | Generic interface to mutable vectors module Data.Vector.Generic.Mutable -- | Class of mutable vectors parametrised with a primitive state token. -- -- Minimum complete implementation: -- -- class MVector v a where basicUnsafeReplicate n x = do { v <- basicUnsafeNew n; basicSet v x; return v } basicClear _ = return () 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) 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 () basicUnsafeMove !dst !src | basicOverlaps dst src = do { srcCopy <- clone src; basicUnsafeCopy dst srcCopy } | otherwise = basicUnsafeCopy dst src basicUnsafeGrow v by = do { v' <- basicUnsafeNew (n + by); basicUnsafeCopy (basicUnsafeSlice 0 n v') v; return v' } where n = basicLength v basicLength :: MVector v a => v s a -> Int basicUnsafeSlice :: MVector v a => Int -> Int -> v s a -> v s a basicOverlaps :: MVector v a => v s a -> v s a -> Bool basicUnsafeNew :: (MVector v a, PrimMonad m) => Int -> m (v (PrimState m) a) basicUnsafeReplicate :: (MVector v a, PrimMonad m) => Int -> a -> m (v (PrimState m) a) basicUnsafeRead :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m a basicUnsafeWrite :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> a -> m () basicClear :: (MVector v a, PrimMonad m) => v (PrimState m) a -> m () basicSet :: (MVector v a, PrimMonad m) => v (PrimState m) a -> a -> m () basicUnsafeCopy :: (MVector v a, PrimMonad m) => v (PrimState m) a -> v (PrimState m) a -> m () basicUnsafeMove :: (MVector v a, PrimMonad m) => v (PrimState m) a -> v (PrimState m) a -> m () basicUnsafeGrow :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m (v (PrimState m) a) -- | Length of the mutable vector. length :: MVector v a => v s a -> Int -- | Check whether the vector is empty null :: MVector v a => v s a -> Bool -- | Yield a part of the mutable vector without copying it. slice :: MVector v a => Int -> Int -> v s a -> v s a init :: MVector v a => v s a -> v s a tail :: MVector v a => v s a -> v s a take :: MVector v a => Int -> v s a -> v s a drop :: MVector v a => Int -> v s a -> v s a splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) -- | Yield a part of the mutable vector without copying it. No bounds -- checks are performed. unsafeSlice :: MVector v a => Int -> Int -> v s a -> v s a unsafeInit :: MVector v a => v s a -> v s a unsafeTail :: MVector v a => v s a -> v s a unsafeTake :: MVector v a => Int -> v s a -> v s a unsafeDrop :: MVector v a => Int -> v s a -> v s a overlaps :: MVector v a => v s a -> v s a -> Bool -- | Create a mutable vector of the given length. new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) -- | Create a mutable vector of the given length. The length is not -- checked. unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) -- | 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) -- | 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) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) -- | 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) -- | 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) -- | 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 () -- | Yield the element at the given position. read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a -- | Replace the element at the given position. write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () -- | 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 -- | 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 () -- | 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 () -- | Set all elements of the vector to the given value. set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () -- | 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 -> v (PrimState m) a -> m () -- | 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 -> v (PrimState m) a -> m () -- | 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 -> v (PrimState m) a -> m () -- | 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 -> v (PrimState m) a -> m () mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a -- | Create a new mutable vector and fill it with elements from the -- Stream. The vector will grow exponentially if the maximum size -- of the Stream is unknown. unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) -- | Create a new mutable vector and fill it with elements from the -- Stream from right to left. The vector will grow exponentially -- if the maximum size of the Stream is unknown. unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) -- | Create a new mutable vector and fill it with elements from the monadic -- stream. The vector will grow exponentially if the maximum size of the -- stream is unknown. munstream :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) -- | Create a new mutable vector and fill it with elements from the monadic -- stream from right to left. The vector will grow exponentially if the -- maximum size of the stream is unknown. munstreamR :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) transform :: (PrimMonad m, MVector v a) => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) transformR :: (PrimMonad m, MVector v a) => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) fill :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) fillR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) unsafeAccum :: (PrimMonad m, MVector v a) => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () accum :: (PrimMonad m, MVector v a) => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () unsafeUpdate :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream (Int, a) -> m () update :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream (Int, a) -> m () reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () unstablePartition :: (PrimMonad m, MVector v a) => (a -> Bool) -> v (PrimState m) a -> m Int unstablePartitionStream :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) partitionStream :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) -- | Purely functional interface to initialisation of mutable vectors module Data.Vector.Generic.New data New v a New :: (forall s. ST s (Mutable v s a)) -> New v a create :: (forall s. ST s (Mutable v s a)) -> New v a run :: New v a -> ST s (Mutable v s a) runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a modifyWithStream :: (forall s. Mutable v s a -> Stream b -> ST s ()) -> New v a -> Stream b -> New v a unstream :: Vector v a => Stream a -> New v a transform :: Vector v a => (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a unstreamR :: Vector v a => Stream a -> New v a transformR :: Vector v a => (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a slice :: Vector v a => Int -> Int -> New v a -> New v a init :: Vector v a => New v a -> New v a tail :: Vector v a => New v a -> New v a take :: Vector v a => Int -> New v a -> New v a drop :: Vector v a => Int -> New v a -> New v a unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a unsafeInit :: Vector v a => New v a -> New v a unsafeTail :: Vector v a => New v a -> New v a -- | Generic interface to pure vectors. module Data.Vector.Generic -- | 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: -- -- class MVector (Mutable v) a => Vector v a where basicUnsafeCopy !dst !src = do_copy 0 where !n = basicLength src do_copy i | i < n = do { x <- basicUnsafeIndexM src i; basicUnsafeWrite dst i x; do_copy (i + 1) } | otherwise = return () elemseq _ = \ _ x -> x basicUnsafeFreeze :: (Vector v a, PrimMonad m) => Mutable v (PrimState m) a -> m (v a) basicUnsafeThaw :: (Vector v a, PrimMonad m) => v a -> m (Mutable v (PrimState m) a) basicLength :: Vector v a => v a -> Int basicUnsafeSlice :: Vector v a => Int -> Int -> v a -> v a basicUnsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a basicUnsafeCopy :: (Vector v a, PrimMonad m) => Mutable v (PrimState m) a -> v a -> m () elemseq :: Vector v a => v a -> a -> b -> b -- | Mutable v s a is the mutable version of the pure vector type -- v a with the state token s -- | O(1) Yield the length of the vector. length :: Vector v a => v a -> Int -- | O(1) Test whether a vector if empty null :: Vector v a => v a -> Bool -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a -- | O(1) Safe indexing (!?) :: Vector v a => v a -> Int -> Maybe a -- | O(1) First element head :: Vector v a => v a -> a -- | O(1) Last element last :: Vector v a => v a -> a -- | O(1) Unsafe indexing without bounds checking unsafeIndex :: Vector v a => v a -> Int -> a -- | O(1) First element without checking if the vector is empty unsafeHead :: Vector v a => v a -> a -- | O(1) Last element without checking if the vector is empty unsafeLast :: Vector v a => v a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -> Int -> v a -> v a -- | O(1) Yield all but the last element without copying. The vector -- may not be empty. init :: Vector v a => v a -> v a -- | O(1) Yield all but the first element without copying. The -- vector may not be empty. tail :: Vector v a => v a -> v a -- | 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 -- | 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 -- | 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. splitAt :: Vector v a => Int -> v a -> (v a, v a) -- | 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 -> Int -> v a -> v a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Empty vector empty :: Vector v a => v a -- | O(1) Vector with exactly one element singleton :: Vector v a => a -> v a -- | O(n) Vector of the given length with the same value in each -- position replicate :: Vector v a => Int -> a -> v a -- | 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 -- | O(n) Apply function n times to value. Zeroth element is -- original value. iterateN :: Vector v a => Int -> (a -> a) -> a -> v a -- | 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) -- | 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) -- | 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 :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a -- | 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 -- | O(n) Construct a vector with at most n by repeatedly -- applying the generator function to the a seed. The generator function -- yields Just the 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 -- | 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 <a> ; c = f <a,b> in f <a,b,c>
--   
constructN :: Vector v a => Int -> (v a -> a) -> v a -- | 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<a> ; c = f <b,a> in f <c,b,a>
--   
constructrN :: Vector v a => Int -> (v a -> a) -> v a -- | 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 -- | 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 :: (Vector v a, Num a) => a -> a -> Int -> v a -- | 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 -- | 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 -- | O(n) Prepend an element cons :: Vector v a => a -> v a -> v a -- | O(n) Append an element snoc :: Vector v a => v a -> a -> v a -- | O(m+n) Concatenate two vectors (++) :: Vector v a => v a -> v a -> v a -- | O(n) Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a -- | 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 <huge vector>)
--   
-- -- 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 -- | 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 -> [(Int, a)] -> v a -- | 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 -> v (Int, a) -> v a -- | 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 -> v Int -> v a -> v a -- | Same as (//) but without bounds checking. unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a -- | Same as update but without bounds checking. unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a -- | Same as update_ but without bounds checking. unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a -- | 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) -> v a -> [(Int, b)] -> v a -- | 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) -> v a -> v (Int, b) -> v a -- | 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) -> v a -> v Int -> v b -> v a -- | Same as accum but without bounds checking. unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int, b)] -> v a -- | 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 -- | 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 -- | O(n) Reverse a vector reverse :: Vector v a => v a -> v a -- | 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 <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>
--   
backpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a -- | Same as backpermute but without bounds checking. unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a -- | 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 :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a -- | O(n) Pair each element in a vector with its index indexed :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -- | O(n) Map a function over a vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b -- | 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 -- | Map a function over a vector and concatenate the results. concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b -- | 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) -- | 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 () -- | O(n) Apply the monadic action to all elements of the vector, -- yielding a vector of results. Equvalent to flip mapM. forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) -- | 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 () -- | 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 -- | 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 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 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 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 -- | 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 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 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 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 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 -- | 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) 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) 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) 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) 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) -- | 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) -- | 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 () -- | 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) 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) 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) 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) 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) -- | O(n) Drop elements that do not satisfy the predicate filter :: Vector v a => (a -> Bool) -> v a -> v a -- | 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 -- | 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) -- | O(n) Yield the longest prefix of elements satisfying the -- predicate without copying. takeWhile :: Vector v a => (a -> Bool) -> v a -> v a -- | O(n) Drop the longest prefix of elements that satisfy the -- predicate without copying. dropWhile :: Vector v a => (a -> Bool) -> v a -> v a -- | 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) -- | 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) -- | 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) -- | 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) -- | O(n) Check if the vector contains an element elem :: (Vector v a, Eq a) => a -> v a -> Bool -- | O(n) Check if the vector does not contain an element (inverse -- of elem) notElem :: (Vector v a, Eq a) => a -> v a -> Bool -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Left fold foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a -- | O(n) Left fold on non-empty vectors foldl1 :: Vector v a => (a -> a -> a) -> v a -> a -- | O(n) Left fold with strict accumulator foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a -- | O(n) Left fold on non-empty vectors with strict accumulator foldl1' :: Vector v a => (a -> a -> a) -> v a -> a -- | O(n) Right fold foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b -- | O(n) Right fold on non-empty vectors foldr1 :: Vector v a => (a -> a -> a) -> v a -> a -- | O(n) Right fold with a strict accumulator foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b -- | O(n) Right fold on non-empty vectors with strict accumulator foldr1' :: Vector v a => (a -> a -> a) -> v a -> a -- | O(n) Left fold (function applied to each element and its index) ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a -- | 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 -- | O(n) Right fold (function applied to each element and its -- index) ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b -- | 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 -- | O(n) Check if all elements satisfy the predicate. all :: Vector v a => (a -> Bool) -> v a -> Bool -- | O(n) Check if any element satisfies the predicate. any :: Vector v a => (a -> Bool) -> v a -> Bool -- | O(n) Check if all elements are True and :: Vector v Bool => v Bool -> Bool -- | O(n) Check if any element is True or :: Vector v Bool => v Bool -> Bool -- | O(n) Compute the sum of the elements sum :: (Vector v a, Num a) => v a -> a -- | O(n) Compute the produce of the elements product :: (Vector v a, Num a) => v a -> a -- | O(n) Yield the maximum element of the vector. The vector may -- not be empty. maximum :: (Vector v a, Ord a) => v a -> a -- | 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 -- | O(n) Yield the minimum element of the vector. The vector may -- not be empty. minimum :: (Vector v a, Ord a) => v a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Monadic fold foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a -- | O(n) Monadic fold with strict accumulator foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a -- | O(n) Monadic fold over non-empty vectors fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a -- | 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 -- | O(n) Monadic fold that discards the result foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () -- | 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 () -- | 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 () -- | 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 () -- | Evaluate each action and collect the results sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) -- | Evaluate each action and discard the results sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () -- | 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 -- | O(n) Prescan with strict accumulator prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a -- | 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 -- | O(n) Scan with strict accumulator postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a -- | O(n) Haskell-style scan -- --
--   scanl f z <x1,...,xn> = <y1,...,y(n+1)>
--     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 -- | O(n) Haskell-style scan with strict accumulator scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a -- | O(n) Scan over a non-empty vector -- --
--   scanl f <x1,...,xn> = <y1,...,yn>
--     where y1 = x1
--           yi = f y(i-1) xi
--   
scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a -- | O(n) Scan over a non-empty vector with a strict accumulator scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a -- | 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 -- | O(n) Right-to-left prescan with strict accumulator prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b -- | O(n) Right-to-left scan postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b -- | O(n) Right-to-left scan with strict accumulator postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b -- | O(n) Right-to-left Haskell-style scan scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b -- | 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 -- | O(n) Right-to-left scan over a non-empty vector scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a -- | 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 -- | O(n) Convert a vector to a list toList :: Vector v a => v a -> [a] -- | O(n) Convert a list to a vector fromList :: Vector v a => [a] -> v a -- | 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 -- | O(n) Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a -- | O(n) Yield an immutable copy of the mutable vector. freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) -- | O(n) Yield a mutable copy of the immutable vector. thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) -- | 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 () -- | 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) -- | 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) -- | 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 () -- | O(1) Convert a vector to a Stream stream :: Vector v a => v a -> Stream a -- | O(n) Construct a vector from a Stream unstream :: Vector v a => Stream a -> v a -- | O(1) Convert a vector to a Stream, proceeding from right -- to left streamR :: Vector v a => v a -> Stream a -- | O(n) Construct a vector from a Stream, proceeding from -- right to left unstreamR :: Vector v a => Stream a -> v a -- | Construct a vector from a monadic initialiser. new :: Vector v a => New v a -> v a -- | Convert a vector to an initialiser which, when run, produces a copy of -- the vector. clone :: Vector v a => v a -> New v a -- | 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 -- | 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 -- | Generic definition of showsPrec showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS -- | Generic definition of readPrec readPrec :: (Vector v a, Read a) => ReadPrec (v a) -- | Generic definion of 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) dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) => (forall d. Data d => c (t d)) -> Maybe (c (v a)) mkType :: String -> DataType -- | Mutable primitive vectors. module Data.Vector.Primitive.Mutable -- | Mutable vectors of primitive types. data MVector s a MVector :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !(MutableByteArray s) -> MVector s a type IOVector = MVector RealWorld type STVector s = MVector s -- | Class of types supporting primitive array operations class Prim a -- | Length of the mutable vector. length :: Prim a => MVector s a -> Int -- | Check whether the vector is empty null :: Prim a => MVector s a -> Bool -- | Yield a part of the mutable vector without copying it. slice :: Prim a => Int -> Int -> MVector s a -> MVector s a init :: Prim a => MVector s a -> MVector s a tail :: Prim a => MVector s a -> MVector s a take :: Prim a => Int -> MVector s a -> MVector s a drop :: Prim a => Int -> MVector s a -> MVector s a splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) -- | Yield a part of the mutable vector without copying it. No bounds -- checks are performed. unsafeSlice :: Prim a => Int -> Int -> MVector s a -> MVector s a unsafeInit :: Prim a => MVector s a -> MVector s a unsafeTail :: Prim a => MVector s a -> MVector s a unsafeTake :: Prim a => Int -> MVector s a -> MVector s a unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a overlaps :: Prim a => MVector s a -> MVector s a -> Bool -- | Create a mutable vector of the given length. new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) -- | Create a mutable vector of the given length. The length is not -- checked. unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | 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 () -- | Yield the element at the given position. read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Yield the element at the given position. No bounds checks are -- performed. unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. No bounds checks are -- performed. unsafeWrite :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. No bounds checks are -- performed. unsafeSwap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () instance Typeable2 MVector instance Prim a => MVector MVector a instance NFData (MVector s a) -- | 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 -- | Unboxed vectors of primitive types data Vector a -- | Mutable vectors of primitive types. data MVector s a MVector :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !(MutableByteArray s) -> MVector s a -- | Class of types supporting primitive array operations class Prim a -- | O(1) Yield the length of the vector. length :: Prim a => Vector a -> Int -- | O(1) Test whether a vector if empty null :: Prim a => Vector a -> Bool -- | O(1) Indexing (!) :: Prim a => Vector a -> Int -> a -- | O(1) Safe indexing (!?) :: Prim a => Vector a -> Int -> Maybe a -- | O(1) First element head :: Prim a => Vector a -> a -- | O(1) Last element last :: Prim a => Vector a -> a -- | O(1) Unsafe indexing without bounds checking unsafeIndex :: Prim a => Vector a -> Int -> a -- | O(1) First element without checking if the vector is empty unsafeHead :: Prim a => Vector a -> a -- | O(1) Last element without checking if the vector is empty unsafeLast :: Prim a => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Yield a slice of the vector without copying it. The vector -- must contain at least i+n elements. slice :: Prim a => Int -> Int -> Vector a -> Vector a -- | O(1) Yield all but the last element without copying. The vector -- may not be empty. init :: Prim a => Vector a -> Vector a -- | O(1) Yield all but the first element without copying. The -- vector may not be empty. tail :: Prim a => Vector a -> Vector a -- | 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 -- | 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 -- | 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. splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) -- | 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 -> Int -> Vector a -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Empty vector empty :: Prim a => Vector a -- | O(1) Vector with exactly one element singleton :: Prim a => a -> Vector a -- | O(n) Vector of the given length with the same value in each -- position replicate :: Prim a => Int -> a -> Vector a -- | O(n) Construct a vector of the given length by applying the -- function to each index generate :: Prim a => Int -> (Int -> a) -> Vector a -- | O(n) Apply function n times to value. Zeroth element is -- original value. iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a -- | 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) -- | 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) -- | 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 -- | 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 -- | O(n) Construct a vector with at most n by repeatedly -- applying the generator function to the a seed. The generator function -- yields Just the 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 -- | 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 <a> ; c = f <a,b> in f <a,b,c>
--   
constructN :: Prim a => Int -> (Vector a -> a) -> Vector a -- | 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<a> ; c = f <b,a> in f <c,b,a>
--   
constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Prepend an element cons :: Prim a => a -> Vector a -> Vector a -- | O(n) Append an element snoc :: Prim a => Vector a -> a -> Vector a -- | O(m+n) Concatenate two vectors (++) :: Prim a => Vector a -> Vector a -> Vector a -- | O(n) Concatenate all vectors in the list concat :: Prim a => [Vector a] -> Vector a -- | 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 <huge vector>)
--   
-- -- 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 -- | 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 -> [(Int, a)] -> Vector a -- | 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 -> Vector Int -> Vector a -> Vector a -- | Same as (//) but without bounds checking. unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a -- | Same as update_ but without bounds checking. unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a -- | 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) -> Vector a -> [(Int, b)] -> Vector a -- | 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) -> Vector a -> Vector Int -> Vector b -> Vector a -- | Same as accum but without bounds checking. unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a -- | Same as accumulate_ but without bounds checking. unsafeAccumulate_ :: (Prim a, Prim b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -- | O(n) Reverse a vector reverse :: Prim a => Vector a -> Vector a -- | 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 <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>
--   
backpermute :: Prim a => Vector a -> Vector Int -> Vector a -- | Same as backpermute but without bounds checking. unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a -- | 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 -- | O(n) Map a function over a vector map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b -- | 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 -- | Map a function over a vector and concatenate the results. concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b -- | 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) -- | 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 () -- | O(n) Apply the monadic action to all elements of the vector, -- yielding a vector of results. Equvalent to flip mapM. forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) -- | 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 () -- | 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 -- | 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 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 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 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 -- | 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 -- | 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 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 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 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 -- | 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) -- | 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 () -- | O(n) Drop elements that do not satisfy the predicate filter :: Prim a => (a -> Bool) -> Vector a -> Vector a -- | 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 -- | O(n) Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) -- | O(n) Yield the longest prefix of elements satisfying the -- predicate without copying. takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a -- | O(n) Drop the longest prefix of elements that satisfy the -- predicate without copying. dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a -- | 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) -- | 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) -- | 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) -- | 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) -- | O(n) Check if the vector contains an element elem :: (Prim a, Eq a) => a -> Vector a -> Bool -- | O(n) Check if the vector does not contain an element (inverse -- of elem) notElem :: (Prim a, Eq a) => a -> Vector a -> Bool -- | 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 -- | 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 -- | O(n) Yield the indices of elements satisfying the predicate in -- ascending order. findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int -- | 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 -- | 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 -- | O(n) Left fold foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold with strict accumulator foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors with strict accumulator foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold with a strict accumulator foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors with strict accumulator foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold (function applied to each element and its index) ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a -- | 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 -- | O(n) Right fold (function applied to each element and its -- index) ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b -- | 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 -- | O(n) Check if all elements satisfy the predicate. all :: Prim a => (a -> Bool) -> Vector a -> Bool -- | O(n) Check if any element satisfies the predicate. any :: Prim a => (a -> Bool) -> Vector a -> Bool -- | O(n) Compute the sum of the elements sum :: (Prim a, Num a) => Vector a -> a -- | O(n) Compute the produce of the elements product :: (Prim a, Num a) => Vector a -> a -- | O(n) Yield the maximum element of the vector. The vector may -- not be empty. maximum :: (Prim a, Ord a) => Vector a -> a -- | 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 -- | O(n) Yield the minimum element of the vector. The vector may -- not be empty. minimum :: (Prim a, Ord a) => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Monadic fold foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold with strict accumulator foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold over non-empty vectors fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold over non-empty vectors with strict -- accumulator fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold that discards the result foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold with strict accumulator that discards the -- result foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold over non-empty vectors that discards the -- result fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () -- | 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 () -- | 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 -- | O(n) Prescan with strict accumulator prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | 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 -- | O(n) Scan with strict accumulator postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Haskell-style scan -- --
--   scanl f z <x1,...,xn> = <y1,...,y(n+1)>
--     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 -- | O(n) Haskell-style scan with strict accumulator scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Scan over a non-empty vector -- --
--   scanl f <x1,...,xn> = <y1,...,yn>
--     where y1 = x1
--           yi = f y(i-1) xi
--   
scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a -- | O(n) Scan over a non-empty vector with a strict accumulator scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Right-to-left prescan with strict accumulator prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan with strict accumulator postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan with strict accumulator scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan over a non-empty vector scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Convert a vector to a list toList :: Prim a => Vector a -> [a] -- | O(n) Convert a list to a vector fromList :: Prim a => [a] -> Vector a -- | 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 -- | O(n) Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a -- | O(n) Yield an immutable copy of the mutable vector. freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -- | O(n) Yield a mutable copy of the immutable vector. thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -- | 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 () -- | 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) -- | 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) -- | 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 () instance Typeable1 Vector instance Prim a => Monoid (Vector a) instance (Prim a, Ord a) => Ord (Vector a) instance (Prim a, Eq a) => Eq (Vector a) instance Prim a => Vector Vector a instance (Data a, Prim a) => Data (Vector a) instance (Read a, Prim a) => Read (Vector a) instance (Show a, Prim a) => Show (Vector a) instance NFData (Vector a) -- | Mutable vectors based on Storable. module Data.Vector.Storable.Mutable -- | Mutable Storable-based vectors data MVector s a MVector :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !(ForeignPtr a) -> MVector s a type IOVector = MVector RealWorld type STVector s = MVector s -- | The member functions of this class facilitate writing values of -- primitive types to raw memory (which may have been allocated with the -- above mentioned routines) and reading values from blocks of raw -- memory. The class, furthermore, includes support for computing the -- storage requirements and alignment restrictions of storable types. -- -- Memory addresses are represented as values of type Ptr -- a, for some a which is an instance of class -- Storable. The type argument to Ptr helps provide some -- valuable type safety in FFI code (you can't mix pointers of different -- types without an explicit cast), while helping the Haskell type system -- figure out which marshalling method is needed for a given pointer. -- -- All marshalling between Haskell and a foreign language ultimately -- boils down to translating Haskell data structures into the binary -- representation of a corresponding data structure of the foreign -- language and vice versa. To code this marshalling in Haskell, it is -- necessary to manipulate primitive data types stored in unstructured -- memory blocks. The class Storable facilitates this manipulation -- on all types for which it is instantiated, which are the standard -- basic types of Haskell, the fixed size Int types -- (Int8, Int16, Int32, Int64), the fixed -- size Word types (Word8, Word16, Word32, -- Word64), StablePtr, all types from -- Foreign.C.Types, as well as Ptr. -- -- Minimal complete definition: sizeOf, alignment, one of -- peek, peekElemOff and peekByteOff, and one of -- poke, pokeElemOff and pokeByteOff. class Storable a -- | Length of the mutable vector. length :: Storable a => MVector s a -> Int -- | Check whether the vector is empty null :: Storable a => MVector s a -> Bool -- | Yield a part of the mutable vector without copying it. slice :: Storable a => Int -> Int -> MVector s a -> MVector s a init :: Storable a => MVector s a -> MVector s a tail :: Storable a => MVector s a -> MVector s a take :: Storable a => Int -> MVector s a -> MVector s a drop :: Storable a => Int -> MVector s a -> MVector s a splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) -- | Yield a part of the mutable vector without copying it. No bounds -- checks are performed. unsafeSlice :: Storable a => Int -> Int -> MVector s a -> MVector s a unsafeInit :: Storable a => MVector s a -> MVector s a unsafeTail :: Storable a => MVector s a -> MVector s a unsafeTake :: Storable a => Int -> MVector s a -> MVector s a unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a overlaps :: Storable a => MVector s a -> MVector s a -> Bool -- | Create a mutable vector of the given length. new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) -- | Create a mutable vector of the given length. The length is not -- checked. unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | 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 () -- | Yield the element at the given position. read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. write :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. swap :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Yield the element at the given position. No bounds checks are -- performed. unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. No bounds checks are -- performed. unsafeWrite :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. No bounds checks are -- performed. unsafeSwap :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 :: (Storable a, Storable b) => MVector s a -> MVector s b -- | 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 -> Int -> Int -> MVector s a -- | 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 -> Int -> MVector s a -- | 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) -- | 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) -- | 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 instance Typeable2 MVector instance Storable a => MVector MVector a instance NFData (MVector s a) -- | Storable-based vectors. module Data.Vector.Storable -- | Storable-based vectors data Vector a -- | Mutable Storable-based vectors data MVector s a MVector :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !(ForeignPtr a) -> MVector s a -- | The member functions of this class facilitate writing values of -- primitive types to raw memory (which may have been allocated with the -- above mentioned routines) and reading values from blocks of raw -- memory. The class, furthermore, includes support for computing the -- storage requirements and alignment restrictions of storable types. -- -- Memory addresses are represented as values of type Ptr -- a, for some a which is an instance of class -- Storable. The type argument to Ptr helps provide some -- valuable type safety in FFI code (you can't mix pointers of different -- types without an explicit cast), while helping the Haskell type system -- figure out which marshalling method is needed for a given pointer. -- -- All marshalling between Haskell and a foreign language ultimately -- boils down to translating Haskell data structures into the binary -- representation of a corresponding data structure of the foreign -- language and vice versa. To code this marshalling in Haskell, it is -- necessary to manipulate primitive data types stored in unstructured -- memory blocks. The class Storable facilitates this manipulation -- on all types for which it is instantiated, which are the standard -- basic types of Haskell, the fixed size Int types -- (Int8, Int16, Int32, Int64), the fixed -- size Word types (Word8, Word16, Word32, -- Word64), StablePtr, all types from -- Foreign.C.Types, as well as Ptr. -- -- Minimal complete definition: sizeOf, alignment, one of -- peek, peekElemOff and peekByteOff, and one of -- poke, pokeElemOff and pokeByteOff. class Storable a -- | O(1) Yield the length of the vector. length :: Storable a => Vector a -> Int -- | O(1) Test whether a vector if empty null :: Storable a => Vector a -> Bool -- | O(1) Indexing (!) :: Storable a => Vector a -> Int -> a -- | O(1) Safe indexing (!?) :: Storable a => Vector a -> Int -> Maybe a -- | O(1) First element head :: Storable a => Vector a -> a -- | O(1) Last element last :: Storable a => Vector a -> a -- | O(1) Unsafe indexing without bounds checking unsafeIndex :: Storable a => Vector a -> Int -> a -- | O(1) First element without checking if the vector is empty unsafeHead :: Storable a => Vector a -> a -- | O(1) Last element without checking if the vector is empty unsafeLast :: Storable a => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Yield a slice of the vector without copying it. The vector -- must contain at least i+n elements. slice :: Storable a => Int -> Int -> Vector a -> Vector a -- | O(1) Yield all but the last element without copying. The vector -- may not be empty. init :: Storable a => Vector a -> Vector a -- | O(1) Yield all but the first element without copying. The -- vector may not be empty. tail :: Storable a => Vector a -> Vector a -- | 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 -- | 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 -- | 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. splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) -- | 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 -> Int -> Vector a -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Empty vector empty :: Storable a => Vector a -- | O(1) Vector with exactly one element singleton :: Storable a => a -> Vector a -- | O(n) Vector of the given length with the same value in each -- position replicate :: Storable a => Int -> a -> Vector a -- | O(n) Construct a vector of the given length by applying the -- function to each index generate :: Storable a => Int -> (Int -> a) -> Vector a -- | O(n) Apply function n times to value. Zeroth element is -- original value. iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a -- | 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) -- | 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) -- | 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 -- | 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 -- | O(n) Construct a vector with at most n by repeatedly -- applying the generator function to the a seed. The generator function -- yields Just the 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 -- | 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 <a> ; c = f <a,b> in f <a,b,c>
--   
constructN :: Storable a => Int -> (Vector a -> a) -> Vector a -- | 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<a> ; c = f <b,a> in f <c,b,a>
--   
constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Prepend an element cons :: Storable a => a -> Vector a -> Vector a -- | O(n) Append an element snoc :: Storable a => Vector a -> a -> Vector a -- | O(m+n) Concatenate two vectors (++) :: Storable a => Vector a -> Vector a -> Vector a -- | O(n) Concatenate all vectors in the list concat :: Storable a => [Vector a] -> Vector a -- | 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 <huge vector>)
--   
-- -- 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 -- | 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 -> [(Int, a)] -> Vector a -- | 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 -> Vector Int -> Vector a -> Vector a -- | Same as (//) but without bounds checking. unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a -- | Same as update_ but without bounds checking. unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a -- | 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) -> Vector a -> [(Int, b)] -> Vector a -- | 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) -> Vector a -> Vector Int -> Vector b -> Vector a -- | Same as accum but without bounds checking. unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a -- | Same as accumulate_ but without bounds checking. unsafeAccumulate_ :: (Storable a, Storable b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -- | O(n) Reverse a vector reverse :: Storable a => Vector a -> Vector a -- | 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 <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>
--   
backpermute :: Storable a => Vector a -> Vector Int -> Vector a -- | Same as backpermute but without bounds checking. unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a -- | 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 -- | O(n) Map a function over a vector map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b -- | 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 -- | Map a function over a vector and concatenate the results. concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b -- | 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) -- | 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 () -- | O(n) Apply the monadic action to all elements of the vector, -- yielding a vector of results. Equvalent to flip mapM. forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) -- | 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 () -- | 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 -- | 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 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 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 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 -- | 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 -- | 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 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 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 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 -- | 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) -- | 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 () -- | O(n) Drop elements that do not satisfy the predicate filter :: Storable a => (a -> Bool) -> Vector a -> Vector a -- | 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 -- | O(n) Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) -- | O(n) Yield the longest prefix of elements satisfying the -- predicate without copying. takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a -- | O(n) Drop the longest prefix of elements that satisfy the -- predicate without copying. dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a -- | 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) -- | 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) -- | 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) -- | 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) -- | O(n) Check if the vector contains an element elem :: (Storable a, Eq a) => a -> Vector a -> Bool -- | O(n) Check if the vector does not contain an element (inverse -- of elem) notElem :: (Storable a, Eq a) => a -> Vector a -> Bool -- | 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 -- | 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 -- | O(n) Yield the indices of elements satisfying the predicate in -- ascending order. findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int -- | 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 -- | 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 -- | O(n) Left fold foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold with strict accumulator foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors with strict accumulator foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold with a strict accumulator foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors with strict accumulator foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold (function applied to each element and its index) ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a -- | 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 -- | O(n) Right fold (function applied to each element and its -- index) ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b -- | 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 -- | O(n) Check if all elements satisfy the predicate. all :: Storable a => (a -> Bool) -> Vector a -> Bool -- | O(n) Check if any element satisfies the predicate. any :: Storable a => (a -> Bool) -> Vector a -> Bool -- | O(n) Check if all elements are True and :: Vector Bool -> Bool -- | O(n) Check if any element is True or :: Vector Bool -> Bool -- | O(n) Compute the sum of the elements sum :: (Storable a, Num a) => Vector a -> a -- | O(n) Compute the produce of the elements product :: (Storable a, Num a) => Vector a -> a -- | O(n) Yield the maximum element of the vector. The vector may -- not be empty. maximum :: (Storable a, Ord a) => Vector a -> a -- | 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 -- | O(n) Yield the minimum element of the vector. The vector may -- not be empty. minimum :: (Storable a, Ord a) => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Monadic fold foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold with strict accumulator foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold over non-empty vectors fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold over non-empty vectors with strict -- accumulator fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold that discards the result foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold with strict accumulator that discards the -- result foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold over non-empty vectors that discards the -- result fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () -- | 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 () -- | 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 -- | O(n) Prescan with strict accumulator prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | 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 -- | O(n) Scan with strict accumulator postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Haskell-style scan -- --
--   scanl f z <x1,...,xn> = <y1,...,y(n+1)>
--     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 -- | O(n) Haskell-style scan with strict accumulator scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Scan over a non-empty vector -- --
--   scanl f <x1,...,xn> = <y1,...,yn>
--     where y1 = x1
--           yi = f y(i-1) xi
--   
scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a -- | O(n) Scan over a non-empty vector with a strict accumulator scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Right-to-left prescan with strict accumulator prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan with strict accumulator postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan with strict accumulator scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan over a non-empty vector scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Convert a vector to a list toList :: Storable a => Vector a -> [a] -- | O(n) Convert a list to a vector fromList :: Storable a => [a] -> Vector a -- | 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 -- | O(n) Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a -- | 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 :: (Storable a, Storable b) => Vector a -> Vector b -- | O(n) Yield an immutable copy of the mutable vector. freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -- | O(n) Yield a mutable copy of the immutable vector. thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -- | 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 () -- | 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) -- | 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) -- | 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 () -- | 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 -> Int -> Int -> Vector a -- | 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 -> Int -> Vector a -- | 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) -- | 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) -- | 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 instance Typeable1 Vector instance Storable a => Monoid (Vector a) instance (Storable a, Ord a) => Ord (Vector a) instance (Storable a, Eq a) => Eq (Vector a) instance Storable a => Vector Vector a instance (Data a, Storable a) => Data (Vector a) instance (Read a, Storable a) => Read (Vector a) instance (Show a, Storable a) => Show (Vector a) instance NFData (Vector a) -- | 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) => MVector MVector (Complex a) where
--      {-# INLINE basicLength #-}
--      basicLength (MV_Complex v) = 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 class (Vector Vector a, MVector MVector a) => Unbox a -- | O(1) Yield the length of the vector. length :: Unbox a => Vector a -> Int -- | O(1) Test whether a vector if empty null :: Unbox a => Vector a -> Bool -- | O(1) Indexing (!) :: Unbox a => Vector a -> Int -> a -- | O(1) Safe indexing (!?) :: Unbox a => Vector a -> Int -> Maybe a -- | O(1) First element head :: Unbox a => Vector a -> a -- | O(1) Last element last :: Unbox a => Vector a -> a -- | O(1) Unsafe indexing without bounds checking unsafeIndex :: Unbox a => Vector a -> Int -> a -- | O(1) First element without checking if the vector is empty unsafeHead :: Unbox a => Vector a -> a -- | O(1) Last element without checking if the vector is empty unsafeLast :: Unbox a => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Yield a slice of the vector without copying it. The vector -- must contain at least i+n elements. slice :: Unbox a => Int -> Int -> Vector a -> Vector a -- | O(1) Yield all but the last element without copying. The vector -- may not be empty. init :: Unbox a => Vector a -> Vector a -- | O(1) Yield all but the first element without copying. The -- vector may not be empty. tail :: Unbox a => Vector a -> Vector a -- | 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 -- | 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 -- | 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. splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) -- | 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 -> Int -> Vector a -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Empty vector empty :: Unbox a => Vector a -- | O(1) Vector with exactly one element singleton :: Unbox a => a -> Vector a -- | O(n) Vector of the given length with the same value in each -- position replicate :: Unbox a => Int -> a -> Vector a -- | O(n) Construct a vector of the given length by applying the -- function to each index generate :: Unbox a => Int -> (Int -> a) -> Vector a -- | O(n) Apply function n times to value. Zeroth element is -- original value. iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a -- | 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) -- | 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) -- | 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 -- | 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 -- | O(n) Construct a vector with at most n by repeatedly -- applying the generator function to the a seed. The generator function -- yields Just the 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 -- | 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 <a> ; c = f <a,b> in f <a,b,c>
--   
constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a -- | 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<a> ; c = f <b,a> in f <c,b,a>
--   
constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Prepend an element cons :: Unbox a => a -> Vector a -> Vector a -- | O(n) Append an element snoc :: Unbox a => Vector a -> a -> Vector a -- | O(m+n) Concatenate two vectors (++) :: Unbox a => Vector a -> Vector a -> Vector a -- | O(n) Concatenate all vectors in the list concat :: Unbox a => [Vector a] -> Vector a -- | 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 <huge vector>)
--   
-- -- 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 -- | 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 -> [(Int, a)] -> Vector a -- | 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 -> Vector (Int, a) -> Vector a -- | 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 -> Vector Int -> Vector a -> Vector a -- | Same as (//) but without bounds checking. unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a -- | Same as update but without bounds checking. unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a -- | Same as update_ but without bounds checking. unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a -- | 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) -> Vector a -> [(Int, b)] -> Vector a -- | 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) -> Vector a -> Vector (Int, b) -> Vector a -- | 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) -> Vector a -> Vector Int -> Vector b -> Vector a -- | Same as accum but without bounds checking. unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a -- | Same as accumulate but without bounds checking. unsafeAccumulate :: (Unbox a, Unbox b) => (a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a -- | Same as accumulate_ but without bounds checking. unsafeAccumulate_ :: (Unbox a, Unbox b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -- | O(n) Reverse a vector reverse :: Unbox a => Vector a -> Vector a -- | 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 <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>
--   
backpermute :: Unbox a => Vector a -> Vector Int -> Vector a -- | Same as backpermute but without bounds checking. unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a -- | 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 -- | O(n) Pair each element in a vector with its index indexed :: Unbox a => Vector a -> Vector (Int, a) -- | O(n) Map a function over a vector map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b -- | 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 -- | Map a function over a vector and concatenate the results. concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b -- | 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) -- | 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 () -- | O(n) Apply the monadic action to all elements of the vector, -- yielding a vector of results. Equvalent to flip mapM. forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) -- | 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 () -- | 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 -- | 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 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 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 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 -- | 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 -- | 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 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 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 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 -- | O(1) Zip 2 vectors zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) -- | O(1) Zip 3 vectors zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c) -- | 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) -- | 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) -- | 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) -- | 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) -- | 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 () -- | O(1) Unzip 2 vectors unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a, Vector b) -- | O(1) Unzip 3 vectors unzip3 :: (Unbox a, Unbox b, Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) -- | 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) -- | 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) -- | 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) -- | O(n) Drop elements that do not satisfy the predicate filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a -- | 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 -- | O(n) Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) -- | O(n) Yield the longest prefix of elements satisfying the -- predicate without copying. takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a -- | O(n) Drop the longest prefix of elements that satisfy the -- predicate without copying. dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a -- | 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) -- | 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) -- | 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) -- | 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) -- | O(n) Check if the vector contains an element elem :: (Unbox a, Eq a) => a -> Vector a -> Bool -- | O(n) Check if the vector does not contain an element (inverse -- of elem) notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool -- | 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 -- | 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 -- | O(n) Yield the indices of elements satisfying the predicate in -- ascending order. findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int -- | 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 -- | 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 -- | O(n) Left fold foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold with strict accumulator foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors with strict accumulator foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a -- | O(n) Right fold with a strict accumulator foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors with strict accumulator foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a -- | O(n) Left fold (function applied to each element and its index) ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a -- | 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 -- | O(n) Right fold (function applied to each element and its -- index) ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b -- | 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 -- | O(n) Check if all elements satisfy the predicate. all :: Unbox a => (a -> Bool) -> Vector a -> Bool -- | O(n) Check if any element satisfies the predicate. any :: Unbox a => (a -> Bool) -> Vector a -> Bool -- | O(n) Check if all elements are True and :: Vector Bool -> Bool -- | O(n) Check if any element is True or :: Vector Bool -> Bool -- | O(n) Compute the sum of the elements sum :: (Unbox a, Num a) => Vector a -> a -- | O(n) Compute the produce of the elements product :: (Unbox a, Num a) => Vector a -> a -- | O(n) Yield the maximum element of the vector. The vector may -- not be empty. maximum :: (Unbox a, Ord a) => Vector a -> a -- | 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 -- | O(n) Yield the minimum element of the vector. The vector may -- not be empty. minimum :: (Unbox a, Ord a) => Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Monadic fold foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold with strict accumulator foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold over non-empty vectors fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold over non-empty vectors with strict -- accumulator fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold that discards the result foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold with strict accumulator that discards the -- result foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold over non-empty vectors that discards the -- result fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () -- | 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 () -- | 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 -- | O(n) Prescan with strict accumulator prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | 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 -- | O(n) Scan with strict accumulator postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Haskell-style scan -- --
--   scanl f z <x1,...,xn> = <y1,...,y(n+1)>
--     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 -- | O(n) Haskell-style scan with strict accumulator scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Scan over a non-empty vector -- --
--   scanl f <x1,...,xn> = <y1,...,yn>
--     where y1 = x1
--           yi = f y(i-1) xi
--   
scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -- | O(n) Scan over a non-empty vector with a strict accumulator scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Right-to-left prescan with strict accumulator prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan with strict accumulator postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan with strict accumulator scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan over a non-empty vector scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a -- | 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 -- | O(n) Convert a vector to a list toList :: Unbox a => Vector a -> [a] -- | O(n) Convert a list to a vector fromList :: Unbox a => [a] -> Vector a -- | 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 -- | O(n) Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a -- | O(n) Yield an immutable copy of the mutable vector. freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) -- | O(n) Yield a mutable copy of the immutable vector. thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) -- | 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 () -- | 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) -- | 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) -- | 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 () instance (Read a, Unbox a) => Read (Vector a) instance (Show a, Unbox a) => Show (Vector a) instance Unbox a => Monoid (Vector a) instance (Unbox a, Ord a) => Ord (Vector a) instance (Unbox a, Eq a) => Eq (Vector a) -- | Mutable adaptive unboxed vectors module Data.Vector.Unboxed.Mutable type IOVector = MVector RealWorld type STVector s = MVector s class (Vector Vector a, MVector MVector a) => Unbox a -- | Length of the mutable vector. length :: Unbox a => MVector s a -> Int -- | Check whether the vector is empty null :: Unbox a => MVector s a -> Bool -- | Yield a part of the mutable vector without copying it. slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a init :: Unbox a => MVector s a -> MVector s a tail :: Unbox a => MVector s a -> MVector s a take :: Unbox a => Int -> MVector s a -> MVector s a drop :: Unbox a => Int -> MVector s a -> MVector s a splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) -- | Yield a part of the mutable vector without copying it. No bounds -- checks are performed. unsafeSlice :: Unbox a => Int -> Int -> MVector s a -> MVector s a unsafeInit :: Unbox a => MVector s a -> MVector s a unsafeTail :: Unbox a => MVector s a -> MVector s a unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a overlaps :: Unbox a => MVector s a -> MVector s a -> Bool -- | Create a mutable vector of the given length. new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) -- | Create a mutable vector of the given length. The length is not -- checked. unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | 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 () -- | O(1) Zip 2 vectors zip :: (Unbox a, Unbox b) => MVector s a -> MVector s b -> MVector s (a, b) -- | 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) -- | 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) -- | 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) -- | 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) -- | O(1) Unzip 2 vectors unzip :: (Unbox a, Unbox b) => MVector s (a, b) -> (MVector s a, MVector s b) -- | 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) -- | 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) -- | 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) -- | 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) -- | Yield the element at the given position. read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Yield the element at the given position. No bounds checks are -- performed. unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. No bounds checks are -- performed. unsafeWrite :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. No bounds checks are -- performed. unsafeSwap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | Mutable boxed vectors. module Data.Vector.Mutable -- | 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) -> MVector s a type IOVector = MVector RealWorld type STVector s = MVector s -- | Length of the mutable vector. length :: MVector s a -> Int -- | Check whether the vector is empty null :: MVector s a -> Bool -- | Yield a part of the mutable vector without copying it. slice :: Int -> Int -> MVector s a -> MVector s a init :: MVector s a -> MVector s a tail :: MVector s a -> MVector s a take :: Int -> MVector s a -> MVector s a drop :: Int -> MVector s a -> MVector s a splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) -- | Yield a part of the mutable vector without copying it. No bounds -- checks are performed. unsafeSlice :: Int -> Int -> MVector s a -> MVector s a unsafeInit :: MVector s a -> MVector s a unsafeTail :: MVector s a -> MVector s a unsafeTake :: Int -> MVector s a -> MVector s a unsafeDrop :: Int -> MVector s a -> MVector s a overlaps :: MVector s a -> MVector s a -> Bool -- | Create a mutable vector of the given length. new :: PrimMonad m => Int -> m (MVector (PrimState m) a) -- | Create a mutable vector of the given length. The length is not -- checked. unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | Create a copy of a mutable vector. clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) -- | 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) -- | 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) -- | 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 () -- | Yield the element at the given position. read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () -- | Yield the element at the given position. No bounds checks are -- performed. unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a -- | Replace the element at the given position. No bounds checks are -- performed. unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () -- | Swap the elements at the given positions. No bounds checks are -- performed. unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () -- | Set all elements of the vector to the given value. set :: PrimMonad m => MVector (PrimState m) a -> a -> m () -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: PrimMonad m => MVector (PrimState m) a -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () -- | 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 -> MVector (PrimState m) a -> m () instance Typeable2 MVector instance MVector MVector a -- | A library for boxed vectors (that is, polymorphic arrays capable of -- holding any Haskell value). The vectors come in two flavours: -- -- -- -- 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, supporting efficient slicing. data Vector a -- | Mutable boxed vectors keyed on the monad they live in (IO or -- ST s). data MVector s a -- | O(1) Yield the length of the vector. length :: Vector a -> Int -- | O(1) Test whether a vector if empty null :: Vector a -> Bool -- | O(1) Indexing (!) :: Vector a -> Int -> a -- | O(1) Safe indexing (!?) :: Vector a -> Int -> Maybe a -- | O(1) First element head :: Vector a -> a -- | O(1) Last element last :: Vector a -> a -- | O(1) Unsafe indexing without bounds checking unsafeIndex :: Vector a -> Int -> a -- | O(1) First element without checking if the vector is empty unsafeHead :: Vector a -> a -- | O(1) Last element without checking if the vector is empty unsafeLast :: Vector a -> a -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Yield a slice of the vector without copying it. The vector -- must contain at least i+n elements. slice :: Int -> Int -> Vector a -> Vector a -- | O(1) Yield all but the last element without copying. The vector -- may not be empty. init :: Vector a -> Vector a -- | O(1) Yield all but the first element without copying. The -- vector may not be empty. tail :: Vector a -> Vector a -- | 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 -- | 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 -- | 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. splitAt :: Int -> Vector a -> (Vector a, Vector a) -- | 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 -> Int -> Vector a -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(1) Empty vector empty :: Vector a -- | O(1) Vector with exactly one element singleton :: a -> Vector a -- | O(n) Vector of the given length with the same value in each -- position replicate :: Int -> a -> Vector a -- | O(n) Construct a vector of the given length by applying the -- function to each index generate :: Int -> (Int -> a) -> Vector a -- | O(n) Apply function n times to value. Zeroth element is -- original value. iterateN :: Int -> (a -> a) -> a -> Vector a -- | 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) -- | 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) -- | 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 -- | 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 -- | O(n) Construct a vector with at most n by repeatedly -- applying the generator function to the a seed. The generator function -- yields Just the 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 -- | 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 <a> ; c = f <a,b> in f <a,b,c>
--   
constructN :: Int -> (Vector a -> a) -> Vector a -- | 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<a> ; c = f <b,a> in f <c,b,a>
--   
constructrN :: Int -> (Vector a -> a) -> Vector a -- | 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 -- | 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 -- | 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 -- | 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 -- | O(n) Prepend an element cons :: a -> Vector a -> Vector a -- | O(n) Append an element snoc :: Vector a -> a -> Vector a -- | O(m+n) Concatenate two vectors (++) :: Vector a -> Vector a -> Vector a -- | O(n) Concatenate all vectors in the list concat :: [Vector a] -> Vector a -- | 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 <huge vector>)
--   
-- -- 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 -- | 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 -> [(Int, a)] -> Vector a -- | 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 -> Vector (Int, a) -> Vector a -- | 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 -> Vector Int -> Vector a -> Vector a -- | Same as (//) but without bounds checking. unsafeUpd :: Vector a -> [(Int, a)] -> Vector a -- | Same as update but without bounds checking. unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a -- | Same as update_ but without bounds checking. unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a -- | 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) -> Vector a -> [(Int, b)] -> Vector a -- | 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) -> Vector a -> Vector (Int, b) -> Vector a -- | 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) -> Vector a -> Vector Int -> Vector b -> Vector a -- | Same as accum but without bounds checking. unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a -- | Same as accumulate but without bounds checking. unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a -- | Same as accumulate_ but without bounds checking. unsafeAccumulate_ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a -- | O(n) Reverse a vector reverse :: Vector a -> Vector a -- | 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 <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>
--   
backpermute :: Vector a -> Vector Int -> Vector a -- | Same as backpermute but without bounds checking. unsafeBackpermute :: Vector a -> Vector Int -> Vector a -- | 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 -- | O(n) Pair each element in a vector with its index indexed :: Vector a -> Vector (Int, a) -- | O(n) Map a function over a vector map :: (a -> b) -> Vector a -> Vector b -- | O(n) Apply a function to every element of a vector and its -- index imap :: (Int -> a -> b) -> Vector a -> Vector b -- | Map a function over a vector and concatenate the results. concatMap :: (a -> Vector b) -> Vector a -> Vector b -- | 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) -- | 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 () -- | O(n) Apply the monadic action to all elements of the vector, -- yielding a vector of results. Equvalent to flip mapM. forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) -- | 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 () -- | O(min(m,n)) Zip two vectors with the given function. zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c -- | Zip three vectors with the given function. zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d zipWith4 :: (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e zipWith5 :: (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g -- | 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 -- | Zip three vectors and their indices with the given function. izipWith3 :: (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d izipWith4 :: (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g -- | Elementwise pairing of array elements. zip :: Vector a -> Vector b -> Vector (a, b) -- | zip together three vectors into a vector of triples zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) zip4 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d) zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e) zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f) -- | 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) -- | 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 () -- | O(min(m,n)) Unzip a vector of pairs. unzip :: Vector (a, b) -> (Vector a, Vector b) unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) unzip5 :: Vector (a, b, c, d, e) -> (Vector a, Vector b, Vector c, Vector d, Vector e) unzip6 :: Vector (a, b, c, d, e, f) -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) -- | O(n) Drop elements that do not satisfy the predicate filter :: (a -> Bool) -> Vector a -> Vector a -- | 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 -- | O(n) Drop elements that do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) -- | O(n) Yield the longest prefix of elements satisfying the -- predicate without copying. takeWhile :: (a -> Bool) -> Vector a -> Vector a -- | O(n) Drop the longest prefix of elements that satisfy the -- predicate without copying. dropWhile :: (a -> Bool) -> Vector a -> Vector a -- | 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) -- | 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) -- | 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) -- | 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) -- | O(n) Check if the vector contains an element elem :: Eq a => a -> Vector a -> Bool -- | O(n) Check if the vector does not contain an element (inverse -- of elem) notElem :: Eq a => a -> Vector a -> Bool -- | O(n) Yield Just the first element matching the predicate -- or Nothing if no such element exists. find :: (a -> Bool) -> Vector a -> Maybe a -- | 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 -- | O(n) Yield the indices of elements satisfying the predicate in -- ascending order. findIndices :: (a -> Bool) -> Vector a -> Vector Int -- | 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 -- | 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 -- | O(n) Left fold foldl :: (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors foldl1 :: (a -> a -> a) -> Vector a -> a -- | O(n) Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold on non-empty vectors with strict accumulator foldl1' :: (a -> a -> a) -> Vector a -> a -- | O(n) Right fold foldr :: (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors foldr1 :: (a -> a -> a) -> Vector a -> a -- | O(n) Right fold with a strict accumulator foldr' :: (a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold on non-empty vectors with strict accumulator foldr1' :: (a -> a -> a) -> Vector a -> a -- | O(n) Left fold (function applied to each element and its index) ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a -- | O(n) Left fold with strict accumulator (function applied to -- each element and its index) ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a -- | O(n) Right fold (function applied to each element and its -- index) ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b -- | O(n) Right fold with strict accumulator (function applied to -- each element and its index) ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b -- | O(n) Check if all elements satisfy the predicate. all :: (a -> Bool) -> Vector a -> Bool -- | O(n) Check if any element satisfies the predicate. any :: (a -> Bool) -> Vector a -> Bool -- | O(n) Check if all elements are True and :: Vector Bool -> Bool -- | O(n) Check if any element is True or :: Vector Bool -> Bool -- | O(n) Compute the sum of the elements sum :: Num a => Vector a -> a -- | O(n) Compute the produce of the elements product :: Num a => Vector a -> a -- | O(n) Yield the maximum element of the vector. The vector may -- not be empty. maximum :: Ord a => Vector a -> a -- | 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 -- | O(n) Yield the minimum element of the vector. The vector may -- not be empty. minimum :: Ord a => Vector a -> a -- | 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 -- | O(n) Yield the index of the minimum element of the vector. The -- vector may not be empty. minIndex :: Ord a => Vector a -> Int -- | 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 -- | O(n) Yield the index of the maximum element of the vector. The -- vector may not be empty. maxIndex :: Ord a => Vector a -> Int -- | 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 -- | O(n) Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold with strict accumulator foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a -- | O(n) Monadic fold over non-empty vectors fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold over non-empty vectors with strict -- accumulator fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a -- | O(n) Monadic fold that discards the result foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold with strict accumulator that discards the -- result foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () -- | O(n) Monadic fold over non-empty vectors that discards the -- result fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () -- | 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 () -- | Evaluate each action and collect the results sequence :: Monad m => Vector (m a) -> m (Vector a) -- | Evaluate each action and discard the results sequence_ :: Monad m => Vector (m a) -> m () -- | 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 -- | O(n) Prescan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -- | 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 -- | O(n) Scan with strict accumulator postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Haskell-style scan -- --
--   scanl f z <x1,...,xn> = <y1,...,y(n+1)>
--     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 -- | O(n) Haskell-style scan with strict accumulator scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a -- | O(n) Scan over a non-empty vector -- --
--   scanl f <x1,...,xn> = <y1,...,yn>
--     where y1 = x1
--           yi = f y(i-1) xi
--   
scanl1 :: (a -> a -> a) -> Vector a -> Vector a -- | O(n) Scan over a non-empty vector with a strict accumulator scanl1' :: (a -> a -> a) -> Vector a -> Vector a -- | O(n) Right-to-left prescan -- --
--   prescanr f z = reverse . prescanl (flip f) z . reverse
--   
prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left prescan with strict accumulator prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan with strict accumulator postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan scanr :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left Haskell-style scan with strict accumulator scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b -- | O(n) Right-to-left scan over a non-empty vector scanr1 :: (a -> a -> a) -> Vector a -> Vector a -- | O(n) Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: (a -> a -> a) -> Vector a -> Vector a -- | O(n) Convert a vector to a list toList :: Vector a -> [a] -- | O(n) Convert a list to a vector fromList :: [a] -> Vector a -- | 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 -- | O(n) Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a -- | O(n) Yield an immutable copy of the mutable vector. freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) -- | O(n) Yield a mutable copy of the immutable vector. thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) -- | 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 () -- | 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) -- | 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) -- | 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 () instance Typeable1 Vector instance Traversable Vector instance Foldable Vector instance Alternative Vector instance Applicative Vector instance MonadPlus Vector instance Monad Vector instance Functor Vector instance Monoid (Vector a) instance Ord a => Ord (Vector a) instance Eq a => Eq (Vector a) instance Vector Vector a instance Data a => Data (Vector a) instance Read a => Read (Vector a) instance Show a => Show (Vector a) instance NFData a => NFData (Vector a)