diff --git a/Data/Vector.hs b/Data/Vector.hs --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -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 diff --git a/Data/Vector/Fusion/Stream.hs b/Data/Vector/Fusion/Stream.hs --- a/Data/Vector/Fusion/Stream.hs +++ b/Data/Vector/Fusion/Stream.hs @@ -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 -- ----------- diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs --- a/Data/Vector/Fusion/Stream/Monadic.hs +++ b/Data/Vector/Fusion/Stream/Monadic.hs @@ -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 [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16 + + #-} + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32 + + #-} + +#endif + +-- NOTE: We could implement a generic "too large" test: +-- +-- len x y | x > y = 0 +-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n +-- | otherwise = error +-- where +-- n = y-x+1 +-- +-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for +-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 +-- + +enumFromTo_int :: (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 [Stream]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64 + +#else + +"enumFromTo [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 [Stream]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Stream m Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Stream m Word32 + +#endif + +"enumFromTo [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Integer -> Integer -> Stream m Integer + + #-} + +-- 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 [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 [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" diff --git a/Data/Vector/Fusion/Stream/Size.hs b/Data/Vector/Fusion/Stream/Size.hs --- a/Data/Vector/Fusion/Stream/Size.hs +++ b/Data/Vector/Fusion/Stream/Size.hs @@ -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 diff --git a/Data/Vector/Fusion/Util.hs b/Data/Vector/Fusion/Util.hs --- a/Data/Vector/Fusion/Util.hs +++ b/Data/Vector/Fusion/Util.hs @@ -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 + diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -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] diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs --- a/Data/Vector/Generic/Mutable.hs +++ b/Data/Vector/Generic/Mutable.hs @@ -1,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) diff --git a/Data/Vector/Generic/New.hs b/Data/Vector/Generic/New.hs --- a/Data/Vector/Generic/New.hs +++ b/Data/Vector/Generic/New.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Rank2Types #-} +{-# 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 #-} diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Internal/Check.hs @@ -0,0 +1,109 @@ +-- | +-- Module : Data.Vector.Internal.Check +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- 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 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 + diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs --- a/Data/Vector/Mutable.hs +++ b/Data/Vector/Mutable.hs @@ -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 diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# 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 diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs --- a/Data/Vector/Primitive/Mutable.hs +++ b/Data/Vector/Primitive/Mutable.hs @@ -1,4 +1,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 diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -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 @@ -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) diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -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 @@ -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 diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Unboxed.hs @@ -0,0 +1,797 @@ +-- | +-- Module : Data.Vector.Unboxed +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- 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" + diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Unboxed/Base.hs @@ -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 +-- 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" + diff --git a/Data/Vector/Unboxed/Mutable.hs b/Data/Vector/Unboxed/Mutable.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Unboxed/Mutable.hs @@ -0,0 +1,158 @@ +-- | +-- Module : Data.Vector.Unboxed.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable adaptive unboxed vectors +-- + +module Data.Vector.Unboxed.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Unbox, + + -- * 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" + diff --git a/include/phases.h b/include/phases.h deleted file mode 100644 --- a/include/phases.h +++ /dev/null @@ -1,6 +0,0 @@ -#define PHASE_STREAM [1] -#define PHASE_INNER [0] - -#define INLINE_STREAM INLINE PHASE_STREAM -#define INLINE_INNER INLINE PHASE_INNER - diff --git a/include/vector.h b/include/vector.h new file mode 100644 --- /dev/null +++ b/include/vector.h @@ -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) + + diff --git a/internal/GenUnboxTuple.hs b/internal/GenUnboxTuple.hs new file mode 100644 --- /dev/null +++ b/internal/GenUnboxTuple.hs @@ -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)] diff --git a/internal/unbox-tuple-instances b/internal/unbox-tuple-instances new file mode 100644 --- /dev/null +++ b/internal/unbox-tuple-instances @@ -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 diff --git a/tests/Tests/Stream.hs b/tests/Tests/Stream.hs --- a/tests/Tests/Stream.hs +++ b/tests/Tests/Stream.hs @@ -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 diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs --- a/tests/Tests/Vector.hs +++ b/tests/Tests/Vector.hs @@ -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))) + ] diff --git a/tests/Utilities.hs b/tests/Utilities.hs --- a/tests/Utilities.hs +++ b/tests/Utilities.hs @@ -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) diff --git a/tests/vector-tests.cabal b/tests/vector-tests.cabal --- a/tests/vector-tests.cabal +++ b/tests/vector-tests.cabal @@ -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 -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 :-) diff --git a/vector.cabal b/vector.cabal --- a/vector.cabal +++ b/vector.cabal @@ -1,11 +1,11 @@ Name: vector -Version: 0.4.2 +Version: 0.5 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Roman Leshchinskiy -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 +