vector 0.12.0.1 → 0.12.0.2
raw patch · 9 files changed
+132/−45 lines, 9 filesdep +base-orphansdep ~primitivenew-uploader
Dependencies added: base-orphans
Dependency ranges changed: primitive
Files
- Data/Vector.hs +6/−1
- Data/Vector/Generic/Base.hs +9/−1
- Data/Vector/Storable/Internal.hs +1/−2
- Data/Vector/Storable/Mutable.hs +34/−11
- changelog +8/−1
- tests/Tests/Vector.hs +44/−22
- tests/Tests/Vector/UnitTests.hs +11/−0
- tests/Utilities.hs +12/−0
- vector.cabal +7/−7
Data/Vector.hs view
@@ -425,7 +425,12 @@ instance Traversable.Traversable Vector where {-# INLINE traverse #-}- traverse f xs = Data.Vector.fromList Applicative.<$> Traversable.traverse f (toList xs)+ traverse f xs =+ -- Get the length of the vector in /O(1)/ time+ let !n = G.length xs+ -- Use fromListN to be more efficient in construction of resulting vector+ -- Also behaves better with compact regions, preventing runtime exceptions+ in Data.Vector.fromListN n Applicative.<$> Traversable.traverse f (toList xs) {-# INLINE mapM #-} mapM = mapM
Data/Vector/Generic/Base.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, ScopedTypeVariables, BangPatterns #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TypeFamilyDependencies #-}+#endif {-# OPTIONS_HADDOCK hide #-} -- |@@ -24,9 +28,13 @@ import Control.Monad.Primitive -- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with--- the state token @s@+-- the state token @s@. It is injective on GHC 8 and newer. --+#if MIN_VERSION_base(4,9,0)+type family Mutable (v :: * -> *) = (mv :: * -> * -> *) | mv -> v+#else type family Mutable (v :: * -> *) :: * -> * -> *+#endif -- | Class of immutable vectors. Every immutable vector is associated with its -- mutable version through the 'Mutable' type family. Methods of this class
Data/Vector/Storable/Internal.hs view
@@ -14,8 +14,7 @@ getPtr, setPtr, updPtr ) where -import Foreign.ForeignPtr-import Foreign.Ptr+ import GHC.ForeignPtr ( ForeignPtr(..) ) import GHC.Ptr ( Ptr(..) )
Data/Vector/Storable/Mutable.hs view
@@ -74,12 +74,14 @@ import GHC.ForeignPtr #endif +import GHC.Base ( Int(..) )+ import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) import Control.Monad.Primitive-import Data.Primitive.Addr import Data.Primitive.Types (Prim)+import qualified Data.Primitive.Types as DPT import GHC.Word (Word8, Word16, Word32, Word64) import GHC.Ptr (Ptr(..))@@ -163,13 +165,11 @@ storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m () {-# INLINE storableZero #-}-storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \(Ptr p) -> do- let q = Addr p- setAddr q byteSize (0 :: Word8)+storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \ptr-> do+ memsetPrimPtr_vector (castPtr ptr) byteSize (0 :: Word8) where x :: a x = undefined- byteSize :: Int byteSize = n * sizeOf x @@ -195,13 +195,36 @@ do_set 1 storableSetAsPrim- :: (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO ()+ :: forall a b . (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () {-# INLINE [0] storableSetAsPrim #-}-storableSetAsPrim n fp x y = withForeignPtr fp $ \(Ptr p) -> do- poke (Ptr p) x- let q = Addr p- w <- readOffAddr q 0- setAddr (q `plusAddr` sizeOf x) (n-1) (w `asTypeOf` y)+storableSetAsPrim n fp x _y = withForeignPtr fp $ \ ptr -> do+ poke ptr x+ -- we dont equate storable and prim reps, so we need to write to a slot+ -- in storable+ -- then read it back as a prim type+ -- then use prim memset+ w<- peakPrimPtr_vector ((castPtr ptr) :: Ptr b) 0+ memsetPrimPtr_vector ((castPtr ptr) `plusPtr` sizeOf x ) (n-1) w++++{-+AFTER primitive 0.7 is pretty old, move to using setPtr. which is really+a confusing misnomer for whats often called memset (initialize an array with a+default value)+-}+-- Fill a memory block with the given value. The length is in+-- elements of type @a@ rather than in bytes.+memsetPrimPtr_vector :: forall a c m. (Prim c, PrimMonad m) => Ptr a -> Int -> c -> m ()+memsetPrimPtr_vector (Ptr addr#) (I# n#) x = primitive_ (DPT.setOffAddr# addr# 0# n# x)+{-# INLINE memsetPrimPtr_vector #-}+++-- Read a value from a memory position given by an address and an offset.+-- The offset is in elements of type @a@ rather than in bytes.+peakPrimPtr_vector :: (Prim a, PrimMonad m) => Ptr a -> Int -> m a+peakPrimPtr_vector (Ptr addr#) (I# i#) = primitive (DPT.readOffAddr# addr# i#)+{-# INLINE peakPrimPtr_vector #-} {-# INLINE mallocVector #-} mallocVector :: Storable a => Int -> IO (ForeignPtr a)
changelog view
@@ -1,3 +1,10 @@+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@@ -27,7 +34,7 @@ Changes in version 0.10.12.3 - * Allow building with `primtive-0.6`+ * Allow building with `primitive-0.6` Changes in version 0.10.12.2
tests/Tests/Vector.hs view
@@ -7,6 +7,7 @@ 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@@ -31,6 +32,8 @@ 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)@@ -70,14 +73,6 @@ -- TODO: test non-IVector stuff? -#if !MIN_VERSION_base(4,7,0)-instance Foldable ((,) a) where- foldMap f (_, b) = f b--instance T.Traversable ((,) a) where- traverse f (a, b) = fmap ((,) a) $ f b-#endif- testSanity :: forall a v. (CommonContext a v) => v a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList,@@ -470,6 +465,8 @@ 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@@ -489,13 +486,23 @@ testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum,- 'prop_minIndex, 'prop_maxIndex ])+ '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@@ -590,7 +597,18 @@ --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) -testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a) => Data.Vector.Vector a -> [Test]+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,@@ -601,7 +619,8 @@ testFunctorFunctions, testMonadFunctions, testApplicativeFunctions,- testAlternativeFunctions+ testAlternativeFunctions,+ testDataFunctions ] testBoolBoxedVector dummy = concatMap ($ dummy)@@ -610,7 +629,7 @@ , testBoolFunctions ] -testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test]+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@@ -619,15 +638,16 @@ ] -testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test]+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+ 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.Vector.Primitive.Vector a -> [Test]+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@@ -636,15 +656,16 @@ ] -testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test]+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+ 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.Vector.Storable.Vector a -> [Test]+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@@ -653,12 +674,13 @@ ] -testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test]+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+ testMonoidFunctions,+ testDataFunctions ] testUnitUnboxedVector dummy = concatMap ($ dummy)@@ -672,7 +694,7 @@ , testBoolFunctions ] -testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test]+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@@ -680,7 +702,7 @@ , testEnumFunctions ] -testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test]+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/Tests/Vector/UnitTests.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Tests.Vector.UnitTests (tests) where import Control.Applicative as Applicative+import Control.Monad.Primitive+import qualified Data.Vector.Generic as Generic import qualified Data.Vector.Storable as Storable import Foreign.Ptr import Foreign.Storable@@ -46,3 +49,11 @@ alignedIntVec :: Storable.Vector (Aligned Int) alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]++#if __GLASGOW_HASKELL__ >= 800+-- Ensure that Mutable is really an injective type family by typechecking a+-- function which relies on injectivity.+_f :: (Generic.Vector v a, Generic.Vector w a, PrimMonad f)+ => Generic.Mutable v (PrimState f) a -> f (w a)+_f v = Generic.convert `fmap` Generic.unsafeFreeze v+#endif
tests/Utilities.hs view
@@ -124,6 +124,10 @@ id_TestData(Double) id_TestData(Ordering) +bimapEither :: (a -> b) -> (c -> d) -> Either a c -> Either b d+bimapEither f _ (Left a) = Left (f a)+bimapEither _ g (Right c) = Right (g c)+ -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well. instance (Eq a, TestData a) => TestData (Maybe a) where@@ -132,6 +136,14 @@ unmodel = fmap unmodel type EqTest (Maybe a) = Property+ equal x y = property (x == y)++instance (Eq a, TestData a, Eq b, TestData b) => TestData (Either a b) where+ type Model (Either a b) = Either (Model a) (Model b)+ model = bimapEither model model+ unmodel = bimapEither unmodel unmodel++ type EqTest (Either a b) = Property equal x y = property (x == y) instance (Eq a, TestData a) => TestData [a] where
vector.cabal view
@@ -1,5 +1,5 @@ Name: vector-Version: 0.12.0.1+Version: 0.12.0.2 -- don't forget to update the changelog file! License: BSD3 License-File: LICENSE@@ -144,8 +144,8 @@ Install-Includes: vector.h - Build-Depends: base >= 4.5 && < 4.10- , primitive >= 0.5.0.1 && < 0.7+ Build-Depends: base >= 4.5 && < 4.13+ , primitive >= 0.5.0.1 && < 0.8 , ghc-prim >= 0.2 && < 0.6 , deepseq >= 1.1 && < 1.5 if !impl(ghc > 8.0)@@ -187,8 +187,8 @@ Utilities hs-source-dirs: tests- Build-Depends: base >= 4.5 && < 5, template-haskell, vector,- random,+ 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, transformers >= 0.2.0.0@@ -225,8 +225,8 @@ Utilities hs-source-dirs: tests- Build-Depends: base >= 4.5 && < 5, template-haskell, vector,- random,+ 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, transformers >= 0.2.0.0