vector 0.12.0.3 → 0.12.1.0
raw patch · 35 files changed
+1782/−1008 lines, 35 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep −test-frameworkdep −test-framework-hunitdep −test-framework-quickcheck2dep ~QuickCheckdep ~basedep ~ghc-prim
Dependencies added: tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: QuickCheck, base, ghc-prim
Files
- Data/Vector.hs +34/−14
- Data/Vector/Fusion/Bundle/Monadic.hs +51/−18
- Data/Vector/Fusion/Bundle/Size.hs +9/−1
- Data/Vector/Fusion/Stream/Monadic.hs +42/−17
- Data/Vector/Generic.hs +39/−18
- Data/Vector/Generic/Mutable.hs +69/−7
- Data/Vector/Internal/Check.hs +1/−1
- Data/Vector/Mutable.hs +16/−8
- Data/Vector/Primitive.hs +25/−7
- Data/Vector/Primitive/Mutable.hs +21/−5
- Data/Vector/Storable.hs +27/−8
- Data/Vector/Storable/Internal.hs +2/−1
- Data/Vector/Storable/Mutable.hs +30/−10
- Data/Vector/Unboxed.hs +10/−3
- Data/Vector/Unboxed/Base.hs +189/−6
- Data/Vector/Unboxed/Mutable.hs +11/−4
- benchmarks/Main.hs +61/−25
- benchmarks/TestData/Graph.hs +5/−3
- benchmarks/TestData/Random.hs +4/−3
- benchmarks/vector-benchmarks.cabal +5/−5
- changelog +0/−84
- changelog.md +107/−0
- tests/Boilerplater.hs +1/−1
- tests/Main.hs +2/−2
- tests/Tests/Bundle.hs +7/−5
- tests/Tests/Move.hs +1/−1
- tests/Tests/Vector.hs +10/−723
- tests/Tests/Vector/Boxed.hs +46/−0
- tests/Tests/Vector/Primitive.hs +34/−0
- tests/Tests/Vector/Property.hs +682/−0
- tests/Tests/Vector/Storable.hs +33/−0
- tests/Tests/Vector/Unboxed.hs +61/−0
- tests/Tests/Vector/UnitTests.hs +104/−4
- tests/Utilities.hs +9/−9
- vector.cabal +34/−15
Data/Vector.hs view
@@ -119,7 +119,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, span, break,+ partition, unstablePartition, partitionWith, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -164,12 +164,17 @@ freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where -import qualified Data.Vector.Generic as G-import Data.Vector.Mutable ( MVector(..) )-import Data.Primitive.Array+import Data.Vector.Mutable ( MVector(..) )+import Data.Primitive.Array import qualified Data.Vector.Fusion.Bundle as Bundle+import qualified Data.Vector.Generic as G -import Control.DeepSeq ( NFData, rnf )+import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ )+ import Control.Monad ( MonadPlus(..), liftM, ap ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive@@ -219,12 +224,19 @@ {-# UNPACK #-} !(Array a) deriving ( Typeable ) +liftRnfV :: (a -> ()) -> Vector a -> ()+liftRnfV elemRnf = foldl' (\_ -> elemRnf) ()+ instance NFData a => NFData (Vector a) where- rnf (Vector i n arr) = rnfAll i- where- rnfAll ix | ix < n = rnf (indexArray arr ix) `seq` rnfAll (ix+1)- | otherwise = ()+ rnf = liftRnfV rnf+ {-# INLINEABLE rnf #-} +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 Vector where+ liftRnf = liftRnfV+ {-# INLINEABLE liftRnf #-}+#endif+ instance Show a => Show (Vector a) where showsPrec = G.showsPrec @@ -251,9 +263,9 @@ instance Data a => Data (Vector a) where gfoldl = G.gfoldl- toConstr _ = error "toConstr"- gunfold _ _ = error "gunfold"- dataTypeOf _ = G.mkType "Data.Vector.Vector"+ toConstr _ = G.mkVecConstr "Data.Vector.Vector"+ gunfold = G.gunfold+ dataTypeOf _ = G.mkVecType "Data.Vector.Vector" dataCast1 = G.dataCast type instance G.Mutable Vector = MVector@@ -340,6 +352,7 @@ {-# INLINE (>>=) #-} (>>=) = flip concatMap+ #if !(MIN_VERSION_base(4,13,0)) {-# INLINE fail #-} fail = Fail.fail -- == \ _str -> empty@@ -697,7 +710,7 @@ -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. ----- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c>+-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c> -- constructN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-}@@ -707,7 +720,7 @@ -- repeatedly applying the generator function to the already constructed part -- of the vector. ----- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a>+-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a> -- constructrN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-}@@ -1249,6 +1262,13 @@ unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition++-- | /O(n)/ Split the vector in two parts, the first one containing the+-- @Right@ elements and the second containing the @Left@ elements.+-- The relative order of the elements is preserved.+partitionWith :: (a -> Either b c) -> Vector a -> (Vector b, Vector c)+{-# INLINE partitionWith #-}+partitionWith = G.partitionWith -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying.
Data/Vector/Fusion/Bundle/Monadic.hs view
@@ -269,7 +269,7 @@ -- | The first @n@ elements take :: Monad m => Int -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED take #-}-take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz)+take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smallerThan n sz) -- | All but the first @n@ elements drop :: Monad m => Int -> Bundle m v a -> Bundle m v a@@ -426,7 +426,15 @@ -- | Check if two 'Bundle's are equal eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool {-# INLINE_FUSED eqBy #-}-eqBy eq x y = S.eqBy eq (sElems x) (sElems y)+eqBy eq x y+ | sizesAreDifferent (sSize x) (sSize y) = return False+ | otherwise = S.eqBy eq (sElems x) (sElems y)+ where+ sizesAreDifferent :: Size -> Size -> Bool+ sizesAreDifferent (Exact a) (Exact b) = a /= b+ sizesAreDifferent (Exact a) (Max b) = a > b+ sizesAreDifferent (Max a) (Exact b) = a < b+ sizesAreDifferent _ _ = False -- | Lexicographically compare two 'Bundle's cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering@@ -758,13 +766,15 @@ -- FIXME: add "too large" test for Int enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_small #-}-enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n)+enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact n) where n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -808,7 +818,7 @@ enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int {-# INLINE_FUSED enumFromTo_int #-}-enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) where {-# INLINE [0] len #-} len :: Int -> Int -> Int@@ -820,12 +830,14 @@ n = v-u+1 {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_intlike #-}-enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0@@ -836,8 +848,10 @@ n = v-u+1 {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -860,7 +874,7 @@ enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_big_word #-}-enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0@@ -871,8 +885,10 @@ n = v-u {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -901,7 +917,7 @@ -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_big_int #-}-enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))+enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0@@ -912,8 +928,10 @@ n = v-u+1 {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES@@ -952,7 +970,7 @@ enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_double #-}-enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n lim))+enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step ini) (Max (len n lim)) where lim = m + 1/2 -- important to float out @@ -966,8 +984,23 @@ l = truncate (y-x)+2 {-# INLINE_INNER step #-}+-- GHC changed definition of Enum for Double in GHC8.6 so we have to+-- accomodate both definitions in order to preserve validity of+-- rewrite rule+--+-- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081+-- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f+#if MIN_VERSION_base(4,12,0)+ ini = 0+ step x | x' <= lim = return $ Yield x' (x+1)+ | otherwise = return $ Done+ where+ x' = x + n+#else+ ini = n step x | x <= lim = return $ Yield x (x+1) | otherwise = return $ Done+#endif {-# RULES
Data/Vector/Fusion/Bundle/Size.hs view
@@ -11,7 +11,7 @@ -- module Data.Vector.Fusion.Bundle.Size (- Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound+ Size(..), clampedSubtract, smaller, smallerThan, larger, toMax, upperBound, lowerBound ) where import Data.Vector.Fusion.Util ( delay_inline )@@ -90,6 +90,14 @@ smaller Unknown (Exact n) = Max n smaller Unknown (Max n) = Max n smaller Unknown Unknown = Unknown++-- | Select a safe smaller than known size.+smallerThan :: Int -> Size -> Size+{-# INLINE smallerThan #-}+smallerThan m (Exact n) = Exact (delay_inline min m n)+smallerThan m (Max n) = Max (delay_inline min m n)+smallerThan _ Unknown = Unknown+ -- | Maximum of two size hints larger :: Size -> Size -> Size
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -1325,11 +1325,13 @@ -- FIXME: add "too large" test for Int enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_small #-}-enumFromTo_small x y = x `seq` y `seq` Stream step x+enumFromTo_small x y = x `seq` y `seq` Stream step (Just x) where {-# INLINE_INNER step #-}- step w | w <= y = return $ Yield w (w+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -1373,7 +1375,7 @@ enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int {-# INLINE_FUSED enumFromTo_int #-}-enumFromTo_int x y = x `seq` y `seq` Stream step x+enumFromTo_int x y = x `seq` y `seq` Stream step (Just x) where -- {-# INLINE [0] len #-} -- len :: Int -> Int -> Int@@ -1385,16 +1387,21 @@ -- n = v-u+1 {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done + enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_intlike #-}-enumFromTo_intlike x y = x `seq` y `seq` Stream step x+enumFromTo_intlike x y = x `seq` y `seq` Stream step (Just x) where {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -1415,11 +1422,13 @@ enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_big_word #-}-enumFromTo_big_word x y = x `seq` y `seq` Stream step x+enumFromTo_big_word x y = x `seq` y `seq` Stream step (Just x) where {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -1449,11 +1458,13 @@ -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_big_int #-}-enumFromTo_big_int x y = x `seq` y `seq` Stream step x+enumFromTo_big_int x y = x `seq` y `seq` Stream step (Just x) where {-# INLINE_INNER step #-}- step z | z <= y = return $ Yield z (z+1)- | otherwise = return $ Done+ step Nothing = return $ Done+ step (Just z) | z == y = return $ Yield z Nothing+ | z < y = return $ Yield z (Just (z+1))+ | otherwise = return $ Done {-# RULES @@ -1489,13 +1500,27 @@ enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_double #-}-enumFromTo_double n m = n `seq` m `seq` Stream step n+enumFromTo_double n m = n `seq` m `seq` Stream step ini where lim = m + 1/2 -- important to float out - {-# INLINE_INNER step #-}+-- GHC changed definition of Enum for Double in GHC8.6 so we have to+-- accomodate both definitions in order to preserve validity of+-- rewrite rule+--+-- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081+-- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f+#if MIN_VERSION_base(4,12,0)+ ini = 0+ step x | x' <= lim = return $ Yield x' (x+1)+ | otherwise = return $ Done+ where+ x' = x + n+#else+ ini = n step x | x <= lim = return $ Yield x (x+1) | otherwise = return $ Done+#endif {-# RULES
Data/Vector/Generic.hs view
@@ -102,7 +102,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, span, break,+ partition, partitionWith, unstablePartition, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -165,7 +165,7 @@ liftShowsPrec, liftReadsPrec, -- ** @Data@ and @Typeable@- gfoldl, dataCast, mkType+ gfoldl, gunfold, dataCast, mkVecType, mkVecConstr ) where import Data.Vector.Generic.Base@@ -211,14 +211,8 @@ #include "vector.h" -import Data.Data ( Data, DataType )-#if MIN_VERSION_base(4,2,0)-import Data.Data ( mkNoRepType )-#else-import Data.Data ( mkNorepType )-mkNoRepType :: String -> DataType-mkNoRepType = mkNorepType-#endif+import Data.Data ( Data, DataType, Constr, Fixity(Prefix),+ mkDataType, mkConstr, constrIndex ) import qualified Data.Traversable as T (Traversable(mapM)) @@ -472,11 +466,13 @@ {-# INLINE unsafeDrop #-} unsafeDrop n v = unsafeSlice n (length v - n) v -{-# RULES -"slice/new [Vector]" forall i n p.- slice i n (new p) = new (New.slice i n p)+-- Turned off due to: https://github.com/haskell/vector/issues/257+-- "slice/new [Vector]" forall i n p.+-- slice i n (new p) = new (New.slice i n p) +{-# RULES+ "init/new [Vector]" forall p. init (new p) = new (New.init p) @@ -573,7 +569,7 @@ -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. ----- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c>+-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c> -- constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a {-# INLINE constructN #-}@@ -602,7 +598,7 @@ -- repeatedly applying the generator function to the already constructed part -- of the vector. ----- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a>+-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a> -- constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a {-# INLINE constructrN #-}@@ -1375,6 +1371,19 @@ v2 <- unsafeFreeze mv2 return (v1,v2)) +partitionWith :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> v a -> (v b, v c)+{-# INLINE partitionWith #-}+partitionWith f = partition_with_stream f . stream++partition_with_stream :: (Vector v a, Vector v b, Vector v c) => (a -> Either b c) -> Bundle u a -> (v b, v c)+{-# INLINE_FUSED partition_with_stream #-}+partition_with_stream f s = s `seq` runST (+ do+ (mv1,mv2) <- M.partitionWithBundle f s+ v1 <- unsafeFreeze mv1+ v2 <- unsafeFreeze mv2+ return (v1,v2))+ -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often@@ -2192,9 +2201,21 @@ {-# INLINE gfoldl #-} gfoldl f z v = z fromList `f` toList v -mkType :: String -> DataType-{-# INLINE mkType #-}-mkType = mkNoRepType+mkVecConstr :: String -> Constr+{-# INLINE mkVecConstr #-}+mkVecConstr name = mkConstr (mkVecType name) "fromList" [] Prefix++mkVecType :: String -> DataType+{-# INLINE mkVecType #-}+mkVecType name = mkDataType name [mkVecConstr name]++gunfold :: (Vector v a, Data a)+ => (forall b r. Data b => c (b -> r) -> c r)+ -> (forall r. r -> c r)+ -> Constr -> c (v a)+gunfold k z c = case constrIndex c of+ 1 -> k (z fromList)+ _ -> error "gunfold" #if __GLASGOW_HASKELL__ >= 707 dataCast :: (Vector v a, Data a, Typeable v, Typeable t)
Data/Vector/Generic/Mutable.hs view
@@ -56,7 +56,8 @@ transform, transformR, fill, fillR, unsafeAccum, accum, unsafeUpdate, update, reverse,- unstablePartition, unstablePartitionBundle, partitionBundle+ unstablePartition, unstablePartitionBundle, partitionBundle,+ partitionWithBundle ) where import Data.Vector.Generic.Mutable.Base@@ -507,8 +508,13 @@ -- Extracting subvectors -- --------------------- --- | Yield a part of the mutable vector without copying it.-slice :: MVector v a => Int -> Int -> v s a -> v s a+-- | Yield a part of the mutable vector without copying it. The vector must+-- contain at least @i+n@ elements.+slice :: MVector v a+ => Int -- ^ @i@ starting index+ -> Int -- ^ @n@ length+ -> v s a+ -> v s a {-# INLINE slice #-} slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) $ unsafeSlice i n v@@ -710,7 +716,7 @@ $ BOUNDS_CHECK(checkIndex) "swap" j (length v) $ unsafeSwap v i j --- | Replace the element at the give position and return the old element.+-- | Replace the element at the given position and return the old element. exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a {-# INLINE exchange #-} exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v)@@ -748,7 +754,7 @@ unsafeWrite v i y unsafeWrite v j x --- | Replace the element at the give position and return the old element. No+-- | Replace the element at the given position and return the old element. No -- bounds checks are performed. unsafeExchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a@@ -787,7 +793,9 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, MVector v a)- => v (PrimState m) a -> v (PrimState m) a -> m ()+ => v (PrimState m) a -- ^ target+ -> v (PrimState m) a -- ^ source+ -> m () {-# INLINE move #-} move dst src = BOUNDS_CHECK(check) "move" "length mismatch" (length dst == length src)@@ -997,6 +1005,60 @@ v2' <- unsafeAppend1 v2 i2 x return (v1, i1, v2', i2+1) ++partitionWithBundle :: (PrimMonad m, MVector v a, MVector v b, MVector v c)+ => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c)+{-# INLINE partitionWithBundle #-}+partitionWithBundle f s+ = case upperBound (Bundle.size s) of+ Just n -> partitionWithMax f s n+ Nothing -> partitionWithUnknown f s++partitionWithMax :: (PrimMonad m, MVector v a, MVector v b, MVector v c)+ => (a -> Either b c) -> Bundle u a -> Int -> m (v (PrimState m) b, v (PrimState m) c)+{-# INLINE partitionWithMax #-}+partitionWithMax f s n+ = do+ v1 <- unsafeNew n+ v2 <- unsafeNew n+ let {-# INLINE_INNER put #-}+ put (i1, i2) x = case f x of+ Left b -> do+ unsafeWrite v1 i1 b+ return (i1+1, i2)+ Right c -> do+ unsafeWrite v2 i2 c+ return (i1, i2+1)+ (n1, n2) <- Bundle.foldM' put (0, 0) s+ INTERNAL_CHECK(checkSlice) "partitionEithersMax" 0 n1 (length v1)+ $ INTERNAL_CHECK(checkSlice) "partitionEithersMax" 0 n2 (length v2)+ $ return (unsafeSlice 0 n1 v1, unsafeSlice 0 n2 v2)++partitionWithUnknown :: forall m v u a b c.+ (PrimMonad m, MVector v a, MVector v b, MVector v c)+ => (a -> Either b c) -> Bundle u a -> m (v (PrimState m) b, v (PrimState m) c)+{-# INLINE partitionWithUnknown #-}+partitionWithUnknown f s+ = do+ v1 <- unsafeNew 0+ v2 <- unsafeNew 0+ (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s+ INTERNAL_CHECK(checkSlice) "partitionEithersUnknown" 0 n1 (length v1')+ $ INTERNAL_CHECK(checkSlice) "partitionEithersUnknown" 0 n2 (length v2')+ $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2')+ where+ put :: (v (PrimState m) b, Int, v (PrimState m) c, Int)+ -> a+ -> m (v (PrimState m) b, Int, v (PrimState m) c, Int)+ {-# INLINE_INNER put #-}+ put (v1, i1, v2, i2) x = case f x of+ Left b -> do+ v1' <- unsafeAppend1 v1 i1 b+ return (v1', i1+1, v2, i2)+ Right c -> do+ v2' <- unsafeAppend1 v2 i2 c+ return (v1, i1, v2', i2+1)+ {- http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations @@ -1011,7 +1073,7 @@ -} -- | Compute the next (lexicographically) permutation of given vector in-place.--- Returns False when input is the last permtuation+-- Returns False when input is the last permutation nextPermutation :: (PrimMonad m,Ord e,MVector v e) => v (PrimState m) e -> m Bool nextPermutation v | dim < 2 = return False
Data/Vector/Internal/Check.hs view
@@ -148,5 +148,5 @@ {-# 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+ (i >= 0 && m >= 0 && m <= n - i) x
Data/Vector/Mutable.hs view
@@ -62,6 +62,8 @@ #include "vector.h" ++ -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int@@ -185,7 +187,7 @@ in go 0 uninitialised :: a-uninitialised = error "Data.Vector.Mutable: uninitialised element"+uninitialised = error "Data.Vector.Mutable: uninitialised element. If you are trying to compact a vector, use the 'force' function to remove uninitialised elements from the underlying array." -- Length information -- ------------------@@ -203,8 +205,12 @@ -- Extracting subvectors -- --------------------- --- | Yield a part of the mutable vector without copying it.-slice :: Int -> Int -> MVector s a -> MVector s a+-- | Yield a part of the mutable vector without copying it. The vector must+-- contain at least @i+n@ elements.+slice :: Int -- ^ @i@ starting index+ -> Int -- ^ @n@ length+ -> MVector s a+ -> MVector s a {-# INLINE slice #-} slice = G.slice @@ -371,8 +377,9 @@ -- | 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 ()+copy :: PrimMonad m => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m () {-# INLINE copy #-} copy = G.copy @@ -391,8 +398,9 @@ -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector.-move :: PrimMonad m- => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+move :: PrimMonad m => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m () {-# INLINE move #-} move = G.move @@ -410,7 +418,7 @@ unsafeMove = G.unsafeMove -- | Compute the next (lexicographically) permutation of given vector in-place.--- Returns False when input is the last permtuation+-- Returns False when input is the last permutation nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool {-# INLINE nextPermutation #-} nextPermutation = G.nextPermutation
Data/Vector/Primitive.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} + -- | -- Module : Data.Vector.Primitive -- Copyright : (c) Roman Leshchinskiy 2008-2010@@ -98,7 +99,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, span, break,+ partition, unstablePartition, partitionWith, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -143,7 +144,11 @@ import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) -import Control.DeepSeq ( NFData(rnf) )+import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ ) import Control.Monad ( liftM ) import Control.Monad.ST ( ST )@@ -177,6 +182,7 @@ import qualified GHC.Exts as Exts #endif + -- | Unboxed vectors of primitive types data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int@@ -186,6 +192,11 @@ instance NFData (Vector a) where rnf (Vector _ _ _) = () +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 Vector where+ liftRnf _ (Vector _ _ _) = ()+#endif+ instance (Show a, Prim a) => Show (Vector a) where showsPrec = G.showsPrec @@ -195,9 +206,9 @@ instance (Data a, Prim a) => Data (Vector a) where gfoldl = G.gfoldl- toConstr _ = error "toConstr"- gunfold _ _ = error "gunfold"- dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector"+ toConstr _ = G.mkVecConstr "Data.Vector.Primitive.Vector"+ gunfold = G.gunfold+ dataTypeOf _ = G.mkVecType "Data.Vector.Primitive.Vector" dataCast1 = G.dataCast @@ -536,7 +547,7 @@ -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. ----- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c>+-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c> -- constructN :: Prim a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-}@@ -546,7 +557,7 @@ -- repeatedly applying the generator function to the already constructed part -- of the vector. ----- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a>+-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a> -- constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-}@@ -978,6 +989,13 @@ unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition++-- | /O(n)/ Split the vector in two parts, the first one containing the+-- @Right@ elements and the second containing the @Left@ elements.+-- The relative order of the elements is preserved.+partitionWith :: (Prim a, Prim b, Prim c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c)+{-# INLINE partitionWith #-}+partitionWith = G.partitionWith -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying.
Data/Vector/Primitive/Mutable.hs view
@@ -57,7 +57,11 @@ import Control.Monad.Primitive import Control.Monad ( liftM ) -import Control.DeepSeq ( NFData(rnf) )+import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ ) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail )@@ -80,6 +84,11 @@ instance NFData (MVector s a) where rnf (MVector _ _ _) = () +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 (MVector s) where+ liftRnf _ (MVector _ _ _) = ()+#endif+ instance Prim a => G.MVector MVector a where basicLength (MVector _ n _) = n basicUnsafeSlice j m (MVector i _ arr)@@ -145,8 +154,13 @@ -- Extracting subvectors -- --------------------- --- | Yield a part of the mutable vector without copying it.-slice :: Prim a => Int -> Int -> MVector s a -> MVector s a+-- | Yield a part of the mutable vector without copying it. The vector must+-- contain at least @i+n@ elements.+slice :: Prim a+ => Int -- ^ @i@ starting index+ -> Int -- ^ @n@ length+ -> MVector s a+ -> MVector s a {-# INLINE slice #-} slice = G.slice @@ -341,7 +355,9 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Prim a)- => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+ => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m () {-# INLINE move #-} move = G.move @@ -360,7 +376,7 @@ unsafeMove = G.unsafeMove -- | Compute the next (lexicographically) permutation of given vector in-place.--- Returns False when input is the last permtuation+-- Returns False when input is the last permutation nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool {-# INLINE nextPermutation #-} nextPermutation = G.nextPermutation
Data/Vector/Storable.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} + -- | -- Module : Data.Vector.Storable -- Copyright : (c) Roman Leshchinskiy 2009-2010@@ -95,7 +96,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, span, break,+ partition, unstablePartition, partitionWith, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -149,7 +150,11 @@ import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray ) -import Control.DeepSeq ( NFData(rnf) )+import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive@@ -186,6 +191,8 @@ #define NOT_VECTOR_MODULE #include "vector.h" ++ -- | 'Storable'-based vectors data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a)@@ -194,6 +201,11 @@ instance NFData (Vector a) where rnf (Vector _ _) = () +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 Vector where+ liftRnf _ (Vector _ _) = ()+#endif+ instance (Show a, Storable a) => Show (Vector a) where showsPrec = G.showsPrec @@ -203,11 +215,12 @@ instance (Data a, Storable a) => Data (Vector a) where gfoldl = G.gfoldl- toConstr _ = error "toConstr"- gunfold _ _ = error "gunfold"- dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector"+ toConstr _ = G.mkVecConstr "Data.Vector.Storable.Vector"+ gunfold = G.gunfold+ dataTypeOf _ = G.mkVecType "Data.Vector.Storable.Vector" dataCast1 = G.dataCast + type instance G.Mutable Vector = MVector instance Storable a => G.Vector Vector a where@@ -546,7 +559,7 @@ -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. ----- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c>+-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c> -- constructN :: Storable a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-}@@ -556,7 +569,7 @@ -- repeatedly applying the generator function to the already constructed part -- of the vector. ----- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a>+-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a> -- constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-}@@ -989,6 +1002,13 @@ {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition +-- | /O(n)/ Split the vector in two parts, the first one containing the+-- @Right@ elements and the second containing the @Left@ elements.+-- The relative order of the elements is preserved.+partitionWith :: (Storable a, Storable b, Storable c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c)+{-# INLINE partitionWith #-}+partitionWith = G.partitionWith+ -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a)@@ -1389,7 +1409,6 @@ unsafeCast (Vector n fp) = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp)- -- Conversions - Mutable vectors -- -----------------------------
Data/Vector/Storable/Internal.hs view
@@ -14,7 +14,8 @@ getPtr, setPtr, updPtr ) where -+import Foreign.ForeignPtr ()+import Foreign.Ptr () import GHC.ForeignPtr ( ForeignPtr(..) ) import GHC.Ptr ( Ptr(..) )
Data/Vector/Storable/Mutable.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-} ++ -- | -- Module : Data.Vector.Storable.Mutable -- Copyright : (c) Roman Leshchinskiy 2009-2010@@ -51,13 +53,18 @@ -- * Unsafe conversions unsafeCast, + -- * Raw pointers unsafeFromForeignPtr, unsafeFromForeignPtr0, unsafeToForeignPtr, unsafeToForeignPtr0, unsafeWith ) where -import Control.DeepSeq ( NFData(rnf) )+import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ ) import qualified Data.Vector.Generic.Mutable as G import Data.Vector.Storable.Internal@@ -76,7 +83,7 @@ import GHC.Base ( Int(..) ) -import Foreign.Ptr+import Foreign.Ptr (castPtr,plusPtr) import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) import Control.Monad.Primitive@@ -91,10 +98,13 @@ import Data.Typeable ( Typeable ) + -- Data.Vector.Internal.Check is not needed #define NOT_VECTOR_MODULE #include "vector.h" ++ -- | Mutable 'Storable'-based vectors data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a)@@ -106,6 +116,11 @@ instance NFData (MVector s a) where rnf (MVector _ _) = () +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 (MVector s) where+ liftRnf _ (MVector _ _) = ()+#endif+ instance Storable a => G.MVector MVector a where {-# INLINE basicLength #-} basicLength (MVector n _) = n@@ -130,7 +145,7 @@ fp <- mallocVector n return $ MVector n fp where- size = sizeOf (undefined :: a)+ size = sizeOf (undefined :: a) `max` 1 mx = maxBound `quot` size :: Int {-# INLINE basicInitialize #-}@@ -201,8 +216,7 @@ poke ptr x -- we dont equate storable and prim reps, so we need to write to a slot -- in storable- -- then read it back as a prim type- -- then use prim memset+ -- then read it back as a prim w<- peakPrimPtr_vector ((castPtr ptr) :: Ptr b) 0 memsetPrimPtr_vector ((castPtr ptr) `plusPtr` sizeOf x ) (n-1) w @@ -210,8 +224,7 @@ {- AFTER primitive 0.7 is pretty old, move to using setPtr. which is really-a confusing misnomer for whats often called memset (initialize an array with a-default value)+a confusing misnomer for whats often called memset (intialize ) -} -- Fill a memory block with the given value. The length is in -- elements of type @a@ rather than in bytes.@@ -269,8 +282,13 @@ -- Extracting subvectors -- --------------------- --- | Yield a part of the mutable vector without copying it.-slice :: Storable a => Int -> Int -> MVector s a -> MVector s a+-- | Yield a part of the mutable vector without copying it. The vector must+-- contain at least @i+n@ elements.+slice :: Storable a+ => Int -- ^ @i@ starting index+ -> Int -- ^ @n@ length+ -> MVector s a+ -> MVector s a {-# INLINE slice #-} slice = G.slice @@ -467,7 +485,9 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Storable a)- => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+ => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m () {-# INLINE move #-} move = G.move
Data/Vector/Unboxed.hs view
@@ -125,7 +125,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, span, break,+ partition, unstablePartition, partitionWith, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -515,7 +515,7 @@ -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. ----- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c>+-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c> -- constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-}@@ -525,7 +525,7 @@ -- repeatedly applying the generator function to the already constructed part -- of the vector. ----- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a>+-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a> -- constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-}@@ -1035,6 +1035,13 @@ unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition++-- | /O(n)/ Split the vector in two parts, the first one containing the+-- @Right@ elements and the second containing the @Left@ elements.+-- The relative order of the elements is preserved.+partitionWith :: (Unbox a, Unbox b, Unbox c) => (a -> Either b c) -> Vector a -> (Vector b, Vector c)+{-# INLINE partitionWith #-}+partitionWith = G.partitionWith -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying.
Data/Vector/Unboxed/Base.hs view
@@ -2,6 +2,9 @@ #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif+#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif {-# OPTIONS_HADDOCK hide #-} -- |@@ -25,15 +28,34 @@ import qualified Data.Vector.Primitive as P -import Control.DeepSeq ( NFData(rnf) )+import Control.Applicative (Const(..)) +import Control.DeepSeq ( NFData(rnf)+#if MIN_VERSION_deepseq(1,4,3)+ , NFData1(liftRnf)+#endif+ )+ import Control.Monad.Primitive import Control.Monad ( liftM ) +#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Functor.Compose+#endif+ import Data.Word ( Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex-+import Data.Monoid (Dual(..),Sum(..),Product(..),All(..),Any(..))+#if MIN_VERSION_base(4,8,0)+import Data.Monoid (Alt(..))+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Min(..),Max(..),First(..),Last(..),WrappedMonoid(..),Arg(..))+#endif #if !MIN_VERSION_base(4,8,0) import Data.Word ( Word ) #endif@@ -45,8 +67,8 @@ mkTyCon3 ) #endif- import Data.Data ( Data(..) )+import GHC.Exts ( Down(..) ) -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE@@ -65,6 +87,13 @@ instance NFData (Vector a) where rnf !_ = () instance NFData (MVector s a) where rnf !_ = () +#if MIN_VERSION_deepseq(1,4,3)+instance NFData1 Vector where+ liftRnf _ !_ = ()+instance NFData1 (MVector s) where+ liftRnf _ !_ = ()+#endif+ -- ----------------- -- Data and Typeable -- -----------------@@ -83,9 +112,9 @@ instance (Data a, Unbox a) => Data (Vector a) where gfoldl = G.gfoldl- toConstr _ = error "toConstr"- gunfold _ _ = error "gunfold"- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"+ toConstr _ = G.mkVecConstr "Data.Vector.Unboxed.Vector"+ gunfold = G.gunfold+ dataTypeOf _ = G.mkVecType "Data.Vector.Unboxed.Vector" dataCast1 = G.dataCast -- ----@@ -399,6 +428,160 @@ = G.basicUnsafeCopy mv v elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x $ G.elemseq (undefined :: Vector a) y z++-- -------+-- Identity+-- -------+#define newtypeMVector(inst_ctxt,inst_head,tyC,con) \+instance inst_ctxt => M.MVector MVector (inst_head) where { \+; {-# INLINE basicLength #-} \+; {-# INLINE basicUnsafeSlice #-} \+; {-# INLINE basicOverlaps #-} \+; {-# INLINE basicUnsafeNew #-} \+; {-# INLINE basicInitialize #-} \+; {-# INLINE basicUnsafeReplicate #-} \+; {-# INLINE basicUnsafeRead #-} \+; {-# INLINE basicUnsafeWrite #-} \+; {-# INLINE basicClear #-} \+; {-# INLINE basicSet #-} \+; {-# INLINE basicUnsafeCopy #-} \+; {-# INLINE basicUnsafeGrow #-} \+; basicLength (con v) = M.basicLength v \+; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \+; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \+; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \+; basicInitialize (con v) = M.basicInitialize v \+; basicUnsafeReplicate n (tyC x) = con `liftM` M.basicUnsafeReplicate n x \+; basicUnsafeRead (con v) i = tyC `liftM` M.basicUnsafeRead v i \+; basicUnsafeWrite (con v) i (tyC x) = M.basicUnsafeWrite v i x \+; basicClear (con v) = M.basicClear v \+; basicSet (con v) (tyC x) = M.basicSet v x \+; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \+; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \+; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n \+}+#define newtypeVector(inst_ctxt,inst_head,tyC,con,mcon) \+instance inst_ctxt => G.Vector Vector (inst_head) where { \+; {-# INLINE basicUnsafeFreeze #-} \+; {-# INLINE basicUnsafeThaw #-} \+; {-# INLINE basicLength #-} \+; {-# INLINE basicUnsafeSlice #-} \+; {-# INLINE basicUnsafeIndexM #-} \+; {-# INLINE elemseq #-} \+; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \+; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \+; basicLength (con v) = G.basicLength v \+; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \+; basicUnsafeIndexM (con v) i = tyC `liftM` G.basicUnsafeIndexM v i \+; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \+; elemseq _ (tyC a) = G.elemseq (undefined :: Vector a) a \+}+#define deriveNewtypeInstances(inst_ctxt,inst_head,rep,tyC,con,mcon) \+newtype instance MVector s (inst_head) = mcon (MVector s (rep)) ;\+newtype instance Vector (inst_head) = con (Vector (rep)) ;\+instance inst_ctxt => Unbox (inst_head) ;\+newtypeMVector(inst_ctxt, inst_head, tyC, mcon) ;\+newtypeVector(inst_ctxt, inst_head, tyC, con, mcon)++#if MIN_VERSION_base(4,8,0)+deriveNewtypeInstances(Unbox a, Identity a, a, Identity, V_Identity, MV_Identity)+#endif++deriveNewtypeInstances(Unbox a, Down a, a, Down, V_Down, MV_Down)+deriveNewtypeInstances(Unbox a, Dual a, a, Dual, V_Dual, MV_Dual)+deriveNewtypeInstances(Unbox a, Sum a, a, Sum, V_Sum, MV_Sum)+deriveNewtypeInstances(Unbox a, Product a, a, Product, V_Product, MV_Product)+++-- --------------+-- Data.Semigroup+-- --------------++#if MIN_VERSION_base(4,9,0)+deriveNewtypeInstances(Unbox a, Min a, a, Min, V_Min, MV_Min)+deriveNewtypeInstances(Unbox a, Max a, a, Max, V_Max, MV_Max)+deriveNewtypeInstances(Unbox a, First a, a, First, V_First, MV_First)+deriveNewtypeInstances(Unbox a, Last a, a, Last, V_Last, MV_Last)+deriveNewtypeInstances(Unbox a, WrappedMonoid a, a, WrapMonoid, V_WrappedMonoid, MV_WrappedMonoid)++-- ------------------+-- Data.Semigroup.Arg+-- ------------------++newtype instance MVector s (Arg a b) = MV_Arg (MVector s (a,b))+newtype instance Vector (Arg a b) = V_Arg (Vector (a,b))++instance (Unbox a, Unbox b) => Unbox (Arg a b)++instance (Unbox a, Unbox b) => M.MVector MVector (Arg a b) where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Arg v) = M.basicLength v+ basicUnsafeSlice i n (MV_Arg v) = MV_Arg $ M.basicUnsafeSlice i n v+ basicOverlaps (MV_Arg v1) (MV_Arg v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Arg `liftM` M.basicUnsafeNew n+ basicInitialize (MV_Arg v) = M.basicInitialize v+ basicUnsafeReplicate n (Arg x y) = MV_Arg `liftM` M.basicUnsafeReplicate n (x,y)+ basicUnsafeRead (MV_Arg v) i = uncurry Arg `liftM` M.basicUnsafeRead v i+ basicUnsafeWrite (MV_Arg v) i (Arg x y) = M.basicUnsafeWrite v i (x,y)+ basicClear (MV_Arg v) = M.basicClear v+ basicSet (MV_Arg v) (Arg x y) = M.basicSet v (x,y)+ basicUnsafeCopy (MV_Arg v1) (MV_Arg v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_Arg v1) (MV_Arg v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_Arg v) n = MV_Arg `liftM` M.basicUnsafeGrow v n++instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MV_Arg v) = V_Arg `liftM` G.basicUnsafeFreeze v+ basicUnsafeThaw (V_Arg v) = MV_Arg `liftM` G.basicUnsafeThaw v+ basicLength (V_Arg v) = G.basicLength v+ basicUnsafeSlice i n (V_Arg v) = V_Arg $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Arg v) i = uncurry Arg `liftM` G.basicUnsafeIndexM v i+ basicUnsafeCopy (MV_Arg mv) (V_Arg v)+ = G.basicUnsafeCopy mv v+ elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x+ $ G.elemseq (undefined :: Vector b) y z+#endif++deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any)+deriveNewtypeInstances((), All, Bool, All, V_All, MV_All)++-- -------+-- Const+-- -------++deriveNewtypeInstances(Unbox a, Const a b, a, Const, V_Const, MV_Const)++-- ---+-- Alt+-- ---++#if MIN_VERSION_base(4,8,0)+deriveNewtypeInstances(Unbox (f a), Alt f a, f a, Alt, V_Alt, MV_Alt)+#endif++-- -------+-- Compose+-- -------++#if MIN_VERSION_base(4,9,0)+deriveNewtypeInstances(Unbox (f (g a)), Compose f g a, f (g a), Compose, V_Compose, MV_Compose)+#endif -- ------ -- Tuples
Data/Vector/Unboxed/Mutable.hs view
@@ -83,8 +83,13 @@ -- Extracting subvectors -- --------------------- --- | Yield a part of the mutable vector without copying it.-slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a+-- | Yield a part of the mutable vector without copying it. The vector must+-- contain at least @i+n@ elements.+slice :: Unbox a+ => Int -- ^ @i@ starting index+ -> Int -- ^ @n@ length+ -> MVector s a+ -> MVector s a {-# INLINE slice #-} slice = G.slice @@ -279,7 +284,9 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Unbox a)- => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()+ => MVector (PrimState m) a -- ^ target+ -> MVector (PrimState m) a -- ^ source+ -> m () {-# INLINE move #-} move = G.move @@ -298,7 +305,7 @@ unsafeMove = G.unsafeMove -- | Compute the next (lexicographically) permutation of given vector in-place.--- Returns False when input is the last permtuation+-- Returns False when input is the last permutation nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool {-# INLINE nextPermutation #-} nextPermutation = G.nextPermutation
benchmarks/Main.hs view
@@ -1,6 +1,8 @@ module Main where import Criterion.Main+import Criterion.Main.Options+import Options.Applicative import Algo.ListRank (listRank) import Algo.Rootfix (rootfix)@@ -17,30 +19,64 @@ import Data.Vector.Unboxed ( Vector ) -size :: Int-size = 100000+import System.Environment+import Data.Word -main = lparens `seq` rparens `seq`- nodes `seq` edges1 `seq` edges2 `seq`- do- as <- randomVector size :: IO (Vector Double)- bs <- randomVector size :: IO (Vector Double)- cs <- randomVector size :: IO (Vector Double)- ds <- randomVector size :: IO (Vector Double)- sp <- randomVector (floor $ sqrt $ fromIntegral size)- :: IO (Vector Double)- as `seq` bs `seq` cs `seq` ds `seq` sp `seq`- defaultMain [ bench "listRank" $ whnf listRank size- , bench "rootfix" $ whnf rootfix (lparens, rparens)- , bench "leaffix" $ whnf leaffix (lparens, rparens)- , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2)- , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2)- , bench "quickhull" $ whnf quickhull (as,bs)- , bench "spectral" $ whnf spectral sp- , bench "tridiag" $ whnf tridiag (as,bs,cs,ds)- ]- where- (lparens, rparens) = parenTree size- (nodes, edges1, edges2) = randomGraph size- +import Data.Word +data BenchArgs = BenchArgs+ { seed :: Word32+ , size :: Int+ , otherArgs :: Mode+ }++defaultSize :: Int+defaultSize = 2000000++defaultSeed :: Word32+defaultSeed = 42++parseBenchArgs :: Parser BenchArgs+parseBenchArgs = BenchArgs+ <$> option auto+ ( long "seed"+ <> metavar "NUM"+ <> value defaultSeed+ <> help "A value with which to initialize the PRNG" )+ <*> option auto+ ( long "size"+ <> metavar "NUM"+ <> value defaultSize+ <> help "A value to use as the default entries in data structures. Benchmarks are broken for very small numbers." )+ <*> parseWith defaultConfig++main :: IO ()+main = do+ args <- execParser $ describeWith parseBenchArgs++ let useSeed = seed args+ let useSize = size args++ let (lparens, rparens) = parenTree useSize+ let (nodes, edges1, edges2) = randomGraph useSeed useSize+ lparens `seq` rparens `seq`+ nodes `seq` edges1 `seq` edges2 `seq` return ()++ as <- randomVector useSeed useSize :: IO (Vector Double)+ bs <- randomVector useSeed useSize :: IO (Vector Double)+ cs <- randomVector useSeed useSize :: IO (Vector Double)+ ds <- randomVector useSeed useSize :: IO (Vector Double)+ sp <- randomVector useSeed (floor $ sqrt $ fromIntegral useSize)+ :: IO (Vector Double)+ as `seq` bs `seq` cs `seq` ds `seq` sp `seq` return ()+ putStrLn "foo"+ runMode (otherArgs args)+ [ bench "listRank" $ whnf listRank useSize+ , bench "rootfix" $ whnf rootfix (lparens, rparens)+ , bench "leaffix" $ whnf leaffix (lparens, rparens)+ , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2)+ , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2)+ , bench "quickhull" $ whnf quickhull (as,bs)+ , bench "spectral" $ whnf spectral sp+ , bench "tridiag" $ whnf tridiag (as,bs,cs,ds)+ ]
benchmarks/TestData/Graph.hs view
@@ -7,11 +7,13 @@ import Control.Monad.ST ( ST, runST ) -randomGraph :: Int -> (Int, V.Vector Int, V.Vector Int)-randomGraph e+import Data.Word++randomGraph :: Word32 -> Int -> (Int, V.Vector Int, V.Vector Int)+randomGraph seed e = runST ( do- g <- create+ g <- initialize (V.singleton seed) arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int]) addRandomEdges n g arr e xs <- STA.getAssocs arr
benchmarks/TestData/Random.hs view
@@ -4,10 +4,11 @@ import System.Random.MWC import Control.Monad.ST ( runST )+import Data.Word -randomVector :: (Variate a, V.Unbox a) => Int -> IO (V.Vector a)-randomVector n = withSystemRandom $ \g ->- do+randomVector :: (Variate a, V.Unbox a) => Word32 -> Int -> IO (V.Vector a)+randomVector seed n = do+ g <- initialize (V.singleton seed) xs <- sequence $ replicate n $ uniform g io (return $ V.fromListN n xs) where
benchmarks/vector-benchmarks.cabal view
@@ -1,5 +1,5 @@ Name: vector-benchmarks-Version: 0.10.9+Version: 0.10.10 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -12,13 +12,13 @@ Main-Is: Main.hs Build-Depends: base >= 2 && < 5, array,- criterion >= 0.5 && < 0.7,- mwc-random >= 0.5 && < 0.13,- vector == 0.10.9+ criterion >= 1.5.4.0 && < 1.6,+ mwc-random >= 0.5 && < 0.15,+ vector, optparse-applicative if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing- + Ghc-Options: -O2 Other-Modules:
− changelog
@@ -1,84 +0,0 @@-Changes in version 0.12.0.3- * Add support for ghc >=8.8 monad fail-Changes in version 0.12.0.2- * Fixes issue #220, compact heap operations crashing on boxed vectors constructed- using traverse.- * remove usage of Data.Primitive.Address and clarify the memset Prim Storable- smuggling trick in Vector.Storable.Mutable- * backport injective type family support--Changes in version 0.12.0.1-- * Make sure `length` can be inlined- * Include modules that test-suites depend on in other-modules--Changes in version 0.12.0.0-- * Documentation fixes/additions- * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq- * New instances for various vector types: Semigroup, MonadZip- * Made `Storable` vectors respect memory alignment- * Changed some macros to ConstraintKinds- - Dropped compatibility with old GHCs to support this- * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related- helper functions.- * Relax context for `Unbox (Complex a)`.--Changes in version 0.11.0.0-- * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}`- * Define non-bottom `fail` for `instance Monad Vector`- * New generalized stream fusion framework- * Various safety fixes- - Various overflows due to vector size have been eliminated- - Memory is initialized on creation of unboxed vectors- * Changes to SPEC usage to allow building under more conditions--Changes in version 0.10.12.3-- * Allow building with `primitive-0.6`--Changes in version 0.10.12.2-- * Add support for `deepseq-1.4.0.0`--Changes in version 0.10.12.1-- * Fixed compilation on non-head GHCs--Changes in version 0.10.12.0-- * Export MVector constructor from Data.Vector.Primitive to match Vector's- (which was already exported).-- * Fix building on GHC 7.9 by adding Applicative instances for Id and Box--Changes in version 0.10.11.0-- * Support OverloadedLists for boxed Vector in GHC >= 7.8--Changes in version 0.10.10.0-- * Minor version bump to rectify PVP violation occured in 0.10.9.3 release--Changes in version 0.10.9.3 (deprecated)-- * Add support for OverloadedLists in GHC >= 7.8--Changes in version 0.10.9.2-- * Fix compilation with GHC 7.9--Changes in version 0.10.9.1-- * Implement poly-kinded Typeable--Changes in version 0.10.0.1-- * Require `primitive` to include workaround for a GHC array copying bug--Changes in version 0.10-- * `NFData` instances- * More efficient block fills- * Safe Haskell support removed
+ changelog.md view
@@ -0,0 +1,107 @@+# Changes in version 0.12.1.0+ * Fix integer overflows in specializations of Bundle/Stream enumFromTo on Integral types+ * Fix possibility of OutOfMemory with `take` and very large arguments.+ * Fix `slice` function causing segfault and not checking the bounds properly.+ * updated specialization rule for EnumFromTo on Float and Double+ to make sure it always matches the version in GHC Base (which changed as of 8.6)+ Thanks to Aleksey Khudyakov @Shimuuar for this fix.+ * fast rejection short circuiting in eqBy operations+ * the O2 test suite now has reasonable memory usage on every GHC version,+ special thanks to Alexey Kuleshevich (@lehins).+ * The `Mutable` type family is now injective on GHC 8.0 or later.+ * Using empty `Storable` vectors no longer results in division-by-zero+ errors.+ * The `Data` instances for `Vector` types now have well defined+ implementations for `toConstr`, `gunfold`, and `dataTypeOf`.+ * New function: `partitionWith`.+ * Add `Unbox` instances for `Identity`, `Const`, `Down`, `Dual`, `Sum`,+ `Product`, `Min`, `Max`, `First`, `Last`, `WrappedMonoid`, `Arg`, `Any`,+ `All`, `Alt`, and `Compose`.+ * Add `NFData1` instances for applicable `Vector` types.++#Changes in version 0.12.0.3+ * Monad Fail support++#Changes in version 0.12.0.2+ * Fixes issue #220, compact heap operations crashing on boxed vectors constructed+ using traverse.+ * backport injective type family support+ * Cleanup the memset code internal to storable vector modules to be+ compatible with future Primitive releases+++#Changes in version 0.12.0.1++ * Make sure `length` can be inlined+ * Include modules that test-suites depend on in other-modules++#Changes in version 0.12.0.0++ * Documentation fixes/additions+ * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq+ * New instances for various vector types: Semigroup, MonadZip+ * Made `Storable` vectors respect memory alignment+ * Changed some macros to ConstraintKinds+ - Dropped compatibility with old GHCs to support this+ * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related+ helper functions.+ * Relax context for `Unbox (Complex a)`.++#Changes in version 0.11.0.0++ * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}`+ * Define non-bottom `fail` for `instance Monad Vector`+ * New generalized stream fusion framework+ * Various safety fixes+ - Various overflows due to vector size have been eliminated+ - Memory is initialized on creation of unboxed vectors+ * Changes to SPEC usage to allow building under more conditions++#Changes in version 0.10.12.3++ * Allow building with `primtive-0.6`++#Changes in version 0.10.12.2++ * Add support for `deepseq-1.4.0.0`++#Changes in version 0.10.12.1++ * Fixed compilation on non-head GHCs++#Changes in version 0.10.12.0++ * Export MVector constructor from Data.Vector.Primitive to match Vector's+ (which was already exported).++ * Fix building on GHC 7.9 by adding Applicative instances for Id and Box++#Changes in version 0.10.11.0++ * Support OverloadedLists for boxed Vector in GHC >= 7.8++#Changes in version 0.10.10.0++ * Minor version bump to rectify PVP violation occured in 0.10.9.3 release++#Changes in version 0.10.9.3 (deprecated)++ * Add support for OverloadedLists in GHC >= 7.8++#Changes in version 0.10.9.2++ * Fix compilation with GHC 7.9++#Changes in version 0.10.9.1++ * Implement poly-kinded Typeable++#Changes in version 0.10.0.1++ * Require `primitive` to include workaround for a GHC array copying bug++#Changes in version 0.10++ * `NFData` instances+ * More efficient block fills+ * Safe Haskell support removed
tests/Boilerplater.hs view
@@ -1,6 +1,6 @@ module Boilerplater where -import Test.Framework.Providers.QuickCheck2+import Test.Tasty.QuickCheck import Language.Haskell.TH
tests/Main.hs view
@@ -5,10 +5,10 @@ import qualified Tests.Bundle import qualified Tests.Move -import Test.Framework (defaultMain)+import Test.Tasty (defaultMain,testGroup) main :: IO ()-main = defaultMain $ Tests.Bundle.tests+main = defaultMain $ testGroup "toplevel" $ Tests.Bundle.tests ++ Tests.Vector.tests ++ Tests.Vector.UnitTests.tests ++ Tests.Move.tests
tests/Tests/Bundle.hs view
@@ -1,19 +1,21 @@ module Tests.Bundle ( tests ) where import Boilerplater-import Utilities+import Utilities hiding (limitUnfolds) import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck -import Test.Framework-import Test.Framework.Providers.QuickCheck2+import Test.Tasty+import Test.Tasty.QuickCheck hiding (testProperties) import Text.Show.Functions () import Data.List (foldl', foldl1', unfoldr, find, findIndex)-import System.Random (Random) +-- migration from testframework to tasty+type Test = TestTree+ #define COMMON_CONTEXT(a) \ VANILLA_CONTEXT(a) @@ -136,7 +138,7 @@ S.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> S.scanl1' `eq` scanl1- + prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs where
tests/Tests/Move.hs view
@@ -1,7 +1,7 @@ module Tests.Move (tests) where import Test.QuickCheck-import Test.Framework.Providers.QuickCheck2+import Test.Tasty.QuickCheck import Test.QuickCheck.Property (Property(..)) import Utilities ()
tests/Tests/Vector.hs view
@@ -1,728 +1,15 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector (tests) where -import Boilerplater-import Utilities as Util--import Data.Functor.Identity-import qualified Data.Traversable as T (Traversable(..))-import Data.Foldable (Foldable(foldMap))-import Data.Orphans ()--import qualified Data.Vector.Generic as V-import qualified Data.Vector-import qualified Data.Vector.Primitive-import qualified Data.Vector.Storable-import qualified Data.Vector.Unboxed-import qualified Data.Vector.Fusion.Bundle as S--import Test.QuickCheck--import Test.Framework-import Test.Framework.Providers.QuickCheck2--import Text.Show.Functions ()-import Data.List-import Data.Monoid-import qualified Control.Applicative as Applicative-import System.Random (Random)--import Data.Functor.Identity-import Control.Monad.Trans.Writer--import Control.Monad.Zip--import Data.Data--type CommonContext a v = (VanillaContext a, VectorContext a v)-type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a- , TestData a, Model a ~ a, EqTest a ~ Property)-type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a)- , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a)---- TODO: implement Vector equivalents of list functions for some of the commented out properties---- TODO: test and implement some of these other Prelude functions:--- mapM *--- mapM_ *--- sequence--- sequence_--- sum *--- product *--- scanl *--- scanl1 *--- scanr *--- scanr1 *--- lookup *--- lines--- words--- unlines--- unwords--- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.--- Ones with *s are the most plausible candidates.---- TODO: add tests for the other extra functions--- IVector exports still needing tests:--- copy,--- slice,--- (//), update, bpermute,--- prescanl, prescanl',--- new,--- unsafeSlice, unsafeIndex,--- vlength, vnew---- TODO: test non-IVector stuff?--testSanity :: forall a v. (CommonContext a v) => v a -> [Test]-testSanity _ = [- testProperty "fromList.toList == id" prop_fromList_toList,- testProperty "toList.fromList == id" prop_toList_fromList,- testProperty "unstream.stream == id" prop_unstream_stream,- testProperty "stream.unstream == id" prop_stream_unstream- ]- where- prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v- prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l- prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v- prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s--testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test]-testPolymorphicFunctions _ = $(testProperties [- 'prop_eq,-- -- Length information- 'prop_length, 'prop_null,-- -- Indexing (FIXME)- 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last,- 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast,-- -- Monadic indexing (FIXME)- {- 'prop_indexM, 'prop_headM, 'prop_lastM,- 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -}-- -- Subvectors (FIXME)- 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,- 'prop_splitAt,- {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail,- 'prop_unsafeTake, 'prop_unsafeDrop, -}-- -- Initialisation (FIXME)- 'prop_empty, 'prop_singleton, 'prop_replicate,- 'prop_generate, 'prop_iterateN, 'prop_iterateNM,-- -- Monadic initialisation (FIXME)- 'prop_createT,- {- 'prop_replicateM, 'prop_generateM, 'prop_create, -}-- -- Unfolding- 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM,- 'prop_constructN, 'prop_constructrN,-- -- Enumeration? (FIXME?)-- -- Concatenation (FIXME)- 'prop_cons, 'prop_snoc, 'prop_append,- 'prop_concat,-- -- Restricting memory usage- 'prop_force,--- -- Bulk updates (FIXME)- 'prop_upd,- {- 'prop_update, 'prop_update_,- 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -}-- -- Accumulations (FIXME)- 'prop_accum,- {- 'prop_accumulate, 'prop_accumulate_,- 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -}-- -- Permutations- 'prop_reverse, 'prop_backpermute,- {- 'prop_unsafeBackpermute, -}-- -- Elementwise indexing- {- 'prop_indexed, -}-- -- Mapping- 'prop_map, 'prop_imap, 'prop_concatMap,-- -- Monadic mapping- {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -}- 'prop_imapM, 'prop_imapM_,-- -- Zipping- 'prop_zipWith, 'prop_zipWith3, {- ... -}- 'prop_izipWith, 'prop_izipWith3, {- ... -}- 'prop_izipWithM, 'prop_izipWithM_,- {- 'prop_zip, ... -}-- -- Monadic zipping- {- 'prop_zipWithM, 'prop_zipWithM_, -}-- -- Unzipping- {- 'prop_unzip, ... -}-- -- Filtering- 'prop_filter, 'prop_ifilter, {- prop_filterM, -}- 'prop_uniq,- 'prop_mapMaybe, 'prop_imapMaybe,- 'prop_takeWhile, 'prop_dropWhile,-- -- Paritioning- 'prop_partition, {- 'prop_unstablePartition, -}- 'prop_span, 'prop_break,-- -- Searching- 'prop_elem, 'prop_notElem,- 'prop_find, 'prop_findIndex, 'prop_findIndices,- 'prop_elemIndex, 'prop_elemIndices,-- -- Folding- 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',- 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1',- 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr',- 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_,-- -- Specialised folds- 'prop_all, 'prop_any,- {- 'prop_maximumBy, 'prop_minimumBy,- 'prop_maxIndexBy, 'prop_minIndexBy, -}-- -- Monadic folds- {- ... -}-- -- Monadic sequencing- {- ... -}-- -- Scans- 'prop_prescanl, 'prop_prescanl',- 'prop_postscanl, 'prop_postscanl',- 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',- 'prop_iscanl, 'prop_iscanl',-- 'prop_prescanr, 'prop_prescanr',- 'prop_postscanr, 'prop_postscanr',- 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',- 'prop_iscanr, 'prop_iscanr'- ])- where- -- Prelude- prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)-- prop_length :: P (v a -> Int) = V.length `eq` length- prop_null :: P (v a -> Bool) = V.null `eq` null-- prop_empty :: P (v a) = V.empty `eq` []- prop_singleton :: P (a -> v a) = V.singleton `eq` singleton- prop_replicate :: P (Int -> a -> v a)- = (\n _ -> n < 1000) ===> V.replicate `eq` replicate- prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:)- prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc- prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++)- prop_concat :: P ([v a] -> v a) = V.concat `eq` concat- prop_force :: P (v a -> v a) = V.force `eq` id- prop_generate :: P (Int -> (Int -> a) -> v a)- = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate- prop_iterateN :: P (Int -> (a -> a) -> a -> v a)- = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f)- prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a))- = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM- prop_createT :: P ((a, v a) -> (a, v a))- prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id-- prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head- prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last- prop_index = \xs ->- not (V.null xs) ==>- forAll (choose (0, V.length xs-1)) $ \i ->- unP prop xs i- where- prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)- prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn- where- fn xs i = case drop i xs of- x:_ | i >= 0 -> Just x- _ -> Nothing- prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head- prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last- prop_unsafeIndex = \xs ->- not (V.null xs) ==>- forAll (choose (0, V.length xs-1)) $ \i ->- unP prop xs i- where- prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!)-- prop_slice = \xs ->- forAll (choose (0, V.length xs)) $ \i ->- forAll (choose (0, V.length xs - i)) $ \n ->- unP prop i n xs- where- prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice-- prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail- prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init- prop_take :: P (Int -> v a -> v a) = V.take `eq` take- prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop- prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt-- prop_accum = \f xs ->- forAll (index_value_pairs (V.length xs)) $ \ps ->- unP prop f xs ps- where- prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a)- = V.accum `eq` accum-- prop_upd = \xs ->- forAll (index_value_pairs (V.length xs)) $ \ps ->- unP prop xs ps- where- prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//)-- prop_backpermute = \xs ->- forAll (indices (V.length xs)) $ \is ->- unP prop xs (V.fromList is)- where- prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute-- prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse-- prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map- prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith- prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)- = V.zipWith3 `eq` zipWith3- prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap- prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a))- = V.imapM `eq` imapM- prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ())- = V.imapM_ `eq` imapM_- prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith- prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a))- = V.izipWithM `eq` izipWithM- prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ())- = V.izipWithM_ `eq` izipWithM_- prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)- = V.izipWith3 `eq` izipWith3-- prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter- prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter- prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe- prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe- prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile- prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile- prop_partition :: P ((a -> Bool) -> v a -> (v a, v a))- = V.partition `eq` partition- prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span- prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break-- prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem- prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem- prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find- prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int)- = V.findIndex `eq` findIndex- prop_findIndices :: P ((a -> Bool) -> v a -> v Int)- = V.findIndices `eq` findIndices- prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex- prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices-- prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl- prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>- V.foldl1 `eq` foldl1- prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl'- prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>- V.foldl1' `eq` foldl1'- prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr- prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>- V.foldr1 `eq` foldr1- prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr- prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>- V.foldr1' `eq` foldr1- prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a)- = V.ifoldl `eq` ifoldl- prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a)- = V.ifoldl' `eq` ifoldl- prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a)- = V.ifoldr `eq` ifoldr- prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a)- = V.ifoldr' `eq` ifoldr- prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)- = V.ifoldM `eq` ifoldM- prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)- = V.ifoldM' `eq` ifoldM- prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())- = V.ifoldM_ `eq` ifoldM_- prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())- = V.ifoldM'_ `eq` ifoldM_-- prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all- prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any-- prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a)- = V.prescanl `eq` prescanl- prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.prescanl' `eq` prescanl- prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a)- = V.postscanl `eq` postscanl- prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.postscanl' `eq` postscanl- prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a)- = V.scanl `eq` scanl- prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.scanl' `eq` scanl- prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanl1 `eq` scanl1- prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanl1' `eq` scanl1- prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a)- = V.iscanl `eq` iscanl- prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)- = V.iscanl' `eq` iscanl-- prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a)- = V.prescanr `eq` prescanr- prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.prescanr' `eq` prescanr- prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a)- = V.postscanr `eq` postscanr- prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.postscanr' `eq` postscanr- prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a)- = V.scanr `eq` scanr- prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a)- = V.scanr' `eq` scanr- prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a)- = V.iscanr `eq` iscanr- prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)- = V.iscanr' `eq` iscanr- prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanr1 `eq` scanr1- prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanr1' `eq` scanr1-- prop_concatMap = forAll arbitrary $ \xs ->- forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs- where- prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap-- prop_uniq :: P (v a -> v a)- = V.uniq `eq` (map head . group)- --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span- --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break- --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt- --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all- --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any-- -- Data.List- --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)- --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)- --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)- --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)- --- --prop_mapAccumL = eq3- -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))- -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))- --- --prop_mapAccumR = eq3- -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))- -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))-- -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This- -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.- limitUnfolds f (theirs, ours)- | ours > 0- , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))- | otherwise = Nothing- limitUnfoldsM f (theirs, ours)- | ours > 0 = do r <- f theirs- return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r- | otherwise = return Nothing--- prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)- = (\n f a -> V.unfoldr (limitUnfolds f) (a, n))- `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))- prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)- = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))- prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))- = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n))- `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))- prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))- = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))-- prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f- where- prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN []-- constructN xs 0 _ = xs- constructN xs n f = constructN (xs ++ [f xs]) (n-1) f-- prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f- where- prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN []-- constructrN xs 0 _ = xs- constructrN xs n f = constructrN (f xs : xs) (n-1) f----testTuplyFunctions:: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test]-testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3- , 'prop_unzip, 'prop_unzip3- , 'prop_mzip, 'prop_munzip- ])- where- prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip- prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3- prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip- prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3- prop_mzip :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a))- = mzip `eq` zip- prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a))- = munzip `eq` unzip--testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test]-testOrdFunctions _ = $(testProperties- ['prop_compare,- 'prop_maximum, 'prop_minimum,- 'prop_minIndex, 'prop_maxIndex,- 'prop_maximumBy, 'prop_minimumBy,- 'prop_maxIndexBy, 'prop_minIndexBy])- 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- prop_maximumBy :: P (v a -> a) =- not . V.null ===> V.maximumBy compare `eq` maximum- prop_minimumBy :: P (v a -> a) =- not . V.null ===> V.minimumBy compare `eq` minimum- prop_maxIndexBy :: P (v a -> Int) =- not . V.null ===> V.maxIndexBy compare `eq` maxIndex- prop_minIndexBy :: P (v a -> Int) =- not . V.null ===> V.minIndexBy compare `eq` minIndex--testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test]-testEnumFunctions _ = $(testProperties- [ 'prop_enumFromN, 'prop_enumFromThenN,- 'prop_enumFromTo, 'prop_enumFromThenTo])- where- prop_enumFromN :: P (a -> Int -> v a)- = (\_ n -> n < 1000)- ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1)-- prop_enumFromThenN :: P (a -> a -> Int -> v a)- = (\_ _ n -> n < 1000)- ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y)-- prop_enumFromTo = \m ->- forAll (choose (-2,100)) $ \n ->- unP prop m (m+n)- where- prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo-- prop_enumFromThenTo = \i j ->- j /= i ==>- forAll (choose (ks i j)) $ \k ->- unP prop i j k- where- prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo-- ks i j | j < i = (i-d*100, i+d*2)- | otherwise = (i-d*2, i+d*100)- where- d = abs (j-i)--testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test]-testMonoidFunctions _ = $(testProperties- [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ])- where- prop_mempty :: P (v a) = mempty `eq` mempty- prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend- prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat--testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test]-testFunctorFunctions _ = $(testProperties- [ 'prop_fmap ])- where- prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap--testMonadFunctions :: forall a v. (CommonContext a v, Monad v) => v a -> [Test]-testMonadFunctions _ = $(testProperties- [ 'prop_return, 'prop_bind ])- where- prop_return :: P (a -> v a) = return `eq` return- prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=)--testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test]-testApplicativeFunctions _ = $(testProperties- [ 'prop_applicative_pure, 'prop_applicative_appl ])- where- prop_applicative_pure :: P (a -> v a)- = Applicative.pure `eq` Applicative.pure- prop_applicative_appl :: [a -> a] -> P (v a -> v a)- = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs--testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test]-testAlternativeFunctions _ = $(testProperties- [ 'prop_alternative_empty, 'prop_alternative_or ])- where- prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty- prop_alternative_or :: P (v a -> v a -> v a)- = (Applicative.<|>) `eq` (Applicative.<|>)--testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test]-testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])- where- prop_and :: P (v Bool -> Bool) = V.and `eq` and- prop_or :: P (v Bool -> Bool) = V.or `eq` or--testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test]-testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])- where- prop_sum :: P (v a -> a) = V.sum `eq` sum- prop_product :: P (v a -> a) = V.product `eq` product--testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test]-testNestedVectorFunctions _ = $(testProperties [])- where- -- Prelude- --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat-- -- Data.List- --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])- --prop_group = V.group `eq1` (group :: v a -> [v a])- --prop_inits = V.inits `eq1` (inits :: v a -> [v a])- --prop_tails = V.tails `eq1` (tails :: v a -> [v a])--testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test]-testDataFunctions _ = $(testProperties ['prop_glength])- where- prop_glength :: P (v a -> Int) = glength `eq` glength- where- glength :: Data b => b -> Int- glength xs = gmapQl (+) 0 toA xs-- toA :: Data b => b -> Int- toA x = maybe (glength x) (const 1) (cast x :: Maybe a)--testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Data a) => Data.Vector.Vector a -> [Test]-testGeneralBoxedVector dummy = concatMap ($ dummy) [- testSanity,- testPolymorphicFunctions,- testOrdFunctions,- testTuplyFunctions,- testNestedVectorFunctions,- testMonoidFunctions,- testFunctorFunctions,- testMonadFunctions,- testApplicativeFunctions,- testAlternativeFunctions,- testDataFunctions- ]--testBoolBoxedVector dummy = concatMap ($ dummy)- [- testGeneralBoxedVector- , testBoolFunctions- ]--testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Vector a -> [Test]-testNumericBoxedVector dummy = concatMap ($ dummy)- [- testGeneralBoxedVector- , testNumFunctions- , testEnumFunctions- ]---testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Data a) => Data.Vector.Primitive.Vector a -> [Test]-testGeneralPrimitiveVector dummy = concatMap ($ dummy) [- testSanity,- testPolymorphicFunctions,- testOrdFunctions,- testMonoidFunctions,- testDataFunctions- ]--testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Primitive.Vector a -> [Test]-testNumericPrimitiveVector dummy = concatMap ($ dummy)- [- testGeneralPrimitiveVector- , testNumFunctions- , testEnumFunctions- ]---testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Data a) => Data.Vector.Storable.Vector a -> [Test]-testGeneralStorableVector dummy = concatMap ($ dummy) [- testSanity,- testPolymorphicFunctions,- testOrdFunctions,- testMonoidFunctions,- testDataFunctions- ]--testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Storable.Vector a -> [Test]-testNumericStorableVector dummy = concatMap ($ dummy)- [- testGeneralStorableVector- , testNumFunctions- , testEnumFunctions- ]---testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]-testGeneralUnboxedVector dummy = concatMap ($ dummy) [- testSanity,- testPolymorphicFunctions,- testOrdFunctions,- testMonoidFunctions,- testDataFunctions- ]--testUnitUnboxedVector dummy = concatMap ($ dummy)- [- testGeneralUnboxedVector- ]--testBoolUnboxedVector dummy = concatMap ($ dummy)- [- testGeneralUnboxedVector- , testBoolFunctions- ]--testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]-testNumericUnboxedVector dummy = concatMap ($ dummy)- [- testGeneralUnboxedVector- , testNumFunctions- , testEnumFunctions- ]+import Test.Tasty (testGroup)+import qualified Tests.Vector.Boxed+import qualified Tests.Vector.Primitive+import qualified Tests.Vector.Storable+import qualified Tests.Vector.Unboxed -testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]-testTupleUnboxedVector dummy = concatMap ($ dummy)- [- testGeneralUnboxedVector+tests =+ [ testGroup "Tests.Vector.Boxed" Tests.Vector.Boxed.tests+ , testGroup "Tests.Vector.Primitive" Tests.Vector.Primitive.tests+ , testGroup "Tests.Vector.Storable" Tests.Vector.Storable.tests+ , testGroup "Tests.Vector.Unboxed" Tests.Vector.Unboxed.tests ]--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 (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 (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)),-- testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())),- testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)),- testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),- testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)),- testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))),- testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int)))-- ]
+ tests/Tests/Vector/Boxed.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE ConstraintKinds #-}+module Tests.Vector.Boxed (tests) where++import Test.Tasty+import qualified Data.Vector+import Tests.Vector.Property++import GHC.Exts (inline)+++testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Data a) => Data.Vector.Vector a -> [Test]+testGeneralBoxedVector dummy = concatMap ($ dummy)+ [+ testSanity+ , inline testPolymorphicFunctions+ , testOrdFunctions+ , testTuplyFunctions+ , testNestedVectorFunctions+ , testMonoidFunctions+ , testFunctorFunctions+ , testMonadFunctions+ , testApplicativeFunctions+ , testAlternativeFunctions+ , testDataFunctions+ ]++testBoolBoxedVector dummy = concatMap ($ dummy)+ [+ testGeneralBoxedVector+ , testBoolFunctions+ ]++testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Vector a -> [Test]+testNumericBoxedVector dummy = concatMap ($ dummy)+ [+ testGeneralBoxedVector+ , testNumFunctions+ , testEnumFunctions+ ]++tests =+ [ testGroup "Bool" $+ testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)+ , testGroup "Int" $+ testNumericBoxedVector (undefined :: Data.Vector.Vector Int)+ ]
+ tests/Tests/Vector/Primitive.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE ConstraintKinds #-}+module Tests.Vector.Primitive (tests) where++import Test.Tasty+import qualified Data.Vector.Primitive+import Tests.Vector.Property++import GHC.Exts (inline)++testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Data a) => Data.Vector.Primitive.Vector a -> [Test]+testGeneralPrimitiveVector dummy = concatMap ($ dummy)+ [+ testSanity+ , inline testPolymorphicFunctions+ , testOrdFunctions+ , testMonoidFunctions+ , testDataFunctions+ ]++testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Primitive.Vector a -> [Test]+testNumericPrimitiveVector dummy = concatMap ($ dummy)+ [+ testGeneralPrimitiveVector+ , testNumFunctions+ , testEnumFunctions+ ]++tests =+ [ testGroup "Int" $+ testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)+ , testGroup "Double" $+ testNumericPrimitiveVector+ (undefined :: Data.Vector.Primitive.Vector Double)+ ]
+ tests/Tests/Vector/Property.hs view
@@ -0,0 +1,682 @@+{-# LANGUAGE ConstraintKinds #-}+module Tests.Vector.Property+ ( CommonContext+ , VanillaContext+ , VectorContext+ , testSanity+ , testPolymorphicFunctions+ , testTuplyFunctions+ , testOrdFunctions+ , testEnumFunctions+ , testMonoidFunctions+ , testFunctorFunctions+ , testMonadFunctions+ , testApplicativeFunctions+ , testAlternativeFunctions+ , testBoolFunctions+ , testNumFunctions+ , testNestedVectorFunctions+ , testDataFunctions+ -- re-exports+ , Data+ , Random+ ,Test+ ) where++import Boilerplater+import Utilities as Util hiding (limitUnfolds)++import Data.Functor.Identity+import qualified Data.Traversable as T (Traversable(..))+import Data.Foldable (Foldable(foldMap))+import Data.Orphans ()++import qualified Data.Vector.Generic as V+import qualified Data.Vector.Fusion.Bundle as S++import Test.QuickCheck++import Test.Tasty+import Test.Tasty.QuickCheck hiding (testProperties)++import Text.Show.Functions ()+import Data.List+++import qualified Control.Applicative as Applicative+import System.Random (Random)++import Data.Functor.Identity+import Control.Monad.Trans.Writer++import Control.Monad.Zip++import Data.Data++import qualified Data.List.NonEmpty as DLE+import Data.Semigroup (Semigroup(..))++type CommonContext a v = (VanillaContext a, VectorContext a v)+type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a+ , TestData a, Model a ~ a, EqTest a ~ Property)+type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a)+ , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a)++-- | migration hack for moving from TestFramework to Tasty+type Test = TestTree+-- TODO: implement Vector equivalents of list functions for some of the commented out properties++-- TODO: test and implement some of these other Prelude functions:+-- mapM *+-- mapM_ *+-- sequence+-- sequence_+-- sum *+-- product *+-- scanl *+-- scanl1 *+-- scanr *+-- scanr1 *+-- lookup *+-- lines+-- words+-- unlines+-- unwords+-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.+-- Ones with *s are the most plausible candidates.++-- TODO: add tests for the other extra functions+-- IVector exports still needing tests:+-- copy,+-- slice,+-- (//), update, bpermute,+-- prescanl, prescanl',+-- new,+-- unsafeSlice, unsafeIndex,+-- vlength, vnew++-- TODO: test non-IVector stuff?++testSanity :: forall a v. (CommonContext a v) => v a -> [Test]+{-# INLINE testSanity #-}+testSanity _ = [+ testProperty "fromList.toList == id" prop_fromList_toList,+ testProperty "toList.fromList == id" prop_toList_fromList,+ testProperty "unstream.stream == id" prop_unstream_stream,+ testProperty "stream.unstream == id" prop_stream_unstream+ ]+ where+ prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v+ prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l+ prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v+ prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s++testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test]+-- FIXME: inlining of unboxed properties blows up the memory during compilation. See #272+--{-# INLINE testPolymorphicFunctions #-}+testPolymorphicFunctions _ = $(testProperties [+ 'prop_eq,++ -- Length information+ 'prop_length, 'prop_null,++ -- Indexing (FIXME)+ 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last,+ 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast,++ -- Monadic indexing (FIXME)+ {- 'prop_indexM, 'prop_headM, 'prop_lastM,+ 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -}++ -- Subvectors (FIXME)+ 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,+ 'prop_splitAt,+ {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail,+ 'prop_unsafeTake, 'prop_unsafeDrop, -}++ -- Initialisation (FIXME)+ 'prop_empty, 'prop_singleton, 'prop_replicate,+ 'prop_generate, 'prop_iterateN, 'prop_iterateNM,++ -- Monadic initialisation (FIXME)+ 'prop_createT,+ {- 'prop_replicateM, 'prop_generateM, 'prop_create, -}++ -- Unfolding+ 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM,+ 'prop_constructN, 'prop_constructrN,++ -- Enumeration? (FIXME?)++ -- Concatenation (FIXME)+ 'prop_cons, 'prop_snoc, 'prop_append,+ 'prop_concat,++ -- Restricting memory usage+ 'prop_force,+++ -- Bulk updates (FIXME)+ 'prop_upd,+ {- 'prop_update, 'prop_update_,+ 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -}++ -- Accumulations (FIXME)+ 'prop_accum,+ {- 'prop_accumulate, 'prop_accumulate_,+ 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -}++ -- Permutations+ 'prop_reverse, 'prop_backpermute,+ {- 'prop_unsafeBackpermute, -}++ -- Elementwise indexing+ {- 'prop_indexed, -}++ -- Mapping+ 'prop_map, 'prop_imap, 'prop_concatMap,++ -- Monadic mapping+ {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -}+ 'prop_imapM, 'prop_imapM_,++ -- Zipping+ 'prop_zipWith, 'prop_zipWith3, {- ... -}+ 'prop_izipWith, 'prop_izipWith3, {- ... -}+ 'prop_izipWithM, 'prop_izipWithM_,+ {- 'prop_zip, ... -}++ -- Monadic zipping+ {- 'prop_zipWithM, 'prop_zipWithM_, -}++ -- Unzipping+ {- 'prop_unzip, ... -}++ -- Filtering+ 'prop_filter, 'prop_ifilter, {- prop_filterM, -}+ 'prop_uniq,+ 'prop_mapMaybe, 'prop_imapMaybe,+ 'prop_takeWhile, 'prop_dropWhile,++ -- Paritioning+ 'prop_partition, {- 'prop_unstablePartition, -}+ 'prop_partitionWith,+ 'prop_span, 'prop_break,++ -- Searching+ 'prop_elem, 'prop_notElem,+ 'prop_find, 'prop_findIndex, 'prop_findIndices,+ 'prop_elemIndex, 'prop_elemIndices,++ -- Folding+ 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',+ 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1',+ 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr',+ 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_,++ -- Specialised folds+ 'prop_all, 'prop_any,+ {- 'prop_maximumBy, 'prop_minimumBy,+ 'prop_maxIndexBy, 'prop_minIndexBy, -}++ -- Monadic folds+ {- ... -}++ -- Monadic sequencing+ {- ... -}++ -- Scans+ 'prop_prescanl, 'prop_prescanl',+ 'prop_postscanl, 'prop_postscanl',+ 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',+ 'prop_iscanl, 'prop_iscanl',++ 'prop_prescanr, 'prop_prescanr',+ 'prop_postscanr, 'prop_postscanr',+ 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',+ 'prop_iscanr, 'prop_iscanr'+ ])+ where+ -- Prelude+ prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)++ prop_length :: P (v a -> Int) = V.length `eq` length+ prop_null :: P (v a -> Bool) = V.null `eq` null++ prop_empty :: P (v a) = V.empty `eq` []+ prop_singleton :: P (a -> v a) = V.singleton `eq` singleton+ prop_replicate :: P (Int -> a -> v a)+ = (\n _ -> n < 1000) ===> V.replicate `eq` replicate+ prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:)+ prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc+ prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++)+ prop_concat :: P ([v a] -> v a) = V.concat `eq` concat+ prop_force :: P (v a -> v a) = V.force `eq` id+ prop_generate :: P (Int -> (Int -> a) -> v a)+ = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate+ prop_iterateN :: P (Int -> (a -> a) -> a -> v a)+ = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f)+ prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a))+ = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM+ prop_createT :: P ((a, v a) -> (a, v a))+ prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id++ prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head+ prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last+ prop_index = \xs ->+ not (V.null xs) ==>+ forAll (choose (0, V.length xs-1)) $ \i ->+ unP prop xs i+ where+ prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)+ prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn+ where+ fn xs i = case drop i xs of+ x:_ | i >= 0 -> Just x+ _ -> Nothing+ prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head+ prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last+ prop_unsafeIndex = \xs ->+ not (V.null xs) ==>+ forAll (choose (0, V.length xs-1)) $ \i ->+ unP prop xs i+ where+ prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!)++ prop_slice = \xs ->+ forAll (choose (0, V.length xs)) $ \i ->+ forAll (choose (0, V.length xs - i)) $ \n ->+ unP prop i n xs+ where+ prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice++ prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail+ prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init+ prop_take :: P (Int -> v a -> v a) = V.take `eq` take+ prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop+ prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt++ prop_accum = \f xs ->+ forAll (index_value_pairs (V.length xs)) $ \ps ->+ unP prop f xs ps+ where+ prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a)+ = V.accum `eq` accum++ prop_upd = \xs ->+ forAll (index_value_pairs (V.length xs)) $ \ps ->+ unP prop xs ps+ where+ prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//)++ prop_backpermute = \xs ->+ forAll (indices (V.length xs)) $ \is ->+ unP prop xs (V.fromList is)+ where+ prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute++ prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse++ prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map+ prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith+ prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)+ = V.zipWith3 `eq` zipWith3+ prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap+ prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a))+ = V.imapM `eq` imapM+ prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ())+ = V.imapM_ `eq` imapM_+ prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith+ prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a))+ = V.izipWithM `eq` izipWithM+ prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ())+ = V.izipWithM_ `eq` izipWithM_+ prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)+ = V.izipWith3 `eq` izipWith3++ prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter+ prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter+ prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe+ prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe+ prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile+ prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile+ prop_partition :: P ((a -> Bool) -> v a -> (v a, v a))+ = V.partition `eq` partition+ prop_partitionWith :: P ((a -> Either a a) -> v a -> (v a, v a))+ = V.partitionWith `eq` partitionWith+ prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span+ prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break++ prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem+ prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem+ prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find+ prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int)+ = V.findIndex `eq` findIndex+ prop_findIndices :: P ((a -> Bool) -> v a -> v Int)+ = V.findIndices `eq` findIndices+ prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex+ prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices++ prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl+ prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>+ V.foldl1 `eq` foldl1+ prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl'+ prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>+ V.foldl1' `eq` foldl1'+ prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr+ prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>+ V.foldr1 `eq` foldr1+ prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr+ prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>+ V.foldr1' `eq` foldr1+ prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a)+ = V.ifoldl `eq` ifoldl+ prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a)+ = V.ifoldl' `eq` ifoldl+ prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a)+ = V.ifoldr `eq` ifoldr+ prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a)+ = V.ifoldr' `eq` ifoldr+ prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)+ = V.ifoldM `eq` ifoldM+ prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a)+ = V.ifoldM' `eq` ifoldM+ prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())+ = V.ifoldM_ `eq` ifoldM_+ prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ())+ = V.ifoldM'_ `eq` ifoldM_++ prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all+ prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any++ prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanl `eq` prescanl+ prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanl' `eq` prescanl+ prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanl `eq` postscanl+ prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanl' `eq` postscanl+ prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanl `eq` scanl+ prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanl' `eq` scanl+ prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanl1 `eq` scanl1+ prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanl1' `eq` scanl1+ prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a)+ = V.iscanl `eq` iscanl+ prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)+ = V.iscanl' `eq` iscanl++ prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanr `eq` prescanr+ prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.prescanr' `eq` prescanr+ prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanr `eq` postscanr+ prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.postscanr' `eq` postscanr+ prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanr `eq` scanr+ prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a)+ = V.scanr' `eq` scanr+ prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a)+ = V.iscanr `eq` iscanr+ prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)+ = V.iscanr' `eq` iscanr+ prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanr1 `eq` scanr1+ prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+ V.scanr1' `eq` scanr1++ prop_concatMap = forAll arbitrary $ \xs ->+ forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs+ where+ prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap++ prop_uniq :: P (v a -> v a)+ = V.uniq `eq` (map head . group)+ --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span+ --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break+ --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt+ --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all+ --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any++ -- Data.List+ --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)+ --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)+ --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)+ --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)+ --+ --prop_mapAccumL = eq3+ -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))+ -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+ --+ --prop_mapAccumR = eq3+ -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))+ -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++ -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This+ -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.+ limitUnfolds f (theirs, ours)+ | ours > 0+ , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+ | otherwise = Nothing+ limitUnfoldsM f (theirs, ours)+ | ours > 0 = do r <- f theirs+ return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r+ | otherwise = return Nothing+++ prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)+ = (\n f a -> V.unfoldr (limitUnfolds f) (a, n))+ `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))+ prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)+ = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))+ prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))+ = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n))+ `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))+ prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))+ = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))++ prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f+ where+ prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN []++ constructN xs 0 _ = xs+ constructN xs n f = constructN (xs ++ [f xs]) (n-1) f++ prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f+ where+ prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN []++ constructrN xs 0 _ = xs+ constructrN xs n f = constructrN (f xs : xs) (n-1) f++-- copied from GHC source code+partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])+partitionWith _ [] = ([],[])+partitionWith f (x:xs) = case f x of+ Left b -> (b:bs, cs)+ Right c -> (bs, c:cs)+ where (bs,cs) = partitionWith f xs++testTuplyFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test]+{-# INLINE testTuplyFunctions #-}+testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3+ , 'prop_unzip, 'prop_unzip3+ ])+ where+ prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip+ prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3+ prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip+ prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3++testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test]+{-# INLINE testOrdFunctions #-}+testOrdFunctions _ = $(testProperties+ ['prop_compare,+ 'prop_maximum, 'prop_minimum,+ 'prop_minIndex, 'prop_maxIndex,+ 'prop_maximumBy, 'prop_minimumBy,+ 'prop_maxIndexBy, 'prop_minIndexBy,+ 'prop_ListLastMaxIndexWins ])+ where+ prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare+ prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum+ prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum+ prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex+ prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` listMaxIndexFMW+ prop_maximumBy :: P (v a -> a) =+ not . V.null ===> V.maximumBy compare `eq` maximum+ prop_minimumBy :: P (v a -> a) =+ not . V.null ===> V.minimumBy compare `eq` minimum+ prop_maxIndexBy :: P (v a -> Int) =+ not . V.null ===> V.maxIndexBy compare `eq` listMaxIndexFMW+ --- (maxIndex)+ prop_ListLastMaxIndexWins :: P (v a -> Int) =+ not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexLMW+ prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) =+ (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW+ prop_FalseListFirstMaxIndexWins :: Property+ prop_FalseListFirstMaxIndexWins = expectFailure prop_FalseListFirstMaxIndexWinsDesc+ prop_minIndexBy :: P (v a -> Int) =+ not . V.null ===> V.minIndexBy compare `eq` minIndex++listMaxIndexFMW :: Ord a => [a] -> Int+listMaxIndexFMW = ( fst . extractFMW . sconcat . DLE.fromList . fmap FMW . zip [0 :: Int ..])++listMaxIndexLMW :: Ord a => [a] -> Int+listMaxIndexLMW = ( fst . extractLMW . sconcat . DLE.fromList . fmap LMW . zip [0 :: Int ..])++newtype LastMaxWith a i = LMW {extractLMW:: (i,a)}+ deriving(Eq,Show,Read)+instance (Ord a) => Semigroup (LastMaxWith a i) where+ (<>) x y | snd (extractLMW x) > snd (extractLMW y) = x+ | snd (extractLMW x) < snd (extractLMW y) = y+ | otherwise = y+newtype FirstMaxWith a i = FMW {extractFMW:: (i,a)}+ deriving(Eq,Show,Read)+instance (Ord a) => Semigroup (FirstMaxWith a i) where+ (<>) x y | snd (extractFMW x) > snd (extractFMW y) = x+ | snd (extractFMW x) < snd (extractFMW y) = y+ | otherwise = x+++testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test]+{-# INLINE testEnumFunctions #-}+testEnumFunctions _ = $(testProperties+ [ 'prop_enumFromN, 'prop_enumFromThenN,+ 'prop_enumFromTo, 'prop_enumFromThenTo])+ where+ prop_enumFromN :: P (a -> Int -> v a)+ = (\_ n -> n < 1000)+ ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1)++ prop_enumFromThenN :: P (a -> a -> Int -> v a)+ = (\_ _ n -> n < 1000)+ ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y)++ prop_enumFromTo = \m ->+ forAll (choose (-2,100)) $ \n ->+ unP prop m (m+n)+ where+ prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo++ prop_enumFromThenTo = \i j ->+ j /= i ==>+ forAll (choose (ks i j)) $ \k ->+ unP prop i j k+ where+ prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo++ ks i j | j < i = (i-d*100, i+d*2)+ | otherwise = (i-d*2, i+d*100)+ where+ d = abs (j-i)++testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test]+{-# INLINE testMonoidFunctions #-}+testMonoidFunctions _ = $(testProperties+ [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ])+ where+ prop_mempty :: P (v a) = mempty `eq` mempty+ prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend+ prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat++testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test]+{-# INLINE testFunctorFunctions #-}+testFunctorFunctions _ = $(testProperties+ [ 'prop_fmap ])+ where+ prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap++testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [Test]+{-# INLINE testMonadFunctions #-}+testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind+ , 'prop_mzip, 'prop_munzip])+ where+ prop_return :: P (a -> v a) = return `eq` return+ prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=)+ prop_mzip :: P (v a -> v a -> v (a, a)) = mzip `eq` zip+ prop_munzip :: P (v (a, a) -> (v a, v a)) = munzip `eq` unzip++testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test]+{-# INLINE testApplicativeFunctions #-}+testApplicativeFunctions _ = $(testProperties+ [ 'prop_applicative_pure, 'prop_applicative_appl ])+ where+ prop_applicative_pure :: P (a -> v a)+ = Applicative.pure `eq` Applicative.pure+ prop_applicative_appl :: [a -> a] -> P (v a -> v a)+ = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs++testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test]+{-# INLINE testAlternativeFunctions #-}+testAlternativeFunctions _ = $(testProperties+ [ 'prop_alternative_empty, 'prop_alternative_or ])+ where+ prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty+ prop_alternative_or :: P (v a -> v a -> v a)+ = (Applicative.<|>) `eq` (Applicative.<|>)++testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test]+{-# INLINE testBoolFunctions #-}+testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])+ where+ prop_and :: P (v Bool -> Bool) = V.and `eq` and+ prop_or :: P (v Bool -> Bool) = V.or `eq` or++testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test]+{-# INLINE testNumFunctions #-}+testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])+ where+ prop_sum :: P (v a -> a) = V.sum `eq` sum+ prop_product :: P (v a -> a) = V.product `eq` product++testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test]+{-# INLINE testNestedVectorFunctions #-}+testNestedVectorFunctions _ = $(testProperties [])+ where+ -- Prelude+ --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat++ -- Data.List+ --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])+ --prop_group = V.group `eq1` (group :: v a -> [v a])+ --prop_inits = V.inits `eq1` (inits :: v a -> [v a])+ --prop_tails = V.tails `eq1` (tails :: v a -> [v a])++testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test]+{-# INLINE testDataFunctions #-}+testDataFunctions _ = $(testProperties ['prop_glength])+ where+ prop_glength :: P (v a -> Int) = glength `eq` glength+ where+ glength :: Data b => b -> Int+ glength xs = gmapQl (+) 0 toA xs++ toA :: Data b => b -> Int+ toA x = maybe (glength x) (const 1) (cast x :: Maybe a)
+ tests/Tests/Vector/Storable.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE ConstraintKinds #-}+module Tests.Vector.Storable (tests) where++import Test.Tasty+import qualified Data.Vector.Storable+import Tests.Vector.Property++import GHC.Exts (inline)++testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Data a) => Data.Vector.Storable.Vector a -> [Test]+testGeneralStorableVector dummy = concatMap ($ dummy)+ [+ testSanity+ , inline testPolymorphicFunctions+ , testOrdFunctions+ , testMonoidFunctions+ , testDataFunctions+ ]++testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Storable.Vector a -> [Test]+testNumericStorableVector dummy = concatMap ($ dummy)+ [+ testGeneralStorableVector+ , testNumFunctions+ , testEnumFunctions+ ]++tests =+ [ testGroup "Data.Vector.Storable.Vector (Int)" $+ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)+ , testGroup "Data.Vector.Storable.Vector (Double)" $+ testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)+ ]
+ tests/Tests/Vector/Unboxed.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ConstraintKinds #-}+module Tests.Vector.Unboxed (tests) where++import Test.Tasty+import qualified Data.Vector.Unboxed+import Tests.Vector.Property++++testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]+testGeneralUnboxedVector dummy = concatMap ($ dummy)+ [+ testSanity+ , testPolymorphicFunctions+ , testOrdFunctions+ , testMonoidFunctions+ , testDataFunctions+ ]++testUnitUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ ]++testBoolUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ , testBoolFunctions+ ]++testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]+testNumericUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ , testNumFunctions+ , testEnumFunctions+ ]++testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test]+testTupleUnboxedVector dummy = concatMap ($ dummy)+ [+ testGeneralUnboxedVector+ ]++tests =+ [ testGroup "()" $+ testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())+ , testGroup "(Bool)" $+ testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)+ , testGroup "(Int)" $+ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)+ , testGroup "(Float)" $+ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)+ , testGroup "(Double)" $+ testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)+ , testGroup "(Int,Bool)" $+ testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int, Bool))+ , testGroup "(Int,Bool,Int)" $+ testTupleUnboxedVector+ (undefined :: Data.Vector.Unboxed.Vector (Int, Bool, Int))+ ]
tests/Tests/Vector/UnitTests.hs view
@@ -4,16 +4,25 @@ module Tests.Vector.UnitTests (tests) where import Control.Applicative as Applicative+import Control.Exception import Control.Monad.Primitive+import Data.Int+import Data.Word+import Data.Typeable+import qualified Data.List as List import qualified Data.Vector.Generic as Generic+import qualified Data.Vector as Boxed+import qualified Data.Vector.Primitive as Primitive import qualified Data.Vector.Storable as Storable+import qualified Data.Vector.Unboxed as Unboxed+import qualified Data.Vector as Vector import Foreign.Ptr import Foreign.Storable import Text.Printf -import Test.Framework-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, assertBool)+import Test.Tasty+import Test.Tasty.HUnit (testCase,Assertion, assertBool, (@=?), assertFailure)+-- import Test.HUnit () newtype Aligned a = Aligned { getAligned :: a } @@ -34,7 +43,7 @@ dummy :: a dummy = undefined -tests :: [Test]+tests :: [TestTree] tests = [ testGroup "Data.Vector.Storable.Vector Alignment" [ testCase "Aligned Double" $@@ -42,7 +51,98 @@ , testCase "Aligned Int" $ checkAddressAlignment alignedIntVec ]+ , testGroup "Regression tests"+ [ testGroup "enumFromTo crash #188"+ [ regression188 ([] :: [Word8])+ , regression188 ([] :: [Word16])+ , regression188 ([] :: [Word32])+ , regression188 ([] :: [Word64])+ , regression188 ([] :: [Word])+ , regression188 ([] :: [Int8])+ , regression188 ([] :: [Int16])+ , regression188 ([] :: [Int32])+ , regression188 ([] :: [Int64])+ , regression188 ([] :: [Int])+ , regression188 ([] :: [Char])+ ]+ ]+ , testGroup "Negative tests"+ [ testGroup "slice out of bounds #257"+ [ testGroup "Boxed" $ testsSliceOutOfBounds Boxed.slice+ , testGroup "Primitive" $ testsSliceOutOfBounds Primitive.slice+ , testGroup "Storable" $ testsSliceOutOfBounds Storable.slice+ , testGroup "Unboxed" $ testsSliceOutOfBounds Unboxed.slice+ ]+ , testGroup "take #282"+ [ testCase "Boxed" $ testTakeOutOfMemory Boxed.take+ , testCase "Primitive" $ testTakeOutOfMemory Primitive.take+ , testCase "Storable" $ testTakeOutOfMemory Storable.take+ , testCase "Unboxed" $ testTakeOutOfMemory Unboxed.take+ ]+ ] ]++testsSliceOutOfBounds ::+ (Show (v Int), Generic.Vector v Int) => (Int -> Int -> v Int -> v Int) -> [TestTree]+testsSliceOutOfBounds sliceWith =+ [ testCase "Negative ix" $ sliceTest sliceWith (-2) 2 xs+ , testCase "Negative size" $ sliceTest sliceWith 2 (-2) xs+ , testCase "Negative ix and size" $ sliceTest sliceWith (-2) (-1) xs+ , testCase "Too large ix" $ sliceTest sliceWith 6 2 xs+ , testCase "Too large size" $ sliceTest sliceWith 2 6 xs+ , testCase "Too large ix and size" $ sliceTest sliceWith 6 6 xs+ , testCase "Overflow" $ sliceTest sliceWith 1 maxBound xs+ , testCase "OutOfMemory" $ sliceTest sliceWith 1 (maxBound `div` intSize) xs+ ]+ where+ intSize = sizeOf (undefined :: Int)+ xs = [1, 2, 3, 4, 5] :: [Int]+{-# INLINE testsSliceOutOfBounds #-}++sliceTest ::+ (Show (v Int), Generic.Vector v Int)+ => (Int -> Int -> v Int -> v Int)+ -> Int+ -> Int+ -> [Int]+ -> Assertion+sliceTest sliceWith i m xs = do+ let vec = Generic.fromList xs+ eRes <- try (pure $! sliceWith i m vec)+ case eRes of+ Right v ->+ assertFailure $+ "Data.Vector.Internal.Check.checkSlice failed to check: " ++ show v+ Left (ErrorCall err) ->+ let assertMsg =+ List.concat+ [ "Expected slice function to produce an 'error' ending with: \""+ , errSuffix+ , "\" instead got: \""+ , err+ ]+ in assertBool assertMsg (errSuffix `List.isSuffixOf` err)+ where+ errSuffix =+ "(slice): invalid slice (" +++ show i ++ "," ++ show m ++ "," ++ show (List.length xs) ++ ")"+{-# INLINE sliceTest #-}++testTakeOutOfMemory ::+ (Show (v Int), Eq (v Int), Generic.Vector v Int) => (Int -> v Int -> v Int) -> Assertion+testTakeOutOfMemory takeWith =+ takeWith (maxBound `div` intSize) (Generic.fromList xs) @=? Generic.fromList xs+ where+ intSize = sizeOf (undefined :: Int)+ xs = [1, 2, 3, 4, 5] :: [Int]+{-# INLINE testTakeOutOfMemory #-}++regression188+ :: forall proxy a. (Typeable a, Enum a, Bounded a, Eq a, Show a)+ => proxy a -> TestTree+regression188 _ = testCase (show (typeOf (undefined :: a)))+ $ Vector.fromList [maxBound::a] @=? Vector.enumFromTo maxBound maxBound+{-# INLINE regression188 #-} alignedDoubleVec :: Storable.Vector (Aligned Double) alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
tests/Utilities.hs view
@@ -231,7 +231,7 @@ index_value_pairs m = sized $ \n -> do len <- choose (0,n)- is <- sequence [choose (0,m-1) | i <- [1..len]]+ is <- sequence [choose (0,m-1) | _i <- [1..len]] xs <- vector len return $ zip is xs @@ -240,7 +240,7 @@ indices m = sized $ \n -> do len <- choose (0,n)- sequence [choose (0,m-1) | i <- [1..len]]+ sequence [choose (0,m-1) | _i <- [1..len]] -- Additional list functions@@ -259,9 +259,9 @@ where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps - go (x:xs) ((i,y) : ps) j- | i == j = go (f x y : xs) ps j- go (x:xs) ps j = x : go xs ps (j+1)+ go (x:xxs) ((i,y) : pps) j+ | i == j = go (f x y : xxs) pps j+ go (x:xxs) pps j = x : go xxs pps (j+1) go [] _ _ = [] (//) :: [a] -> [(Int, a)] -> [a]@@ -269,9 +269,9 @@ where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps - go (x:xs) ((i,y) : ps) j- | i == j = go (y:xs) ps j- go (x:xs) ps j = x : go xs ps (j+1)+ go (_x:xxs) ((i,y) : pps) j+ | i == j = go (y:xxs) pps j+ go (x:xxs) pps j = x : go xxs pps (j+1) go [] _ _ = [] @@ -336,7 +336,7 @@ maxIndex :: Ord a => [a] -> Int maxIndex = fst . foldr1 imax . zip [0..] where- imax (i,x) (j,y) | x >= y = (i,x)+ imax (i,x) (j,y) | x > y = (i,x) | otherwise = (j,y) iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a]
vector.cabal view
@@ -1,5 +1,5 @@ Name: vector-Version: 0.12.0.3+Version: 0.12.1.0 -- don't forget to update the changelog file! License: BSD3 License-File: LICENSE@@ -39,13 +39,19 @@ GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3,- GHC == 8.0.1+ GHC == 8.0.2,+ GHC == 8.2.2,+ GHC == 8.4.4,+ GHC == 8.6.5,+ GHC == 8.8.1,+ GHC == 8.10.1 + Cabal-Version: >=1.10 Build-Type: Simple Extra-Source-Files:- changelog+ changelog.md README.md tests/LICENSE tests/Setup.hs@@ -65,10 +71,11 @@ benchmarks/TestData/Graph.hs benchmarks/TestData/ParenTree.hs benchmarks/TestData/Random.hs- changelog internal/GenUnboxTuple.hs internal/unbox-tuple-instances ++ Flag BoundsChecks Description: Enable bounds checking Default: True@@ -91,6 +98,7 @@ Default: False Manual: True + Library Default-Language: Haskell2010 Other-Extensions:@@ -144,13 +152,13 @@ Install-Includes: vector.h - Build-Depends: base >= 4.5 && < 4.13+ Build-Depends: base >= 4.5 && < 4.15 , primitive >= 0.5.0.1 && < 0.8- , ghc-prim >= 0.2 && < 0.6+ , ghc-prim >= 0.2 && < 0.7 , deepseq >= 1.1 && < 1.5 if !impl(ghc > 8.0) Build-Depends: fail == 4.9.*- , semigroups >= 0.18 && < 0.19+ , semigroups >= 0.18 && < 0.20 Ghc-Options: -O2 -Wall @@ -184,14 +192,19 @@ Tests.Bundle Tests.Move Tests.Vector+ Tests.Vector.Property+ Tests.Vector.Boxed+ Tests.Vector.Storable+ Tests.Vector.Primitive+ Tests.Vector.Unboxed Tests.Vector.UnitTests Utilities hs-source-dirs: tests Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector,- random, primitive,- QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,- test-framework-hunit, test-framework-quickcheck2,+ primitive, random,+ QuickCheck >= 2.9 && < 2.14 , HUnit, tasty,+ tasty-hunit, tasty-quickcheck, transformers >= 0.2.0.0 default-extensions: CPP,@@ -204,7 +217,7 @@ TypeFamilies, TemplateHaskell - Ghc-Options: -O0+ Ghc-Options: -O0 -threaded Ghc-Options: -Wall if !flag(Wall)@@ -222,14 +235,19 @@ Tests.Bundle Tests.Move Tests.Vector+ Tests.Vector.Property+ Tests.Vector.Boxed+ Tests.Vector.Storable+ Tests.Vector.Primitive+ Tests.Vector.Unboxed Tests.Vector.UnitTests Utilities hs-source-dirs: tests Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector,- random, primitive,- QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,- test-framework-hunit, test-framework-quickcheck2,+ primitive, random,+ QuickCheck >= 2.9 && < 2.14 , HUnit, tasty,+ tasty-hunit, tasty-quickcheck, transformers >= 0.2.0.0 default-extensions: CPP,@@ -242,8 +260,9 @@ TypeFamilies, TemplateHaskell - Ghc-Options: -O2 -Wall + Ghc-Options: -Wall+ Ghc-Options: -O2 -threaded if !flag(Wall) Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures if impl(ghc >= 8.0) && impl(ghc < 8.1)