vector 0.4.2 → 0.5
raw patch · 26 files changed
+6735/−711 lines, 26 filesdep ~primitive
Dependency ranges changed: primitive
Files
- Data/Vector.hs +405/−29
- Data/Vector/Fusion/Stream.hs +108/−37
- Data/Vector/Fusion/Stream/Monadic.hs +548/−173
- Data/Vector/Fusion/Stream/Size.hs +10/−6
- Data/Vector/Fusion/Util.hs +11/−2
- Data/Vector/Generic.hs +706/−91
- Data/Vector/Generic/Mutable.hs +642/−143
- Data/Vector/Generic/New.hs +78/−21
- Data/Vector/Internal/Check.hs +109/−0
- Data/Vector/Mutable.hs +163/−29
- Data/Vector/Primitive.hs +387/−30
- Data/Vector/Primitive/Mutable.hs +157/−25
- Data/Vector/Storable.hs +452/−33
- Data/Vector/Storable/Mutable.hs +198/−27
- Data/Vector/Unboxed.hs +797/−0
- Data/Vector/Unboxed/Base.hs +334/−0
- Data/Vector/Unboxed/Mutable.hs +158/−0
- include/phases.h +0/−6
- include/vector.h +31/−0
- internal/GenUnboxTuple.hs +219/−0
- internal/unbox-tuple-instances +937/−0
- tests/Tests/Stream.hs +2/−2
- tests/Tests/Vector.hs +169/−21
- tests/Utilities.hs +50/−1
- tests/vector-tests.cabal +4/−4
- vector.cabal +60/−31
Data/Vector.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-} -- | -- Module : Data.Vector@@ -19,34 +19,50 @@ length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++), copy,+ empty, singleton, cons, snoc, replicate, generate, (++), copy, -- * Accessing individual elements (!), head, last, indexM, headM, lastM,+ unsafeIndex, unsafeHead, unsafeLast,+ unsafeIndexM, unsafeHeadM, unsafeLastM, -- * Subvectors slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, -- * Permutations- accum, (//), update, backpermute, reverse,+ accum, accumulate, accumulate_,+ (//), update, update_,+ backpermute, reverse,+ unsafeAccum, unsafeAccumulate, unsafeAccumulate_,+ unsafeUpd, unsafeUpdate, unsafeUpdate_,+ unsafeBackpermute, -- * Mapping- map, concatMap,+ map, imap, concatMap, -- * Zipping and unzipping- zipWith, zipWith3, zip, zip3, unzip, unzip3,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ izipWith, izipWith3, izipWith4, izipWith5, izipWith6,+ zip, zip3, zip4, zip5, zip6,+ unzip, unzip3, unzip4, unzip5, unzip6, -- * Filtering- filter, takeWhile, dropWhile,+ filter, ifilter, takeWhile, dropWhile,+ partition, unstablePartition, span, break, -- * Searching- elem, notElem, find, findIndex,+ elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding- foldl, foldl1, foldl', foldl1', foldr, foldr1,+ foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',+ ifoldl, ifoldl', ifoldr, ifoldr', -- * Specialised folds- and, or, sum, product, maximum, minimum,+ all, any, and, or,+ sum, product,+ maximum, maximumBy, minimum, minimumBy,+ minIndex, minIndexBy, maxIndex, maxIndexBy, -- * Unfolding unfoldr,@@ -55,9 +71,12 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1',+ prescanr, prescanr',+ postscanr, postscanr',+ scanr, scanr', scanr1, scanr1', -- * Enumeration- enumFromTo, enumFromThenTo,+ enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversion to/from lists toList, fromList@@ -67,7 +86,7 @@ import Data.Vector.Mutable ( MVector(..) ) import Data.Primitive.Array -import Control.Monad.ST ( runST )+import Control.Monad ( liftM ) import Prelude hiding ( length, null, replicate, (++),@@ -75,11 +94,11 @@ init, tail, take, drop, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3,- filter, takeWhile, dropWhile,+ filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1,- and, or, sum, product, minimum, maximum,- scanl, scanl1,+ all, any, and, or, sum, product, minimum, maximum,+ scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo ) import qualified Prelude@@ -91,21 +110,21 @@ instance Show a => Show (Vector a) where show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList +type instance G.Mutable Vector = MVector+ instance G.Vector Vector a where- {-# INLINE vnew #-}- vnew init = runST (do- MVector i n marr <- init- arr <- unsafeFreezeArray marr- return (Vector i n arr))+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MVector i n marr)+ = Vector i n `liftM` unsafeFreezeArray marr - {-# INLINE vlength #-}- vlength (Vector _ n _) = n+ {-# INLINE basicLength #-}+ basicLength (Vector _ n _) = n - {-# INLINE unsafeSlice #-}- unsafeSlice (Vector i _ arr) j n = Vector (i+j) n arr+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr - {-# INLINE unsafeIndexM #-}- unsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) instance Eq a => Eq (Vector a) where {-# INLINE (==) #-}@@ -144,6 +163,12 @@ {-# INLINE replicate #-} replicate = G.replicate +-- | Generate a vector of the given length by applying the function to each+-- index+generate :: Int -> (Int -> a) -> Vector a+{-# INLINE generate #-}+generate = G.generate+ -- | Prepend an element cons :: a -> Vector a -> Vector a {-# INLINE cons #-}@@ -183,6 +208,23 @@ {-# INLINE last #-} last = G.last +-- | Unsafe indexing without bounds checking+unsafeIndex :: Vector a -> Int -> a+{-# INLINE unsafeIndex #-}+unsafeIndex = G.unsafeIndex++-- | Yield the first element of a vector without checking if the vector is+-- empty+unsafeHead :: Vector a -> a+{-# INLINE unsafeHead #-}+unsafeHead = G.unsafeHead++-- | Yield the last element of a vector without checking if the vector is+-- empty+unsafeLast :: Vector a -> a+{-# INLINE unsafeLast #-}+unsafeLast = G.unsafeLast+ -- | Monadic indexing which can be strict in the vector while remaining lazy in -- the element indexM :: Monad m => Vector a -> Int -> m a@@ -197,14 +239,28 @@ {-# INLINE lastM #-} lastM = G.lastM +-- | Unsafe monadic indexing without bounds checks+unsafeIndexM :: Monad m => Vector a -> Int -> m a+{-# INLINE unsafeIndexM #-}+unsafeIndexM = G.unsafeIndexM++unsafeHeadM :: Monad m => Vector a -> m a+{-# INLINE unsafeHeadM #-}+unsafeHeadM = G.unsafeHeadM++unsafeLastM :: Monad m => Vector a -> m a+{-# INLINE unsafeLastM #-}+unsafeLastM = G.unsafeLastM+ -- Subarrays -- --------- -- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: Vector a -> Int -- ^ starting index- -> Int -- ^ length- -> Vector a+-- 'basicUnsafeSlice'.+slice :: Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a {-# INLINE slice #-} slice = G.slice @@ -228,13 +284,71 @@ {-# INLINE drop #-} drop = G.drop +-- | Unsafely yield a part of the vector without copying it and without+-- performing bounds checks.+unsafeSlice :: Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++unsafeInit :: Vector a -> Vector a+{-# INLINE unsafeInit #-}+unsafeInit = G.unsafeInit++unsafeTail :: Vector a -> Vector a+{-# INLINE unsafeTail #-}+unsafeTail = G.unsafeTail++unsafeTake :: Int -> Vector a -> Vector a+{-# INLINE unsafeTake #-}+unsafeTake = G.unsafeTake++unsafeDrop :: Int -> Vector a -> Vector a+{-# INLINE unsafeDrop #-}+unsafeDrop = G.unsafeDrop+ -- Permutations -- ------------ +unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE unsafeAccum #-}+unsafeAccum = G.unsafeAccum++unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a+{-# INLINE unsafeAccumulate #-}+unsafeAccumulate = G.unsafeAccumulate++unsafeAccumulate_+ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE unsafeAccumulate_ #-}+unsafeAccumulate_ = G.unsafeAccumulate_+ accum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE accum #-} accum = G.accum +accumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a+{-# INLINE accumulate #-}+accumulate = G.accumulate++accumulate_ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE accumulate_ #-}+accumulate_ = G.accumulate_++unsafeUpd :: Vector a -> [(Int, a)] -> Vector a+{-# INLINE unsafeUpd #-}+unsafeUpd = G.unsafeUpd++unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a+{-# INLINE unsafeUpdate #-}+unsafeUpdate = G.unsafeUpdate++unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE unsafeUpdate_ #-}+unsafeUpdate_ = G.unsafeUpdate_+ (//) :: Vector a -> [(Int, a)] -> Vector a {-# INLINE (//) #-} (//) = (G.//)@@ -243,10 +357,18 @@ {-# INLINE update #-} update = G.update +update_ :: Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE update_ #-}+update_ = G.update_+ backpermute :: Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute +unsafeBackpermute :: Vector a -> Vector Int -> Vector a+{-# INLINE unsafeBackpermute #-}+unsafeBackpermute = G.unsafeBackpermute+ reverse :: Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse@@ -259,6 +381,11 @@ {-# INLINE map #-} map = G.map +-- | Apply a function to every index/value pair+imap :: (Int -> a -> b) -> Vector a -> Vector b+{-# INLINE imap #-}+imap = G.imap+ concatMap :: (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap@@ -276,6 +403,51 @@ {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 +zipWith4 :: (a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE zipWith4 #-}+zipWith4 = G.zipWith4++zipWith5 :: (a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE zipWith5 #-}+zipWith5 = G.zipWith5++zipWith6 :: (a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE zipWith6 #-}+zipWith6 = G.zipWith6++-- | Zip two vectors and their indices with the given function.+izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE izipWith #-}+izipWith = G.izipWith++-- | Zip three vectors and their indices with the given function.+izipWith3 :: (Int -> a -> b -> c -> d)+ -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE izipWith3 #-}+izipWith3 = G.izipWith3++izipWith4 :: (Int -> a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE izipWith4 #-}+izipWith4 = G.izipWith4++izipWith5 :: (Int -> a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE izipWith5 #-}+izipWith5 = G.izipWith5++izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE izipWith6 #-}+izipWith6 = G.izipWith6+ zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-} zip = G.zip@@ -284,6 +456,21 @@ {-# INLINE zip3 #-} zip3 = G.zip3 +zip4 :: Vector a -> Vector b -> Vector c -> Vector d+ -> Vector (a, b, c, d)+{-# INLINE zip4 #-}+zip4 = G.zip4++zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector (a, b, c, d, e)+{-# INLINE zip5 #-}+zip5 = G.zip5++zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f+ -> Vector (a, b, c, d, e, f)+{-# INLINE zip6 #-}+zip6 = G.zip6+ unzip :: Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} unzip = G.unzip@@ -292,6 +479,20 @@ {-# INLINE unzip3 #-} unzip3 = G.unzip3 +unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d)+{-# INLINE unzip4 #-}+unzip4 = G.unzip4++unzip5 :: Vector (a, b, c, d, e)+ -> (Vector a, Vector b, Vector c, Vector d, Vector e)+{-# INLINE unzip5 #-}+unzip5 = G.unzip5++unzip6 :: Vector (a, b, c, d, e, f)+ -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f)+{-# INLINE unzip6 #-}+unzip6 = G.unzip6+ -- Filtering -- --------- @@ -300,6 +501,12 @@ {-# INLINE filter #-} filter = G.filter +-- | Drop elements that do not satisfy the predicate (applied to values and+-- their indices)+ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a+{-# INLINE ifilter #-}+ifilter = G.ifilter+ -- | Yield the longest prefix of elements satisfying the predicate. takeWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-}@@ -310,6 +517,33 @@ {-# INLINE dropWhile #-} dropWhile = G.dropWhile +-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The+-- relative order of the elements is preserved at the cost of a (sometimes)+-- reduced performance compared to 'unstablePartition'.+partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE partition #-}+partition = G.partition++-- | 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.+unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE unstablePartition #-}+unstablePartition = G.unstablePartition++-- | Split the vector into the longest prefix of elements that satisfy the+-- predicate and the rest.+span :: (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE span #-}+span = G.span++-- | Split the vector into the longest prefix of elements that do not satisfy+-- the predicate and the rest.+break :: (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE break #-}+break = G.break+ -- Searching -- --------- @@ -337,6 +571,22 @@ {-# INLINE findIndex #-} findIndex = G.findIndex +-- | Yield the indices of elements satisfying the predicate+findIndices :: (a -> Bool) -> Vector a -> Vector Int+{-# INLINE findIndices #-}+findIndices = G.findIndices++-- | Yield 'Just' the index of the first occurence of the given element or+-- 'Nothing' if the vector does not contain the element+elemIndex :: Eq a => a -> Vector a -> Maybe Int+{-# INLINE elemIndex #-}+elemIndex = G.elemIndex++-- | Yield the indices of all occurences of the given element+elemIndices :: Eq a => a -> Vector a -> Vector Int+{-# INLINE elemIndices #-}+elemIndices = G.elemIndices+ -- Folding -- ------- @@ -370,9 +620,49 @@ {-# INLINE foldr1 #-} foldr1 = G.foldr1 +-- | Right fold with a strict accumulator+foldr' :: (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr' #-}+foldr' = G.foldr'++-- | Right fold on non-empty vectors with strict accumulator+foldr1' :: (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1' #-}+foldr1' = G.foldr1'++-- | Left fold (function applied to each element and its index)+ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl #-}+ifoldl = G.ifoldl++-- | Left fold with strict accumulator (function applied to each element and+-- its index)+ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl' #-}+ifoldl' = G.ifoldl'++-- | Right fold (function applied to each element and its index)+ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr #-}+ifoldr = G.ifoldr++-- | Right fold with strict accumulator (function applied to each element and+-- its index)+ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr' #-}+ifoldr' = G.ifoldr'+ -- Specialised folds -- ----------------- +all :: (a -> Bool) -> Vector a -> Bool+{-# INLINE all #-}+all = G.all++any :: (a -> Bool) -> Vector a -> Bool+{-# INLINE any #-}+any = G.any+ and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and@@ -393,10 +683,34 @@ {-# INLINE maximum #-} maximum = G.maximum +maximumBy :: (a -> a -> Ordering) -> Vector a -> a+{-# INLINE maximumBy #-}+maximumBy = G.maximumBy+ minimum :: Ord a => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum +minimumBy :: (a -> a -> Ordering) -> Vector a -> a+{-# INLINE minimumBy #-}+minimumBy = G.minimumBy++maxIndex :: Ord a => Vector a -> Int+{-# INLINE maxIndex #-}+maxIndex = G.maxIndex++maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE maxIndexBy #-}+maxIndexBy = G.maxIndexBy++minIndex :: Ord a => Vector a -> Int+{-# INLINE minIndex #-}+minIndex = G.minIndex++minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE minIndexBy #-}+minIndexBy = G.minIndexBy+ -- Unfolding -- --------- @@ -447,13 +761,75 @@ {-# INLINE scanl1' #-} scanl1' = G.scanl1' ++-- | Prefix right-to-left scan+prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr #-}+prescanr = G.prescanr++-- | Prefix right-to-left scan with strict accumulator+prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr' #-}+prescanr' = G.prescanr'++-- | Suffix right-to-left scan+postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr #-}+postscanr = G.postscanr++-- | Suffix right-to-left scan with strict accumulator+postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr' #-}+postscanr' = G.postscanr'++-- | Haskell-style right-to-left scan+scanr :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr #-}+scanr = G.scanr++-- | Haskell-style right-to-left scan with strict accumulator+scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr' #-}+scanr' = G.scanr'++-- | Right-to-left scan over a non-empty vector+scanr1 :: (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1 #-}+scanr1 = G.scanr1++-- | Right-to-left scan over a non-empty vector with a strict accumulator+scanr1' :: (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1' #-}+scanr1' = G.scanr1'+ -- Enumeration -- ----------- +-- | Yield a vector of the given length containing the values @x@, @x+1@ etc.+-- This operation is usually more efficient than 'enumFromTo'.+enumFromN :: Num a => a -> Int -> Vector a+{-# INLINE enumFromN #-}+enumFromN = G.enumFromN++-- | 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 :: Num a => a -> a -> Int -> Vector a+{-# INLINE enumFromStepN #-}+enumFromStepN = G.enumFromStepN++-- | Enumerate values from @x@ to @y@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromN' instead. enumFromTo :: Enum a => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo +-- | Enumerate values from @x@ to @y@ with a specific step @z@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead. enumFromThenTo :: Enum a => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo
Data/Vector/Fusion/Stream.hs view
@@ -12,14 +12,12 @@ -- Streams for stream fusion -- -#include "phases.h"- module Data.Vector.Fusion.Stream ( -- * Types Step(..), Stream, MStream, -- * In-place markers- inplace, inplace',+ inplace, -- * Size hints size, sized,@@ -28,19 +26,21 @@ length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++),+ empty, singleton, cons, snoc, replicate, generate, (++), -- * Accessing individual elements head, last, (!!), -- * Substreams- extract, init, tail, take, drop,+ slice, init, tail, take, drop, -- * Mapping- map, concatMap,+ map, concatMap, unbox, -- * Zipping- zipWith, zipWith3,+ indexed, indexedR,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ zip, zip3, zip4, zip5, zip6, -- * Filtering filter, takeWhile, dropWhile,@@ -63,6 +63,9 @@ scanl, scanl', scanl1, scanl1', + -- * Enumerations+ enumFromStepN, enumFromTo, enumFromThenTo,+ -- * Conversions toList, fromList, liftStream, @@ -80,24 +83,27 @@ head, last, (!!), init, tail, take, drop, map, concatMap,- zipWith, zipWith3,+ zipWith, zipWith3, zip, zip3, filter, takeWhile, dropWhile, elem, notElem, foldl, foldl1, foldr, foldr1, and, or, scanl, scanl1,+ enumFromTo, enumFromThenTo, mapM_ ) +#include "vector.h"+ -- | The type of pure streams type Stream = M.Stream Id -- | Alternative name for monadic streams type MStream = M.Stream -inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m a)- -> Stream a -> Stream a+inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m b)+ -> Stream a -> Stream b {-# INLINE_STREAM inplace #-}-inplace f s = f s+inplace f s = s `seq` f s {-# RULES @@ -109,27 +115,6 @@ #-} -inplace' :: (forall m. Monad m => M.Stream m a -> M.Stream m b)- -> Stream a -> Stream b-{-# INLINE_STREAM inplace' #-}-inplace' f s = f s---- FIXME: We'd like to have this-{- RULES--"inplace' [Vector]" inplace' = inplace--}--- but it's only available in 6.13--- (see http://hackage.haskell.org/trac/ghc/ticket/3670)--{-# RULES--"inplace' [Vector]"- forall (f :: forall m. Monad m => MStream m a -> MStream m a).- inplace' f = inplace f-- #-}- -- | Convert a pure stream to a monadic stream liftStream :: Monad m => Stream a -> M.Stream m a {-# INLINE_STREAM liftStream #-}@@ -176,6 +161,11 @@ {-# INLINE replicate #-} replicate = M.replicate +-- | Generate a stream from its indices+generate :: Int -> (Int -> a) -> Stream a+{-# INLINE generate #-}+generate = M.generate+ -- | Prepend an element cons :: a -> Stream a -> Stream a {-# INLINE cons #-}@@ -214,11 +204,12 @@ -- ---------- -- | Extract a substream of the given length starting at the given position.-extract :: Stream a -> Int -- ^ starting index- -> Int -- ^ length- -> Stream a-{-# INLINE extract #-}-extract = M.extract+slice :: Int -- ^ starting index+ -> Int -- ^ length+ -> Stream a+ -> Stream a+{-# INLINE slice #-}+slice = M.slice -- | All but the last element init :: Stream a -> Stream a@@ -248,6 +239,10 @@ {-# INLINE map #-} map = M.map +unbox :: Stream (Box a) -> Stream a+{-# INLINE unbox #-}+unbox = M.unbox+ concatMap :: (a -> Stream b) -> Stream a -> Stream b {-# INLINE concatMap #-} concatMap = M.concatMap@@ -255,6 +250,17 @@ -- Zipping -- ------- +-- | Pair each element in a 'Stream' with its index+indexed :: Stream a -> Stream (Int,a)+{-# INLINE indexed #-}+indexed = M.indexed++-- | Pair each element in a 'Stream' with its index, starting from the right+-- and counting down+indexedR :: Int -> Stream a -> Stream (Int,a)+{-# INLINE_STREAM indexedR #-}+indexedR = M.indexedR+ -- | Zip two 'Stream's with the given function zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c {-# INLINE zipWith #-}@@ -265,6 +271,47 @@ {-# INLINE zipWith3 #-} zipWith3 = M.zipWith3 +zipWith4 :: (a -> b -> c -> d -> e)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e+{-# INLINE zipWith4 #-}+zipWith4 = M.zipWith4++zipWith5 :: (a -> b -> c -> d -> e -> f)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f+{-# INLINE zipWith5 #-}+zipWith5 = M.zipWith5++zipWith6 :: (a -> b -> c -> d -> e -> f -> g)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f -> Stream g+{-# INLINE zipWith6 #-}+zipWith6 = M.zipWith6++zip :: Stream a -> Stream b -> Stream (a,b)+{-# INLINE zip #-}+zip = M.zip++zip3 :: Stream a -> Stream b -> Stream c -> Stream (a,b,c)+{-# INLINE zip3 #-}+zip3 = M.zip3++zip4 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream (a,b,c,d)+{-# INLINE zip4 #-}+zip4 = M.zip4++zip5 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream (a,b,c,d,e)+{-# INLINE zip5 #-}+zip5 = M.zip5++zip6 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f -> Stream (a,b,c,d,e,f)+{-# INLINE zip6 #-}+zip6 = M.zip6+ -- Filtering -- --------- @@ -478,6 +525,30 @@ {-# INLINE fold1M' #-} fold1M' m = M.fold1M' m . liftStream +-- Enumerations+-- ------------++-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,+-- @x+y+y@ etc.+enumFromStepN :: Num a => a -> a -> Int -> Stream a+{-# INLINE enumFromStepN #-}+enumFromStepN = M.enumFromStepN++-- | Enumerate values+--+-- /WARNING:/ This operations can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromTo :: Enum a => a -> a -> Stream a+{-# INLINE enumFromTo #-}+enumFromTo = M.enumFromTo++-- | Enumerate values with a given step.+--+-- /WARNING:/ This operations is very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: Enum a => a -> a -> a -> Stream a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = M.enumFromThenTo -- Conversions -- -----------
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -12,8 +12,6 @@ -- Monadic streams -- -#include "phases.h"- module Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), @@ -24,19 +22,22 @@ length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++),+ empty, singleton, cons, snoc, replicate, generate, generateM, (++), -- * Accessing elements head, last, (!!), -- * Substreams- extract, init, tail, take, drop,+ slice, init, tail, take, drop, -- * Mapping- map, mapM, mapM_, trans, concatMap,+ map, mapM, mapM_, trans, unbox, concatMap, -- * Zipping- zipWith, zipWithM, zipWith3, zipWith3M,+ indexed, indexedR,+ zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ zip, zip3, zip4, zip5, zip6, -- * Filtering filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,@@ -61,26 +62,48 @@ scanl, scanlM, scanl', scanlM', scanl1, scanl1M, scanl1', scanl1M', + -- * Enumerations+ enumFromStepN, enumFromTo, enumFromThenTo,+ -- * Conversions toList, fromList ) where import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Util ( Box(..), delay_inline ) +import Data.Char ( ord )+import GHC.Base ( unsafeChr ) import Control.Monad ( liftM ) import Prelude hiding ( length, null, replicate, (++), head, last, (!!), init, tail, take, drop, map, mapM, mapM_, concatMap,- zipWith, zipWith3,+ zipWith, zipWith3, zip, zip3, filter, takeWhile, dropWhile, elem, notElem, foldl, foldl1, foldr, foldr1, and, or,- scanl, scanl1 )+ scanl, scanl1,+ enumFromTo, enumFromThenTo ) import qualified Prelude +import Data.Int ( Int8, Int16, Int32, Int64 )+import Data.Word ( Word8, Word16, Word32, Word, Word64 )++#if __GLASGOW_HASKELL__ >= 613+import SpecConstr ( SpecConstrAnnotation(..) )+#endif++#include "vector.h"++data SPEC = SPEC | SPEC2+#if __GLASGOW_HASKELL__ >= 613+{-# ANN type SPEC ForceSpecConstr #-}+#endif++ -- | Result of taking a single step in a stream data Step s a = Yield a s -- ^ a new element and a new seed | Skip s -- ^ just a new seed@@ -133,12 +156,29 @@ -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a {-# INLINE_STREAM replicate #-}-replicate n x = Stream (return . step) n (Exact (max n 0))+-- NOTE: We delay inlining max here because GHC will create a join point for+-- the call to newArray# otherwise which is not really nice.+replicate n x = Stream (return . step) n (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-}- step i | i > 0 = Yield x (i-1)- | otherwise = Done+ step i | i <= 0 = Done+ | otherwise = Yield x (i-1) +generate :: Monad m => Int -> (Int -> a) -> Stream m a+{-# INLINE generate #-}+generate n f = generateM n (return . f)++-- | Generate a stream from its indices+generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+{-# INLINE_STREAM generateM #-}+generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0))+ where+ {-# INLINE_INNER step #-}+ step i | i < n = do+ x <- f i+ return $ Yield x (i+1)+ | otherwise = return Done+ -- | Prepend an element cons :: Monad m => a -> Stream m a -> Stream m a {-# INLINE cons #-}@@ -175,58 +215,65 @@ -- | First element of the 'Stream' or error if empty head :: Monad m => Stream m a -> m a {-# INLINE_STREAM head #-}-head (Stream step s _) = head_loop s+head (Stream step s _) = head_loop SPEC s where- head_loop s = do- r <- step s- case r of- Yield x _ -> return x- Skip s' -> head_loop s'- Done -> errorEmptyStream "head"+ head_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x _ -> return x+ Skip s' -> head_loop SPEC s'+ Done -> BOUNDS_ERROR(emptyStream) "head" ++ -- | Last element of the 'Stream' or error if empty last :: Monad m => Stream m a -> m a {-# INLINE_STREAM last #-}-last (Stream step s _) = last_loop0 s+last (Stream step s _) = last_loop0 SPEC s where- last_loop0 s = do- r <- step s- case r of- Yield x s' -> last_loop1 x s'- Skip s' -> last_loop0 s'- Done -> errorEmptyStream "last"+ last_loop0 SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> last_loop1 SPEC x s'+ Skip s' -> last_loop0 SPEC s'+ Done -> BOUNDS_ERROR(emptyStream) "last" - last_loop1 x s = do- r <- step s- case r of- Yield y s' -> last_loop1 y s'- Skip s' -> last_loop1 x s'- Done -> return x+ last_loop1 SPEC x s+ = do+ r <- step s+ case r of+ Yield y s' -> last_loop1 SPEC y s'+ Skip s' -> last_loop1 SPEC x s'+ Done -> return x -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-}-Stream step s _ !! i | i < 0 = errorNegativeIndex "!!"- | otherwise = loop s i+Stream step s _ !! i | i < 0 = BOUNDS_ERROR(error) "!!" "negative index"+ | otherwise = index_loop SPEC s i where- loop s i = i `seq`- do- r <- step s- case r of- Yield x s' | i == 0 -> return x- | otherwise -> loop s' (i-1)- Skip s' -> loop s' i- Done -> errorIndexOutOfRange "!!"+ index_loop SPEC s i+ = i `seq`+ do+ r <- step s+ case r of+ Yield x s' | i == 0 -> return x+ | otherwise -> index_loop SPEC s' (i-1)+ Skip s' -> index_loop SPEC s' i+ Done -> BOUNDS_ERROR(emptyStream) "!!" -- Substreams -- ---------- -- | Extract a substream of the given length starting at the given position.-extract :: Monad m => Stream m a -> Int -- ^ starting index- -> Int -- ^ length- -> Stream m a-{-# INLINE extract #-}-extract s i n = take n (drop i s)+slice :: Monad m => Int -- ^ starting index+ -> Int -- ^ length+ -> Stream m a+ -> Stream m a+{-# INLINE slice #-}+slice i n s = take n (drop i s) -- | All but the last element init :: Monad m => Stream m a -> Stream m a@@ -238,7 +285,7 @@ case r of Yield x s' -> Skip (Just x, s') Skip s' -> Skip (Nothing, s')- Done -> errorEmptyStream "init"+ Done -> BOUNDS_ERROR(emptyStream) "init" ) (step s) step' (Just x, s) = liftM (\r -> @@ -258,7 +305,7 @@ case r of Yield x s' -> Skip (Right s') Skip s' -> Skip (Left s')- Done -> errorEmptyStream "tail"+ Done -> BOUNDS_ERROR(emptyStream) "tail" ) (step s) step' (Right s) = liftM (\r ->@@ -316,6 +363,7 @@ {-# INLINE map #-} map f = mapM (return . f) + -- | Map a monadic function over a 'Stream' mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b {-# INLINE_STREAM mapM #-}@@ -332,14 +380,15 @@ -- | Execute a monadic action for each element of the 'Stream' mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () {-# INLINE_STREAM mapM_ #-}-mapM_ m (Stream step s _) = mapM_go s+mapM_ m (Stream step s _) = mapM_loop SPEC s where- mapM_go s = do- r <- step s- case r of- Yield x s' -> do { m x; mapM_go s' }- Skip s' -> mapM_go s'- Done -> return ()+ mapM_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> do { m x; mapM_loop SPEC s' }+ Skip s' -> mapM_loop SPEC s'+ Done -> return () -- | Transform a 'Stream' to use a different monad trans :: (Monad m, Monad m') => (forall a. m a -> m' a)@@ -347,14 +396,52 @@ {-# INLINE_STREAM trans #-} trans f (Stream step s n) = Stream (f . step) s n +unbox :: Monad m => Stream m (Box a) -> Stream m a+{-# INLINE_STREAM unbox #-}+unbox (Stream step s n) = Stream step' s n+ where+ {-# INLINE_INNER step' #-}+ step' s = do+ r <- step s+ case r of+ Yield (Box x) s' -> return $ Yield x s'+ Skip s' -> return $ Skip s'+ Done -> return $ Done+ -- Zipping -- ------- --- | Zip two 'Stream's with the given function-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-{-# INLINE zipWith #-}-zipWith f = zipWithM (\a b -> return (f a b))+-- | Pair each element in a 'Stream' with its index+indexed :: Monad m => Stream m a -> Stream m (Int,a)+{-# INLINE_STREAM indexed #-}+indexed (Stream step s n) = Stream step' (s,0) n+ where+ {-# INLINE_INNER step' #-}+ step' (s,i) = i `seq`+ do+ r <- step s+ case r of+ Yield x s' -> return $ Yield (i,x) (s', i+1)+ Skip s' -> return $ Skip (s', i)+ Done -> return Done +-- | Pair each element in a 'Stream' with its index, starting from the right+-- and counting down+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a)+{-# INLINE_STREAM indexedR #-}+indexedR m (Stream step s n) = Stream step' (s,m) n+ where+ {-# INLINE_INNER step' #-}+ step' (s,i) = i `seq`+ do+ r <- step s+ case r of+ Yield x s' -> let i' = i-1+ in+ return $ Yield (i',x) (s', i')+ Skip s' -> return $ Skip (s', i)+ Done -> return Done+ -- | Zip two 'Stream's with the given monadic function zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c {-# INLINE_STREAM zipWithM #-}@@ -379,12 +466,14 @@ Skip sb' -> return $ Skip (sa, sb', Just x) Done -> return $ Done --- | Zip three 'Stream's with the given function-zipWith3 :: Monad m => (a -> b -> c -> d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d-{-# INLINE zipWith3 #-}-zipWith3 f = zipWith3M (\a b c -> return (f a b c))+-- FIXME: This might expose an opportunity for inplace execution.+{-# RULES --- | Zip three 'Stream's with the given monadic function+"zipWithM xs xs [Vector.Stream]" forall f xs.+ zipWithM f xs xs = mapM (\x -> f x x) xs++ #-}+ zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d {-# INLINE_STREAM zipWith3M #-} zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)@@ -412,6 +501,78 @@ Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y)) Done -> return $ Done +zipWith4M :: Monad m => (a -> b -> c -> d -> m e)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e+{-# INLINE zipWith4M #-}+zipWith4M f sa sb sc sd+ = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)++zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m f+{-# INLINE zipWith5M #-}+zipWith5M f sa sb sc sd se+ = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)++zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m f -> Stream m g+{-# INLINE zipWith6M #-}+zipWith6M fn sa sb sc sd se sf+ = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)+ (zip3 sd se sf)++zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+{-# INLINE zipWith #-}+zipWith f = zipWithM (\a b -> return (f a b))++zipWith3 :: Monad m => (a -> b -> c -> d)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+{-# INLINE zipWith3 #-}+zipWith3 f = zipWith3M (\a b c -> return (f a b c))++zipWith4 :: Monad m => (a -> b -> c -> d -> e)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e+{-# INLINE zipWith4 #-}+zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))++zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m f+{-# INLINE zipWith5 #-}+zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))++zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)+ -> Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m f -> Stream m g+{-# INLINE zipWith6 #-}+zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))++zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b)+{-# INLINE zip #-}+zip = zipWith (,)++zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c)+{-# INLINE zip3 #-}+zip3 = zipWith3 (,,)++zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m (a,b,c,d)+{-# INLINE zip4 #-}+zip4 = zipWith4 (,,,)++zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m (a,b,c,d,e)+{-# INLINE zip5 #-}+zip5 = zipWith5 (,,,,)++zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d+ -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f)+{-# INLINE zip6 #-}+zip6 = zipWith6 (,,,,,)+ -- Filtering -- --------- @@ -500,15 +661,16 @@ -- | Check whether the 'Stream' contains an element elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool {-# INLINE_STREAM elem #-}-elem x (Stream step s _) = elem_loop s+elem x (Stream step s _) = elem_loop SPEC s where- elem_loop s = do- r <- step s- case r of- Yield y s' | x == y -> return True- | otherwise -> elem_loop s'- Skip s' -> elem_loop s'- Done -> return False+ elem_loop SPEC s+ = do+ r <- step s+ case r of+ Yield y s' | x == y -> return True+ | otherwise -> elem_loop SPEC s'+ Skip s' -> elem_loop SPEC s'+ Done -> return False infix 4 `notElem` -- | Inverse of `elem`@@ -526,17 +688,18 @@ -- 'Nothing' if no such element exists. findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a) {-# INLINE_STREAM findM #-}-findM f (Stream step s _) = find_loop s+findM f (Stream step s _) = find_loop SPEC s where- find_loop s = do- r <- step s- case r of- Yield x s' -> do- b <- f x- if b then return $ Just x- else find_loop s'- Skip s' -> find_loop s'- Done -> return Nothing+ find_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> do+ b <- f x+ if b then return $ Just x+ else find_loop SPEC s'+ Skip s' -> find_loop SPEC s'+ Done -> return Nothing -- | Yield 'Just' the index of the first element that satisfies the predicate -- or 'Nothing' if no such element exists.@@ -548,17 +711,18 @@ -- predicate or 'Nothing' if no such element exists. findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int) {-# INLINE_STREAM findIndexM #-}-findIndexM f (Stream step s _) = findIndex_loop s 0+findIndexM f (Stream step s _) = findIndex_loop SPEC s 0 where- findIndex_loop s i = do- r <- step s- case r of- Yield x s' -> do- b <- f x- if b then return $ Just i- else findIndex_loop s' (i+1)- Skip s' -> findIndex_loop s' i- Done -> return Nothing+ findIndex_loop SPEC s i+ = do+ r <- step s+ case r of+ Yield x s' -> do+ b <- f x+ if b then return $ Just i+ else findIndex_loop SPEC s' (i+1)+ Skip s' -> findIndex_loop SPEC s' i+ Done -> return Nothing -- Folding -- -------@@ -571,14 +735,15 @@ -- | Left fold with a monadic operator foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE_STREAM foldlM #-}-foldlM m z (Stream step s _) = foldlM_go z s+foldlM m z (Stream step s _) = foldlM_loop SPEC z s where- foldlM_go z s = do- r <- step s- case r of- Yield x s' -> do { z' <- m z x; foldlM_go z' s' }- Skip s' -> foldlM_go z s'- Done -> return z+ foldlM_loop SPEC z s+ = do+ r <- step s+ case r of+ Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' }+ Skip s' -> foldlM_loop SPEC z s'+ Done -> return z -- | Same as 'foldlM' foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a@@ -593,14 +758,15 @@ -- | Left fold over a non-empty 'Stream' with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldl1M #-}-foldl1M f (Stream step s sz) = foldl1M_go s+foldl1M f (Stream step s sz) = foldl1M_loop SPEC s where- foldl1M_go s = do- r <- step s- case r of- Yield x s' -> foldlM f x (Stream step s' (sz - 1))- Skip s' -> foldl1M_go s'- Done -> errorEmptyStream "foldl1M"+ foldl1M_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> foldlM f x (Stream step s' (sz - 1))+ Skip s' -> foldl1M_loop SPEC s'+ Done -> BOUNDS_ERROR(emptyStream) "foldl1M" -- | Same as 'foldl1M' fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a@@ -615,15 +781,16 @@ -- | Left fold with a strict accumulator and a monadic operator foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE_STREAM foldlM' #-}-foldlM' m z (Stream step s _) = foldlM'_go z s+foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s where- foldlM'_go z s = z `seq`- do- r <- step s- case r of- Yield x s' -> do { z' <- m z x; foldlM'_go z' s' }- Skip s' -> foldlM'_go z s'- Done -> return z+ foldlM'_loop SPEC z s+ = z `seq`+ do+ r <- step s+ case r of+ Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }+ Skip s' -> foldlM'_loop SPEC z s'+ Done -> return z -- | Same as 'foldlM'' foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a@@ -639,14 +806,15 @@ -- monadic operator foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldl1M' #-}-foldl1M' f (Stream step s sz) = foldl1M'_go s+foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s where- foldl1M'_go s = do- r <- step s- case r of- Yield x s' -> foldlM' f x (Stream step s' (sz - 1))- Skip s' -> foldl1M'_go s'- Done -> errorEmptyStream "foldl1M'"+ foldl1M'_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> foldlM' f x (Stream step s' (sz - 1))+ Skip s' -> foldl1M'_loop SPEC s'+ Done -> BOUNDS_ERROR(emptyStream) "foldl1M'" -- | Same as 'foldl1M'' fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a@@ -661,14 +829,15 @@ -- | Right fold with a monadic operator foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b {-# INLINE_STREAM foldrM #-}-foldrM f z (Stream step s _) = foldrM_go s+foldrM f z (Stream step s _) = foldrM_loop SPEC s where- foldrM_go s = do- r <- step s- case r of- Yield x s' -> f x =<< foldrM_go s'- Skip s' -> foldrM_go s'- Done -> return z+ foldrM_loop SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> f x =<< foldrM_loop SPEC s'+ Skip s' -> foldrM_loop SPEC s'+ Done -> return z -- | Right fold over a non-empty stream foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a@@ -678,48 +847,52 @@ -- | Right fold over a non-empty stream with a monadic operator foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldr1M #-}-foldr1M f (Stream step s _) = foldr1M_go0 s+foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s where- foldr1M_go0 s = do- r <- step s- case r of- Yield x s' -> foldr1M_go1 x s'- Skip s' -> foldr1M_go0 s'- Done -> errorEmptyStream "foldr1M"+ foldr1M_loop0 SPEC s+ = do+ r <- step s+ case r of+ Yield x s' -> foldr1M_loop1 SPEC x s'+ Skip s' -> foldr1M_loop0 SPEC s'+ Done -> BOUNDS_ERROR(emptyStream) "foldr1M" - foldr1M_go1 x s = do- r <- step s- case r of- Yield y s' -> f x =<< foldr1M_go1 y s'- Skip s' -> foldr1M_go1 x s'- Done -> return x+ foldr1M_loop1 SPEC x s+ = do+ r <- step s+ case r of+ Yield y s' -> f x =<< foldr1M_loop1 SPEC y s'+ Skip s' -> foldr1M_loop1 SPEC x s'+ Done -> return x -- Specialised folds -- ----------------- and :: Monad m => Stream m Bool -> m Bool {-# INLINE_STREAM and #-}-and (Stream step s _) = and_go s+and (Stream step s _) = and_loop SPEC s where- and_go s = do- r <- step s- case r of- Yield False _ -> return False- Yield True s' -> and_go s'- Skip s' -> and_go s'- Done -> return True+ and_loop SPEC s+ = do+ r <- step s+ case r of+ Yield False _ -> return False+ Yield True s' -> and_loop SPEC s'+ Skip s' -> and_loop SPEC s'+ Done -> return True or :: Monad m => Stream m Bool -> m Bool {-# INLINE_STREAM or #-}-or (Stream step s _) = or_go s+or (Stream step s _) = or_loop SPEC s where- or_go s = do- r <- step s- case r of- Yield False s' -> or_go s'- Yield True _ -> return True- Skip s' -> or_go s'- Done -> return False+ or_loop SPEC s+ = do+ r <- step s+ case r of+ Yield False s' -> or_loop SPEC s'+ Yield True _ -> return True+ Skip s' -> or_loop SPEC s'+ Done -> return False concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b {-# INLINE concatMap #-}@@ -885,7 +1058,7 @@ case r of Yield x s' -> return $ Yield x (s', Just x) Skip s' -> return $ Skip (s', Nothing)- Done -> errorEmptyStream "scanl1M"+ Done -> BOUNDS_ERROR(emptyStream) "scanl1M" step' (s, Just x) = do r <- step s@@ -913,7 +1086,7 @@ case r of Yield x s' -> x `seq` return (Yield x (s', Just x)) Skip s' -> return $ Skip (s', Nothing)- Done -> errorEmptyStream "scanl1M"+ Done -> BOUNDS_ERROR(emptyStream) "scanl1M" step' (s, Just x) = x `seq` do@@ -925,6 +1098,222 @@ Skip s' -> return $ Skip (s', Just x) Done -> return Done +-- Enumerations+-- ------------++-- The Enum class is broken for this, there just doesn't seem to be a+-- way to implement this generically. We have to specialise for as many types+-- as we can but this doesn't help in polymorphic loops.++-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,+-- @x+y+y@ etc.+enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a+{-# INLINE_STREAM enumFromStepN #-}+enumFromStepN x y n = n `seq` Stream step (x,n) (Exact (delay_inline max n 0))+ where+ {-# INLINE_INNER step #-}+ step (x,n) | n > 0 = return $ Yield x (x+y,n-1)+ | otherwise = return $ Done++-- | Enumerate values+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo #-}+enumFromTo x y = fromList [x .. y]++-- FIXME: Specialise enumFromTo for Float and Double. Also, try to do+-- something about pairs?++-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for+-- overflow which can't happen here.++-- FIXME: add "too large" test for Int+enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_small #-}+enumFromTo_small x y = Stream step x (Exact n)+ where+ n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0++ {-# INLINE_INNER step #-}+ step x | x <= y = return $ Yield x (x+1)+ | otherwise = return $ Done++{-# RULES++"enumFromTo<Int8> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8++"enumFromTo<Int16> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16++"enumFromTo<Word8> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8++"enumFromTo<Word16> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16++ #-}++#if WORD_SIZE_IN_BITS > 32++{-# RULES++"enumFromTo<Int32> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32++"enumFromTo<Word32> [Stream]"+ enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32++ #-}++#endif++-- NOTE: We could implement a generic "too large" test:+--+-- len x y | x > y = 0+-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n+-- | otherwise = error+-- where+-- n = y-x+1+--+-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for+-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744+--++enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_int #-}+enumFromTo_int x y = Stream step x (Exact (len x y))+ where+ {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n > 0)+ $ fromIntegral n+ where+ n = y-x+1++ {-# INLINE_INNER step #-}+ step x | x <= y = return $ Yield x (x+1)+ | otherwise = return $ Done++{-# RULES++"enumFromTo<Int> [Stream]"+ enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int++#if WORD_SIZE_IN_BITS > 32++"enumFromTo<Int64> [Stream]"+ enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64++#else++"enumFromTo<Int32> [Stream]"+ enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32++#endif++ #-}++enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_big_word #-}+enumFromTo_big_word x y = Stream step x (Exact (len x y))+ where+ {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n < fromIntegral (maxBound :: Int))+ $ fromIntegral (n+1)+ where+ n = y-x++ {-# INLINE_INNER step #-}+ step x | x <= y = return $ Yield x (x+1)+ | otherwise = return $ Done++{-# RULES++"enumFromTo<Word> [Stream]"+ enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word++"enumFromTo<Word64> [Stream]"+ enumFromTo = enumFromTo_big_word+ :: Monad m => Word64 -> Word64 -> Stream m Word64++#if WORD_SIZE_IN_BITS == 32++"enumFromTo<Word32> [Stream]"+ enumFromTo = enumFromTo_big_word+ :: Monad m => Word32 -> Word32 -> Stream m Word32++#endif++"enumFromTo<Integer> [Stream]"+ enumFromTo = enumFromTo_big_word+ :: Monad m => Integer -> Integer -> Stream m Integer++ #-}++-- FIXME: the "too large" test is totally wrong+enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_big_int #-}+enumFromTo_big_int x y = Stream step x (Exact (len x y))+ where+ {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n > 0 && n <= fromIntegral (maxBound :: Int))+ $ fromIntegral n+ where+ n = y-x+1+ + {-# INLINE_INNER step #-}+ step x | x <= y = return $ Yield x (x+1)+ | otherwise = return $ Done++#if WORD_SIZE_IN_BITS > 32++{-# RULES++"enumFromTo<Int64> [Stream]"+ enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64++ #-}++#endif++enumFromTo_char :: Monad m => Char -> Char -> Stream m Char+{-# INLINE_STREAM enumFromTo_char #-}+enumFromTo_char x y = Stream step xn (Exact n)+ where+ xn = ord x+ yn = ord y++ n = delay_inline max 0 (yn - xn + 1)++ {-# INLINE_INNER step #-}+ step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1)+ | otherwise = return $ Done++{-# RULES++"enumFromTo<Char> [Stream]"+ enumFromTo = enumFromTo_char++ #-}++-- | Enumerate values with a given step.+--+-- /WARNING:/ This operation is very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a+{-# INLINE_STREAM enumFromThenTo #-}+enumFromThenTo x y z = fromList [x, y .. z]++-- FIXME: Specialise enumFromThenTo.+ -- Conversions -- ----------- @@ -940,18 +1329,4 @@ where step (x:xs) = return (Yield x xs) step [] = return Done---streamError :: String -> String -> a-streamError fn msg = error $ "Data.Vector.Fusion.Stream.Monadic."- Prelude.++ fn Prelude.++ ": " Prelude.++ msg--errorEmptyStream :: String -> a-errorEmptyStream fn = streamError fn "empty stream"--errorNegativeIndex :: String -> a-errorNegativeIndex fn = streamError fn "negative index"--errorIndexOutOfRange :: String -> a-errorIndexOutOfRange fn = streamError fn "index out of range"
Data/Vector/Fusion/Stream/Size.hs view
@@ -14,6 +14,8 @@ Size(..), smaller, larger, toMax, upperBound ) where +import Data.Vector.Fusion.Util ( delay_inline )+ -- | Size hint data Size = Exact Int -- ^ Exact size | Max Int -- ^ Upper bound on the size@@ -44,11 +46,12 @@ -- | Minimum of two size hints smaller :: Size -> Size -> Size-smaller (Exact m) (Exact n) = Exact (m `min` n)-smaller (Exact m) (Max n) = Max (m `min` n)+{-# INLINE smaller #-}+smaller (Exact m) (Exact n) = Exact (delay_inline min m n)+smaller (Exact m) (Max n) = Max (delay_inline min m n) smaller (Exact m) Unknown = Max m-smaller (Max m) (Exact n) = Max (m `min` n)-smaller (Max m) (Max n) = Max (m `min` n)+smaller (Max m) (Exact n) = Max (delay_inline min m n)+smaller (Max m) (Max n) = Max (delay_inline min m n) smaller (Max m) Unknown = Max m smaller Unknown (Exact n) = Max n smaller Unknown (Max n) = Max n@@ -56,12 +59,13 @@ -- | Maximum of two size hints larger :: Size -> Size -> Size-larger (Exact m) (Exact n) = Exact (m `max` n)+{-# INLINE larger #-}+larger (Exact m) (Exact n) = Exact (delay_inline max m n) larger (Exact m) (Max n) | m >= n = Exact m | otherwise = Max n larger (Max m) (Exact n) | n >= m = Exact n | otherwise = Max m-larger (Max m) (Max n) = Max (m `max` n)+larger (Max m) (Max n) = Max (delay_inline max m n) larger _ _ = Unknown -- | Convert a size hint to an upper bound
Data/Vector/Fusion/Util.hs view
@@ -10,9 +10,12 @@ -- Fusion-related utility types -- -module Data.Vector.Fusion.Util ( Id(..), Box(..) )-where+module Data.Vector.Fusion.Util (+ Id(..), Box(..), + delay_inline+) where+ -- | Identity monad newtype Id a = Id { unId :: a } @@ -32,4 +35,10 @@ instance Monad Box where return = Box Box x >>= f = f x++-- | Delay inlining a function until late in the game (simplifier phase 0).+delay_inline :: (a -> b) -> a -> b+{-# INLINE [0] delay_inline #-}+delay_inline f = f+
Data/Vector/Generic.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,- ScopedTypeVariables #-}+ TypeFamilies, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Generic -- Copyright : (c) Roman Leshchinskiy 2008-2009@@ -12,47 +12,61 @@ -- Generic interface to pure vectors -- -#include "phases.h"- module Data.Vector.Generic ( -- * Immutable vectors- Vector(..),+ Vector(..), Mutable, -- * Length information length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++), copy,+ empty, singleton, cons, snoc, replicate, generate, (++), copy, -- * Accessing individual elements (!), head, last, indexM, headM, lastM,+ unsafeIndex, unsafeHead, unsafeLast,+ unsafeIndexM, unsafeHeadM, unsafeLastM, -- * Subvectors slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, -- * Permutations- accum, (//), update, backpermute, reverse,+ accum, accumulate, accumulate_,+ (//), update, update_,+ backpermute, reverse,+ unsafeAccum, unsafeAccumulate, unsafeAccumulate_,+ unsafeUpd, unsafeUpdate, unsafeUpdate_,+ unsafeBackpermute, -- * Mapping- map, concatMap,+ map, imap, concatMap, -- * Zipping and unzipping- zipWith, zipWith3, zip, zip3, unzip, unzip3,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ izipWith, izipWith3, izipWith4, izipWith5, izipWith6,+ zip, zip3, zip4, zip5, zip6,+ unzip, unzip3, unzip4, unzip5, unzip6, -- * Comparisons eq, cmp, -- * Filtering- filter, takeWhile, dropWhile,+ filter, ifilter, takeWhile, dropWhile,+ partition, unstablePartition, span, break, -- * Searching- elem, notElem, find, findIndex,+ elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding- foldl, foldl1, foldl', foldl1', foldr, foldr1,+ foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',+ ifoldl, ifoldl', ifoldr, ifoldr', -- * Specialised folds- and, or, sum, product, maximum, minimum,+ all, any, and, or,+ sum, product,+ maximum, maximumBy, minimum, minimumBy,+ minIndex, minIndexBy, maxIndex, maxIndexBy, -- * Unfolding unfoldr,@@ -61,57 +75,67 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1',+ prescanr, prescanr',+ postscanr, postscanr',+ scanr, scanr', scanr1, scanr1', -- * Enumeration- enumFromTo, enumFromThenTo,+ enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversion to/from lists toList, fromList, -- * Conversion to/from Streams- stream, unstream,+ stream, unstream, streamR, unstreamR, -- * MVector-based initialisation new ) where import Data.Vector.Generic.Mutable ( MVector )+import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic.New as New import Data.Vector.Generic.New ( New ) import qualified Data.Vector.Fusion.Stream as Stream-import Data.Vector.Fusion.Stream ( Stream, MStream, inplace, inplace' )+import Data.Vector.Fusion.Stream ( Stream, MStream, inplace ) import qualified Data.Vector.Fusion.Stream.Monadic as MStream import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util -import Control.Exception ( assert )-+import Control.Monad.ST ( runST )+import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, (++), head, last, init, tail, take, drop, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3,- filter, takeWhile, dropWhile,+ filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1,- and, or, sum, product, maximum, minimum,- scanl, scanl1,+ all, any, and, or, sum, product, maximum, minimum,+ scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo ) +#include "vector.h"++type family Mutable (v :: * -> *) :: * -> * -> *+ -- | Class of immutable vectors. ---class Vector v a where- -- | Construct a pure vector from a monadic initialiser (not fusible!)- vnew :: (forall mv m. MVector mv m a => m (mv a)) -> v a+class MVector (Mutable v) a => Vector v a where+ -- | Unsafely convert a mutable vector to its immutable version+ -- without copying. The mutable vector may not be used after+ -- this operation.+ unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) -- | Length of the vector (not fusible!)- vlength :: v a -> Int+ basicLength :: v a -> Int -- | Yield a part of the vector without copying it. No range checks!- unsafeSlice :: v a -> Int -> Int -> v a+ basicUnsafeSlice :: Int -> Int -> v a -> v a -- | Yield the element at the given position in a monad. The monad allows us -- to be strict in the vector if we want. Suppose we had@@ -126,16 +150,21 @@ -- would retain a reference to the original vector in each element we write. -- This is not what we want! --- -- With 'unsafeIndexM', we can do+ -- With 'basicUnsafeIndexM', we can do --- -- > copy mv v ... = ... case unsafeIndexM v i of+ -- > copy mv v ... = ... case basicUnsafeIndexM v i of -- > Box x -> unsafeWrite mv i x ... -- -- which does not have this problem because indexing (but not the returned -- element!) is evaluated immediately. --- unsafeIndexM :: Monad m => v a -> Int -> m a+ basicUnsafeIndexM :: Monad m => v a -> Int -> m a + elemseq :: v a -> a -> b -> b++ {-# INLINE elemseq #-}+ elemseq _ = \_ x -> x+ -- Fusion -- ------ @@ -150,7 +179,9 @@ -- See http://hackage.haskell.org/trac/ghc/ticket/2600 new' :: Vector v a => v a -> New a -> v a {-# INLINE_STREAM new' #-}-new' _ m = vnew (New.run m)+new' _ m = m `seq` runST (do+ mv <- New.run m+ unsafeFreeze mv) -- | Convert a vector to a 'Stream' stream :: Vector v a => v a -> Stream a@@ -163,7 +194,7 @@ -- makes the code easier to read {-# INLINE get #-} get i | i >= n = Nothing- | otherwise = case unsafeIndexM v i of Box x -> Just (x, i+1)+ | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1) -- | Create a vector from a 'Stream' unstream :: Vector v a => Stream a -> v a@@ -192,12 +223,54 @@ #-} +-- | Convert a vector to a 'Stream'+streamR :: Vector v a => v a -> Stream a+{-# INLINE_STREAM streamR #-}+streamR v = v `seq` (Stream.unfoldr get n `Stream.sized` Exact n)+ where+ n = length v++ -- NOTE: the False case comes first in Core so making it the recursive one+ -- makes the code easier to read+ {-# INLINE get #-}+ get 0 = Nothing+ get i = let i' = i-1+ in+ case basicUnsafeIndexM v i' of Box x -> Just (x, i')++-- | Create a vector from a 'Stream'+unstreamR :: Vector v a => Stream a -> v a+{-# INLINE unstreamR #-}+unstreamR s = new (New.unstreamR s)++{-# RULES++"streamR/unstreamR [Vector]" forall v s.+ streamR (new' v (New.unstreamR s)) = s++"New.unstreamR/streamR/new [Vector]" forall v p.+ New.unstreamR (streamR (new' v p)) = p++ #-}++{-# RULES++"inplace [Vector]"+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.+ New.unstreamR (inplace f (streamR (new' v m))) = New.transformR f m++"uninplace [Vector]"+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.+ streamR (new' v (New.transformR f m)) = inplace f (streamR (new' v m))++ #-}+ -- Length -- ------ length :: Vector v a => v a -> Int {-# INLINE_STREAM length #-}-length v = vlength v+length v = basicLength v {-# RULES @@ -207,15 +280,8 @@ #-} null :: Vector v a => v a -> Bool-{-# INLINE_STREAM null #-}-null v = vlength v == 0--{-# RULES--"null/unstream [Vector]" forall v s.- null (new' v (New.unstream s)) = Stream.null s-- #-}+{-# INLINE null #-}+null v = length v == 0 -- Construction -- ------------@@ -226,24 +292,38 @@ empty = unstream Stream.empty -- | Vector with exaclty one element-singleton :: Vector v a => a -> v a+singleton :: forall v a. Vector v a => a -> v a {-# INLINE singleton #-}-singleton x = unstream (Stream.singleton x)+singleton x = elemseq (undefined :: v a) x+ $ unstream (Stream.singleton x) -- | Vector of the given length with the given value in each position-replicate :: Vector v a => Int -> a -> v a+replicate :: forall v a. Vector v a => Int -> a -> v a {-# INLINE replicate #-}-replicate n = unstream . Stream.replicate n+replicate n x = elemseq (undefined :: v a) x+ $ unstream+ $ Stream.replicate n x +-- | Generate a vector of the given length by applying the function to each+-- index+generate :: Vector v a => Int -> (Int -> a) -> v a+{-# INLINE generate #-}+generate n f = unstream (Stream.generate n f)+ -- | Prepend an element-cons :: Vector v a => a -> v a -> v a+cons :: forall v a. Vector v a => a -> v a -> v a {-# INLINE cons #-}-cons x = unstream . Stream.cons x . stream+cons x v = elemseq (undefined :: v a) x+ $ unstream+ $ Stream.cons x+ $ stream v -- | Append an element-snoc :: Vector v a => v a -> a -> v a+snoc :: forall v a. Vector v a => v a -> a -> v a {-# INLINE snoc #-}-snoc v = unstream . Stream.snoc (stream v)+snoc v x = elemseq (undefined :: v a) x+ $ unstream+ $ Stream.snoc (stream v) x infixr 5 ++ -- | Concatenate two vectors@@ -269,8 +349,8 @@ -- | Indexing (!) :: Vector v a => v a -> Int -> a {-# INLINE_STREAM (!) #-}-v ! i = assert (i >= 0 && i < length v)- $ unId (unsafeIndexM v i)+v ! i = BOUNDS_CHECK(checkIndex) "(!)" i (length v)+ $ unId (basicUnsafeIndexM v i) -- | First element head :: Vector v a => v a -> a@@ -282,6 +362,24 @@ {-# INLINE_STREAM last #-} last v = v ! (length v - 1) +-- | Unsafe indexing without bounds checking+unsafeIndex :: Vector v a => v a -> Int -> a+{-# INLINE_STREAM unsafeIndex #-}+unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v)+ $ unId (basicUnsafeIndexM v i)++-- | Yield the first element of a vector without checking if the vector is+-- empty+unsafeHead :: Vector v a => v a -> a+{-# INLINE_STREAM unsafeHead #-}+unsafeHead v = unsafeIndex v 0++-- | Yield the last element of a vector without checking if the vector is+-- empty+unsafeLast :: Vector v a => v a -> a+{-# INLINE_STREAM unsafeLast #-}+unsafeLast v = unsafeIndex v (length v - 1)+ {-# RULES "(!)/unstream [Vector]" forall v i s.@@ -293,14 +391,23 @@ "last/unstream [Vector]" forall v s. last (new' v (New.unstream s)) = Stream.last s +"unsafeIndex/unstream [Vector]" forall v i s.+ unsafeIndex (new' v (New.unstream s)) i = s Stream.!! i++"unsafeHead/unstream [Vector]" forall v s.+ unsafeHead (new' v (New.unstream s)) = Stream.head s++"unsafeLast/unstream [Vector]" forall v s.+ unsafeLast (new' v (New.unstream s)) = Stream.last s+ #-} -- | Monadic indexing which can be strict in the vector while remaining lazy in -- the element. indexM :: (Vector v a, Monad m) => v a -> Int -> m a {-# INLINE_STREAM indexM #-}-indexM v i = assert (i >= 0 && i < length v)- $ unsafeIndexM v i+indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v)+ $ basicUnsafeIndexM v i headM :: (Vector v a, Monad m) => v a -> m a {-# INLINE_STREAM headM #-}@@ -310,6 +417,20 @@ {-# INLINE_STREAM lastM #-} lastM v = indexM v (length v - 1) +-- | Unsafe monadic indexing without bounds checks+unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a+{-# INLINE_STREAM unsafeIndexM #-}+unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v)+ $ basicUnsafeIndexM v i++unsafeHeadM :: (Vector v a, Monad m) => v a -> m a+{-# INLINE_STREAM unsafeHeadM #-}+unsafeHeadM v = unsafeIndexM v 0++unsafeLastM :: (Vector v a, Monad m) => v a -> m a+{-# INLINE_STREAM unsafeLastM #-}+unsafeLastM v = unsafeIndexM v (length v - 1)+ -- FIXME: the rhs of these rules are lazy in the stream which is WRONG {- RULES @@ -329,42 +450,69 @@ -- FIXME: slicing doesn't work with the inplace stuff at the moment --- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: Vector v a => v a -> Int -- ^ starting index- -> Int -- ^ length- -> v a+-- | Yield a part of the vector without copying it.+slice :: Vector v a => Int -- ^ starting index+ -> Int -- ^ length+ -> v a+ -> v a {-# INLINE_STREAM slice #-}-slice v i n = assert (i >= 0 && n >= 0 && i+n <= length v)- $ unsafeSlice v i n+slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v)+ $ basicUnsafeSlice i n v -- | Yield all but the last element without copying. init :: Vector v a => v a -> v a {-# INLINE_STREAM init #-}-init v = slice v 0 (length v - 1)+init v = slice 0 (length v - 1) v -- | All but the first element (without copying). tail :: Vector v a => v a -> v a {-# INLINE_STREAM tail #-}-tail v = slice v 1 (length v - 1)+tail v = slice 1 (length v - 1) v -- | Yield the first @n@ elements without copying. take :: Vector v a => Int -> v a -> v a {-# INLINE_STREAM take #-}-take n v = slice v 0 (min n' (length v))+take n v = unsafeSlice 0 (delay_inline min n' (length v)) v where n' = max n 0 -- | Yield all but the first @n@ elements without copying. drop :: Vector v a => Int -> v a -> v a {-# INLINE_STREAM drop #-}-drop n v = slice v (min n' len) (max 0 (len - n'))+drop n v = unsafeSlice (delay_inline min n' len)+ (delay_inline max 0 (len - n')) v where n' = max n 0 len = length v +-- | Unsafely yield a part of the vector without copying it and without+-- performing bounds checks.+unsafeSlice :: Vector v a => Int -- ^ starting index+ -> Int -- ^ length+ -> v a+ -> v a+{-# INLINE_STREAM unsafeSlice #-}+unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v)+ $ basicUnsafeSlice i n v++unsafeInit :: Vector v a => v a -> v a+{-# INLINE_STREAM unsafeInit #-}+unsafeInit v = unsafeSlice 0 (length v - 1) v++unsafeTail :: Vector v a => v a -> v a+{-# INLINE_STREAM unsafeTail #-}+unsafeTail v = unsafeSlice 1 (length v - 1) v++unsafeTake :: Vector v a => Int -> v a -> v a+{-# INLINE unsafeTake #-}+unsafeTake n v = unsafeSlice 0 n v++unsafeDrop :: Vector v a => Int -> v a -> v a+{-# INLINE unsafeDrop #-}+unsafeDrop n v = unsafeSlice n (length v - n) v+ {-# RULES -"slice/new [Vector]" forall v p i n.- slice (new' v p) i n = new' v (New.slice p i n)+"slice/new [Vector]" forall i n v p.+ slice i n (new' v p) = new' v (New.slice i n p) "init/new [Vector]" forall v p. init (new' v p) = new' v (New.init p)@@ -378,25 +526,93 @@ "drop/new [Vector]" forall n v p. drop n (new' v p) = new' v (New.drop n p) +"unsafeSlice/new [Vector]" forall i n v p.+ unsafeSlice i n (new' v p) = new' v (New.unsafeSlice i n p)++"unsafeInit/new [Vector]" forall v p.+ unsafeInit (new' v p) = new' v (New.unsafeInit p)++"unsafeTail/new [Vector]" forall v p.+ unsafeTail (new' v p) = new' v (New.unsafeTail p)+ #-} -- Permutations -- ------------ +unsafeAccum_stream+ :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a+{-# INLINE unsafeAccum_stream #-}+unsafeAccum_stream f v s = new (New.accum f (New.unstream (stream v)) s)++unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a+{-# INLINE unsafeAccum #-}+unsafeAccum f v us = unsafeAccum_stream f v (Stream.fromList us)++unsafeAccumulate :: (Vector v a, Vector v (Int, b))+ => (a -> b -> a) -> v a -> v (Int,b) -> v a+{-# INLINE unsafeAccumulate #-}+unsafeAccumulate f v us = unsafeAccum_stream f v (stream us)++unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b)+ => (a -> b -> a) -> v a -> v Int -> v b -> v a+{-# INLINE unsafeAccumulate_ #-}+unsafeAccumulate_ f v is xs+ = unsafeAccum_stream f v (Stream.zipWith (,) (stream is) (stream xs))++accum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a+{-# INLINE accum_stream #-}+accum_stream f v s = new (New.accum f (New.unstream (stream v)) s)+ accum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE accum #-}-accum f v us = new (New.accum f (New.unstream (stream v))- (Stream.fromList us))+accum f v us = accum_stream f v (Stream.fromList us) +accumulate :: (Vector v a, Vector v (Int, b))+ => (a -> b -> a) -> v a -> v (Int,b) -> v a+{-# INLINE accumulate #-}+accumulate f v us = accum_stream f v (stream us)++accumulate_ :: (Vector v a, Vector v Int, Vector v b)+ => (a -> b -> a) -> v a -> v Int -> v b -> v a+{-# INLINE accumulate_ #-}+accumulate_ f v is xs = accum_stream f v (Stream.zipWith (,) (stream is)+ (stream xs))+ ++unsafeUpdate_stream :: Vector v a => v a -> Stream (Int,a) -> v a+{-# INLINE unsafeUpdate_stream #-}+unsafeUpdate_stream v s = new (New.unsafeUpdate (New.unstream (stream v)) s)++unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a+{-# INLINE unsafeUpd #-}+unsafeUpd v us = unsafeUpdate_stream v (Stream.fromList us)++unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a+{-# INLINE unsafeUpdate #-}+unsafeUpdate v w = unsafeUpdate_stream v (stream w)++unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a+{-# INLINE unsafeUpdate_ #-}+unsafeUpdate_ v is w+ = unsafeUpdate_stream v (Stream.zipWith (,) (stream is) (stream w))++update_stream :: Vector v a => v a -> Stream (Int,a) -> v a+{-# INLINE update_stream #-}+update_stream v s = new (New.update (New.unstream (stream v)) s)+ (//) :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE (//) #-}-v // us = new (New.update (New.unstream (stream v))- (Stream.fromList us))+v // us = update_stream v (Stream.fromList us) update :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a {-# INLINE update #-}-update v w = new (New.update (New.unstream (stream v)) (stream w))+update v w = update_stream v (stream w) +update_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a+{-# INLINE update_ #-}+update_ v is w = update_stream v (Stream.zipWith (,) (stream is) (stream w))+ -- This somewhat non-intuitive definition ensures that the resulting vector -- does not retain references to the original one even if it is lazy in its -- elements. This would not be the case if we simply used@@ -406,11 +622,18 @@ {-# INLINE backpermute #-} backpermute v is = seq v $ unstream- $ MStream.trans (Id . unBox)- $ MStream.mapM (indexM v)- $ MStream.trans (Box . unId)+ $ Stream.unbox+ $ Stream.map (indexM v) $ stream is +unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a+{-# INLINE unsafeBackpermute #-}+unsafeBackpermute v is = seq v+ $ unstream+ $ Stream.unbox+ $ Stream.map (unsafeIndexM v)+ $ stream is+ reverse :: (Vector v a) => v a -> v a {-# INLINE reverse #-} reverse = new . New.reverse . New.unstream . stream@@ -421,8 +644,14 @@ -- | Map a function over a vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b {-# INLINE map #-}-map f = unstream . inplace' (MStream.map f) . stream+map f = unstream . inplace (MStream.map f) . stream +-- | Apply a function to every index/value pair+imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b+{-# INLINE imap #-}+imap f = unstream . inplace (MStream.map (uncurry f) . MStream.indexed)+ . stream+ concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b {-# INLINE concatMap #-} concatMap f = unstream . Stream.concatMap (stream . f) . stream@@ -431,31 +660,171 @@ -- ----------------- -- | 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+zipWith :: (Vector v a, Vector v b, Vector v c)+ => (a -> b -> c) -> v a -> v b -> v c {-# INLINE zipWith #-} zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) -- | 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+zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d)+ => (a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE zipWith3 #-}-zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs))+zipWith3 f as bs cs = unstream (Stream.zipWith3 f (stream as)+ (stream bs)+ (stream cs)) +zipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e)+ => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e+{-# INLINE zipWith4 #-}+zipWith4 f as bs cs ds+ = unstream (Stream.zipWith4 f (stream as)+ (stream bs)+ (stream cs)+ (stream ds))++zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f)+ => (a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e+ -> v f+{-# INLINE zipWith5 #-}+zipWith5 f as bs cs ds es+ = unstream (Stream.zipWith5 f (stream as)+ (stream bs)+ (stream cs)+ (stream ds)+ (stream es))++zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f, Vector v g)+ => (a -> b -> c -> d -> e -> f -> g)+ -> v a -> v b -> v c -> v d -> v e -> v f -> v g+{-# INLINE zipWith6 #-}+zipWith6 f as bs cs ds es fs+ = unstream (Stream.zipWith6 f (stream as)+ (stream bs)+ (stream cs)+ (stream ds)+ (stream es)+ (stream fs))++-- | Zip two vectors and their indices with the given function.+izipWith :: (Vector v a, Vector v b, Vector v c)+ => (Int -> a -> b -> c) -> v a -> v b -> v c+{-# INLINE izipWith #-}+izipWith f xs ys = unstream+ (Stream.zipWith (uncurry f) (Stream.indexed (stream xs))+ (stream ys))++-- | Zip three vectors and their indices with the given function.+izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d)+ => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d+{-# INLINE izipWith3 #-}+izipWith3 f as bs cs+ = unstream (Stream.zipWith3 (uncurry f) (Stream.indexed (stream as))+ (stream bs)+ (stream cs))++izipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e)+ => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e+{-# INLINE izipWith4 #-}+izipWith4 f as bs cs ds+ = unstream (Stream.zipWith4 (uncurry f) (Stream.indexed (stream as))+ (stream bs)+ (stream cs)+ (stream ds))++izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f)+ => (Int -> a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d+ -> v e -> v f+{-# INLINE izipWith5 #-}+izipWith5 f as bs cs ds es+ = unstream (Stream.zipWith5 (uncurry f) (Stream.indexed (stream as))+ (stream bs)+ (stream cs)+ (stream ds)+ (stream es))++izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f, Vector v g)+ => (Int -> a -> b -> c -> d -> e -> f -> g)+ -> v a -> v b -> v c -> v d -> v e -> v f -> v g+{-# INLINE izipWith6 #-}+izipWith6 f as bs cs ds es fs+ = unstream (Stream.zipWith6 (uncurry f) (Stream.indexed (stream as))+ (stream bs)+ (stream cs)+ (stream ds)+ (stream es)+ (stream fs))+ zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) {-# INLINE zip #-} zip = zipWith (,) -zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v a -> v b -> v c -> v (a, b, c)+zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c))+ => v a -> v b -> v c -> v (a, b, c) {-# INLINE zip3 #-} zip3 = zipWith3 (,,) +zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d))+ => v a -> v b -> v c -> v d -> v (a, b, c, d)+{-# INLINE zip4 #-}+zip4 = zipWith4 (,,,)++zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v (a, b, c, d, e))+ => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e)+{-# INLINE zip5 #-}+zip5 = zipWith5 (,,,,)++zip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f, Vector v (a, b, c, d, e, f))+ => v a -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f)+{-# INLINE zip6 #-}+zip6 = zipWith6 (,,,,,)+ unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) {-# INLINE unzip #-} unzip xs = (map fst xs, map snd xs) -unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v (a, b, c) -> (v a, v b, v c)+unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c))+ => v (a, b, c) -> (v a, v b, v c) {-# INLINE unzip3 #-}-unzip3 xs = (map (\(a, b, c) -> a) xs, map (\(a, b, c) -> b) xs, map (\(a, b, c) -> c) xs)+unzip3 xs = (map (\(a, b, c) -> a) xs,+ map (\(a, b, c) -> b) xs,+ map (\(a, b, c) -> c) xs) +unzip4 :: (Vector v a, Vector v b, Vector v c, Vector v d,+ Vector v (a, b, c, d))+ => v (a, b, c, d) -> (v a, v b, v c, v d)+{-# INLINE unzip4 #-}+unzip4 xs = (map (\(a, b, c, d) -> a) xs,+ map (\(a, b, c, d) -> b) xs,+ map (\(a, b, c, d) -> c) xs,+ map (\(a, b, c, d) -> d) xs)++unzip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v (a, b, c, d, e))+ => v (a, b, c, d, e) -> (v a, v b, v c, v d, v e)+{-# INLINE unzip5 #-}+unzip5 xs = (map (\(a, b, c, d, e) -> a) xs,+ map (\(a, b, c, d, e) -> b) xs,+ map (\(a, b, c, d, e) -> c) xs,+ map (\(a, b, c, d, e) -> d) xs,+ map (\(a, b, c, d, e) -> e) xs)++unzip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e,+ Vector v f, Vector v (a, b, c, d, e, f))+ => v (a, b, c, d, e, f) -> (v a, v b, v c, v d, v e, v f)+{-# INLINE unzip6 #-}+unzip6 xs = (map (\(a, b, c, d, e, f) -> a) xs,+ map (\(a, b, c, d, e, f) -> b) xs,+ map (\(a, b, c, d, e, f) -> c) xs,+ map (\(a, b, c, d, e, f) -> d) xs,+ map (\(a, b, c, d, e, f) -> e) xs,+ map (\(a, b, c, d, e, f) -> f) xs)+ -- Comparisons -- ----------- @@ -470,11 +839,20 @@ -- Filtering -- --------- --- | Drop elements which do not satisfy the predicate+-- | Drop elements that do not satisfy the predicate filter :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE filter #-} filter f = unstream . inplace (MStream.filter f) . stream +-- | Drop elements that do not satisfy the predicate (applied to values and+-- their indices)+ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a+{-# INLINE ifilter #-}+ifilter f = unstream+ . inplace (MStream.map snd . MStream.filter (uncurry f)+ . MStream.indexed)+ . stream+ -- | Yield the longest prefix of elements satisfying the predicate. takeWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE takeWhile #-}@@ -485,6 +863,79 @@ {-# INLINE dropWhile #-} dropWhile f = unstream . Stream.dropWhile f . stream +-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The+-- relative order of the elements is preserved at the cost of a (sometimes)+-- reduced performance compared to 'unstablePartition'.+partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a)+{-# INLINE partition #-}+partition f = partition_stream f . stream++-- FIXME: Make this inplace-fusible (look at how stable_partition is+-- implemented in C++)++partition_stream :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)+{-# INLINE_STREAM partition_stream #-}+partition_stream f s = s `seq` runST (+ do+ (mv1,mv2) <- M.partitionStream f s+ v1 <- unsafeFreeze mv1+ v2 <- unsafeFreeze mv2+ return (v1,v2))++-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The order+-- of the elements is not preserved but the operation is often faster than+-- 'partition'.+unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a)+{-# INLINE unstablePartition #-}+unstablePartition f = unstablePartition_stream f . stream++unstablePartition_stream+ :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)+{-# INLINE_STREAM unstablePartition_stream #-}+unstablePartition_stream f s = s `seq` runST (+ do+ (mv1,mv2) <- M.unstablePartitionStream f s+ v1 <- unsafeFreeze mv1+ v2 <- unsafeFreeze mv2+ return (v1,v2))++unstablePartition_new :: Vector v a => (a -> Bool) -> New a -> (v a, v a)+{-# INLINE_STREAM unstablePartition_new #-}+unstablePartition_new f (New.New p) = runST (+ do+ mv <- p+ i <- M.unstablePartition f mv+ v <- unsafeFreeze mv+ return (unsafeTake i v, unsafeDrop i v))++{-# RULES++"unstablePartition" forall f v p.+ unstablePartition_stream f (stream (new' v p))+ = unstablePartition_new f p++ #-}+++-- FIXME: make span and break fusible++-- | Split the vector into the longest prefix of elements that satisfy the+-- predicate and the rest.+span :: Vector v a => (a -> Bool) -> v a -> (v a, v a)+{-# INLINE span #-}+span f = break (not . f)++-- | Split the vector into the longest prefix of elements that do not satisfy+-- the predicate and the rest.+break :: Vector v a => (a -> Bool) -> v a -> (v a, v a)+{-# INLINE break #-}+break f xs = case findIndex f xs of+ Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs)+ Nothing -> (xs, empty)+ + -- Searching -- --------- @@ -512,6 +963,25 @@ {-# INLINE findIndex #-} findIndex f = Stream.findIndex f . stream +-- | Yield the indices of elements satisfying the predicate+findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int+{-# INLINE findIndices #-}+findIndices f = unstream+ . inplace (MStream.map fst . MStream.filter (f . snd)+ . MStream.indexed)+ . stream++-- | Yield 'Just' the index of the first occurence of the given element or+-- 'Nothing' if the vector does not contain the element+elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int+{-# INLINE elemIndex #-}+elemIndex x = findIndex (x==)++-- | Yield the indices of all occurences of the given element+elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int+{-# INLINE elemIndices #-}+elemIndices x = findIndices (x==)+ -- Folding -- ------- @@ -520,7 +990,7 @@ {-# INLINE foldl #-} foldl f z = Stream.foldl f z . stream --- | Lefgt fold on non-empty vectors+-- | Left fold on non-empty vectors foldl1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-} foldl1 f = Stream.foldl1 f . stream@@ -545,9 +1015,50 @@ {-# INLINE foldr1 #-} foldr1 f = Stream.foldr1 f . stream +-- | Right fold with a strict accumulator+foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b+{-# INLINE foldr' #-}+foldr' f z = Stream.foldl' (flip f) z . streamR++-- | Right fold on non-empty vectors with strict accumulator+foldr1' :: Vector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldr1' #-}+foldr1' f = Stream.foldl1' (flip f) . streamR++-- | Left fold (function applied to each element and its index)+ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a+{-# INLINE ifoldl #-}+ifoldl f z = Stream.foldl (uncurry . f) z . Stream.indexed . stream++-- | Left fold with strict accumulator (function applied to each element and+-- its index)+ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a+{-# INLINE ifoldl' #-}+ifoldl' f z = Stream.foldl' (uncurry . f) z . Stream.indexed . stream++-- | Right fold (function applied to each element and its index)+ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b+{-# INLINE ifoldr #-}+ifoldr f z = Stream.foldr (uncurry f) z . Stream.indexed . stream++-- | Right fold with strict accumulator (function applied to each element and+-- its index)+ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b+{-# INLINE ifoldr' #-}+ifoldr' f z xs = Stream.foldl' (flip (uncurry f)) z+ $ Stream.indexedR (length xs) $ streamR xs+ -- Specialised folds -- ----------------- +all :: Vector v a => (a -> Bool) -> v a -> Bool+{-# INLINE all #-}+all f = Stream.and . Stream.map f . stream++any :: Vector v a => (a -> Bool) -> v a -> Bool+{-# INLINE any #-}+any f = Stream.or . Stream.map f . stream+ and :: Vector v Bool => v Bool -> Bool {-# INLINE and #-} and = Stream.and . stream@@ -568,10 +1079,53 @@ {-# INLINE maximum #-} maximum = Stream.foldl1' max . stream +maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a+{-# INLINE maximumBy #-}+maximumBy cmp = Stream.foldl1' maxBy . stream+ where+ {-# INLINE maxBy #-}+ maxBy x y = case cmp x y of+ LT -> y+ _ -> x+ minimum :: (Vector v a, Ord a) => v a -> a {-# INLINE minimum #-} minimum = Stream.foldl1' min . stream +minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a+{-# INLINE minimumBy #-}+minimumBy cmp = Stream.foldl1' minBy . stream+ where+ {-# INLINE minBy #-}+ minBy x y = case cmp x y of+ GT -> y+ _ -> x++maxIndex :: (Vector v a, Ord a) => v a -> Int+{-# INLINE maxIndex #-}+maxIndex = maxIndexBy compare++maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int+{-# INLINE maxIndexBy #-}+maxIndexBy cmp = fst . Stream.foldl1' imax . Stream.indexed . stream+ where+ imax (i,x) (j,y) = case cmp x y of+ LT -> (j,y)+ _ -> (i,x)++minIndex :: (Vector v a, Ord a) => v a -> Int+{-# INLINE minIndex #-}+minIndex = minIndexBy compare++minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int+{-# INLINE minIndexBy #-}+minIndexBy cmp = fst . Stream.foldl1' imin . Stream.indexed . stream+ where+ imin (i,x) (j,y) = case cmp x y of+ GT -> (j,y)+ _ -> (i,x)++ -- Unfolding -- --------- @@ -585,22 +1139,22 @@ -- | Prefix scan prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl #-}-prescanl f z = unstream . inplace' (MStream.prescanl f z) . stream+prescanl f z = unstream . inplace (MStream.prescanl f z) . stream -- | Prefix scan with strict accumulator prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl' #-}-prescanl' f z = unstream . inplace' (MStream.prescanl' f z) . stream+prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream -- | Suffix scan postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl #-}-postscanl f z = unstream . inplace' (MStream.postscanl f z) . stream+postscanl f z = unstream . inplace (MStream.postscanl f z) . stream -- | Suffix scan with strict accumulator postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl' #-}-postscanl' f z = unstream . inplace' (MStream.postscanl' f z) . stream+postscanl' f z = unstream . inplace (MStream.postscanl' f z) . stream -- | Haskell-style scan scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a@@ -622,20 +1176,81 @@ {-# INLINE scanl1' #-} scanl1' f = unstream . inplace (MStream.scanl1' f) . stream ++-- | Prefix right-to-left scan+prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE prescanr #-}+prescanr f z = unstreamR . inplace (MStream.prescanl (flip f) z) . streamR++-- | Prefix right-to-left scan with strict accumulator+prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE prescanr' #-}+prescanr' f z = unstreamR . inplace (MStream.prescanl' (flip f) z) . streamR++-- | Suffix right-to-left scan+postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE postscanr #-}+postscanr f z = unstreamR . inplace (MStream.postscanl (flip f) z) . streamR++-- | Suffix right-to-left scan with strict accumulator+postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE postscanr' #-}+postscanr' f z = unstreamR . inplace (MStream.postscanl' (flip f) z) . streamR++-- | Haskell-style right-to-left scan+scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE scanr #-}+scanr f z = unstreamR . Stream.scanl (flip f) z . streamR++-- | Haskell-style right-to-left scan with strict accumulator+scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b+{-# INLINE scanr' #-}+scanr' f z = unstreamR . Stream.scanl' (flip f) z . streamR++-- | Right-to-left scan over a non-empty vector+scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a+{-# INLINE scanr1 #-}+scanr1 f = unstreamR . inplace (MStream.scanl1 (flip f)) . streamR++-- | Right-to-left scan over a non-empty vector with a strict accumulator+scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a+{-# INLINE scanr1' #-}+scanr1' f = unstreamR . inplace (MStream.scanl1' (flip f)) . streamR+ -- Enumeration -- ----------- --- FIXME: The Enum class is irreparably broken, there just doesn't seem to be a--- way to implement this generically. Either specialise this or define a new--- Enum-like class with a proper interface.+-- | Yield a vector of the given length containing the values @x@, @x+1@ etc.+-- This operation is usually more efficient than 'enumFromTo'.+enumFromN :: (Vector v a, Num a) => a -> Int -> v a+{-# INLINE enumFromN #-}+enumFromN x n = enumFromStepN x 1 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 :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a+{-# INLINE enumFromStepN #-}+enumFromStepN x y n = elemseq (undefined :: v a) x+ $ elemseq (undefined :: v a) y+ $ unstream+ $ Stream.enumFromStepN x y n++-- | Enumerate values from @x@ to @y@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromN' instead. enumFromTo :: (Vector v a, Enum a) => a -> a -> v a {-# INLINE enumFromTo #-}-enumFromTo from to = fromList [from .. to]+enumFromTo x y = unstream (Stream.enumFromTo x y) +-- | Enumerate values from @x@ to @y@ with a specific step @z@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead. enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a {-# INLINE enumFromThenTo #-}-enumFromThenTo from next to = fromList [from, next .. to]+enumFromThenTo x y z = unstream (Stream.enumFromThenTo x y z) -- | Convert a vector to a list toList :: Vector v a => v a -> [a]
Data/Vector/Generic/Mutable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses, BangPatterns, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Generic.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2009@@ -11,14 +11,24 @@ -- Generic interface to mutable vectors -- -#include "phases.h"- module Data.Vector.Generic.Mutable (- MVectorPure(..), MVector(..),+ -- * Class of mutable vector types+ MVector(..), - slice, new, newWith, read, write, copy, grow,- unstream, transform,- accum, update, reverse+ -- * Operations on mutable vectors+ length, overlaps, new, newWith, read, write, swap, clear, set, copy, grow,++ slice, take, drop, init, tail,+ unsafeSlice, unsafeInit, unsafeTail,++ -- * Unsafe operations+ unsafeNew, unsafeNewWith, unsafeRead, unsafeWrite, unsafeSwap,+ unsafeCopy, unsafeGrow,++ -- * Internal operations+ unstream, transform, unstreamR, transformR,+ unsafeAccum, accum, unsafeUpdate, update, reverse,+ unstablePartition, unstablePartitionStream, partitionStream ) where import qualified Data.Vector.Fusion.Stream as Stream@@ -26,147 +36,154 @@ import qualified Data.Vector.Fusion.Stream.Monadic as MStream import Data.Vector.Fusion.Stream.Size -import Control.Exception ( assert )+import Control.Monad.Primitive ( PrimMonad, PrimState ) import GHC.Float ( double2Int, int2Double ) -import Prelude hiding ( length, reverse, map, read )+import Prelude hiding ( length, reverse, map, read,+ take, drop, init, tail ) -gROWTH_FACTOR :: Double-gROWTH_FACTOR = 1.5+#include "vector.h" --- | Basic pure functions on mutable vectors-class MVectorPure v a where- -- | Length of the mutable vector- length :: v a -> Int+-- | Class of mutable vectors parametrised with a primitive state token.+--+class MVector v a where+ -- | Length of the mutable vector. This method should not be+ -- called directly, use 'length' instead.+ basicLength :: v s a -> Int - -- | Yield a part of the mutable vector without copying it. No range checks!- unsafeSlice :: v a -> Int -- ^ starting index- -> Int -- ^ length of the slice- -> v a+ -- | Yield a part of the mutable vector without copying it. This method+ -- should not be called directly, use 'unsafeSlice' instead.+ basicUnsafeSlice :: Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> v s a+ -> v s a - -- Check whether two vectors overlap.- overlaps :: v a -> v a -> Bool+ -- Check whether two vectors overlap. This method should not be+ -- called directly, use 'overlaps' instead.+ basicOverlaps :: v s a -> v s a -> Bool --- | Class of mutable vectors. The type @m@ is the monad in which the mutable--- vector can be transformed and @a@ is the type of elements.----class (Monad m, MVectorPure v a) => MVector v m a where- -- | Create a mutable vector of the given length. Length is not checked!- unsafeNew :: Int -> m (v a)+ -- | Create a mutable vector of the given length. This method should not be+ -- called directly, use 'unsafeNew' instead.+ basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) -- | Create a mutable vector of the given length and fill it with an- -- initial value. Length is not checked!- unsafeNewWith :: Int -> a -> m (v a)+ -- initial value. This method should not be called directly, use+ -- 'unsafeNewWith' instead.+ basicUnsafeNewWith :: PrimMonad m => Int -> a -> m (v (PrimState m) a) - -- | Yield the element at the given position. Index is not checked!- unsafeRead :: v a -> Int -> m a+ -- | Yield the element at the given position. This method should not be+ -- called directly, use 'unsafeRead' instead.+ basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a - -- | Replace the element at the given position. Index is not checked!- unsafeWrite :: v a -> Int -> a -> m ()+ -- | Replace the element at the given position. This method should not be+ -- called directly, use 'unsafeWrite' instead.+ basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () - -- | Clear all references to external objects- clear :: v a -> m ()+ -- | Reset all elements of the vector to some undefined value, clearing all+ -- references to external objects. This is usually a noop for unboxed+ -- vectors. This method should not be called directly, use 'clear' instead.+ basicClear :: PrimMonad m => v (PrimState m) a -> m () - -- | Write the value at each position.- set :: v a -> a -> m ()+ -- | Set all elements of the vector to the given value. This method should+ -- not be called directly, use 'set' instead.+ basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () - -- | Copy a vector. The two vectors may not overlap. This is not checked!- unsafeCopy :: v a -- ^ target- -> v a -- ^ source- -> m ()+ -- | Copy a vector. The two vectors may not overlap. This method should not+ -- be called directly, use 'unsafeCopy' instead.+ basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target+ -> v (PrimState m) a -- ^ source+ -> m () - -- | Grow a vector by the given number of elements. The length is not- -- checked!- unsafeGrow :: v a -> Int -> m (v a)+ -- | Grow a vector by the given number of elements. This method should not be+ -- called directly, use 'unsafeGrow' instead.+ basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int+ -> m (v (PrimState m) a) - {-# INLINE unsafeNewWith #-}- unsafeNewWith n x = do- v <- unsafeNew n- set v x- return v+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n x+ = do+ v <- basicUnsafeNew n+ basicSet v x+ return v - {-# INLINE set #-}- set v x = do_set 0+ {-# INLINE basicClear #-}+ basicClear _ = return ()++ {-# INLINE basicSet #-}+ basicSet v x = do_set 0 where- n = length v+ n = basicLength v do_set i | i < n = do- unsafeWrite v i x- do_set (i+1)+ basicUnsafeWrite v i x+ do_set (i+1) | otherwise = return () - {-# INLINE unsafeCopy #-}- unsafeCopy dst src = do_copy 0+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy dst src = do_copy 0 where- n = length src+ n = basicLength src do_copy i | i < n = do- x <- unsafeRead src i- unsafeWrite dst i x+ x <- basicUnsafeRead src i+ basicUnsafeWrite dst i x do_copy (i+1) | otherwise = return () - {-# INLINE unsafeGrow #-}- unsafeGrow v by = do- v' <- unsafeNew (n+by)- unsafeCopy (unsafeSlice v' 0 n) v- return v'+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow v by+ = do+ v' <- basicUnsafeNew (n+by)+ basicUnsafeCopy (basicUnsafeSlice 0 n v') v+ return v' where- n = length v---- | Test whether the index is valid for the vector-inBounds :: MVectorPure v a => v a -> Int -> Bool-{-# INLINE inBounds #-}-inBounds v i = i >= 0 && i < length v---- | Yield a part of the mutable vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: MVectorPure v a => v a -> Int -> Int -> v a-{-# INLINE slice #-}-slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)- $ unsafeSlice v i n---- | Create a mutable vector of the given length. Safer version of--- 'unsafeNew'.-new :: MVector v m a => Int -> m (v a)-{-# INLINE new #-}-new n = assert (n >= 0) $ unsafeNew n---- | Create a mutable vector of the given length and fill it with an--- initial value. Safer version of 'unsafeNewWith'.-newWith :: MVector v m a => Int -> a -> m (v a)-{-# INLINE newWith #-}-newWith n x = assert (n >= 0) $ unsafeNewWith n x+ n = basicLength v --- | Yield the element at the given position. Safer version of 'unsafeRead'.-read :: MVector v m a => v a -> Int -> m a-{-# INLINE read #-}-read v i = assert (inBounds v i) $ unsafeRead v i+-- ------------------+-- Internal functions+-- ------------------ --- | Replace the element at the given position. Safer version of--- 'unsafeWrite'.-write :: MVector v m a => v a -> Int -> a -> m ()-{-# INLINE write #-}-write v i x = assert (inBounds v i) $ unsafeWrite v i x+-- Check whether two vectors overlap.+overlaps :: MVector v a => v s a -> v s a -> Bool+{-# INLINE overlaps #-}+overlaps = basicOverlaps --- | Copy a vector. The two vectors may not overlap. Safer version of--- 'unsafeCopy'.-copy :: MVector v m a => v a -> v a -> m ()-{-# INLINE copy #-}-copy dst src = assert (not (dst `overlaps` src) && length dst == length src)- $ unsafeCopy dst src+unsafeAppend1 :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a)+{-# INLINE_INNER unsafeAppend1 #-}+ -- NOTE: The case distinction has to be on the outside because+ -- GHC creates a join point for the unsafeWrite even when everything+ -- is inlined. This is bad because with the join point, v isn't getting+ -- unboxed.+unsafeAppend1 v i x+ | i < length v = do+ unsafeWrite v i x+ return v+ | otherwise = do+ v' <- enlarge v+ INTERNAL_CHECK(checkIndex) "unsafeAppend1" i (length v')+ $ unsafeWrite v' i x+ return v' --- | Grow a vector by the given number of elements. Safer version of--- 'unsafeGrow'.-grow :: MVector v m a => v a -> Int -> m (v a)-{-# INLINE grow #-}-grow v by = assert (by >= 0)- $ unsafeGrow v by+unsafePrepend1 :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int)+{-# INLINE_INNER unsafePrepend1 #-}+unsafePrepend1 v i x+ | i /= 0 = do+ let i' = i-1+ unsafeWrite v i' x+ return (v, i')+ | otherwise = do+ (v', i) <- enlargeFront v+ let i' = i-1+ INTERNAL_CHECK(checkIndex) "unsafePrepend1" i' (length v')+ $ unsafeWrite v' i' x+ return (v', i') -mstream :: MVector v m a => v a -> MStream m a+mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a {-# INLINE mstream #-} mstream v = v `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n) where@@ -177,80 +194,562 @@ return $ Just (x, i+1) | otherwise = return $ Nothing -munstream :: MVector v m a => v a -> MStream m a -> m (v a)+munstream :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) {-# INLINE munstream #-} munstream v s = v `seq` do n' <- MStream.foldM put 0 s- return $ slice v 0 n'+ return $ unsafeSlice 0 n' v where {-# INLINE_INNER put #-}- put i x = do { write v i x; return (i+1) }+ put i x = do+ INTERNAL_CHECK(checkIndex) "munstream" i (length v)+ $ unsafeWrite v i x+ return (i+1) -transform :: MVector v m a => (MStream m a -> MStream m a) -> v a -> m (v a)+transform :: (PrimMonad m, MVector v a)+ => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_STREAM transform #-} transform f v = munstream v (f (mstream v)) +mrstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a+{-# INLINE mrstream #-}+mrstream v = v `seq` (MStream.unfoldrM get n `MStream.sized` Exact n)+ where+ n = length v++ {-# INLINE_INNER get #-}+ get i | j >= 0 = do x <- unsafeRead v j+ return $ Just (x,j)+ | otherwise = return Nothing+ where+ j = i-1++munstreamR :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a)+{-# INLINE munstreamR #-}+munstreamR v s = v `seq` do+ i <- MStream.foldM put n s+ return $ unsafeSlice i (n-i) v+ where+ n = length v++ {-# INLINE_INNER put #-}+ put i x = do+ unsafeWrite v j x+ return j+ where+ j = i-1++transformR :: (PrimMonad m, MVector v a)+ => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE_STREAM transformR #-}+transformR f v = munstreamR v (f (mrstream v))+ -- | Create a new mutable vector and fill it with elements from the 'Stream'. -- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is -- inexact.-unstream :: MVector v m a => Stream a -> m (v a)+unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) {-# INLINE_STREAM unstream #-} unstream s = case upperBound (Stream.size s) of Just n -> unstreamMax s n Nothing -> unstreamUnknown s -unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)+-- FIXME: I can't think of how to prevent GHC from floating out+-- unstreamUnknown. That is bad because SpecConstr then generates two+-- specialisations: one for when it is called from unstream (it doesn't know+-- the shape of the vector) and one for when the vector has grown. To see the+-- problem simply compile this:+--+-- fromList = Data.Vector.Unboxed.unstream . Stream.fromList+--++unstreamMax+ :: (PrimMonad m, MVector v a) => Stream a -> Int -> m (v (PrimState m) a) {-# INLINE unstreamMax #-} unstreamMax s n = do- v <- new n- let put i x = do { write v i x; return (i+1) }+ v <- INTERNAL_CHECK(checkLength) "unstreamMax" n+ $ unsafeNew n+ let put i x = do+ INTERNAL_CHECK(checkIndex) "unstreamMax" i n+ $ unsafeWrite v i x+ return (i+1) n' <- Stream.foldM' put 0 s- return $ slice v 0 n'+ return $ INTERNAL_CHECK(checkSlice) "unstreamMax" 0 n' n+ $ unsafeSlice 0 n' v -unstreamUnknown :: MVector v m a => Stream a -> m (v a)+unstreamUnknown+ :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) {-# INLINE unstreamUnknown #-} unstreamUnknown s = do- v <- new 0+ v <- unsafeNew 0 (v', n) <- Stream.foldM put (v, 0) s- return $ slice v' 0 n+ return $ INTERNAL_CHECK(checkSlice) "unstreamUnknown" 0 n (length v')+ $ unsafeSlice 0 n v' where {-# INLINE_INNER put #-}- put (v, i) x = do- v' <- enlarge v i- unsafeWrite v' i x- return (v', i+1)+ put (v,i) x = do+ v' <- unsafeAppend1 v i x+ return (v',i+1) - {-# INLINE_INNER enlarge #-}- enlarge v i | i < length v = return v- | otherwise = unsafeGrow v- . max 1- . double2Int- $ int2Double (length v) * gROWTH_FACTOR+-- | Create a new mutable vector and fill it with elements from the 'Stream'.+-- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is+-- inexact.+unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+{-# INLINE_STREAM unstreamR #-}+unstreamR s = case upperBound (Stream.size s) of+ Just n -> unstreamRMax s n+ Nothing -> unstreamRUnknown s -accum :: MVector v m a => (a -> b -> a) -> v a -> Stream (Int, b) -> m ()+unstreamRMax+ :: (PrimMonad m, MVector v a) => Stream a -> Int -> m (v (PrimState m) a)+{-# INLINE unstreamRMax #-}+unstreamRMax s n+ = do+ v <- INTERNAL_CHECK(checkLength) "unstreamRMax" n+ $ unsafeNew n+ let put i x = do+ let i' = i-1+ INTERNAL_CHECK(checkIndex) "unstreamRMax" i' n+ $ unsafeWrite v i' x+ return i'+ i <- Stream.foldM' put n s+ return $ INTERNAL_CHECK(checkSlice) "unstreamRMax" i (n-i) n+ $ unsafeSlice i (n-i) v++unstreamRUnknown+ :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+{-# INLINE unstreamRUnknown #-}+unstreamRUnknown s+ = do+ v <- unsafeNew 0+ (v', i) <- Stream.foldM put (v, 0) s+ let n = length v'+ return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n+ $ unsafeSlice i (n-i) v'+ where+ {-# INLINE_INNER put #-}+ put (v,i) x = unsafePrepend1 v i x++-- Length+-- ------++-- | Length of the mutable vector.+length :: MVector v a => v s a -> Int+{-# INLINE length #-}+length = basicLength++-- | Check whether the vector is empty+null :: MVector v a => v s a -> Bool+{-# INLINE null #-}+null v = length v == 0+++-- Construction+-- ------------++-- | Create a mutable vector of the given length.+new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a)+{-# INLINE new #-}+new n = BOUNDS_CHECK(checkLength) "new" n+ $ unsafeNew n++-- | Create a mutable vector of the given length and fill it with an+-- initial value.+newWith :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a)+{-# INLINE newWith #-}+newWith n x = BOUNDS_CHECK(checkLength) "newWith" n+ $ unsafeNewWith n x++-- | 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)+{-# INLINE unsafeNew #-}+unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n+ $ basicUnsafeNew n++-- | Create a mutable vector of the given length and fill it with an+-- initial value. The length is not checked.+unsafeNewWith :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith n x = UNSAFE_CHECK(checkLength) "unsafeNewWith" n+ $ basicUnsafeNewWith n x+++-- Growing+-- -------++-- | Grow a vector by the given number of elements. The number must be+-- positive.+grow :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> m (v (PrimState m) a)+{-# INLINE grow #-}+grow v by = BOUNDS_CHECK(checkLength) "grow" by+ $ unsafeGrow v by++growFront :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> m (v (PrimState m) a)+{-# INLINE growFront #-}+growFront v by = BOUNDS_CHECK(checkLength) "growFront" by+ $ unsafeGrowFront v by++enlarge_delta v = max (length v) 1++-- | Grow a vector logarithmically+enlarge :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE enlarge #-}+enlarge v = unsafeGrow v (enlarge_delta v)++enlargeFront :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> m (v (PrimState m) a, Int)+{-# INLINE enlargeFront #-}+enlargeFront v = do+ v' <- unsafeGrowFront v by+ return (v', by)+ where+ by = enlarge_delta v++-- | Grow a vector by the given number of elements. The number must be+-- positive but this is not checked.+unsafeGrow :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> m (v (PrimState m) a)+{-# INLINE unsafeGrow #-}+unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n+ $ basicUnsafeGrow v n++unsafeGrowFront :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> m (v (PrimState m) a)+{-# INLINE unsafeGrowFront #-}+unsafeGrowFront v by = UNSAFE_CHECK(checkLength) "unsafeGrowFront" by+ $ do+ let n = length v+ v' <- basicUnsafeNew (by+n)+ basicUnsafeCopy (basicUnsafeSlice by n v') v+ return v'++-- Accessing individual elements+-- -----------------------------++-- | Yield the element at the given position.+read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read v i = BOUNDS_CHECK(checkIndex) "read" i (length v)+ $ unsafeRead v i++-- | Replace the element at the given position.+write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write v i x = BOUNDS_CHECK(checkIndex) "write" i (length v)+ $ unsafeWrite v i x++-- | Swap the elements at the given positions.+swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m ()+{-# INLINE swap #-}+swap v i j = BOUNDS_CHECK(checkIndex) "swap" i (length v)+ $ BOUNDS_CHECK(checkIndex) "swap" j (length v)+ $ unsafeSwap v i j++-- | Replace the element at the give position and return the old element.+exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a+{-# INLINE exchange #-}+exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v)+ $ unsafeExchange v i x++-- | Yield the element at the given position. No bounds checks are performed.+unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead v i = UNSAFE_CHECK(checkIndex) "unsafeRead" i (length v)+ $ basicUnsafeRead v i++-- | Replace the element at the given position. No bounds checks are performed.+unsafeWrite :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite v i x = UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v)+ $ basicUnsafeWrite v i x++-- | Swap the elements at the given positions. No bounds checks are performed.+unsafeSwap :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> Int -> m ()+{-# INLINE unsafeSwap #-}+unsafeSwap v i j = UNSAFE_CHECK(checkIndex) "unsafeSwap" i (length v)+ $ UNSAFE_CHECK(checkIndex) "unsafeSwap" j (length v)+ $ do+ x <- unsafeRead v i+ y <- unsafeRead v j+ unsafeWrite v i y+ unsafeWrite v j x++-- | Replace the element at the give position and return the old element. No+-- bounds checks are performed.+unsafeExchange :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Int -> a -> m a+{-# INLINE unsafeExchange #-}+unsafeExchange v i x = UNSAFE_CHECK(checkIndex) "unsafeExchange" i (length v)+ $ do+ y <- unsafeRead v i+ unsafeWrite v i x+ return y++-- Block operations+-- ----------------++-- | Reset all elements of the vector to some undefined value, clearing all+-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m ()+{-# INLINE clear #-}+clear = basicClear++-- | Set all elements of the vector to the given value.+set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m ()+{-# INLINE set #-}+set = basicSet++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap.+copy :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> v (PrimState m) a -> m ()+{-# INLINE copy #-}+copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors"+ (not (dst `overlaps` src))+ $ BOUNDS_CHECK(check) "copy" "length mismatch"+ (length dst == length src)+ $ unsafeCopy dst src++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap. This is not checked.+unsafeCopy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target+ -> v (PrimState m) a -- ^ source+ -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch"+ (length dst == length src)+ $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors"+ (not (dst `overlaps` src))+ $ basicUnsafeCopy dst src++-- Subvectors+-- ----------++-- | Yield a part of the mutable vector without copying it.+slice :: MVector v a => Int -> Int -> v s a -> v s a+{-# INLINE slice #-}+slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v)+ $ unsafeSlice i n v++take :: MVector v a => Int -> v s a -> v s a+{-# INLINE take #-}+take n v = unsafeSlice 0 (min (max n 0) (length v)) v++drop :: MVector v a => Int -> v s a -> v s a+{-# INLINE drop #-}+drop n v = unsafeSlice (min m n') (max 0 (m - n')) v+ where+ n' = max n 0+ m = length v++init :: MVector v a => v s a -> v s a+{-# INLINE init #-}+init v = slice 0 (length v - 1) v++tail :: MVector v a => v s a -> v s a+{-# INLINE tail #-}+tail v = slice 1 (length v - 1) v++-- | Yield a part of the mutable vector without copying it. No bounds checks+-- are performed.+unsafeSlice :: MVector v a => Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> v s a+ -> v s a+{-# INLINE unsafeSlice #-}+unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v)+ $ basicUnsafeSlice i n v++unsafeInit :: MVector v a => v s a -> v s a+{-# INLINE unsafeInit #-}+unsafeInit v = unsafeSlice 0 (length v - 1) v++unsafeTail :: MVector v a => v s a -> v s a+{-# INLINE unsafeTail #-}+unsafeTail v = unsafeSlice 1 (length v - 1) v++unsafeTake :: MVector v a => Int -> v s a -> v s a+{-# INLINE unsafeTake #-}+unsafeTake n v = unsafeSlice 0 n v++unsafeDrop :: MVector v a => Int -> v s a -> v s a+{-# INLINE unsafeDrop #-}+unsafeDrop n v = unsafeSlice n (length v - n) v++-- Permutations+-- ------------++accum :: (PrimMonad m, MVector v a)+ => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () {-# INLINE accum #-} accum f !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = do- a <- read v i- write v i (f a b)+ a <- BOUNDS_CHECK(checkIndex) "accum" i (length v)+ $ unsafeRead v i+ unsafeWrite v i (f a b) -update :: MVector v m a => v a -> Stream (Int, a) -> m ()+update :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Stream (Int, a) -> m () {-# INLINE update #-}-update = accum (const id)+update !v s = Stream.mapM_ upd s+ where+ {-# INLINE_INNER upd #-}+ upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i (length v)+ $ unsafeWrite v i b -reverse :: MVector v m a => v a -> m ()+unsafeAccum :: (PrimMonad m, MVector v a)+ => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m ()+{-# INLINE unsafeAccum #-}+unsafeAccum f !v s = Stream.mapM_ upd s+ where+ {-# INLINE_INNER upd #-}+ upd (i,b) = do+ a <- UNSAFE_CHECK(checkIndex) "accum" i (length v)+ $ unsafeRead v i+ unsafeWrite v i (f a b)++unsafeUpdate :: (PrimMonad m, MVector v a)+ => v (PrimState m) a -> Stream (Int, a) -> m ()+{-# INLINE unsafeUpdate #-}+unsafeUpdate !v s = Stream.mapM_ upd s+ where+ {-# INLINE_INNER upd #-}+ upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i (length v)+ $ unsafeWrite v i b++reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () {-# INLINE reverse #-} reverse !v = reverse_loop 0 (length v - 1) where reverse_loop i j | i < j = do- x <- unsafeRead v i- y <- unsafeRead v j- unsafeWrite v i y- unsafeWrite v j x+ unsafeSwap v i j reverse_loop (i + 1) (j - 1) reverse_loop _ _ = return ()++unstablePartition :: forall m v a. (PrimMonad m, MVector v a)+ => (a -> Bool) -> v (PrimState m) a -> m Int+{-# INLINE unstablePartition #-}+unstablePartition f !v = from_left 0 (length v)+ where+ -- NOTE: GHC 6.10.4 panics without the signatures on from_left and+ -- from_right+ from_left :: Int -> Int -> m Int+ from_left i j+ | i == j = return i+ | otherwise = do+ x <- unsafeRead v i+ if f x+ then from_left (i+1) j+ else from_right i (j-1)++ from_right :: Int -> Int -> m Int+ from_right i j+ | i == j = return i+ | otherwise = do+ x <- unsafeRead v j+ if f x+ then do+ y <- unsafeRead v i+ unsafeWrite v i x+ unsafeWrite v j y+ from_left (i+1) j+ else from_right i (j-1)++unstablePartitionStream :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE unstablePartitionStream #-}+unstablePartitionStream f s+ = case upperBound (Stream.size s) of+ Just n -> unstablePartitionMax f s n+ Nothing -> partitionUnknown f s++unstablePartitionMax :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> Int+ -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE unstablePartitionMax #-}+unstablePartitionMax f s n+ = do+ v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n+ $ unsafeNew n+ let {-# INLINE_INNER put #-}+ put (i, j) x+ | f x = do+ unsafeWrite v i x+ return (i+1, j)+ | otherwise = do+ unsafeWrite v (j-1) x+ return (i, j-1)+ + (i,j) <- Stream.foldM' put (0, n) s+ return (unsafeSlice 0 i v, unsafeSlice j (n-j) v)++partitionStream :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE partitionStream #-}+partitionStream f s+ = case upperBound (Stream.size s) of+ Just n -> partitionMax f s n+ Nothing -> partitionUnknown f s++partitionMax :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE partitionMax #-}+partitionMax f s n+ = do+ v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n+ $ unsafeNew n++ let {-# INLINE_INNER put #-}+ put (i,j) x+ | f x = do+ unsafeWrite v i x+ return (i+1,j)++ | otherwise = let j' = j-1 in+ do+ unsafeWrite v j' x+ return (i,j') + + (i,j) <- Stream.foldM' put (0,n) s+ INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j)+ $ return ()+ let l = unsafeSlice 0 i v+ r = unsafeSlice j (n-j) v+ reverse r+ return (l,r)++partitionUnknown :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE partitionUnknown #-}+partitionUnknown f s+ = do+ v1 <- unsafeNew 0+ v2 <- unsafeNew 0+ (v1', n1, v2', n2) <- Stream.foldM' put (v1, 0, v2, 0) s+ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1')+ $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2')+ $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2')+ where+ -- NOTE: The case distinction has to be on the outside because+ -- GHC creates a join point for the unsafeWrite even when everything+ -- is inlined. This is bad because with the join point, v isn't getting+ -- unboxed.+ {-# INLINE_INNER put #-}+ put (v1, i1, v2, i2) x+ | f x = do+ v1' <- unsafeAppend1 v1 i1 x+ return (v1', i1+1, v2, i2)+ | otherwise = do+ v2' <- unsafeAppend1 v2 i2 x+ return (v1, i1, v2', i2+1)
Data/Vector/Generic/New.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE Rank2Types, FlexibleContexts #-} -- | -- Module : Data.Vector.Generic.New@@ -12,39 +12,43 @@ -- Purely functional interface to initialisation of mutable vectors -- -#include "phases.h"- module Data.Vector.Generic.New (- New(..), run, unstream, transform, accum, update, reverse,- slice, init, tail, take, drop+ New(..), run, unstream, transform, unstreamR, transformR,+ accum, update, reverse,+ slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail,+ unsafeAccum, unsafeUpdate ) where import qualified Data.Vector.Generic.Mutable as MVector-import Data.Vector.Generic.Mutable ( MVector, MVectorPure )+import Data.Vector.Generic.Mutable ( MVector ) import Data.Vector.Fusion.Stream ( Stream, MStream ) import qualified Data.Vector.Fusion.Stream as Stream +import Control.Monad.ST ( ST ) import Control.Monad ( liftM ) import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) -newtype New a = New (forall m mv. MVector mv m a => m (mv a))+#include "vector.h" -run :: MVector mv m a => New a -> m (mv a)+data New a = New (forall mv s. MVector mv a => ST s (mv s a))++run :: MVector mv a => New a -> ST s (mv s a) {-# INLINE run #-} run (New p) = p -apply :: (forall mv a. MVectorPure mv a => mv a -> mv a) -> New a -> New a+apply :: (forall mv s a. MVector mv a => mv s a -> mv s a) -> New a -> New a {-# INLINE apply #-} apply f (New p) = New (liftM f p) -modify :: New a -> (forall m mv. MVector mv m a => mv a -> m ()) -> New a+modify :: New a -> (forall mv s. MVector mv a => mv s a -> ST s ()) -> New a {-# INLINE modify #-} modify (New p) q = New (do { v <- p; q v; return v }) unstream :: Stream a -> New a {-# INLINE_STREAM unstream #-}-unstream s = New (MVector.unstream s)+unstream s = s `seq` New (MVector.unstream s) transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a {-# INLINE_STREAM transform #-}@@ -65,30 +69,66 @@ #-} -slice :: New a -> Int -> Int -> New a++unstreamR :: Stream a -> New a+{-# INLINE_STREAM unstreamR #-}+unstreamR s = s `seq` New (MVector.unstreamR s)++transformR :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a+{-# INLINE_STREAM transformR #-}+transformR f (New p) = New (MVector.transformR f =<< p)++{-# RULES++"transformR/transformR [New]"+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ (g :: forall m. Monad m => MStream m a -> MStream m a)+ p .+ transformR f (transformR g p) = transformR (f . g) p++"transformR/unstreamR [New]"+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ s.+ transformR f (unstreamR s) = unstreamR (f s)++ #-}++slice :: Int -> Int -> New a -> New a {-# INLINE_STREAM slice #-}-slice m i n = apply (\v -> MVector.slice v i n) m+slice i n m = apply (MVector.slice i n) m init :: New a -> New a {-# INLINE_STREAM init #-}-init m = apply (\v -> MVector.slice v 0 (MVector.length v - 1)) m+init m = apply MVector.init m tail :: New a -> New a {-# INLINE_STREAM tail #-}-tail m = apply (\v -> MVector.slice v 1 (MVector.length v - 1)) m+tail m = apply MVector.tail m take :: Int -> New a -> New a {-# INLINE_STREAM take #-}-take n m = apply (\v -> MVector.slice v 0 (min n (MVector.length v))) m+take n m = apply (MVector.take n) m drop :: Int -> New a -> New a {-# INLINE_STREAM drop #-}-drop n m = apply (\v -> MVector.slice v n (max 0 (MVector.length v - n))) m+drop n m = apply (MVector.drop n) m +unsafeSlice :: Int -> Int -> New a -> New a+{-# INLINE_STREAM unsafeSlice #-}+unsafeSlice i n m = apply (MVector.unsafeSlice i n) m++unsafeInit :: New a -> New a+{-# INLINE_STREAM unsafeInit #-}+unsafeInit m = apply MVector.unsafeInit m++unsafeTail :: New a -> New a+{-# INLINE_STREAM unsafeTail #-}+unsafeTail m = apply MVector.unsafeTail m+ {-# RULES -"slice/unstream [New]" forall s i n.- slice (unstream s) i n = unstream (Stream.extract s i n)+"slice/unstream [New]" forall i n s.+ slice i n (unstream s) = unstream (Stream.slice i n s) "init/unstream [New]" forall s. init (unstream s) = unstream (Stream.init s)@@ -102,15 +142,32 @@ "drop/unstream [New]" forall n s. drop n (unstream s) = unstream (Stream.drop n s) +"unsafeSlice/unstream [New]" forall i n s.+ unsafeSlice i n (unstream s) = unstream (Stream.slice i n s)++"unsafeInit/unstream [New]" forall s.+ unsafeInit (unstream s) = unstream (Stream.init s)++"unsafeTail/unstream [New]" forall s.+ unsafeTail (unstream s) = unstream (Stream.tail s)+ #-} +unsafeAccum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a+{-# INLINE_STREAM unsafeAccum #-}+unsafeAccum f m s = s `seq` modify m (\v -> MVector.unsafeAccum f v s)+ accum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a {-# INLINE_STREAM accum #-}-accum f m s = modify m (\v -> MVector.accum f v s)+accum f m s = s `seq` modify m (\v -> MVector.accum f v s) +unsafeUpdate :: New a -> Stream (Int, a) -> New a+{-# INLINE_STREAM unsafeUpdate #-}+unsafeUpdate m s = s `seq` modify m (\v -> MVector.unsafeUpdate v s)+ update :: New a -> Stream (Int, a) -> New a {-# INLINE_STREAM update #-}-update m s = modify m (\v -> MVector.update v s)+update m s = s `seq` modify m (\v -> MVector.update v s) reverse :: New a -> New a {-# INLINE_STREAM reverse #-}
+ Data/Vector/Internal/Check.hs view
@@ -0,0 +1,109 @@+-- |+-- Module : Data.Vector.Internal.Check+-- Copyright : (c) Roman Leshchinskiy 2009+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable+--+-- Bounds checking infrastructure+--++module Data.Vector.Internal.Check (+ Checks(..), doChecks,++ error, emptyStream,+ check, assert, checkIndex, checkLength, checkSlice+) where++import Prelude hiding( error )+import qualified Prelude as P++data Checks = Bounds | Unsafe | Internal deriving( Eq )++doBoundsChecks :: Bool+#ifdef VECTOR_BOUNDS_CHECKS+doBoundsChecks = True+#else+doBoundsChecks = False+#endif++doUnsafeChecks :: Bool+#ifdef VECTOR_UNSAFE_CHECKS+doUnsafeChecks = True+#else+doUnsafeChecks = False+#endif++doInternalChecks :: Bool+#ifdef VECTOR_INTERNAL_CHECKS+doInternalChecks = True+#else+doInternalChecks = False+#endif+++doChecks :: Checks -> Bool+{-# INLINE doChecks #-}+doChecks Bounds = doBoundsChecks+doChecks Unsafe = doUnsafeChecks+doChecks Internal = doInternalChecks++error :: String -> Int -> Checks -> String -> String -> a+error file line kind loc msg+ = P.error $ unlines $+ (if kind == Internal+ then (["*** Internal error in package vector"+ ,"*** Please submit a bug report"]++)+ else id) $+ [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]++emptyStream :: String -> Int -> Checks -> String -> a+{-# NOINLINE emptyStream #-}+emptyStream file line kind loc+ = error file line kind loc "empty stream"++check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a+{-# INLINE check #-}+check file line kind loc msg cond x+ | not (doChecks kind) || cond = x+ | otherwise = error file line kind loc msg++assert_msg :: String+assert_msg = "assertion failure"++assert :: String -> Int -> Checks -> String -> Bool -> a -> a+{-# INLINE assert #-}+assert file line kind loc = check file line kind loc assert_msg++checkIndex_msg :: Int -> Int -> String+{-# NOINLINE checkIndex_msg #-}+checkIndex_msg i n = "index out of bounds " ++ show (i,n)++checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a+{-# INLINE checkIndex #-}+checkIndex file line kind loc i n x+ = check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x+++checkLength_msg :: Int -> String+{-# NOINLINE checkLength_msg #-}+checkLength_msg n = "negative length " ++ show n++checkLength :: String -> Int -> Checks -> String -> Int -> a -> a+{-# INLINE checkLength #-}+checkLength file line kind loc n x+ = check file line kind loc (checkLength_msg n) (n >= 0) x+++checkSlice_msg :: Int -> Int -> Int -> String+{-# NOINLINE checkSlice_msg #-}+checkSlice_msg i m n = "invalid slice " ++ show (i,m,n)++checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a+{-# INLINE checkSlice #-}+checkSlice file line kind loc i m n x+ = check file line kind loc (checkSlice_msg i m n)+ (i >= 0 && m >= 0 && i+m <= n) x+
Data/Vector/Mutable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} -- | -- Module : Data.Vector.Mutable@@ -12,54 +12,188 @@ -- Mutable boxed vectors. -- -module Data.Vector.Mutable ( MVector(..), IOVector, STVector )-where+module Data.Vector.Mutable (+ -- * Mutable boxed vectors+ MVector(..), IOVector, STVector, + -- * Operations on mutable vectors+ length, overlaps, slice, new, newWith, read, write, swap,+ clear, set, copy, grow,++ -- * Unsafe operations+ unsafeSlice, unsafeNew, unsafeNewWith, unsafeRead, unsafeWrite,+ unsafeCopy, unsafeGrow+) where+ import qualified Data.Vector.Generic.Mutable as G import Data.Primitive.Array-import Control.Monad.Primitive ( PrimMonad )+import Control.Monad.Primitive import Control.Monad.ST ( ST ) +import Prelude hiding ( length, read )++#include "vector.h"+ -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).-data MVector m a = MVector {-# UNPACK #-} !Int+data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int- {-# UNPACK #-} !(MutableArray m a)+ {-# UNPACK #-} !(MutableArray s a) -type IOVector = MVector IO-type STVector s = MVector (ST s)+type IOVector = MVector RealWorld+type STVector s = MVector s -instance G.MVectorPure (MVector m) a where- length (MVector _ n _) = n- unsafeSlice (MVector i _ arr) j m = MVector (i+j) m arr+instance G.MVector MVector a where+ {-# INLINE basicLength #-}+ basicLength (MVector _ n _) = n - {-# INLINE overlaps #-}- overlaps (MVector i m arr1) (MVector j n arr2)+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice j m (MVector i n arr) = MVector (i+j) m arr++ {-# INLINE basicOverlaps #-}+ basicOverlaps (MVector i m arr1) (MVector j n arr2) = sameMutableArray arr1 arr2 && (between i j (j+n) || between j i (i+m)) where between x y z = x >= y && x < z --instance PrimMonad m => G.MVector (MVector m) m a where- {-# INLINE unsafeNew #-}- unsafeNew n = do- arr <- newArray n uninitialised- return (MVector 0 n arr)+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n+ = do+ arr <- newArray n uninitialised+ return (MVector 0 n arr) - {-# INLINE unsafeNewWith #-}- unsafeNewWith n x = do- arr <- newArray n x- return (MVector 0 n arr)+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n x+ = do+ arr <- newArray n x+ return (MVector 0 n arr) - {-# INLINE unsafeRead #-}- unsafeRead (MVector i _ arr) j = readArray arr (i+j)+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MVector i n arr) j = readArray arr (i+j) - {-# INLINE unsafeWrite #-}- unsafeWrite (MVector i _ arr) j x = writeArray arr (i+j) x+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MVector i n arr) j x = writeArray arr (i+j) x - {-# INLINE clear #-}- clear v = G.set v uninitialised+ {-# INLINE basicClear #-}+ basicClear v = G.set v uninitialised uninitialised :: a uninitialised = error "Data.Vector.Mutable: uninitialised element"+++-- | Yield a part of the mutable vector without copying it. No bounds checks+-- are performed.+unsafeSlice :: Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> MVector s a+ -> MVector s a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++-- | Create a mutable vector of the given length. The length is not checked.+unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeNew #-}+unsafeNew = G.unsafeNew++-- | Create a mutable vector of the given length and fill it with an+-- initial value. The length is not checked.+unsafeNewWith :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith = G.unsafeNewWith++-- | Yield the element at the given position. No bounds checks are performed.+unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead = G.unsafeRead++-- | Replace the element at the given position. No bounds checks are performed.+unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite = G.unsafeWrite++-- | Swap the elements at the given positions. No bounds checks are performed.+unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE unsafeSwap #-}+unsafeSwap = G.unsafeSwap++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap. This is not checked.+unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy++-- | Grow a vector by the given number of elements. The number must be+-- positive but this is not checked.+unsafeGrow :: PrimMonad m+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeGrow #-}+unsafeGrow = G.unsafeGrow++-- | Length of the mutable vector.+length :: MVector s a -> Int+{-# INLINE length #-}+length = G.length++-- Check whether two vectors overlap.+overlaps :: MVector s a -> MVector s a -> Bool+{-# INLINE overlaps #-}+overlaps = G.overlaps++-- | Yield a part of the mutable vector without copying it.+slice :: Int -> Int -> MVector s a -> MVector s a+{-# INLINE slice #-}+slice = G.slice++-- | Create a mutable vector of the given length.+new :: PrimMonad m => Int -> m (MVector (PrimState m) a)+{-# INLINE new #-}+new = G.new++-- | Create a mutable vector of the given length and fill it with an+-- initial value.+newWith :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE newWith #-}+newWith = G.newWith++-- | Yield the element at the given position.+read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read = G.read++-- | Replace the element at the given position.+write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write = G.write++-- | Swap the elements at the given positions.+swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE swap #-}+swap = G.swap++-- | Reset all elements of the vector to some undefined value, clearing all+-- references to external objects. This is usually a noop for unboxed vectors. +clear :: PrimMonad m => MVector (PrimState m) a -> m ()+{-# INLINE clear #-}+clear = G.clear++-- | Set all elements of the vector to the given value.+set :: PrimMonad m => MVector (PrimState m) a -> a -> m ()+{-# INLINE set #-}+set = G.set++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap.+copy :: PrimMonad m+ => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+{-# INLINE copy #-}+copy = G.copy++-- | Grow a vector by the given number of elements. The number must be+-- positive.+grow :: PrimMonad m+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE grow #-}+grow = G.grow
Data/Vector/Primitive.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-} -- | -- Module : Data.Vector.Primitive@@ -19,34 +19,46 @@ length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++), copy,+ empty, singleton, cons, snoc, replicate, generate, (++), copy, -- * Accessing individual elements- (!), head, last,+ (!), head, last, indexM, headM, lastM,+ unsafeIndex, unsafeHead, unsafeLast,+ unsafeIndexM, unsafeHeadM, unsafeLastM, -- * Subvectors slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, -- * Permutations- accum, (//), backpermute, reverse,+ accum, accumulate_, (//), update_, backpermute, reverse,+ unsafeAccum, unsafeAccumulate_,+ unsafeUpd, unsafeUpdate_,+ unsafeBackpermute, -- * Mapping- map, concatMap,+ map, imap, concatMap, -- * Zipping and unzipping- zipWith, zipWith3,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ izipWith, izipWith3, izipWith4, izipWith5, izipWith6, -- * Filtering- filter, takeWhile, dropWhile,+ filter, ifilter, takeWhile, dropWhile,+ partition, unstablePartition, span, break, -- * Searching- elem, notElem, find, findIndex,+ elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding- foldl, foldl1, foldl', foldl1', foldr, foldr1,+ foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',+ ifoldl, ifoldl', ifoldr, ifoldr', -- * Specialised folds- sum, product, maximum, minimum,+ all, any,+ sum, product,+ maximum, maximumBy, minimum, minimumBy,+ minIndex, minIndexBy, maxIndex, maxIndexBy, -- * Unfolding unfoldr,@@ -55,9 +67,12 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1',+ prescanr, prescanr',+ postscanr, postscanr',+ scanr, scanr', scanr1, scanr1', -- * Enumeration- enumFromTo, enumFromThenTo,+ enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversion to/from lists toList, fromList@@ -68,7 +83,7 @@ import Data.Primitive.ByteArray import Data.Primitive ( Prim ) -import Control.Monad.ST ( runST )+import Control.Monad ( liftM ) import Prelude hiding ( length, null, replicate, (++),@@ -76,11 +91,11 @@ init, tail, take, drop, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3,- filter, takeWhile, dropWhile,+ filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1,- sum, product, minimum, maximum,- scanl, scanl1,+ all, any, sum, product, minimum, maximum,+ scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo ) import qualified Prelude@@ -93,22 +108,25 @@ instance (Show a, Prim a) => Show (Vector a) where show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList +type instance G.Mutable Vector = MVector+ instance Prim a => G.Vector Vector a where- {-# INLINE vnew #-}- vnew init = runST (do- MVector i n marr <- init- arr <- unsafeFreezeByteArray marr- return (Vector i n arr))+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MVector i n marr)+ = Vector i n `liftM` unsafeFreezeByteArray marr - {-# INLINE vlength #-}- vlength (Vector _ n _) = n+ {-# INLINE basicLength #-}+ basicLength (Vector _ n _) = n - {-# INLINE unsafeSlice #-}- unsafeSlice (Vector i _ arr) j n = Vector (i+j) n arr+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr - {-# INLINE unsafeIndexM #-}- unsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j))+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j)) + {-# INLINE elemseq #-}+ elemseq _ = seq+ instance (Prim a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} (==) = G.eq@@ -146,6 +164,12 @@ {-# INLINE replicate #-} replicate = G.replicate +-- | Generate a vector of the given length by applying the function to each+-- index+generate :: Prim a => Int -> (Int -> a) -> Vector a+{-# INLINE generate #-}+generate = G.generate+ -- | Prepend an element cons :: Prim a => a -> Vector a -> Vector a {-# INLINE cons #-}@@ -185,14 +209,59 @@ {-# INLINE last #-} last = G.last +-- | Unsafe indexing without bounds checking+unsafeIndex :: Prim a => Vector a -> Int -> a+{-# INLINE unsafeIndex #-}+unsafeIndex = G.unsafeIndex++-- | Yield the first element of a vector without checking if the vector is+-- empty+unsafeHead :: Prim a => Vector a -> a+{-# INLINE unsafeHead #-}+unsafeHead = G.unsafeHead++-- | Yield the last element of a vector without checking if the vector is+-- empty+unsafeLast :: Prim a => Vector a -> a+{-# INLINE unsafeLast #-}+unsafeLast = G.unsafeLast++-- | Monadic indexing which can be strict in the vector while remaining lazy in+-- the element+indexM :: (Prim a, Monad m) => Vector a -> Int -> m a+{-# INLINE indexM #-}+indexM = G.indexM++headM :: (Prim a, Monad m) => Vector a -> m a+{-# INLINE headM #-}+headM = G.headM++lastM :: (Prim a, Monad m) => Vector a -> m a+{-# INLINE lastM #-}+lastM = G.lastM++-- | Unsafe monadic indexing without bounds checks+unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a+{-# INLINE unsafeIndexM #-}+unsafeIndexM = G.unsafeIndexM++unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a+{-# INLINE unsafeHeadM #-}+unsafeHeadM = G.unsafeHeadM++unsafeLastM :: (Prim a, Monad m) => Vector a -> m a+{-# INLINE unsafeLastM #-}+unsafeLastM = G.unsafeLastM+ -- Subarrays -- --------- -- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: Prim a => Vector a -> Int -- ^ starting index- -> Int -- ^ length- -> Vector a+-- 'basicUnsafeSlice'.+slice :: Prim a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a {-# INLINE slice #-} slice = G.slice @@ -216,21 +285,76 @@ {-# INLINE drop #-} drop = G.drop +-- | Unsafely yield a part of the vector without copying it and without+-- performing bounds checks.+unsafeSlice :: Prim a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++unsafeInit :: Prim a => Vector a -> Vector a+{-# INLINE unsafeInit #-}+unsafeInit = G.unsafeInit++unsafeTail :: Prim a => Vector a -> Vector a+{-# INLINE unsafeTail #-}+unsafeTail = G.unsafeTail++unsafeTake :: Prim a => Int -> Vector a -> Vector a+{-# INLINE unsafeTake #-}+unsafeTake = G.unsafeTake++unsafeDrop :: Prim a => Int -> Vector a -> Vector a+{-# INLINE unsafeDrop #-}+unsafeDrop = G.unsafeDrop+ -- Permutations -- ------------ +unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE unsafeAccum #-}+unsafeAccum = G.unsafeAccum++unsafeAccumulate_ :: (Prim a, Prim b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE unsafeAccumulate_ #-}+unsafeAccumulate_ = G.unsafeAccumulate_+ accum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE accum #-} accum = G.accum +accumulate_ :: (Prim a, Prim b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE accumulate_ #-}+accumulate_ = G.accumulate_++unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE unsafeUpd #-}+unsafeUpd = G.unsafeUpd++unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE unsafeUpdate_ #-}+unsafeUpdate_ = G.unsafeUpdate_+ (//) :: Prim a => Vector a -> [(Int, a)] -> Vector a {-# INLINE (//) #-} (//) = (G.//) +update_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE update_ #-}+update_ = G.update_+ backpermute :: Prim a => Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute +unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a+{-# INLINE unsafeBackpermute #-}+unsafeBackpermute = G.unsafeBackpermute+ reverse :: Prim a => Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse@@ -243,6 +367,11 @@ {-# INLINE map #-} map = G.map +-- | Apply a function to every index/value pair+imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b+{-# INLINE imap #-}+imap = G.imap+ concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap@@ -262,6 +391,59 @@ {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 +zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e)+ => (a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE zipWith4 #-}+zipWith4 = G.zipWith4++zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f)+ => (a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE zipWith5 #-}+zipWith5 = G.zipWith5++zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g)+ => (a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE zipWith6 #-}+zipWith6 = G.zipWith6++-- | Zip two vectors and their indices with the given function.+izipWith :: (Prim a, Prim b, Prim c)+ => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE izipWith #-}+izipWith = G.izipWith++-- | Zip three vectors and their indices with the given function.+izipWith3 :: (Prim a, Prim b, Prim c, Prim d)+ => (Int -> a -> b -> c -> d)+ -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE izipWith3 #-}+izipWith3 = G.izipWith3++izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e)+ => (Int -> a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE izipWith4 #-}+izipWith4 = G.izipWith4++izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f)+ => (Int -> a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE izipWith5 #-}+izipWith5 = G.izipWith5++izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g)+ => (Int -> a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE izipWith6 #-}+izipWith6 = G.izipWith6+ -- Filtering -- --------- @@ -270,6 +452,12 @@ {-# INLINE filter #-} filter = G.filter +-- | Drop elements that do not satisfy the predicate (applied to values and+-- their indices)+ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a+{-# INLINE ifilter #-}+ifilter = G.ifilter+ -- | Yield the longest prefix of elements satisfying the predicate. takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-}@@ -280,6 +468,33 @@ {-# INLINE dropWhile #-} dropWhile = G.dropWhile +-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The+-- relative order of the elements is preserved at the cost of a (sometimes)+-- reduced performance compared to 'unstablePartition'.+partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE partition #-}+partition = G.partition++-- | 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.+unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE unstablePartition #-}+unstablePartition = G.unstablePartition++-- | Split the vector into the longest prefix of elements that satisfy the+-- predicate and the rest.+span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE span #-}+span = G.span++-- | Split the vector into the longest prefix of elements that do not satisfy+-- the predicate and the rest.+break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE break #-}+break = G.break+ -- Searching -- --------- @@ -307,6 +522,22 @@ {-# INLINE findIndex #-} findIndex = G.findIndex +-- | Yield the indices of elements satisfying the predicate+findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int+{-# INLINE findIndices #-}+findIndices = G.findIndices++-- | Yield 'Just' the index of the first occurence of the given element or+-- 'Nothing' if the vector does not contain the element+elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int+{-# INLINE elemIndex #-}+elemIndex = G.elemIndex++-- | Yield the indices of all occurences of the given element+elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int+{-# INLINE elemIndices #-}+elemIndices = G.elemIndices+ -- Folding -- ------- @@ -340,9 +571,49 @@ {-# INLINE foldr1 #-} foldr1 = G.foldr1 +-- | Right fold with a strict accumulator+foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr' #-}+foldr' = G.foldr'++-- | Right fold on non-empty vectors with strict accumulator+foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1' #-}+foldr1' = G.foldr1'++-- | Left fold (function applied to each element and its index)+ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl #-}+ifoldl = G.ifoldl++-- | Left fold with strict accumulator (function applied to each element and+-- its index)+ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl' #-}+ifoldl' = G.ifoldl'++-- | Right fold (function applied to each element and its index)+ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr #-}+ifoldr = G.ifoldr++-- | Right fold with strict accumulator (function applied to each element and+-- its index)+ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr' #-}+ifoldr' = G.ifoldr'+ -- Specialised folds -- ----------------- +all :: Prim a => (a -> Bool) -> Vector a -> Bool+{-# INLINE all #-}+all = G.all++any :: Prim a => (a -> Bool) -> Vector a -> Bool+{-# INLINE any #-}+any = G.any+ sum :: (Prim a, Num a) => Vector a -> a {-# INLINE sum #-} sum = G.sum@@ -355,10 +626,34 @@ {-# INLINE maximum #-} maximum = G.maximum +maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE maximumBy #-}+maximumBy = G.maximumBy+ minimum :: (Prim a, Ord a) => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum +minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE minimumBy #-}+minimumBy = G.minimumBy++maxIndex :: (Prim a, Ord a) => Vector a -> Int+{-# INLINE maxIndex #-}+maxIndex = G.maxIndex++maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE maxIndexBy #-}+maxIndexBy = G.maxIndexBy++minIndex :: (Prim a, Ord a) => Vector a -> Int+{-# INLINE minIndex #-}+minIndex = G.minIndex++minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE minIndexBy #-}+minIndexBy = G.minIndexBy+ -- Unfolding -- --------- @@ -409,13 +704,75 @@ {-# INLINE scanl1' #-} scanl1' = G.scanl1' ++-- | Prefix right-to-left scan+prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr #-}+prescanr = G.prescanr++-- | Prefix right-to-left scan with strict accumulator+prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr' #-}+prescanr' = G.prescanr'++-- | Suffix right-to-left scan+postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr #-}+postscanr = G.postscanr++-- | Suffix right-to-left scan with strict accumulator+postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr' #-}+postscanr' = G.postscanr'++-- | Haskell-style right-to-left scan+scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr #-}+scanr = G.scanr++-- | Haskell-style right-to-left scan with strict accumulator+scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr' #-}+scanr' = G.scanr'++-- | Right-to-left scan over a non-empty vector+scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1 #-}+scanr1 = G.scanr1++-- | Right-to-left scan over a non-empty vector with a strict accumulator+scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1' #-}+scanr1' = G.scanr1'+ -- Enumeration -- ----------- +-- | Yield a vector of the given length containing the values @x@, @x+1@ etc.+-- This operation is usually more efficient than 'enumFromTo'.+enumFromN :: (Prim a, Num a) => a -> Int -> Vector a+{-# INLINE enumFromN #-}+enumFromN = G.enumFromN++-- | 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 :: (Prim a, Num a) => a -> a -> Int -> Vector a+{-# INLINE enumFromStepN #-}+enumFromStepN = G.enumFromStepN++-- | Enumerate values from @x@ to @y@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromN' instead. enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo +-- | Enumerate values from @x@ to @y@ with a specific step @z@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead. enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo
Data/Vector/Primitive/Mutable.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables,+ FlexibleContexts #-} -- | -- Module : Data.Vector.Primitive.Mutable@@ -12,47 +13,178 @@ -- Mutable primitive vectors. -- -module Data.Vector.Primitive.Mutable ( MVector(..), IOVector, STVector )-where+module Data.Vector.Primitive.Mutable (+ -- * Mutable vectors of primitive types+ MVector(..), IOVector, STVector, Prim, + -- * Operations on mutable vectors+ length, overlaps, slice, new, newWith, read, write, swap,+ clear, set, copy, grow,++ -- * Unsafe operations+ unsafeSlice, unsafeNew, unsafeNewWith, unsafeRead, unsafeWrite, unsafeSwap,+ unsafeCopy, unsafeGrow+) where+ import qualified Data.Vector.Generic.Mutable as G import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) import Control.Monad.Primitive import Control.Monad.ST ( ST )+import Control.Monad ( liftM ) --- | Mutable unboxed vectors. They live in the 'ST' monad.-data MVector m a = MVector {-# UNPACK #-} !Int- {-# UNPACK #-} !Int- {-# UNPACK #-} !(MutableByteArray m)+import Prelude hiding( length, read ) -type IOVector = MVector IO-type STVector s = MVector (ST s)+#include "vector.h" -instance Prim a => G.MVectorPure (MVector m) a where- length (MVector _ n _) = n- unsafeSlice (MVector i _ arr) j m = MVector (i+j) m arr+-- | Mutable vectors of primitive types.+data MVector s a = MVector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !(MutableByteArray s) - {-# INLINE overlaps #-}- overlaps (MVector i m arr1) (MVector j n arr2)+type IOVector = MVector RealWorld+type STVector s = MVector s++instance Prim a => G.MVector MVector a where+ basicLength (MVector _ n _) = n+ basicUnsafeSlice j m (MVector i n arr)+ = MVector (i+j) m arr++ {-# INLINE basicOverlaps #-}+ basicOverlaps (MVector i m arr1) (MVector j n arr2) = sameMutableByteArray arr1 arr2 && (between i j (j+n) || between j i (i+m)) where between x y z = x >= y && x < z + {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n = MVector 0 n+ `liftM` newByteArray (n * sizeOf (undefined :: a)) -instance (Prim a, PrimMonad m) => G.MVector (MVector m) m a where- {-# INLINE unsafeNew #-}- unsafeNew n = do- arr <- newByteArray (n * sizeOf (undefined :: a))- return (MVector 0 n arr)+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MVector i n arr) j = readByteArray arr (i+j) - {-# INLINE unsafeRead #-}- unsafeRead (MVector i _ arr) j = readByteArray arr (i+j)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MVector i n arr) j x = writeByteArray arr (i+j) x - {-# INLINE unsafeWrite #-}- unsafeWrite (MVector i _ arr) j x = writeByteArray arr (i+j) x+-- | Yield a part of the mutable vector without copying it. No bounds checks+-- are performed.+unsafeSlice :: Prim a => Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> MVector s a + -> MVector s a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice - {-# INLINE clear #-}- clear _ = return ()++-- | Create a mutable vector of the given length. The length is not checked.+unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeNew #-}+unsafeNew = G.unsafeNew++-- | Create a mutable vector of the given length and fill it with an+-- initial value. The length is not checked.+unsafeNewWith :: (PrimMonad m, Prim a)+ => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith = G.unsafeNewWith++-- | Yield the element at the given position. No bounds checks are performed.+unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead = G.unsafeRead++-- | Replace the element at the given position. No bounds checks are performed.+unsafeWrite :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite = G.unsafeWrite++-- | Swap the elements at the given positions. No bounds checks are performed.+unsafeSwap :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE unsafeSwap #-}+unsafeSwap = G.unsafeSwap++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap. This is not checked.+unsafeCopy :: (PrimMonad m, Prim a) => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy++-- | Grow a vector by the given number of elements. The number must be+-- positive but this is not checked.+unsafeGrow :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeGrow #-}+unsafeGrow = G.unsafeGrow++-- | Length of the mutable vector.+length :: Prim a => MVector s a -> Int+{-# INLINE length #-}+length = G.length++-- Check whether two vectors overlap.+overlaps :: Prim a => MVector s a -> MVector s a -> Bool+{-# INLINE overlaps #-}+overlaps = G.overlaps++-- | Yield a part of the mutable vector without copying it.+slice :: Prim a => Int -> Int -> MVector s a -> MVector s a+{-# INLINE slice #-}+slice = G.slice++-- | Create a mutable vector of the given length.+new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a)+{-# INLINE new #-}+new = G.new++-- | Create a mutable vector of the given length and fill it with an+-- initial value.+newWith :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE newWith #-}+newWith = G.newWith++-- | Yield the element at the given position.+read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read = G.read++-- | Replace the element at the given position.+write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write = G.write++-- | Swap the elements at the given positions.+swap :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE swap #-}+swap = G.swap++-- | Reset all elements of the vector to some undefined value, clearing all+-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m ()+{-# INLINE clear #-}+clear = G.clear++-- | Set all elements of the vector to the given value.+set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m ()+{-# INLINE set #-}+set = G.set++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap.+copy :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+{-# INLINE copy #-}+copy = G.copy++-- | Grow a vector by the given number of elements. The number must be+-- positive.+grow :: (PrimMonad m, Prim a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE grow #-}+grow = G.grow
Data/Vector/Storable.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} -- | -- Module : Data.Vector.Storable--- Copyright : (c) Roman Leshchinskiy 2009+-- Copyright : (c) Roman Leshchinskiy 2009-10 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -19,34 +19,46 @@ length, null, -- * Construction- empty, singleton, cons, snoc, replicate, (++), copy,+ empty, singleton, cons, snoc, replicate, generate, (++), copy, -- * Accessing individual elements- (!), head, last,+ (!), head, last, indexM, headM, lastM,+ unsafeIndex, unsafeHead, unsafeLast,+ unsafeIndexM, unsafeHeadM, unsafeLastM, -- * Subvectors slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, -- * Permutations- accum, (//), backpermute, reverse,+ accum, accumulate_, (//), update_, backpermute, reverse,+ unsafeAccum, unsafeAccumulate_,+ unsafeUpd, unsafeUpdate_,+ unsafeBackpermute, -- * Mapping- map, concatMap,+ map, imap, concatMap, -- * Zipping and unzipping- zipWith, zipWith3,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ izipWith, izipWith3, izipWith4, izipWith5, izipWith6, -- * Filtering- filter, takeWhile, dropWhile,+ filter, ifilter, takeWhile, dropWhile,+ partition, unstablePartition, span, break, -- * Searching- elem, notElem, find, findIndex,+ elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding- foldl, foldl1, foldl', foldl1', foldr, foldr1,+ foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',+ ifoldl, ifoldl', ifoldr, ifoldr', -- * Specialised folds- and, or, sum, product, maximum, minimum,+ all, any, and, or,+ sum, product,+ maximum, maximumBy, minimum, minimumBy,+ minIndex, minIndexBy, maxIndex, maxIndexBy, -- * Unfolding unfoldr,@@ -55,12 +67,18 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1',+ prescanr, prescanr',+ postscanr, postscanr',+ scanr, scanr', scanr1, scanr1', -- * Enumeration- enumFromTo, enumFromThenTo,+ enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversion to/from lists- toList, fromList+ toList, fromList,++ -- * Accessing the underlying memory+ unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith ) where import qualified Data.Vector.Generic as G@@ -69,8 +87,10 @@ import Foreign.Storable import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Marshal.Array ( advancePtr ) -import System.IO.Unsafe ( unsafePerformIO )+import Control.Monad.ST ( ST, runST ) import Prelude hiding ( length, null, replicate, (++),@@ -78,15 +98,17 @@ init, tail, take, drop, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3,- filter, takeWhile, dropWhile,+ filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1,- and, or, sum, product, minimum, maximum,- scanl, scanl1,+ all, any, and, or, sum, product, minimum, maximum,+ scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo ) import qualified Prelude +#include "vector.h"+ -- | 'Storable'-based vectors data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int@@ -98,27 +120,51 @@ . show . toList +type instance G.Mutable Vector = MVector+ instance Storable a => G.Vector Vector a where- {-# INLINE vnew #-}- vnew init = unsafePerformIO (do- MVector i n p <- init- return (Vector i n p))+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MVector i n p) = return $ Vector i n p - {-# INLINE vlength #-}- vlength (Vector _ n _) = n+ {-# INLINE basicLength #-}+ basicLength (Vector _ n _) = n - {-# INLINE unsafeSlice #-}- unsafeSlice (Vector i _ p) j n = Vector (i+j) n p+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice j n (Vector i _ p) = Vector (i+j) n p - {-# INLINE unsafeIndexM #-}- unsafeIndexM (Vector i _ p) j = return- . inlinePerformIO- $ withForeignPtr p (`peekElemOff` (i+j))+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (Vector i _ p) j = return+ . inlinePerformIO+ $ withForeignPtr p (`peekElemOff` (i+j)) + {-# INLINE elemseq #-}+ elemseq _ = seq+ instance (Storable a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} (==) = G.eq +{-+eq_memcmp :: forall a. Storable a => Vector a -> Vector a -> Bool+{-# INLINE_STREAM eq_memcmp #-}+eq_memcmp (Vector i m p) (Vector j n q)+ = m == n && inlinePerformIO+ (withForeignPtr p $ \p' ->+ withForeignPtr q $ \q' ->+ return $+ memcmp (p' `plusPtr` i) (q' `plusPtr` j)+ (fromIntegral $ sizeOf (undefined :: a) * m) == 0)++foreign import ccall unsafe "string.h memcmp" memcmp+ :: Ptr a -> Ptr a -> CSize -> CInt++{-# RULES++"(==) [Vector.Storable Int]"+ G.eq = eq_memcmp :: Vector Int -> Vector Int -> Bool+ #-}+-}+ instance (Storable a, Ord a) => Ord (Vector a) where {-# INLINE compare #-} compare = G.cmp@@ -152,6 +198,12 @@ {-# INLINE replicate #-} replicate = G.replicate +-- | Generate a vector of the given length by applying the function to each+-- index+generate :: Storable a => Int -> (Int -> a) -> Vector a+{-# INLINE generate #-}+generate = G.generate+ -- | Prepend an element cons :: Storable a => a -> Vector a -> Vector a {-# INLINE cons #-}@@ -191,14 +243,59 @@ {-# INLINE last #-} last = G.last +-- | Unsafe indexing without bounds checking+unsafeIndex :: Storable a => Vector a -> Int -> a+{-# INLINE unsafeIndex #-}+unsafeIndex = G.unsafeIndex++-- | Yield the first element of a vector without checking if the vector is+-- empty+unsafeHead :: Storable a => Vector a -> a+{-# INLINE unsafeHead #-}+unsafeHead = G.unsafeHead++-- | Yield the last element of a vector without checking if the vector is+-- empty+unsafeLast :: Storable a => Vector a -> a+{-# INLINE unsafeLast #-}+unsafeLast = G.unsafeLast++-- | Monadic indexing which can be strict in the vector while remaining lazy in+-- the element+indexM :: (Storable a, Monad m) => Vector a -> Int -> m a+{-# INLINE indexM #-}+indexM = G.indexM++headM :: (Storable a, Monad m) => Vector a -> m a+{-# INLINE headM #-}+headM = G.headM++lastM :: (Storable a, Monad m) => Vector a -> m a+{-# INLINE lastM #-}+lastM = G.lastM++-- | Unsafe monadic indexing without bounds checks+unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a+{-# INLINE unsafeIndexM #-}+unsafeIndexM = G.unsafeIndexM++unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a+{-# INLINE unsafeHeadM #-}+unsafeHeadM = G.unsafeHeadM++unsafeLastM :: (Storable a, Monad m) => Vector a -> m a+{-# INLINE unsafeLastM #-}+unsafeLastM = G.unsafeLastM+ -- Subarrays -- --------- -- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: Storable a => Vector a -> Int -- ^ starting index- -> Int -- ^ length- -> Vector a+-- 'basicUnsafeSlice'.+slice :: Storable a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a {-# INLINE slice #-} slice = G.slice @@ -222,21 +319,76 @@ {-# INLINE drop #-} drop = G.drop +-- | Unsafely yield a part of the vector without copying it and without+-- performing bounds checks.+unsafeSlice :: Storable a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++unsafeInit :: Storable a => Vector a -> Vector a+{-# INLINE unsafeInit #-}+unsafeInit = G.unsafeInit++unsafeTail :: Storable a => Vector a -> Vector a+{-# INLINE unsafeTail #-}+unsafeTail = G.unsafeTail++unsafeTake :: Storable a => Int -> Vector a -> Vector a+{-# INLINE unsafeTake #-}+unsafeTake = G.unsafeTake++unsafeDrop :: Storable a => Int -> Vector a -> Vector a+{-# INLINE unsafeDrop #-}+unsafeDrop = G.unsafeDrop+ -- Permutations -- ------------ +unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE unsafeAccum #-}+unsafeAccum = G.unsafeAccum++unsafeAccumulate_ :: (Storable a, Storable b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE unsafeAccumulate_ #-}+unsafeAccumulate_ = G.unsafeAccumulate_+ accum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE accum #-} accum = G.accum +accumulate_ :: (Storable a, Storable b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE accumulate_ #-}+accumulate_ = G.accumulate_++unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE unsafeUpd #-}+unsafeUpd = G.unsafeUpd++unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE unsafeUpdate_ #-}+unsafeUpdate_ = G.unsafeUpdate_+ (//) :: Storable a => Vector a -> [(Int, a)] -> Vector a {-# INLINE (//) #-} (//) = (G.//) +update_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE update_ #-}+update_ = G.update_+ backpermute :: Storable a => Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute +unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a+{-# INLINE unsafeBackpermute #-}+unsafeBackpermute = G.unsafeBackpermute+ reverse :: Storable a => Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse@@ -249,6 +401,11 @@ {-# INLINE map #-} map = G.map +-- | Apply a function to every index/value pair+imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b+{-# INLINE imap #-}+imap = G.imap+ concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap@@ -268,6 +425,63 @@ {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 +zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e)+ => (a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE zipWith4 #-}+zipWith4 = G.zipWith4++zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e,+ Storable f)+ => (a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE zipWith5 #-}+zipWith5 = G.zipWith5++zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e,+ Storable f, Storable g)+ => (a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE zipWith6 #-}+zipWith6 = G.zipWith6++-- | Zip two vectors and their indices with the given function.+izipWith :: (Storable a, Storable b, Storable c)+ => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE izipWith #-}+izipWith = G.izipWith++-- | Zip three vectors and their indices with the given function.+izipWith3 :: (Storable a, Storable b, Storable c, Storable d)+ => (Int -> a -> b -> c -> d)+ -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE izipWith3 #-}+izipWith3 = G.izipWith3++izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e)+ => (Int -> a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE izipWith4 #-}+izipWith4 = G.izipWith4++izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e,+ Storable f)+ => (Int -> a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE izipWith5 #-}+izipWith5 = G.izipWith5++izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e,+ Storable f, Storable g)+ => (Int -> a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE izipWith6 #-}+izipWith6 = G.izipWith6+ -- Filtering -- --------- @@ -276,6 +490,12 @@ {-# INLINE filter #-} filter = G.filter +-- | Drop elements that do not satisfy the predicate (applied to values and+-- their indices)+ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a+{-# INLINE ifilter #-}+ifilter = G.ifilter+ -- | Yield the longest prefix of elements satisfying the predicate. takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-}@@ -286,6 +506,34 @@ {-# INLINE dropWhile #-} dropWhile = G.dropWhile +-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The+-- relative order of the elements is preserved at the cost of a (sometimes)+-- reduced performance compared to 'unstablePartition'.+partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE partition #-}+partition = G.partition++-- | 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.+unstablePartition+ :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE unstablePartition #-}+unstablePartition = G.unstablePartition++-- | Split the vector into the longest prefix of elements that satisfy the+-- predicate and the rest.+span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE span #-}+span = G.span++-- | Split the vector into the longest prefix of elements that do not satisfy+-- the predicate and the rest.+break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE break #-}+break = G.break+ -- Searching -- --------- @@ -313,6 +561,22 @@ {-# INLINE findIndex #-} findIndex = G.findIndex +-- | Yield the indices of elements satisfying the predicate+findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int+{-# INLINE findIndices #-}+findIndices = G.findIndices++-- | Yield 'Just' the index of the first occurence of the given element or+-- 'Nothing' if the vector does not contain the element+elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int+{-# INLINE elemIndex #-}+elemIndex = G.elemIndex++-- | Yield the indices of all occurences of the given element+elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int+{-# INLINE elemIndices #-}+elemIndices = G.elemIndices+ -- Folding -- ------- @@ -346,9 +610,49 @@ {-# INLINE foldr1 #-} foldr1 = G.foldr1 +-- | Right fold with a strict accumulator+foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr' #-}+foldr' = G.foldr'++-- | Right fold on non-empty vectors with strict accumulator+foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1' #-}+foldr1' = G.foldr1'++-- | Left fold (function applied to each element and its index)+ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl #-}+ifoldl = G.ifoldl++-- | Left fold with strict accumulator (function applied to each element and+-- its index)+ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl' #-}+ifoldl' = G.ifoldl'++-- | Right fold (function applied to each element and its index)+ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr #-}+ifoldr = G.ifoldr++-- | Right fold with strict accumulator (function applied to each element and+-- its index)+ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr' #-}+ifoldr' = G.ifoldr'+ -- Specialised folds -- ----------------- +all :: Storable a => (a -> Bool) -> Vector a -> Bool+{-# INLINE all #-}+all = G.all++any :: Storable a => (a -> Bool) -> Vector a -> Bool+{-# INLINE any #-}+any = G.any+ and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and@@ -369,10 +673,34 @@ {-# INLINE maximum #-} maximum = G.maximum +maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE maximumBy #-}+maximumBy = G.maximumBy+ minimum :: (Storable a, Ord a) => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum +minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE minimumBy #-}+minimumBy = G.minimumBy++maxIndex :: (Storable a, Ord a) => Vector a -> Int+{-# INLINE maxIndex #-}+maxIndex = G.maxIndex++maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE maxIndexBy #-}+maxIndexBy = G.maxIndexBy++minIndex :: (Storable a, Ord a) => Vector a -> Int+{-# INLINE minIndex #-}+minIndex = G.minIndex++minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE minIndexBy #-}+minIndexBy = G.minIndexBy+ -- Unfolding -- --------- @@ -423,13 +751,79 @@ {-# INLINE scanl1' #-} scanl1' = G.scanl1' ++-- | Prefix right-to-left scan+prescanr+ :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr #-}+prescanr = G.prescanr++-- | Prefix right-to-left scan with strict accumulator+prescanr'+ :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr' #-}+prescanr' = G.prescanr'++-- | Suffix right-to-left scan+postscanr+ :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr #-}+postscanr = G.postscanr++-- | Suffix right-to-left scan with strict accumulator+postscanr'+ :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr' #-}+postscanr' = G.postscanr'++-- | Haskell-style right-to-left scan+scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr #-}+scanr = G.scanr++-- | Haskell-style right-to-left scan with strict accumulator+scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr' #-}+scanr' = G.scanr'++-- | Right-to-left scan over a non-empty vector+scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1 #-}+scanr1 = G.scanr1++-- | Right-to-left scan over a non-empty vector with a strict accumulator+scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1' #-}+scanr1' = G.scanr1'+ -- Enumeration -- ----------- +-- | Yield a vector of the given length containing the values @x@, @x+1@ etc.+-- This operation is usually more efficient than 'enumFromTo'.+enumFromN :: (Storable a, Num a) => a -> Int -> Vector a+{-# INLINE enumFromN #-}+enumFromN = G.enumFromN++-- | 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 :: (Storable a, Num a) => a -> a -> Int -> Vector a+{-# INLINE enumFromStepN #-}+enumFromStepN = G.enumFromStepN++-- | Enumerate values from @x@ to @y@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromN' instead. enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo +-- | Enumerate values from @x@ to @y@ with a specific step @z@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead. enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo@@ -446,4 +840,29 @@ fromList :: Storable a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList++-- Accessing the underlying memory+-- -------------------------------++-- | Create a vector from a 'ForeignPtr' with an offset and a length. The data+-- may not be modified through the 'ForeignPtr' afterwards.+unsafeFromForeignPtr :: ForeignPtr a -- ^ pointer+ -> Int -- ^ offset+ -> Int -- ^ length+ -> Vector a+{-# INLINE unsafeFromForeignPtr #-}+unsafeFromForeignPtr p i n = Vector i n p++-- | Yield the underlying 'ForeignPtr' together with the offset to the data+-- and its length. The data may not be modified through the 'ForeignPtr'.+unsafeToForeignPtr :: Vector a -> (ForeignPtr a, Int, Int)+{-# INLINE unsafeToForeignPtr #-}+unsafeToForeignPtr (Vector i n p) = (p,i,n)++-- | Pass a pointer to the vector's data to the IO action. The data may not be+-- modified through the 'Ptr.+unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b+{-# INLINE unsafeWith #-}+unsafeWith (Vector i n fp) m+ = withForeignPtr fp $ \p -> m (p `advancePtr` i)
Data/Vector/Storable/Mutable.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Data.Vector.Storable.Mutable--- Copyright : (c) Roman Leshchinskiy 2009+-- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -12,43 +12,214 @@ -- Mutable vectors based on Storable. -- -module Data.Vector.Storable.Mutable( MVector(..) )-where+module Data.Vector.Storable.Mutable(+ -- * Mutable vectors of 'Storable' types+ MVector(..), IOVector, STVector, Storable, + -- * Operations on mutable vectors+ length, overlaps, slice, new, newWith, read, write, swap,+ clear, set, copy, grow,++ -- * Unsafe operations+ unsafeSlice, unsafeNew, unsafeNewWith, unsafeRead, unsafeWrite, unsafeSwap,+ unsafeCopy, unsafeGrow,++ -- * Accessing the underlying memory+ unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith+) where+ import qualified Data.Vector.Generic.Mutable as G import Foreign.Storable import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Marshal.Array ( advancePtr ) --- | Mutable 'Storable'-based vectors in the 'IO' monad.-data MVector a = MVector {-# UNPACK #-} !Int- {-# UNPACK #-} !Int- {-# UNPACK #-} !(ForeignPtr a)+import Control.Monad.Primitive -instance G.MVectorPure MVector a where- {-# INLINE length #-}- length (MVector _ n _) = n+import Prelude hiding( length, read ) - {-# INLINE unsafeSlice #-}- unsafeSlice (MVector i _ p) j m = MVector (i+j) m p+#include "vector.h" +-- | Mutable 'Storable'-based vectors+data MVector s a = MVector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !(ForeignPtr a)++type IOVector = MVector RealWorld+type STVector s = MVector s++instance Storable a => G.MVector MVector a where+ {-# INLINE basicLength #-}+ basicLength (MVector _ n _) = n++ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice j m (MVector i n p) = MVector (i+j) m p+ -- FIXME: implement this properly- {-# INLINE overlaps #-}- overlaps (MVector i m p) (MVector j n q)- = True+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MVector i m p) (MVector j n q) = True -instance Storable a => G.MVector MVector IO a where- {-# INLINE unsafeNew #-}- unsafeNew n = MVector 0 n `fmap` mallocForeignPtrArray n+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n+ = unsafePrimToPrim+ $ MVector 0 n `fmap` mallocForeignPtrArray n - {-# INLINE unsafeRead #-}- unsafeRead (MVector i n p) j = withForeignPtr p $ \ptr ->- peekElemOff ptr (i+j)- - {-# INLINE unsafeWrite #-}- unsafeWrite (MVector i n p) j x = withForeignPtr p $ \ptr ->- pokeElemOff ptr (i+j) x + {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MVector i n p) j+ = unsafePrimToPrim+ $ withForeignPtr p $ \ptr -> peekElemOff ptr (i+j) - {-# INLINE clear #-}- clear _ = return ()+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MVector i n p) j x+ = unsafePrimToPrim+ $ withForeignPtr p $ \ptr -> pokeElemOff ptr (i+j) x++-- | 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.+unsafeFromForeignPtr :: ForeignPtr a -- ^ pointer+ -> Int -- ^ offset+ -> Int -- ^ length+ -> MVector s a+{-# INLINE unsafeFromForeignPtr #-}+unsafeFromForeignPtr p i n = MVector i n p++-- | 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 :: MVector s a -> (ForeignPtr a, Int, Int)+{-# INLINE unsafeToForeignPtr #-}+unsafeToForeignPtr (MVector i n p) = (p,i,n)++-- | Pass a pointer to the vector's data to the IO action. Modifying data+-- through the pointer is unsafe if the vector could have been frozen before+-- the modification.+unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b+{-# INLINE unsafeWith #-}+unsafeWith (MVector i n fp) m+ = withForeignPtr fp $ \p -> m (p `advancePtr` i)++-- | Yield a part of the mutable vector without copying it. No bounds checks+-- are performed.+unsafeSlice :: Storable a => Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> MVector s a+ -> MVector s a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++-- | Create a mutable vector of the given length. The length is not checked.+unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeNew #-}+unsafeNew = G.unsafeNew++-- | Create a mutable vector of the given length and fill it with an+-- initial value. The length is not checked.+unsafeNewWith :: (PrimMonad m, Storable a)+ => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith = G.unsafeNewWith++-- | Yield the element at the given position. No bounds checks are performed.+unsafeRead :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead = G.unsafeRead++-- | Replace the element at the given position. No bounds checks are performed.+unsafeWrite :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite = G.unsafeWrite++-- | Swap the elements at the given positions. No bounds checks are performed.+unsafeSwap :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE unsafeSwap #-}+unsafeSwap = G.unsafeSwap++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap. This is not checked.+unsafeCopy :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy++-- | Grow a vector by the given number of elements. The number must be+-- positive but this is not checked.+unsafeGrow :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeGrow #-}+unsafeGrow = G.unsafeGrow++-- | Length of the mutable vector.+length :: Storable a => MVector s a -> Int+{-# INLINE length #-}+length = G.length++-- Check whether two vectors overlap.+overlaps :: Storable a => MVector s a -> MVector s a -> Bool+{-# INLINE overlaps #-}+overlaps = G.overlaps++-- | Yield a part of the mutable vector without copying it.+slice :: Storable a => Int -> Int -> MVector s a -> MVector s a+{-# INLINE slice #-}+slice = G.slice++-- | Create a mutable vector of the given length.+new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)+{-# INLINE new #-}+new = G.new++-- | Create a mutable vector of the given length and fill it with an+-- initial value.+newWith :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE newWith #-}+newWith = G.newWith++-- | Yield the element at the given position.+read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read = G.read++-- | Replace the element at the given position.+write :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write = G.write++-- | Swap the elements at the given positions.+swap :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE swap #-}+swap = G.swap++-- | Reset all elements of the vector to some undefined value, clearing all+-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m ()+{-# INLINE clear #-}+clear = G.clear++-- | Set all elements of the vector to the given value.+set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m ()+{-# INLINE set #-}+set = G.set++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap.+copy :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+{-# INLINE copy #-}+copy = G.copy++-- | Grow a vector by the given number of elements. The number must be+-- positive.+grow :: (PrimMonad m, Storable a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE grow #-}+grow = G.grow
+ Data/Vector/Unboxed.hs view
@@ -0,0 +1,797 @@+-- |+-- Module : Data.Vector.Unboxed+-- Copyright : (c) Roman Leshchinskiy 2009+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable+--+-- Adaptive unboxed vectors+--++module Data.Vector.Unboxed (+ Vector, MVector(..), Unbox,++ -- * Length information+ length, null,++ -- * Construction+ empty, singleton, cons, snoc, replicate, generate, (++), copy,++ -- * Accessing individual elements+ (!), head, last, indexM, headM, lastM,+ unsafeIndex, unsafeHead, unsafeLast,+ unsafeIndexM, unsafeHeadM, unsafeLastM,++ -- * Subvectors+ slice, init, tail, take, drop,+ unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop,++ -- * Permutations+ accum, accumulate, accumulate_,+ (//), update, update_,+ backpermute, reverse,+ unsafeAccum, unsafeAccumulate, unsafeAccumulate_,+ unsafeUpd, unsafeUpdate, unsafeUpdate_,+ unsafeBackpermute,++ -- * Mapping+ map, imap, concatMap,++ -- * Zipping and unzipping+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ izipWith, izipWith3, izipWith4, izipWith5, izipWith6,+ zip, zip3, zip4, zip5, zip6,+ unzip, unzip3, unzip4, unzip5, unzip6,++ -- * Filtering+ filter, ifilter, takeWhile, dropWhile,+ partition, unstablePartition, span, break,++ -- * Searching+ elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,++ -- * Folding+ foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1',+ ifoldl, ifoldl', ifoldr, ifoldr',++ -- * Specialised folds+ all, any, and, or,+ sum, product,+ maximum, maximumBy, minimum, minimumBy,+ minIndex, minIndexBy, maxIndex, maxIndexBy,++ -- * Unfolding+ unfoldr,++ -- * Scans+ prescanl, prescanl',+ postscanl, postscanl',+ scanl, scanl', scanl1, scanl1',+ prescanr, prescanr',+ postscanr, postscanr',+ scanr, scanr', scanr1, scanr1',++ -- * Enumeration+ enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,++ -- * Conversion to/from lists+ toList, fromList+) where++import Data.Vector.Unboxed.Base+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Fusion.Stream as Stream++import Prelude hiding ( length, null,+ replicate, (++),+ head, last,+ init, tail, take, drop, reverse,+ map, concatMap,+ zipWith, zipWith3, zip, zip3, unzip, unzip3,+ filter, takeWhile, dropWhile, span, break,+ elem, notElem,+ foldl, foldl1, foldr, foldr1,+ all, any, and, or, sum, product, minimum, maximum,+ scanl, scanl1, scanr, scanr1,+ enumFromTo, enumFromThenTo )+import qualified Prelude++#include "vector.h"++instance (Unbox a, Eq a) => Eq (Vector a) where+ {-# INLINE (==) #-}+ (==) = G.eq++instance (Unbox a, Ord a) => Ord (Vector a) where+ {-# INLINE compare #-}+ compare = G.cmp++instance (Show a, Unbox a) => Show (Vector a) where+ show = (Prelude.++ " :: Data.Vector.Unboxed.Vector") . ("fromList " Prelude.++) . show . toList++-- Length+-- ------++length :: Unbox a => Vector a -> Int+{-# INLINE length #-}+length = G.length++null :: Unbox a => Vector a -> Bool+{-# INLINE null #-}+null = G.null++-- Construction+-- ------------++-- | Empty vector+empty :: Unbox a => Vector a+{-# INLINE empty #-}+empty = G.empty++-- | Vector with exaclty one element+singleton :: Unbox a => a -> Vector a+{-# INLINE singleton #-}+singleton = G.singleton++-- | Vector of the given length with the given value in each position+replicate :: Unbox a => Int -> a -> Vector a+{-# INLINE replicate #-}+replicate = G.replicate++-- | Generate a vector of the given length by applying the function to each+-- index+generate :: Unbox a => Int -> (Int -> a) -> Vector a+{-# INLINE generate #-}+generate = G.generate++-- | Prepend an element+cons :: Unbox a => a -> Vector a -> Vector a+{-# INLINE cons #-}+cons = G.cons++-- | Append an element+snoc :: Unbox a => Vector a -> a -> Vector a+{-# INLINE snoc #-}+snoc = G.snoc++infixr 5 +++-- | Concatenate two vectors+(++) :: Unbox a => Vector a -> Vector a -> Vector a+{-# INLINE (++) #-}+(++) = (G.++)++-- | Create a copy of a vector. Useful when dealing with slices.+copy :: Unbox a => Vector a -> Vector a+{-# INLINE copy #-}+copy = G.copy++-- Accessing individual elements+-- -----------------------------++-- | Indexing+(!) :: Unbox a => Vector a -> Int -> a+{-# INLINE (!) #-}+(!) = (G.!)++-- | First element+head :: Unbox a => Vector a -> a+{-# INLINE head #-}+head = G.head++-- | Last element+last :: Unbox a => Vector a -> a+{-# INLINE last #-}+last = G.last++-- | Unsafe indexing without bounds checking+unsafeIndex :: Unbox a => Vector a -> Int -> a+{-# INLINE unsafeIndex #-}+unsafeIndex = G.unsafeIndex++-- | Yield the first element of a vector without checking if the vector is+-- empty+unsafeHead :: Unbox a => Vector a -> a+{-# INLINE unsafeHead #-}+unsafeHead = G.unsafeHead++-- | Yield the last element of a vector without checking if the vector is+-- empty+unsafeLast :: Unbox a => Vector a -> a+{-# INLINE unsafeLast #-}+unsafeLast = G.unsafeLast++-- | Monadic indexing which can be strict in the vector while remaining lazy in+-- the element+indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a+{-# INLINE indexM #-}+indexM = G.indexM++headM :: (Unbox a, Monad m) => Vector a -> m a+{-# INLINE headM #-}+headM = G.headM++lastM :: (Unbox a, Monad m) => Vector a -> m a+{-# INLINE lastM #-}+lastM = G.lastM++-- | Unsafe monadic indexing without bounds checks+unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a+{-# INLINE unsafeIndexM #-}+unsafeIndexM = G.unsafeIndexM++unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a+{-# INLINE unsafeHeadM #-}+unsafeHeadM = G.unsafeHeadM++unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a+{-# INLINE unsafeLastM #-}+unsafeLastM = G.unsafeLastM++-- Subarrays+-- ---------++-- | Yield a part of the vector without copying it. Safer version of+-- 'basicUnsafeSlice'.+slice :: Unbox a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a+{-# INLINE slice #-}+slice = G.slice++-- | Yield all but the last element without copying.+init :: Unbox a => Vector a -> Vector a+{-# INLINE init #-}+init = G.init++-- | All but the first element (without copying).+tail :: Unbox a => Vector a -> Vector a+{-# INLINE tail #-}+tail = G.tail++-- | Yield the first @n@ elements without copying.+take :: Unbox a => Int -> Vector a -> Vector a+{-# INLINE take #-}+take = G.take++-- | Yield all but the first @n@ elements without copying.+drop :: Unbox a => Int -> Vector a -> Vector a+{-# INLINE drop #-}+drop = G.drop++-- | Unsafely yield a part of the vector without copying it and without+-- performing bounds checks.+unsafeSlice :: Unbox a => Int -- ^ starting index+ -> Int -- ^ length+ -> Vector a+ -> Vector a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++unsafeInit :: Unbox a => Vector a -> Vector a+{-# INLINE unsafeInit #-}+unsafeInit = G.unsafeInit++unsafeTail :: Unbox a => Vector a -> Vector a+{-# INLINE unsafeTail #-}+unsafeTail = G.unsafeTail++unsafeTake :: Unbox a => Int -> Vector a -> Vector a+{-# INLINE unsafeTake #-}+unsafeTake = G.unsafeTake++unsafeDrop :: Unbox a => Int -> Vector a -> Vector a+{-# INLINE unsafeDrop #-}+unsafeDrop = G.unsafeDrop++-- Permutations+-- ------------++unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE unsafeAccum #-}+unsafeAccum = G.unsafeAccum++unsafeAccumulate :: (Unbox a, Unbox b)+ => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a+{-# INLINE unsafeAccumulate #-}+unsafeAccumulate = G.unsafeAccumulate++unsafeAccumulate_ :: (Unbox a, Unbox b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE unsafeAccumulate_ #-}+unsafeAccumulate_ = G.unsafeAccumulate_++accum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE accum #-}+accum = G.accum++accumulate :: (Unbox a, Unbox b)+ => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a+{-# INLINE accumulate #-}+accumulate = G.accumulate++accumulate_ :: (Unbox a, Unbox b) =>+ (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a+{-# INLINE accumulate_ #-}+accumulate_ = G.accumulate_++unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE unsafeUpd #-}+unsafeUpd = G.unsafeUpd++unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a+{-# INLINE unsafeUpdate #-}+unsafeUpdate = G.unsafeUpdate++unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE unsafeUpdate_ #-}+unsafeUpdate_ = G.unsafeUpdate_++(//) :: Unbox a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE (//) #-}+(//) = (G.//)++update :: Unbox a => Vector a -> Vector (Int, a) -> Vector a+{-# INLINE update #-}+update = G.update++update_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a+{-# INLINE update_ #-}+update_ = G.update_++backpermute :: Unbox a => Vector a -> Vector Int -> Vector a+{-# INLINE backpermute #-}+backpermute = G.backpermute++unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a+{-# INLINE unsafeBackpermute #-}+unsafeBackpermute = G.unsafeBackpermute++reverse :: Unbox a => Vector a -> Vector a+{-# INLINE reverse #-}+reverse = G.reverse++-- Mapping+-- -------++-- | Map a function over a vector+map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b+{-# INLINE map #-}+map = G.map++-- | Apply a function to every index/value pair+imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b+{-# INLINE imap #-}+imap = G.imap++concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b+{-# INLINE concatMap #-}+concatMap = G.concatMap++-- Zipping/unzipping+-- -----------------++-- | Zip two vectors with the given function.+zipWith :: (Unbox a, Unbox b, Unbox c)+ => (a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE zipWith #-}+zipWith = G.zipWith++-- | Zip three vectors with the given function.+zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d)+ => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE zipWith3 #-}+zipWith3 = G.zipWith3++zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e)+ => (a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE zipWith4 #-}+zipWith4 = G.zipWith4++zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f)+ => (a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE zipWith5 #-}+zipWith5 = G.zipWith5++zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g)+ => (a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE zipWith6 #-}+zipWith6 = G.zipWith6++-- | Zip two vectors and their indices with the given function.+izipWith :: (Unbox a, Unbox b, Unbox c)+ => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE izipWith #-}+izipWith = G.izipWith++-- | Zip three vectors and their indices with the given function.+izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d)+ => (Int -> a -> b -> c -> d)+ -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE izipWith3 #-}+izipWith3 = G.izipWith3++izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e)+ => (Int -> a -> b -> c -> d -> e)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+{-# INLINE izipWith4 #-}+izipWith4 = G.izipWith4++izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f)+ => (Int -> a -> b -> c -> d -> e -> f)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f+{-# INLINE izipWith5 #-}+izipWith5 = G.izipWith5++izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g)+ => (Int -> a -> b -> c -> d -> e -> f -> g)+ -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+ -> Vector f -> Vector g+{-# INLINE izipWith6 #-}+izipWith6 = G.izipWith6++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE filter #-}+filter = G.filter++-- | Drop elements that do not satisfy the predicate (applied to values and+-- their indices)+ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a+{-# INLINE ifilter #-}+ifilter = G.ifilter++-- | Yield the longest prefix of elements satisfying the predicate.+takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE takeWhile #-}+takeWhile = G.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate.+dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE dropWhile #-}+dropWhile = G.dropWhile++-- | Split the vector in two parts, the first one containing those elements+-- that satisfy the predicate and the second one those that don't. The+-- relative order of the elements is preserved at the cost of a (sometimes)+-- reduced performance compared to 'unstablePartition'.+partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE partition #-}+partition = G.partition++-- | 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.+unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE unstablePartition #-}+unstablePartition = G.unstablePartition++-- | Split the vector into the longest prefix of elements that satisfy the+-- predicate and the rest.+span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE span #-}+span = G.span++-- | Split the vector into the longest prefix of elements that do not satisfy+-- the predicate and the rest.+break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE break #-}+break = G.break++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the vector contains an element+elem :: (Unbox a, Eq a) => a -> Vector a -> Bool+{-# INLINE elem #-}+elem = G.elem++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool+{-# INLINE notElem #-}+notElem = G.notElem++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a+{-# INLINE find #-}+find = G.find++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int+{-# INLINE findIndex #-}+findIndex = G.findIndex++-- | Yield the indices of elements satisfying the predicate+findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int+{-# INLINE findIndices #-}+findIndices = G.findIndices++-- | Yield 'Just' the index of the first occurence of the given element or+-- 'Nothing' if the vector does not contain the element+elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int+{-# INLINE elemIndex #-}+elemIndex = G.elemIndex++-- | Yield the indices of all occurences of the given element+elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int+{-# INLINE elemIndices #-}+elemIndices = G.elemIndices++-- Folding+-- -------++-- | Left fold+foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl #-}+foldl = G.foldl++-- | Lefgt fold on non-empty vectors+foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1 #-}+foldl1 = G.foldl1++-- | Left fold with strict accumulator+foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl' #-}+foldl' = G.foldl'++-- | Left fold on non-empty vectors with strict accumulator+foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1' #-}+foldl1' = G.foldl1'++-- | Right fold+foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr #-}+foldr = G.foldr++-- | Right fold on non-empty vectors+foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1 #-}+foldr1 = G.foldr1++-- | Right fold with a strict accumulator+foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr' #-}+foldr' = G.foldr'++-- | Right fold on non-empty vectors with strict accumulator+foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1' #-}+foldr1' = G.foldr1'++-- | Left fold (function applied to each element and its index)+ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl #-}+ifoldl = G.ifoldl++-- | Left fold with strict accumulator (function applied to each element and+-- its index)+ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a+{-# INLINE ifoldl' #-}+ifoldl' = G.ifoldl'++-- | Right fold (function applied to each element and its index)+ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr #-}+ifoldr = G.ifoldr++-- | Right fold with strict accumulator (function applied to each element and+-- its index)+ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b+{-# INLINE ifoldr' #-}+ifoldr' = G.ifoldr'++-- Specialised folds+-- -----------------++all :: Unbox a => (a -> Bool) -> Vector a -> Bool+{-# INLINE all #-}+all = G.all++any :: Unbox a => (a -> Bool) -> Vector a -> Bool+{-# INLINE any #-}+any = G.any++and :: Vector Bool -> Bool+{-# INLINE and #-}+and = G.and++or :: Vector Bool -> Bool+{-# INLINE or #-}+or = G.or++sum :: (Unbox a, Num a) => Vector a -> a+{-# INLINE sum #-}+sum = G.sum++product :: (Unbox a, Num a) => Vector a -> a+{-# INLINE product #-}+product = G.product++maximum :: (Unbox a, Ord a) => Vector a -> a+{-# INLINE maximum #-}+maximum = G.maximum++maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE maximumBy #-}+maximumBy = G.maximumBy++minimum :: (Unbox a, Ord a) => Vector a -> a+{-# INLINE minimum #-}+minimum = G.minimum++minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a+{-# INLINE minimumBy #-}+minimumBy = G.minimumBy++maxIndex :: (Unbox a, Ord a) => Vector a -> Int+{-# INLINE maxIndex #-}+maxIndex = G.maxIndex++maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE maxIndexBy #-}+maxIndexBy = G.maxIndexBy++minIndex :: (Unbox a, Ord a) => Vector a -> Int+{-# INLINE minIndex #-}+minIndex = G.minIndex++minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int+{-# INLINE minIndexBy #-}+minIndexBy = G.minIndexBy++-- Unfolding+-- ---------++unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldr #-}+unfoldr = G.unfoldr++-- Scans+-- -----++-- | Prefix scan+prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl #-}+prescanl = G.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl' #-}+prescanl' = G.prescanl'++-- | Suffix scan+postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl #-}+postscanl = G.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl' #-}+postscanl' = G.postscanl'++-- | Haskell-style scan+scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl #-}+scanl = G.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl' #-}+scanl' = G.scanl'++-- | Scan over a non-empty 'Vector'+scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1 #-}+scanl1 = G.scanl1++-- | Scan over a non-empty 'Vector' with a strict accumulator+scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1' #-}+scanl1' = G.scanl1'+++-- | Prefix right-to-left scan+prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr #-}+prescanr = G.prescanr++-- | Prefix right-to-left scan with strict accumulator+prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE prescanr' #-}+prescanr' = G.prescanr'++-- | Suffix right-to-left scan+postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr #-}+postscanr = G.postscanr++-- | Suffix right-to-left scan with strict accumulator+postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE postscanr' #-}+postscanr' = G.postscanr'++-- | Haskell-style right-to-left scan+scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr #-}+scanr = G.scanr++-- | Haskell-style right-to-left scan with strict accumulator+scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b+{-# INLINE scanr' #-}+scanr' = G.scanr'++-- | Right-to-left scan over a non-empty vector+scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1 #-}+scanr1 = G.scanr1++-- | Right-to-left scan over a non-empty vector with a strict accumulator+scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanr1' #-}+scanr1' = G.scanr1'++-- Enumeration+-- -----------++-- | Yield a vector of the given length containing the values @x@, @x+1@ etc.+-- This operation is usually more efficient than 'enumFromTo'.+enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a+{-# INLINE enumFromN #-}+enumFromN = G.enumFromN++-- | 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 :: (Unbox a, Num a) => a -> a -> Int -> Vector a+{-# INLINE enumFromStepN #-}+enumFromStepN = G.enumFromStepN++-- | Enumerate values from @x@ to @y@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromN' instead.+enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a+{-# INLINE enumFromTo #-}+enumFromTo = G.enumFromTo++-- | Enumerate values from @x@ to @y@ with a specific step @z@.+--+-- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = G.enumFromThenTo++-- Conversion to/from lists+-- ------------------------++-- | Convert a vector to a list+toList :: Unbox a => Vector a -> [a]+{-# INLINE toList #-}+toList = G.toList++-- | Convert a list to a vector+fromList :: Unbox a => [a] -> Vector a+{-# INLINE fromList #-}+fromList = G.fromList++#define DEFINE_IMMUTABLE+#include "unbox-tuple-instances"+
+ Data/Vector/Unboxed/Base.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts,+ ScopedTypeVariables #-}+-- |+-- Module : Data.Vector.Unboxed.Base+-- Copyright : (c) Roman Leshchinskiy 2009+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable+--+-- Adaptive unboxed vectors: basic implementation+--++module Data.Vector.Unboxed.Base (+ MVector(..), IOVector, STVector, Vector(..), Unbox+) where++import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as M++import qualified Data.Vector.Primitive as P++import Control.Monad.Primitive+import Control.Monad.ST ( runST )+import Control.Monad ( liftM )++import Data.Word ( Word, Word8, Word16, Word32, Word64 )+import Data.Int ( Int8, Int16, Int32, Int64 )+import Data.Complex++#include "vector.h"++data family MVector s a+data family Vector a++type IOVector = MVector RealWorld+type STVector s = MVector s++type instance G.Mutable Vector = MVector++class (G.Vector Vector a, M.MVector MVector a) => Unbox a+++-- ----+-- Unit+-- ----++newtype instance MVector s () = MV_Unit Int+newtype instance Vector () = V_Unit Int++instance Unbox ()++instance M.MVector MVector () where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}++ basicLength (MV_Unit n) = n++ basicUnsafeSlice i m (MV_Unit n) = MV_Unit m++ basicOverlaps _ _ = False++ basicUnsafeNew n = return (MV_Unit n)++ basicUnsafeRead (MV_Unit _) _ = return ()++ basicUnsafeWrite (MV_Unit _) _ () = return ()++ basicClear _ = return ()++ basicSet (MV_Unit _) () = return ()++ basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return ()++ basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m)++instance G.Vector Vector () where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_Unit n) = return $ V_Unit n++ {-# INLINE basicLength #-}+ basicLength (V_Unit n) = n++ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i m (V_Unit n) = V_Unit m++ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_Unit _) i = return ()++ {-# INLINE elemseq #-}+ elemseq _ = seq+++-- ---------------+-- Primitive types+-- ---------------++#define primMVector(ty,con) \+instance M.MVector MVector ty where { \+ {-# INLINE basicLength #-} \+; {-# INLINE basicUnsafeSlice #-} \+; {-# INLINE basicOverlaps #-} \+; {-# INLINE basicUnsafeNew #-} \+; {-# INLINE basicUnsafeNewWith #-} \+; {-# INLINE basicUnsafeRead #-} \+; {-# INLINE basicUnsafeWrite #-} \+; {-# INLINE basicClear #-} \+; {-# INLINE basicSet #-} \+; {-# INLINE basicUnsafeCopy #-} \+; {-# INLINE basicUnsafeGrow #-} \+; basicLength (con v) = M.basicLength v \+; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \+; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \+; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \+; basicUnsafeNewWith n x = con `liftM` M.basicUnsafeNewWith n x \+; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \+; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \+; basicClear (con v) = M.basicClear v \+; basicSet (con v) x = M.basicSet v x \+; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \+; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n }++#define primVector(ty,con,mcon) \+instance G.Vector Vector ty where { \+ {-# INLINE unsafeFreeze #-} \+; {-# INLINE basicLength #-} \+; {-# INLINE basicUnsafeSlice #-} \+; {-# INLINE basicUnsafeIndexM #-} \+; {-# INLINE elemseq #-} \+; unsafeFreeze (mcon v) = con `liftM` G.unsafeFreeze v \+; basicLength (con v) = G.basicLength v \+; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \+; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \+; elemseq _ = seq }++newtype instance MVector s Int = MV_Int (P.MVector s Int)+newtype instance Vector Int = V_Int (P.Vector Int)+instance Unbox Int+primMVector(Int, MV_Int)+primVector(Int, V_Int, MV_Int)++newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8)+newtype instance Vector Int8 = V_Int8 (P.Vector Int8)+instance Unbox Int8+primMVector(Int8, MV_Int8)+primVector(Int8, V_Int8, MV_Int8)++newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16)+newtype instance Vector Int16 = V_Int16 (P.Vector Int16)+instance Unbox Int16+primMVector(Int16, MV_Int16)+primVector(Int16, V_Int16, MV_Int16)++newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32)+newtype instance Vector Int32 = V_Int32 (P.Vector Int32)+instance Unbox Int32+primMVector(Int32, MV_Int32)+primVector(Int32, V_Int32, MV_Int32)++newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64)+newtype instance Vector Int64 = V_Int64 (P.Vector Int64)+instance Unbox Int64+primMVector(Int64, MV_Int64)+primVector(Int64, V_Int64, MV_Int64)+++newtype instance MVector s Word = MV_Word (P.MVector s Word)+newtype instance Vector Word = V_Word (P.Vector Word)+instance Unbox Word+primMVector(Word, MV_Word)+primVector(Word, V_Word, MV_Word)++newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8)+newtype instance Vector Word8 = V_Word8 (P.Vector Word8)+instance Unbox Word8+primMVector(Word8, MV_Word8)+primVector(Word8, V_Word8, MV_Word8)++newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16)+newtype instance Vector Word16 = V_Word16 (P.Vector Word16)+instance Unbox Word16+primMVector(Word16, MV_Word16)+primVector(Word16, V_Word16, MV_Word16)++newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32)+newtype instance Vector Word32 = V_Word32 (P.Vector Word32)+instance Unbox Word32+primMVector(Word32, MV_Word32)+primVector(Word32, V_Word32, MV_Word32)++newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64)+newtype instance Vector Word64 = V_Word64 (P.Vector Word64)+instance Unbox Word64+primMVector(Word64, MV_Word64)+primVector(Word64, V_Word64, MV_Word64)+++newtype instance MVector s Float = MV_Float (P.MVector s Float)+newtype instance Vector Float = V_Float (P.Vector Float)+instance Unbox Float+primMVector(Float, MV_Float)+primVector(Float, V_Float, MV_Float)++newtype instance MVector s Double = MV_Double (P.MVector s Double)+newtype instance Vector Double = V_Double (P.Vector Double)+instance Unbox Double+primMVector(Double, MV_Double)+primVector(Double, V_Double, MV_Double)+++newtype instance MVector s Char = MV_Char (P.MVector s Char)+newtype instance Vector Char = V_Char (P.Vector Char)+instance Unbox Char+primMVector(Char, MV_Char)+primVector(Char, V_Char, MV_Char)++-- ----+-- Bool+-- ----++fromBool :: Bool -> Word8+{-# INLINE fromBool #-}+fromBool True = 1+fromBool False = 0++toBool :: Word8 -> Bool+{-# INLINE toBool #-}+toBool 0 = False+toBool _ = True++newtype instance MVector s Bool = MV_Bool (P.MVector s Word8)+newtype instance Vector Bool = V_Bool (P.Vector Word8)++instance Unbox Bool++instance M.MVector MVector Bool where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeNewWith #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Bool v) = M.basicLength v+ basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v+ basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n+ basicUnsafeNewWith n x = MV_Bool `liftM` M.basicUnsafeNewWith n (fromBool x)+ basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i+ basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x)+ basicClear (MV_Bool v) = M.basicClear v+ basicSet (MV_Bool v) x = M.basicSet v (fromBool x)+ basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n++instance G.Vector Vector Bool where+ {-# INLINE unsafeFreeze #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ unsafeFreeze (MV_Bool v) = V_Bool `liftM` G.unsafeFreeze v+ basicLength (V_Bool v) = G.basicLength v+ basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i+ elemseq _ = seq++-- -------+-- Complex+-- -------++newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a))+newtype instance Vector (Complex a) = V_Complex (Vector (a,a))++instance (RealFloat a, Unbox a) => Unbox (Complex a)++instance (RealFloat a, Unbox a) => M.MVector MVector (Complex a) where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeNewWith #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Complex v) = M.basicLength v+ basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v+ basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n+ basicUnsafeNewWith n (x :+ y) = MV_Complex `liftM` M.basicUnsafeNewWith n (x,y)+ basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i+ basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y)+ basicClear (MV_Complex v) = M.basicClear v+ basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y)+ basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n++instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where+ {-# INLINE unsafeFreeze #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ unsafeFreeze (MV_Complex v) = V_Complex `liftM` G.unsafeFreeze v+ basicLength (V_Complex v) = G.basicLength v+ basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Complex v) i+ = uncurry (:+) `liftM` G.basicUnsafeIndexM v i+ elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x+ $ G.elemseq (undefined :: Vector a) y z++-- ------+-- Tuples+-- ------++#define DEFINE_INSTANCES+#include "unbox-tuple-instances"+
+ Data/Vector/Unboxed/Mutable.hs view
@@ -0,0 +1,158 @@+-- |+-- Module : Data.Vector.Unboxed.Mutable+-- Copyright : (c) Roman Leshchinskiy 2009+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable+--+-- Mutable adaptive unboxed vectors+--++module Data.Vector.Unboxed.Mutable (+ -- * Mutable vectors of primitive types+ MVector(..), IOVector, STVector, Unbox,++ -- * Operations on mutable vectors+ length, overlaps, slice, new, newWith, read, write, swap,+ clear, set, copy, grow,+ zip, zip3, zip4, zip5, zip6,+ unzip, unzip3, unzip4, unzip5, unzip6,++ -- * Unsafe operations+ unsafeSlice, unsafeNew, unsafeNewWith, unsafeRead, unsafeWrite, unsafeSwap,+ unsafeCopy, unsafeGrow+) where++import Data.Vector.Unboxed.Base+import qualified Data.Vector.Generic.Mutable as G+import Control.Monad.Primitive++import Prelude hiding ( zip, zip3, unzip, unzip3, length, read )++#include "vector.h"++-- | Yield a part of the mutable vector without copying it. No bounds checks+-- are performed.+unsafeSlice :: Unbox a => Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> MVector s a+ -> MVector s a+{-# INLINE unsafeSlice #-}+unsafeSlice = G.unsafeSlice++-- | Create a mutable vector of the given length. The length is not checked.+unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeNew #-}+unsafeNew = G.unsafeNew++-- | Create a mutable vector of the given length and fill it with an+-- initial value. The length is not checked.+unsafeNewWith :: (PrimMonad m, Unbox a)+ => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith = G.unsafeNewWith++-- | Yield the element at the given position. No bounds checks are performed.+unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead = G.unsafeRead++-- | Replace the element at the given position. No bounds checks are performed.+unsafeWrite :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite = G.unsafeWrite++-- | Swap the elements at the given positions. No bounds checks are performed.+unsafeSwap :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE unsafeSwap #-}+unsafeSwap = G.unsafeSwap++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap. This is not checked.+unsafeCopy :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy++-- | Grow a vector by the given number of elements. The number must be+-- positive but this is not checked.+unsafeGrow :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE unsafeGrow #-}+unsafeGrow = G.unsafeGrow++-- | Length of the mutable vector.+length :: Unbox a => MVector s a -> Int+{-# INLINE length #-}+length = G.length++-- Check whether two vectors overlap.+overlaps :: Unbox a => MVector s a -> MVector s a -> Bool+{-# INLINE overlaps #-}+overlaps = G.overlaps++-- | Yield a part of the mutable vector without copying it.+slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a+{-# INLINE slice #-}+slice = G.slice++-- | Create a mutable vector of the given length.+new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a)+{-# INLINE new #-}+new = G.new++-- | Create a mutable vector of the given length and fill it with an+-- initial value.+newWith :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a)+{-# INLINE newWith #-}+newWith = G.newWith++-- | Yield the element at the given position.+read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read = G.read++-- | Replace the element at the given position.+write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write = G.write++-- | Swap the elements at the given positions.+swap :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> Int -> Int -> m ()+{-# INLINE swap #-}+swap = G.swap++-- | Reset all elements of the vector to some undefined value, clearing all+-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m ()+{-# INLINE clear #-}+clear = G.clear++-- | Set all elements of the vector to the given value.+set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m ()+{-# INLINE set #-}+set = G.set++-- | Copy a vector. The two vectors must have the same length and may not+-- overlap.+copy :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+{-# INLINE copy #-}+copy = G.copy++-- | Grow a vector by the given number of elements. The number must be+-- positive.+grow :: (PrimMonad m, Unbox a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+{-# INLINE grow #-}+grow = G.grow++#define DEFINE_MUTABLE+#include "unbox-tuple-instances"+
− include/phases.h
@@ -1,6 +0,0 @@-#define PHASE_STREAM [1]-#define PHASE_INNER [0]--#define INLINE_STREAM INLINE PHASE_STREAM-#define INLINE_INNER INLINE PHASE_INNER-
+ include/vector.h view
@@ -0,0 +1,31 @@+#define PHASE_STREAM [1]+#define PHASE_INNER [0]++#define INLINE_STREAM INLINE PHASE_STREAM+#define INLINE_INNER INLINE PHASE_INNER++#ifndef NOT_VECTOR_MODULE+import qualified Data.Vector.Internal.Check as Ck+#endif++#define ERROR(f) (Ck.f __FILE__ __LINE__)+#define ASSERT (Ck.assert __FILE__ __LINE__)+#define ENSURE (Ck.f __FILE__ __LINE__)+#define CHECK(f) (Ck.f __FILE__ __LINE__)++#define BOUNDS_ERROR(f) (ERROR(f) Ck.Bounds)+#define BOUNDS_ASSERT (ASSERT Ck.Bounds)+#define BOUNDS_ENSURE (ENSURE Ck.Bounds)+#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds)++#define UNSAFE_ERROR(f) (ERROR(f) Ck.Unsafe)+#define UNSAFE_ASSERT (ASSERT Ck.Unsafe)+#define UNSAFE_ENSURE (ENSURE Ck.Unsafe)+#define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe)++#define INTERNAL_ERROR(f) (ERROR(f) Ck.Internal)+#define INTERNAL_ASSERT (ASSERT Ck.Internal)+#define INTERNAL_ENSURE (ENSURE Ck.Internal)+#define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal)++
+ internal/GenUnboxTuple.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE ParallelListComp #-}+module Main where++import Text.PrettyPrint++import System.Environment ( getArgs )++main = do+ [s] <- getArgs+ let n = read s+ mapM_ (putStrLn . render . generate) [2..n]++generate :: Int -> Doc+generate n =+ vcat [ text "#ifdef DEFINE_INSTANCES"+ , data_instance "MVector s" "MV"+ , data_instance "Vector" "V"+ , class_instance "Unbox"+ , class_instance "M.MVector MVector" <+> text "where"+ , nest 2 $ vcat $ map method methods_MVector+ , class_instance "G.Vector Vector" <+> text "where"+ , nest 2 $ vcat $ map method methods_Vector+ , text "#endif"+ , text "#ifdef DEFINE_MUTABLE"+ , define_zip "MVector s" "MV"+ , define_unzip "MVector s" "MV"+ , text "#endif"+ , text "#ifdef DEFINE_IMMUTABLE"+ , define_zip "Vector" "V"+ , define_zip_rule+ , define_unzip "Vector" "V"+ , text "#endif"+ ]++ where+ vars = map char $ take n ['a'..]+ varss = map (<> char 's') vars+ tuple xs = parens $ hsep $ punctuate comma xs+ vtuple xs = parens $ sep $ punctuate comma xs+ con s = text s <> char '_' <> int n+ var c = text (c : "_")++ data_instance ty c+ = hang (hsep [text "data instance", text ty, tuple vars])+ 4+ (hsep [char '=', con c, text "{-# UNPACK #-} !Int"+ , vcat $ map (\v -> char '!' <> parens (text ty <+> v)) vars])++ class_instance cls+ = text "instance" <+> vtuple [text "Unbox" <+> v | v <- vars]+ <+> text "=>" <+> text cls <+> tuple vars+++ define_zip ty c+ = sep [name <+> text "::"+ <+> vtuple [text "Unbox" <+> v | v <- vars]+ <+> text "=>"+ <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars])+ <+> text "->"+ <+> text ty <+> tuple vars+ ,text "{-# INLINE_STREAM" <+> name <+> text "#-}"+ ,name <+> sep varss+ <+> text "="+ <+> con c+ <+> text "len"+ <+> sep [parens $ text "unsafeSlice"+ <+> char '0'+ <+> text "len"+ <+> vs | vs <- varss]+ ,nest 2 $ hang (text "where")+ 2+ $ text "len ="+ <+> sep (punctuate (text " `min`")+ [text "length" <+> vs | vs <- varss])+ ]+ where+ name | n == 2 = text "zip"+ | otherwise = text "zip" <> int n++ define_zip_rule+ = hang (text "{-# RULES" <+> text "\"stream/" <> name "zip"+ <> text " [Vector.Unboxed]\" forall" <+> sep varss <+> char '.')+ 2 $+ text "G.stream" <+> parens (name "zip" <+> sep varss)+ <+> char '='+ <+> text "Stream." <> name "zipWith" <+> tuple (replicate n empty)+ <+> sep [parens $ text "G.stream" <+> vs | vs <- varss]+ $$ text "#-}"+ where+ name s | n == 2 = text s+ | otherwise = text s <> int n+ ++ define_unzip ty c+ = sep [name <+> text "::"+ <+> vtuple [text "Unbox" <+> v | v <- vars]+ <+> text "=>"+ <+> text ty <+> tuple vars+ <+> text "->" <+> vtuple [text ty <+> v | v <- vars]+ ,text "{-# INLINE" <+> name <+> text "#-}"+ ,name <+> pat c <+> text "="+ <+> vtuple varss+ ]+ where+ name | n == 2 = text "unzip"+ | otherwise = text "unzip" <> int n++ pat c = parens $ con c <+> var 'n' <+> sep varss+ patn c n = parens $ con c <+> (var 'n' <> int n)+ <+> sep [v <> int n | v <- varss]++ qM s = text "M." <> text s+ qG s = text "G." <> text s++ gen_length c _ = (pat c, var 'n')++ gen_unsafeSlice mod c rec+ = (var 'i' <+> var 'm' <+> pat c,+ con c <+> var 'm'+ <+> vcat [parens+ $ text mod <> char '.' <> text rec+ <+> var 'i' <+> var 'm' <+> vs+ | vs <- varss])+++ gen_overlaps rec = (patn "MV" 1 <+> patn "MV" 2,+ vcat $ r : [text "||" <+> r | r <- rs])+ where+ r : rs = [qM rec <+> v <> char '1' <+> v <> char '2' | v <- varss]++ gen_unsafeNew rec+ = (var 'n',+ mk_do [v <+> text "<-" <+> qM rec <+> var 'n' | v <- varss]+ $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss)++ gen_unsafeNewWith rec+ = (var 'n' <+> tuple vars,+ mk_do [vs <+> text "<-" <+> qM rec <+> var 'n' <+> v+ | v <- vars | vs <- varss]+ $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss)++ gen_unsafeRead rec+ = (pat "MV" <+> var 'i',+ mk_do [v <+> text "<-" <+> qM rec <+> vs <+> var 'i' | v <- vars+ | vs <- varss]+ $ text "return" <+> tuple vars)++ gen_unsafeWrite rec+ = (pat "MV" <+> var 'i' <+> tuple vars,+ mk_do [qM rec <+> vs <+> var 'i' <+> v | v <- vars | vs <- varss]+ empty)++ gen_clear rec+ = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty)++ gen_set rec+ = (pat "MV" <+> tuple vars,+ mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty)++ gen_unsafeCopy rec+ = (patn "MV" 1 <+> patn "MV" 2,+ mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]+ empty)++ gen_unsafeGrow rec+ = (pat "MV" <+> var 'm',+ mk_do [vs <> char '\'' <+> text "<-"+ <+> qM rec <+> vs <+> var 'm' | vs <- varss]+ $ text "return $" <+> con "MV"+ <+> parens (var 'm' <> char '+' <> var 'n')+ <+> sep (map (<> char '\'') varss))++ gen_unsafeFreeze rec+ = (pat "MV",+ mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss]+ $ text "return $" <+> con "V" <+> var 'n'+ <+> sep [vs <> char '\'' | vs <- varss])++ gen_basicUnsafeIndexM rec+ = (pat "V" <+> var 'i',+ mk_do [v <+> text "<-" <+> qG rec <+> vs <+> var 'i'+ | vs <- varss | v <- vars]+ $ text "return" <+> tuple vars)++ gen_elemseq rec+ = (char '_' <+> tuple vars <+> var 'x',+ vcat [qG rec <+> parens (text "undefined :: Vector" <+> v)+ <+> v <+> char '$' | v <- vars]+ <+> var 'x')+++ mk_do cmds ret = hang (text "do")+ 2+ $ vcat $ cmds ++ [ret]++ method (s, f) = case f s of+ (p,e) -> text "{-# INLINE" <+> text s <+> text " #-}"+ $$ hang (text s <+> p)+ 4+ (char '=' <+> e)+ ++ methods_MVector = [("basicLength", gen_length "MV")+ ,("basicUnsafeSlice", gen_unsafeSlice "M" "MV")+ ,("basicOverlaps", gen_overlaps)+ ,("basicUnsafeNew", gen_unsafeNew)+ ,("basicUnsafeNewWith", gen_unsafeNewWith)+ ,("basicUnsafeRead", gen_unsafeRead)+ ,("basicUnsafeWrite", gen_unsafeWrite)+ ,("basicClear", gen_clear)+ ,("basicSet", gen_set)+ ,("basicUnsafeCopy", gen_unsafeCopy)+ ,("basicUnsafeGrow", gen_unsafeGrow)]++ methods_Vector = [("unsafeFreeze", gen_unsafeFreeze)+ ,("basicLength", gen_length "V")+ ,("basicUnsafeSlice", gen_unsafeSlice "G" "V")+ ,("basicUnsafeIndexM", gen_basicUnsafeIndexM)+ ,("elemseq", gen_elemseq)]
+ internal/unbox-tuple-instances view
@@ -0,0 +1,937 @@+#ifdef DEFINE_INSTANCES+data instance MVector s (a, b)+ = MV_2 {-# UNPACK #-} !Int !(MVector s a)+ !(MVector s b)+data instance Vector (a, b)+ = V_2 {-# UNPACK #-} !Int !(Vector a)+ !(Vector b)+instance (Unbox a, Unbox b) => Unbox (a, b)+instance (Unbox a, Unbox b) => M.MVector MVector (a, b) where+ {-# INLINE basicLength #-}+ basicLength (MV_2 n_ as bs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (MV_2 n_ as bs)+ = MV_2 m_ (M.basicUnsafeSlice i_ m_ as)+ (M.basicUnsafeSlice i_ m_ bs)+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2)+ = M.basicOverlaps as1 as2+ || M.basicOverlaps bs1 bs2+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n_+ = do+ as <- M.basicUnsafeNew n_+ bs <- M.basicUnsafeNew n_+ return $ MV_2 n_ as bs+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n_ (a, b)+ = do+ as <- M.basicUnsafeNewWith n_ a+ bs <- M.basicUnsafeNewWith n_ b+ return $ MV_2 n_ as bs+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MV_2 n_ as bs) i_+ = do+ a <- M.basicUnsafeRead as i_+ b <- M.basicUnsafeRead bs i_+ return (a, b)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MV_2 n_ as bs) i_ (a, b)+ = do+ M.basicUnsafeWrite as i_ a+ M.basicUnsafeWrite bs i_ b+ {-# INLINE basicClear #-}+ basicClear (MV_2 n_ as bs)+ = do+ M.basicClear as+ M.basicClear bs+ {-# INLINE basicSet #-}+ basicSet (MV_2 n_ as bs) (a, b)+ = do+ M.basicSet as a+ M.basicSet bs b+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2)+ = do+ M.basicUnsafeCopy as1 as2+ M.basicUnsafeCopy bs1 bs2+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow (MV_2 n_ as bs) m_+ = do+ as' <- M.basicUnsafeGrow as m_+ bs' <- M.basicUnsafeGrow bs m_+ return $ MV_2 (m_+n_) as' bs'+instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_2 n_ as bs)+ = do+ as' <- G.unsafeFreeze as+ bs' <- G.unsafeFreeze bs+ return $ V_2 n_ as' bs'+ {-# INLINE basicLength #-}+ basicLength (V_2 n_ as bs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (V_2 n_ as bs)+ = V_2 m_ (G.basicUnsafeSlice i_ m_ as)+ (G.basicUnsafeSlice i_ m_ bs)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_2 n_ as bs) i_+ = do+ a <- G.basicUnsafeIndexM as i_+ b <- G.basicUnsafeIndexM bs i_+ return (a, b)+ {-# INLINE elemseq #-}+ elemseq _ (a, b) x_+ = G.elemseq (undefined :: Vector a) a $+ G.elemseq (undefined :: Vector b) b $ x_+#endif+#ifdef DEFINE_MUTABLE+zip :: (Unbox a, Unbox b) => MVector s a ->+ MVector s b -> MVector s (a, b)+{-# INLINE_STREAM zip #-}+zip as bs = MV_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs)+ where len = length as `min` length bs+unzip :: (Unbox a, Unbox b) => MVector s (a, b) -> (MVector s a,+ MVector s b)+{-# INLINE unzip #-}+unzip (MV_2 n_ as bs) = (as, bs)+#endif+#ifdef DEFINE_IMMUTABLE+zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b)+{-# INLINE_STREAM zip #-}+zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs)+ where len = length as `min` length bs+{-# RULES "stream/zip [Vector.Unboxed]" forall as bs .+ G.stream (zip as bs) = Stream.zipWith (,) (G.stream as)+ (G.stream bs)+ #-}+unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a,+ Vector b)+{-# INLINE unzip #-}+unzip (V_2 n_ as bs) = (as, bs)+#endif+#ifdef DEFINE_INSTANCES+data instance MVector s (a, b, c)+ = MV_3 {-# UNPACK #-} !Int !(MVector s a)+ !(MVector s b)+ !(MVector s c)+data instance Vector (a, b, c)+ = V_3 {-# UNPACK #-} !Int !(Vector a)+ !(Vector b)+ !(Vector c)+instance (Unbox a, Unbox b, Unbox c) => Unbox (a, b, c)+instance (Unbox a,+ Unbox b,+ Unbox c) => M.MVector MVector (a, b, c) where+ {-# INLINE basicLength #-}+ basicLength (MV_3 n_ as bs cs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (MV_3 n_ as bs cs)+ = MV_3 m_ (M.basicUnsafeSlice i_ m_ as)+ (M.basicUnsafeSlice i_ m_ bs)+ (M.basicUnsafeSlice i_ m_ cs)+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2)+ = M.basicOverlaps as1 as2+ || M.basicOverlaps bs1 bs2+ || M.basicOverlaps cs1 cs2+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n_+ = do+ as <- M.basicUnsafeNew n_+ bs <- M.basicUnsafeNew n_+ cs <- M.basicUnsafeNew n_+ return $ MV_3 n_ as bs cs+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n_ (a, b, c)+ = do+ as <- M.basicUnsafeNewWith n_ a+ bs <- M.basicUnsafeNewWith n_ b+ cs <- M.basicUnsafeNewWith n_ c+ return $ MV_3 n_ as bs cs+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MV_3 n_ as bs cs) i_+ = do+ a <- M.basicUnsafeRead as i_+ b <- M.basicUnsafeRead bs i_+ c <- M.basicUnsafeRead cs i_+ return (a, b, c)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MV_3 n_ as bs cs) i_ (a, b, c)+ = do+ M.basicUnsafeWrite as i_ a+ M.basicUnsafeWrite bs i_ b+ M.basicUnsafeWrite cs i_ c+ {-# INLINE basicClear #-}+ basicClear (MV_3 n_ as bs cs)+ = do+ M.basicClear as+ M.basicClear bs+ M.basicClear cs+ {-# INLINE basicSet #-}+ basicSet (MV_3 n_ as bs cs) (a, b, c)+ = do+ M.basicSet as a+ M.basicSet bs b+ M.basicSet cs c+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2)+ = do+ M.basicUnsafeCopy as1 as2+ M.basicUnsafeCopy bs1 bs2+ M.basicUnsafeCopy cs1 cs2+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow (MV_3 n_ as bs cs) m_+ = do+ as' <- M.basicUnsafeGrow as m_+ bs' <- M.basicUnsafeGrow bs m_+ cs' <- M.basicUnsafeGrow cs m_+ return $ MV_3 (m_+n_) as' bs' cs'+instance (Unbox a,+ Unbox b,+ Unbox c) => G.Vector Vector (a, b, c) where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_3 n_ as bs cs)+ = do+ as' <- G.unsafeFreeze as+ bs' <- G.unsafeFreeze bs+ cs' <- G.unsafeFreeze cs+ return $ V_3 n_ as' bs' cs'+ {-# INLINE basicLength #-}+ basicLength (V_3 n_ as bs cs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (V_3 n_ as bs cs)+ = V_3 m_ (G.basicUnsafeSlice i_ m_ as)+ (G.basicUnsafeSlice i_ m_ bs)+ (G.basicUnsafeSlice i_ m_ cs)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_3 n_ as bs cs) i_+ = do+ a <- G.basicUnsafeIndexM as i_+ b <- G.basicUnsafeIndexM bs i_+ c <- G.basicUnsafeIndexM cs i_+ return (a, b, c)+ {-# INLINE elemseq #-}+ elemseq _ (a, b, c) x_+ = G.elemseq (undefined :: Vector a) a $+ G.elemseq (undefined :: Vector b) b $+ G.elemseq (undefined :: Vector c) c $ x_+#endif+#ifdef DEFINE_MUTABLE+zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a ->+ MVector s b ->+ MVector s c -> MVector s (a, b, c)+{-# INLINE_STREAM zip3 #-}+zip3 as bs cs = MV_3 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ where len = length as `min` length bs `min` length cs+unzip3 :: (Unbox a,+ Unbox b,+ Unbox c) => MVector s (a, b, c) -> (MVector s a,+ MVector s b,+ MVector s c)+{-# INLINE unzip3 #-}+unzip3 (MV_3 n_ as bs cs) = (as, bs, cs)+#endif+#ifdef DEFINE_IMMUTABLE+zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a ->+ Vector b ->+ Vector c -> Vector (a, b, c)+{-# INLINE_STREAM zip3 #-}+zip3 as bs cs = V_3 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ where len = length as `min` length bs `min` length cs+{-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs .+ G.stream (zip3 as bs cs) = Stream.zipWith3 (, ,) (G.stream as)+ (G.stream bs)+ (G.stream cs)+ #-}+unzip3 :: (Unbox a,+ Unbox b,+ Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c)+{-# INLINE unzip3 #-}+unzip3 (V_3 n_ as bs cs) = (as, bs, cs)+#endif+#ifdef DEFINE_INSTANCES+data instance MVector s (a, b, c, d)+ = MV_4 {-# UNPACK #-} !Int !(MVector s a)+ !(MVector s b)+ !(MVector s c)+ !(MVector s d)+data instance Vector (a, b, c, d)+ = V_4 {-# UNPACK #-} !Int !(Vector a)+ !(Vector b)+ !(Vector c)+ !(Vector d)+instance (Unbox a, Unbox b, Unbox c, Unbox d) => Unbox (a, b, c, d)+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d) => M.MVector MVector (a, b, c, d) where+ {-# INLINE basicLength #-}+ basicLength (MV_4 n_ as bs cs ds) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (MV_4 n_ as bs cs ds)+ = MV_4 m_ (M.basicUnsafeSlice i_ m_ as)+ (M.basicUnsafeSlice i_ m_ bs)+ (M.basicUnsafeSlice i_ m_ cs)+ (M.basicUnsafeSlice i_ m_ ds)+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2 bs2 cs2 ds2)+ = M.basicOverlaps as1 as2+ || M.basicOverlaps bs1 bs2+ || M.basicOverlaps cs1 cs2+ || M.basicOverlaps ds1 ds2+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n_+ = do+ as <- M.basicUnsafeNew n_+ bs <- M.basicUnsafeNew n_+ cs <- M.basicUnsafeNew n_+ ds <- M.basicUnsafeNew n_+ return $ MV_4 n_ as bs cs ds+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n_ (a, b, c, d)+ = do+ as <- M.basicUnsafeNewWith n_ a+ bs <- M.basicUnsafeNewWith n_ b+ cs <- M.basicUnsafeNewWith n_ c+ ds <- M.basicUnsafeNewWith n_ d+ return $ MV_4 n_ as bs cs ds+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MV_4 n_ as bs cs ds) i_+ = do+ a <- M.basicUnsafeRead as i_+ b <- M.basicUnsafeRead bs i_+ c <- M.basicUnsafeRead cs i_+ d <- M.basicUnsafeRead ds i_+ return (a, b, c, d)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MV_4 n_ as bs cs ds) i_ (a, b, c, d)+ = do+ M.basicUnsafeWrite as i_ a+ M.basicUnsafeWrite bs i_ b+ M.basicUnsafeWrite cs i_ c+ M.basicUnsafeWrite ds i_ d+ {-# INLINE basicClear #-}+ basicClear (MV_4 n_ as bs cs ds)+ = do+ M.basicClear as+ M.basicClear bs+ M.basicClear cs+ M.basicClear ds+ {-# INLINE basicSet #-}+ basicSet (MV_4 n_ as bs cs ds) (a, b, c, d)+ = do+ M.basicSet as a+ M.basicSet bs b+ M.basicSet cs c+ M.basicSet ds d+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2+ bs2+ cs2+ ds2)+ = do+ M.basicUnsafeCopy as1 as2+ M.basicUnsafeCopy bs1 bs2+ M.basicUnsafeCopy cs1 cs2+ M.basicUnsafeCopy ds1 ds2+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow (MV_4 n_ as bs cs ds) m_+ = do+ as' <- M.basicUnsafeGrow as m_+ bs' <- M.basicUnsafeGrow bs m_+ cs' <- M.basicUnsafeGrow cs m_+ ds' <- M.basicUnsafeGrow ds m_+ return $ MV_4 (m_+n_) as' bs' cs' ds'+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d) => G.Vector Vector (a, b, c, d) where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_4 n_ as bs cs ds)+ = do+ as' <- G.unsafeFreeze as+ bs' <- G.unsafeFreeze bs+ cs' <- G.unsafeFreeze cs+ ds' <- G.unsafeFreeze ds+ return $ V_4 n_ as' bs' cs' ds'+ {-# INLINE basicLength #-}+ basicLength (V_4 n_ as bs cs ds) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (V_4 n_ as bs cs ds)+ = V_4 m_ (G.basicUnsafeSlice i_ m_ as)+ (G.basicUnsafeSlice i_ m_ bs)+ (G.basicUnsafeSlice i_ m_ cs)+ (G.basicUnsafeSlice i_ m_ ds)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_4 n_ as bs cs ds) i_+ = do+ a <- G.basicUnsafeIndexM as i_+ b <- G.basicUnsafeIndexM bs i_+ c <- G.basicUnsafeIndexM cs i_+ d <- G.basicUnsafeIndexM ds i_+ return (a, b, c, d)+ {-# INLINE elemseq #-}+ elemseq _ (a, b, c, d) x_+ = G.elemseq (undefined :: Vector a) a $+ G.elemseq (undefined :: Vector b) b $+ G.elemseq (undefined :: Vector c) c $+ G.elemseq (undefined :: Vector d) d $ x_+#endif+#ifdef DEFINE_MUTABLE+zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a ->+ MVector s b ->+ MVector s c ->+ MVector s d -> MVector s (a, b, c, d)+{-# INLINE_STREAM zip4 #-}+zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ where+ len = length as `min` length bs `min` length cs `min` length ds+unzip4 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d) => MVector s (a, b, c, d) -> (MVector s a,+ MVector s b,+ MVector s c,+ MVector s d)+{-# INLINE unzip4 #-}+unzip4 (MV_4 n_ as bs cs ds) = (as, bs, cs, ds)+#endif+#ifdef DEFINE_IMMUTABLE+zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector a ->+ Vector b ->+ Vector c ->+ Vector d -> Vector (a, b, c, d)+{-# INLINE_STREAM zip4 #-}+zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ where+ len = length as `min` length bs `min` length cs `min` length ds+{-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds .+ G.stream (zip4 as bs cs ds) = Stream.zipWith4 (, , ,) (G.stream as)+ (G.stream bs)+ (G.stream cs)+ (G.stream ds)+ #-}+unzip4 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d) => Vector (a, b, c, d) -> (Vector a,+ Vector b,+ Vector c,+ Vector d)+{-# INLINE unzip4 #-}+unzip4 (V_4 n_ as bs cs ds) = (as, bs, cs, ds)+#endif+#ifdef DEFINE_INSTANCES+data instance MVector s (a, b, c, d, e)+ = MV_5 {-# UNPACK #-} !Int !(MVector s a)+ !(MVector s b)+ !(MVector s c)+ !(MVector s d)+ !(MVector s e)+data instance Vector (a, b, c, d, e)+ = V_5 {-# UNPACK #-} !Int !(Vector a)+ !(Vector b)+ !(Vector c)+ !(Vector d)+ !(Vector e)+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => Unbox (a, b, c, d, e)+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => M.MVector MVector (a, b, c, d, e) where+ {-# INLINE basicLength #-}+ basicLength (MV_5 n_ as bs cs ds es) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (MV_5 n_ as bs cs ds es)+ = MV_5 m_ (M.basicUnsafeSlice i_ m_ as)+ (M.basicUnsafeSlice i_ m_ bs)+ (M.basicUnsafeSlice i_ m_ cs)+ (M.basicUnsafeSlice i_ m_ ds)+ (M.basicUnsafeSlice i_ m_ es)+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2+ bs2+ cs2+ ds2+ es2)+ = M.basicOverlaps as1 as2+ || M.basicOverlaps bs1 bs2+ || M.basicOverlaps cs1 cs2+ || M.basicOverlaps ds1 ds2+ || M.basicOverlaps es1 es2+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n_+ = do+ as <- M.basicUnsafeNew n_+ bs <- M.basicUnsafeNew n_+ cs <- M.basicUnsafeNew n_+ ds <- M.basicUnsafeNew n_+ es <- M.basicUnsafeNew n_+ return $ MV_5 n_ as bs cs ds es+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n_ (a, b, c, d, e)+ = do+ as <- M.basicUnsafeNewWith n_ a+ bs <- M.basicUnsafeNewWith n_ b+ cs <- M.basicUnsafeNewWith n_ c+ ds <- M.basicUnsafeNewWith n_ d+ es <- M.basicUnsafeNewWith n_ e+ return $ MV_5 n_ as bs cs ds es+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MV_5 n_ as bs cs ds es) i_+ = do+ a <- M.basicUnsafeRead as i_+ b <- M.basicUnsafeRead bs i_+ c <- M.basicUnsafeRead cs i_+ d <- M.basicUnsafeRead ds i_+ e <- M.basicUnsafeRead es i_+ return (a, b, c, d, e)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MV_5 n_ as bs cs ds es) i_ (a, b, c, d, e)+ = do+ M.basicUnsafeWrite as i_ a+ M.basicUnsafeWrite bs i_ b+ M.basicUnsafeWrite cs i_ c+ M.basicUnsafeWrite ds i_ d+ M.basicUnsafeWrite es i_ e+ {-# INLINE basicClear #-}+ basicClear (MV_5 n_ as bs cs ds es)+ = do+ M.basicClear as+ M.basicClear bs+ M.basicClear cs+ M.basicClear ds+ M.basicClear es+ {-# INLINE basicSet #-}+ basicSet (MV_5 n_ as bs cs ds es) (a, b, c, d, e)+ = do+ M.basicSet as a+ M.basicSet bs b+ M.basicSet cs c+ M.basicSet ds d+ M.basicSet es e+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2+ bs2+ cs2+ ds2+ es2)+ = do+ M.basicUnsafeCopy as1 as2+ M.basicUnsafeCopy bs1 bs2+ M.basicUnsafeCopy cs1 cs2+ M.basicUnsafeCopy ds1 ds2+ M.basicUnsafeCopy es1 es2+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow (MV_5 n_ as bs cs ds es) m_+ = do+ as' <- M.basicUnsafeGrow as m_+ bs' <- M.basicUnsafeGrow bs m_+ cs' <- M.basicUnsafeGrow cs m_+ ds' <- M.basicUnsafeGrow ds m_+ es' <- M.basicUnsafeGrow es m_+ return $ MV_5 (m_+n_) as' bs' cs' ds' es'+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => G.Vector Vector (a, b, c, d, e) where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_5 n_ as bs cs ds es)+ = do+ as' <- G.unsafeFreeze as+ bs' <- G.unsafeFreeze bs+ cs' <- G.unsafeFreeze cs+ ds' <- G.unsafeFreeze ds+ es' <- G.unsafeFreeze es+ return $ V_5 n_ as' bs' cs' ds' es'+ {-# INLINE basicLength #-}+ basicLength (V_5 n_ as bs cs ds es) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (V_5 n_ as bs cs ds es)+ = V_5 m_ (G.basicUnsafeSlice i_ m_ as)+ (G.basicUnsafeSlice i_ m_ bs)+ (G.basicUnsafeSlice i_ m_ cs)+ (G.basicUnsafeSlice i_ m_ ds)+ (G.basicUnsafeSlice i_ m_ es)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_5 n_ as bs cs ds es) i_+ = do+ a <- G.basicUnsafeIndexM as i_+ b <- G.basicUnsafeIndexM bs i_+ c <- G.basicUnsafeIndexM cs i_+ d <- G.basicUnsafeIndexM ds i_+ e <- G.basicUnsafeIndexM es i_+ return (a, b, c, d, e)+ {-# INLINE elemseq #-}+ elemseq _ (a, b, c, d, e) x_+ = G.elemseq (undefined :: Vector a) a $+ G.elemseq (undefined :: Vector b) b $+ G.elemseq (undefined :: Vector c) c $+ G.elemseq (undefined :: Vector d) d $+ G.elemseq (undefined :: Vector e) e $ x_+#endif+#ifdef DEFINE_MUTABLE+zip5 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => MVector s a ->+ MVector s b ->+ MVector s c ->+ MVector s d ->+ MVector s e -> MVector s (a, b, c, d, e)+{-# INLINE_STREAM zip5 #-}+zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ (unsafeSlice 0 len es)+ where+ len = length as `min`+ length bs `min`+ length cs `min`+ length ds `min`+ length es+unzip5 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => MVector s (a, b, c, d, e) -> (MVector s a,+ MVector s b,+ MVector s c,+ MVector s d,+ MVector s e)+{-# INLINE unzip5 #-}+unzip5 (MV_5 n_ as bs cs ds es) = (as, bs, cs, ds, es)+#endif+#ifdef DEFINE_IMMUTABLE+zip5 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => Vector a ->+ Vector b ->+ Vector c ->+ Vector d ->+ Vector e -> Vector (a, b, c, d, e)+{-# INLINE_STREAM zip5 #-}+zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ (unsafeSlice 0 len es)+ where+ len = length as `min`+ length bs `min`+ length cs `min`+ length ds `min`+ length es+{-# RULES "stream/zip5 [Vector.Unboxed]" forall as bs cs ds es .+ G.stream (zip5 as+ bs+ cs+ ds+ es) = Stream.zipWith5 (, , , ,) (G.stream as)+ (G.stream bs)+ (G.stream cs)+ (G.stream ds)+ (G.stream es)+ #-}+unzip5 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e) => Vector (a, b, c, d, e) -> (Vector a,+ Vector b,+ Vector c,+ Vector d,+ Vector e)+{-# INLINE unzip5 #-}+unzip5 (V_5 n_ as bs cs ds es) = (as, bs, cs, ds, es)+#endif+#ifdef DEFINE_INSTANCES+data instance MVector s (a, b, c, d, e, f)+ = MV_6 {-# UNPACK #-} !Int !(MVector s a)+ !(MVector s b)+ !(MVector s c)+ !(MVector s d)+ !(MVector s e)+ !(MVector s f)+data instance Vector (a, b, c, d, e, f)+ = V_6 {-# UNPACK #-} !Int !(Vector a)+ !(Vector b)+ !(Vector c)+ !(Vector d)+ !(Vector e)+ !(Vector f)+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => Unbox (a, b, c, d, e, f)+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => M.MVector MVector (a, b, c, d, e, f) where+ {-# INLINE basicLength #-}+ basicLength (MV_6 n_ as bs cs ds es fs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (MV_6 n_ as bs cs ds es fs)+ = MV_6 m_ (M.basicUnsafeSlice i_ m_ as)+ (M.basicUnsafeSlice i_ m_ bs)+ (M.basicUnsafeSlice i_ m_ cs)+ (M.basicUnsafeSlice i_ m_ ds)+ (M.basicUnsafeSlice i_ m_ es)+ (M.basicUnsafeSlice i_ m_ fs)+ {-# INLINE basicOverlaps #-}+ basicOverlaps (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2+ bs2+ cs2+ ds2+ es2+ fs2)+ = M.basicOverlaps as1 as2+ || M.basicOverlaps bs1 bs2+ || M.basicOverlaps cs1 cs2+ || M.basicOverlaps ds1 ds2+ || M.basicOverlaps es1 es2+ || M.basicOverlaps fs1 fs2+ {-# INLINE basicUnsafeNew #-}+ basicUnsafeNew n_+ = do+ as <- M.basicUnsafeNew n_+ bs <- M.basicUnsafeNew n_+ cs <- M.basicUnsafeNew n_+ ds <- M.basicUnsafeNew n_+ es <- M.basicUnsafeNew n_+ fs <- M.basicUnsafeNew n_+ return $ MV_6 n_ as bs cs ds es fs+ {-# INLINE basicUnsafeNewWith #-}+ basicUnsafeNewWith n_ (a, b, c, d, e, f)+ = do+ as <- M.basicUnsafeNewWith n_ a+ bs <- M.basicUnsafeNewWith n_ b+ cs <- M.basicUnsafeNewWith n_ c+ ds <- M.basicUnsafeNewWith n_ d+ es <- M.basicUnsafeNewWith n_ e+ fs <- M.basicUnsafeNewWith n_ f+ return $ MV_6 n_ as bs cs ds es fs+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeRead (MV_6 n_ as bs cs ds es fs) i_+ = do+ a <- M.basicUnsafeRead as i_+ b <- M.basicUnsafeRead bs i_+ c <- M.basicUnsafeRead cs i_+ d <- M.basicUnsafeRead ds i_+ e <- M.basicUnsafeRead es i_+ f <- M.basicUnsafeRead fs i_+ return (a, b, c, d, e, f)+ {-# INLINE basicUnsafeWrite #-}+ basicUnsafeWrite (MV_6 n_ as bs cs ds es fs) i_ (a, b, c, d, e, f)+ = do+ M.basicUnsafeWrite as i_ a+ M.basicUnsafeWrite bs i_ b+ M.basicUnsafeWrite cs i_ c+ M.basicUnsafeWrite ds i_ d+ M.basicUnsafeWrite es i_ e+ M.basicUnsafeWrite fs i_ f+ {-# INLINE basicClear #-}+ basicClear (MV_6 n_ as bs cs ds es fs)+ = do+ M.basicClear as+ M.basicClear bs+ M.basicClear cs+ M.basicClear ds+ M.basicClear es+ M.basicClear fs+ {-# INLINE basicSet #-}+ basicSet (MV_6 n_ as bs cs ds es fs) (a, b, c, d, e, f)+ = do+ M.basicSet as a+ M.basicSet bs b+ M.basicSet cs c+ M.basicSet ds d+ M.basicSet es e+ M.basicSet fs f+ {-# INLINE basicUnsafeCopy #-}+ basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2+ bs2+ cs2+ ds2+ es2+ fs2)+ = do+ M.basicUnsafeCopy as1 as2+ M.basicUnsafeCopy bs1 bs2+ M.basicUnsafeCopy cs1 cs2+ M.basicUnsafeCopy ds1 ds2+ M.basicUnsafeCopy es1 es2+ M.basicUnsafeCopy fs1 fs2+ {-# INLINE basicUnsafeGrow #-}+ basicUnsafeGrow (MV_6 n_ as bs cs ds es fs) m_+ = do+ as' <- M.basicUnsafeGrow as m_+ bs' <- M.basicUnsafeGrow bs m_+ cs' <- M.basicUnsafeGrow cs m_+ ds' <- M.basicUnsafeGrow ds m_+ es' <- M.basicUnsafeGrow es m_+ fs' <- M.basicUnsafeGrow fs m_+ return $ MV_6 (m_+n_) as' bs' cs' ds' es' fs'+instance (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => G.Vector Vector (a, b, c, d, e, f) where+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze (MV_6 n_ as bs cs ds es fs)+ = do+ as' <- G.unsafeFreeze as+ bs' <- G.unsafeFreeze bs+ cs' <- G.unsafeFreeze cs+ ds' <- G.unsafeFreeze ds+ es' <- G.unsafeFreeze es+ fs' <- G.unsafeFreeze fs+ return $ V_6 n_ as' bs' cs' ds' es' fs'+ {-# INLINE basicLength #-}+ basicLength (V_6 n_ as bs cs ds es fs) = n_+ {-# INLINE basicUnsafeSlice #-}+ basicUnsafeSlice i_ m_ (V_6 n_ as bs cs ds es fs)+ = V_6 m_ (G.basicUnsafeSlice i_ m_ as)+ (G.basicUnsafeSlice i_ m_ bs)+ (G.basicUnsafeSlice i_ m_ cs)+ (G.basicUnsafeSlice i_ m_ ds)+ (G.basicUnsafeSlice i_ m_ es)+ (G.basicUnsafeSlice i_ m_ fs)+ {-# INLINE basicUnsafeIndexM #-}+ basicUnsafeIndexM (V_6 n_ as bs cs ds es fs) i_+ = do+ a <- G.basicUnsafeIndexM as i_+ b <- G.basicUnsafeIndexM bs i_+ c <- G.basicUnsafeIndexM cs i_+ d <- G.basicUnsafeIndexM ds i_+ e <- G.basicUnsafeIndexM es i_+ f <- G.basicUnsafeIndexM fs i_+ return (a, b, c, d, e, f)+ {-# INLINE elemseq #-}+ elemseq _ (a, b, c, d, e, f) x_+ = G.elemseq (undefined :: Vector a) a $+ G.elemseq (undefined :: Vector b) b $+ G.elemseq (undefined :: Vector c) c $+ G.elemseq (undefined :: Vector d) d $+ G.elemseq (undefined :: Vector e) e $+ G.elemseq (undefined :: Vector f) f $ x_+#endif+#ifdef DEFINE_MUTABLE+zip6 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => MVector s a ->+ MVector s b ->+ MVector s c ->+ MVector s d ->+ MVector s e ->+ MVector s f -> MVector s (a, b, c, d, e, f)+{-# INLINE_STREAM zip6 #-}+zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ (unsafeSlice 0 len es)+ (unsafeSlice 0 len fs)+ where+ len = length as `min`+ length bs `min`+ length cs `min`+ length ds `min`+ length es `min`+ length fs+unzip6 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => MVector s (a, b, c, d, e, f) -> (MVector s a,+ MVector s b,+ MVector s c,+ MVector s d,+ MVector s e,+ MVector s f)+{-# INLINE unzip6 #-}+unzip6 (MV_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs)+#endif+#ifdef DEFINE_IMMUTABLE+zip6 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => Vector a ->+ Vector b ->+ Vector c ->+ Vector d ->+ Vector e ->+ Vector f -> Vector (a, b, c, d, e, f)+{-# INLINE_STREAM zip6 #-}+zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as)+ (unsafeSlice 0 len bs)+ (unsafeSlice 0 len cs)+ (unsafeSlice 0 len ds)+ (unsafeSlice 0 len es)+ (unsafeSlice 0 len fs)+ where+ len = length as `min`+ length bs `min`+ length cs `min`+ length ds `min`+ length es `min`+ length fs+{-# RULES "stream/zip6 [Vector.Unboxed]" forall as bs cs ds es fs .+ G.stream (zip6 as+ bs+ cs+ ds+ es+ fs) = Stream.zipWith6 (, , , , ,) (G.stream as)+ (G.stream bs)+ (G.stream cs)+ (G.stream ds)+ (G.stream es)+ (G.stream fs)+ #-}+unzip6 :: (Unbox a,+ Unbox b,+ Unbox c,+ Unbox d,+ Unbox e,+ Unbox f) => Vector (a, b, c, d, e, f) -> (Vector a,+ Vector b,+ Vector c,+ Vector d,+ Vector e,+ Vector f)+{-# INLINE unzip6 #-}+unzip6 (V_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs)+#endif
tests/Tests/Stream.hs view
@@ -86,9 +86,9 @@ prop_extract = \xs -> forAll (choose (0, S.length xs)) $ \i -> forAll (choose (0, S.length xs - i)) $ \n ->- unP prop xs i n+ unP prop i n xs where- prop :: P (S.Stream a -> Int -> Int -> S.Stream a) = S.extract `eq` slice+ prop :: P (Int -> Int -> S.Stream a -> S.Stream a) = S.slice `eq` slice prop_tail :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.tail `eq` tail prop_init :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.init `eq` init
tests/Tests/Vector.hs view
@@ -7,6 +7,7 @@ import qualified Data.Vector import qualified Data.Vector.Primitive import qualified Data.Vector.Storable+import qualified Data.Vector.Unboxed import qualified Data.Vector.Fusion.Stream as S import Test.QuickCheck@@ -15,7 +16,7 @@ import Test.Framework.Providers.QuickCheck2 import Text.Show.Functions ()-import Data.List (foldl', foldl1', unfoldr, find, findIndex)+import Data.List import System.Random (Random) #define COMMON_CONTEXT(a, v) \@@ -80,29 +81,41 @@ 'prop_length, 'prop_null, 'prop_empty, 'prop_singleton, 'prop_replicate,- 'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy,+ 'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy, 'prop_generate, 'prop_head, 'prop_last, 'prop_index,+ 'prop_unsafeHead, 'prop_unsafeLast, 'prop_unsafeIndex, 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, - 'prop_accum, 'prop_write, 'prop_backpermute, 'prop_reverse,+ 'prop_accum, 'prop_upd, 'prop_backpermute, 'prop_reverse, 'prop_map, 'prop_zipWith, 'prop_zipWith3,- 'prop_filter, 'prop_takeWhile, 'prop_dropWhile,+ 'prop_imap, 'prop_izipWith, 'prop_izipWith3, + 'prop_filter, 'prop_ifilter, 'prop_takeWhile, 'prop_dropWhile,+ 'prop_partition, 'prop_span, 'prop_break,+ 'prop_elem, 'prop_notElem,- 'prop_find, 'prop_findIndex,+ 'prop_find, 'prop_findIndex, 'prop_findIndices,+ 'prop_elemIndex, 'prop_elemIndices, 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',- 'prop_foldr, 'prop_foldr1,+ 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1',+ 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', + 'prop_all, 'prop_any,+ 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', - 'prop_concatMap,- 'prop_unfoldr+ 'prop_prescanr, 'prop_prescanr',+ 'prop_postscanr, 'prop_postscanr',+ 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',++ 'prop_concatMap {- ,+ 'prop_unfoldr -} ]) where -- Prelude@@ -119,6 +132,8 @@ prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) prop_copy :: P (v a -> v a) = V.copy `eq` id+ prop_generate :: P (Int -> (Int -> a) -> v a)+ = (\n _ -> n < 1000) ===> V.generate `eq` generate prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last@@ -128,13 +143,21 @@ unP prop xs i where prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)+ prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head+ prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last+ prop_unsafeIndex = \xs ->+ not (V.null xs) ==>+ forAll (choose (0, V.length xs-1)) $ \i ->+ unP prop xs i+ where+ prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!) prop_slice = \xs -> forAll (choose (0, V.length xs)) $ \i -> forAll (choose (0, V.length xs - i)) $ \n ->- unP prop xs i n+ unP prop i n xs where- prop :: P (v a -> Int -> Int -> v a) = V.slice `eq` slice+ prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init@@ -148,7 +171,7 @@ prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) = V.accum `eq` accum - prop_write = \xs ->+ prop_upd = \xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> unP prop xs ps where@@ -166,16 +189,29 @@ prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) = V.zipWith3 `eq` zipWith3+ prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap+ prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith+ prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)+ = V.izipWith3 `eq` izipWith3 prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter+ prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile+ prop_partition :: P ((a -> Bool) -> v a -> (v a, v a))+ = V.partition `eq` partition+ prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span+ prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) = V.findIndex `eq` findIndex+ prop_findIndices :: P ((a -> Bool) -> v a -> v Int)+ = V.findIndices `eq` findIndices+ prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex+ prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>@@ -186,7 +222,21 @@ prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldr1 `eq` foldr1+ prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr+ prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>+ V.foldr1' `eq` foldr1+ prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a)+ = V.ifoldl `eq` ifoldl+ prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a)+ = V.ifoldl' `eq` ifoldl+ prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a)+ = V.ifoldr `eq` ifoldr+ prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a)+ = V.ifoldr' `eq` ifoldr + prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all+ prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any+ prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)@@ -204,6 +254,23 @@ prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanl1' `eq` scanl1 + prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanr `eq` prescanr+ prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanr' `eq` prescanr+ prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanr `eq` postscanr+ prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanr' `eq` postscanr+ prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanr `eq` scanr+ prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanr' `eq` scanr+ prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanr1 `eq` scanr1+ prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanr1' `eq` scanr1+ prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs where@@ -248,15 +315,30 @@ prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]-testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])+testOrdFunctions _ = $(testProperties+ ['prop_compare,+ 'prop_maximum, 'prop_minimum,+ 'prop_minIndex, 'prop_maxIndex ]) where prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum+ prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex+ prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a, Random a) => v a -> [Test]-testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])+testEnumFunctions _ = $(testProperties+ [ 'prop_enumFromN, 'prop_enumFromThenN,+ 'prop_enumFromTo, 'prop_enumFromThenTo]) where+ prop_enumFromN :: P (a -> Int -> v a)+ = (\_ n -> n < 1000)+ ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1)++ prop_enumFromThenN :: P (a -> a -> Int -> v a)+ = (\_ _ n -> n < 1000)+ ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y)+ prop_enumFromTo = \m -> forAll (choose (-2,100)) $ \n -> unP prop m (m+n)@@ -308,35 +390,101 @@ testNestedVectorFunctions ] -testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy-testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy+testBoolBoxedVector dummy = concatMap ($ dummy)+ [+ testGeneralBoxedVector+ , testBoolFunctions+ ] +testNumericBoxedVector dummy = concatMap ($ dummy)+ [+ testGeneralBoxedVector+ , testNumFunctions+ , testEnumFunctions+ ]+++ testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions ] +testBoolPrimitiveVector dummy = concatMap ($ dummy)+ [+ testGeneralPrimitiveVector+ , testBoolFunctions+ ]++testNumericPrimitiveVector dummy = concatMap ($ dummy)+ [+ testGeneralPrimitiveVector+ , testNumFunctions+ , testEnumFunctions+ ]+++ testGeneralStorableVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions ] -testBoolPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testBoolFunctions dummy-testNumericPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy-testNumericStorableVector dummy = testGeneralStorableVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy+testNumericStorableVector dummy = concatMap ($ dummy)+ [+ testGeneralStorableVector+ , testNumFunctions+ , testEnumFunctions+ ] +++testGeneralUnboxedVector dummy = concatMap ($ dummy) [+ testSanity,+ testPolymorphicFunctions,+ testOrdFunctions+ ]++testUnitUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ ]++testBoolUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ , testBoolFunctions+ ]++testNumericUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ , testNumFunctions+ , testEnumFunctions+ ]++testTupleUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ ]+ tests = [ testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)), testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)), testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)),- testGroup "Data.Vector.Primitive.Vector (Float)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Float)), testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)), testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)),- testGroup "Data.Vector.Storable.Vector (Float)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Float)),- testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double))+ testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)),++ testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())),+ testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),+ testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)),+ testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))),+ testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int)))+ ]
tests/Utilities.hs view
@@ -7,6 +7,7 @@ import qualified Data.Vector.Generic as DVG import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS+import qualified Data.Vector.Unboxed as DVU import qualified Data.Vector.Fusion.Stream as S import Data.List ( sortBy )@@ -34,6 +35,12 @@ instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where coarbitrary = coarbitrary . DVS.toList +instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where+ arbitrary = fmap DVU.fromList arbitrary++instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where+ coarbitrary = coarbitrary . DVU.toList+ instance Arbitrary a => Arbitrary (S.Stream a) where arbitrary = fmap S.fromList arbitrary @@ -80,6 +87,14 @@ type EqTest (DVS.Vector a) = Property equal x y = property (x == y) +instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where+ type Model (DVU.Vector a) = [a]+ model = DVU.toList+ unmodel = DVU.fromList++ type EqTest (DVU.Vector a) = Property+ equal x y = property (x == y)+ #define id_TestData(ty) \ instance TestData ty where { \ type Model ty = ty; \@@ -89,6 +104,7 @@ type EqTest ty = Property; \ equal x y = property (x == y) } +id_TestData(()) id_TestData(Bool) id_TestData(Int) id_TestData(Float)@@ -189,10 +205,13 @@ -- Additional list functions singleton x = [x] snoc xs x = xs ++ [x]-slice xs i n = take n (drop i xs)+generate n f = [f i | i <- [0 .. n-1]]+slice i n xs = take n (drop i xs) backpermute xs is = map (xs!!) is prescanl f z = init . scanl f z postscanl f z = tail . scanl f z+prescanr f z = tail . scanr f z+postscanr f z = init . scanr f z accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a] accum f xs ps = go xs ps' 0@@ -213,4 +232,34 @@ | i == j = go (y:xs) ps j go (x:xs) ps j = x : go xs ps (j+1) go [] _ _ = []++imap :: (Int -> a -> a) -> [a] -> [a]+imap f = map (uncurry f) . zip [0..]++izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a]+izipWith f = zipWith (uncurry f) . zip [0..]++izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]+izipWith3 f = zipWith3 (uncurry f) . zip [0..]++ifilter :: (Int -> a -> Bool) -> [a] -> [a]+ifilter f = map snd . filter (uncurry f) . zip [0..]++ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a+ifoldl f z = foldl (uncurry . f) z . zip [0..]++ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b+ifoldr f z = foldr (uncurry f) z . zip [0..]++minIndex :: Ord a => [a] -> Int+minIndex = fst . foldr1 imin . zip [0..]+ where+ imin (i,x) (j,y) | x <= y = (i,x)+ | otherwise = (j,y)++maxIndex :: Ord a => [a] -> Int+maxIndex = fst . foldr1 imax . zip [0..]+ where+ imax (i,x) (j,y) | x >= y = (i,x)+ | otherwise = (j,y)
tests/vector-tests.cabal view
@@ -1,10 +1,10 @@ Name: vector-tests-Version: 0.2+Version: 0.5 License: BSD3 License-File: LICENSE-Author: Roman Leshchinskiy+Author: Max Bolingbroke, Roman Leshchinskiy Maintainer: Roman Leshchinskiy <rl@cse.unsw.edu.au>-Copyright: (c) Roman Leshchinskiy 2008+Copyright: (c) Max Bolinbroke, Roman Leshchinskiy 2008-2009 Homepage: http://darcs.haskell.org/vector Category: Data Structures Synopsis: Efficient Arrays@@ -27,7 +27,7 @@ TypeFamilies, TemplateHaskell - Build-Depends: base, template-haskell, vector, random,+ Build-Depends: base >= 4 && < 5, template-haskell, vector, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 -- Don't let fusion occur or GHC will make our tests less informative in some cases :-)
vector.cabal view
@@ -1,11 +1,11 @@ Name: vector-Version: 0.4.2+Version: 0.5 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au> Maintainer: Roman Leshchinskiy <rl@cse.unsw.edu.au>-Copyright: (c) Roman Leshchinskiy 2008-2009-Homepage: http://darcs.haskell.org/vector+Copyright: (c) Roman Leshchinskiy 2008-2010+Homepage: http://code.haskell.org/vector Category: Data, Data Structures Synopsis: Efficient Arrays Description:@@ -15,15 +15,30 @@ . It is structured as follows: .- [@Data.Vector@] boxed vectors of arbitrary types+ [@Data.Vector@] Boxed vectors of arbitrary types. .- [@Data.Vector.Primitive@] unboxed vectors of primitive types as- defined by the @primitive@ package+ [@Data.Vector.Unboxed@] Unboxed vectors with an adaptive+ representation based on data type families. .- [@Data.Vector.Storable@] unboxed vectors of 'Storable' types+ [@Data.Vector.Storable@] Unboxed vectors of 'Storable' types. .- [@Data.Vector.Generic@] generic interface to the vector types+ [@Data.Vector.Primitive@] Unboxed vectors of primitive types as+ defined by the @primitive@ package. @Data.Vector.Unboxed@ is more+ flexible at no performance cost. .+ [@Data.Vector.Generic@] Generic interface to the vector types.+ .+ Changes since version 0.4.2+ .+ * Unboxed vectors of primitive types and tuples+ .+ * Redesigned interface between mutable and immutable vectors (now+ with the popular @unsafeFreeze@ primitive)+ .+ * Many new combinators+ .+ * Significant performance improvements+ . Cabal-Version: >= 1.2 Build-Type: Simple@@ -37,16 +52,29 @@ tests/Utilities.hs tests/Tests/Stream.hs tests/Tests/Vector.hs+ internal/GenUnboxTuple.hs+ internal/unbox-tuple-instances -Flag EnableAssertions- Description: Enable assertions that check parameters to functions are reasonable.- These will impose a moderate performance cost on users of the library,- with the benefit that you get reasonable errors rather than segmentation faults!- Default: True+Flag BoundsChecks+ Description: Enable bounds checking+ Default: True +Flag UnsafeChecks+ Description: Enable bounds checking in unsafe operations at the cost of a+ significant performance penalty+ Default: False++Flag InternalChecks+ Description: Enable internal consistency checks at the cost of a+ significant performance penalty+ Default: False++ Library Extensions: CPP Exposed-Modules:+ Data.Vector.Internal.Check+ Data.Vector.Fusion.Util Data.Vector.Fusion.Stream.Size Data.Vector.Fusion.Stream.Monadic@@ -63,31 +91,32 @@ Data.Vector.Storable.Mutable Data.Vector.Storable + Data.Vector.Unboxed.Base+ Data.Vector.Unboxed.Mutable+ Data.Vector.Unboxed+ Data.Vector.Mutable Data.Vector+ Include-Dirs:- include+ include, internal Install-Includes:- phases.h+ vector.h - Build-Depends: base >= 2 && < 5, ghc >= 6.9, primitive >= 0.1 && < 0.2+ Build-Depends: base >= 2 && < 5, ghc >= 6.9, primitive >= 0.2 && < 0.3 --- -finline-if-enough-args is ESSENTIAL. If we don't have this the partial application--- of e.g. Stream.Monadic.++ to the monad dictionary at the use site in Stream.++ causes--- it to be fruitlessly inlined. This in turn leads to a huge RHS for Stream.++, so it--- doesn't get inlined at the final call site and fusion fails to occur. if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args --- It's probably a good idea to compile the library with -O2 as well. However, it's probably--- not as essential as you think because most of the optimisation occurs when the library--- functions from here are inlined into the user programs (which SHOULD be compiled with -O2!).------ We have to fiddle with the assertion stuff at this point too because -O2 implies -fno-ignore-asserts,--- meaning that their relative ordering is CRUCIAL. Setting them together guarantees it.- if flag(enableassertions)- -- Asserts are ignored by default at -O1 or higher- Ghc-Options: -O2 -fno-ignore-asserts- else- Ghc-Options: -O2+ Ghc-Options: -O2++ if flag(BoundsChecks)+ cpp-options: -DVECTOR_BOUNDS_CHECKS++ if flag(UnsafeChecks)+ cpp-options: -DVECTOR_UNSAFE_CHECKS++ if flag(InternalChecks)+ cpp-options: -DVECTOR_INTERNAL_CHECKS+