diff --git a/Data/Primitive/PrimArray.hs b/Data/Primitive/PrimArray.hs index f333c1ec..4e730a0d 100644 --- a/Data/Primitive/PrimArray.hs +++ b/Data/Primitive/PrimArray.hs @@ -66,6 +66,10 @@ module Data.Primitive.PrimArray , foldlPrimArray , foldlPrimArray' , foldlPrimArrayM' + , foldMapRPrimArray + , foldMapLPrimArray + , foldMapRPrimArray' + , foldMapLPrimArray' -- * Effectful Folding , traversePrimArray_ , itraversePrimArray_ @@ -467,6 +471,72 @@ sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int {-# INLINE sizeofPrimArray #-} sizeofPrimArray (PrimArray arr#) = I# (quotInt# (sizeofByteArray# arr#) (sizeOf# (undefined :: a))) +-- | Map each element of the primitive array to a monoid, and combine the results. +-- The combination is right-associated, and the accumulation is lazy. +-- +-- ==== __Examples__ +-- +-- @mySum = 'Data.Monoid.getSum' '$' 'foldMapRPrimArray' 'Data.Monoid.Sum' ('fromList' [1,2,3])@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' ('foldMapRPrimArray' 'Data.Monoid.Sum' ('fromList' [1,2])) '<>' ('Data.Monoid.Sum' 3 '<>' 'mempty')@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' ('foldMapRPrimArray' 'Data.Monoid.Sum' ('fromList' [1])) '<>' ('Data.Monoid.Sum' 2 '<>' ('Data.Monoid.Sum' 3 '<>' 'mempty'))@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' ('Data.Monoid.Sum' 1 '<>' ('Data.Monoid.Sum' 2 '<>' ('Data.Monoid.Sum' 3 '<>' 'mempty')))@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' ('Data.Monoid.Sum' 1 '<>' ('Data.Monoid.Sum' 2 '<>' 'Data.Monoid.Sum' 3))@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' ('Data.Monoid.Sum' 1 '<>' 'Data.Monoid.Sum' 5)@ +-- +-- @mySum = 'Data.Monoid.getSum' '$' 'Data.Monoid.Sum' 6@ +-- +-- @mySum = 6@ +foldMapRPrimArray :: forall a m. (Prim a, Monoid m) => (a -> m) -> PrimArray a -> m +{-# INLINE foldMapRPrimArray #-} +foldMapRPrimArray f = foldrPrimArray (\a acc -> f a `mappend` acc) mempty + +-- | Map each element of the primitive array to a monoid, and combine the results. +-- The combination is left-associated, and the accumulation is lazy. +-- +-- ==== __Examples__ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' 'foldMapLPrimArray' 'Data.Monoid.Product' ('fromList' [1,2,3])@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' ('mempty' '<>' 'Data.Monoid.Product' 1) '<>' ('foldMapLPrimArray' 'Data.Monoid.Product' ('fromList' [2,3])@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' (('mempty' '<>' 'Data.Monoid.Product' 1) '<>' 'Data.Monoid.Product' 2) '<>' ('foldMapLPrimArray' 'Data.Monoid.Product' ('fromList' [3]))@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' ((('mempty' '<>' 'Data.Monoid.Product' 1) '<>' 'Data.Monoid.Product' 2) '<>' 'Data.Monoid.Product' 3)@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' (('Data.Monoid.Product' 1 '<>' 'Data.Monoid.Product' 2) '<>' 'Data.Monoid.Product' 3)@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' ('Data.Monoid.Product' 2 '<>' 'Data.Monoid.Product' 3)@ +-- +-- @myProd = 'Data.Monoid.getProduct' '$' 'Data.Monoid.Product' 6@ +-- +-- @myProd = 6@ +foldMapLPrimArray :: forall a m. (Prim a, Monoid m) => (a -> m) -> PrimArray a -> m +{-# INLINE foldMapLPrimArray #-} +foldMapLPrimArray f = foldlPrimArray (\acc a -> acc `mappend` f a) mempty + +-- | Map each element of the primitive array to a monoid, and combine the results. +-- The combination is right-associated, and the accumulation is strict. This means +-- that at each step, we force the accumulator value to WHNF. We also force the value +-- of the result of the function argument at each point, meaning that both arguments +-- of 'mappend' will be evaluated. +foldMapRPrimArray' :: forall a m. (Prim a, Monoid m) => (a -> m) -> PrimArray a -> m +{-# INLINE foldMapRPrimArray' #-} +foldMapRPrimArray' f = foldrPrimArray (\ a !acc -> let !fa = f $! a in fa `mappend` acc) mempty + +-- | Map each element of the primitive array to a monoid, and combine the results. +-- The combination is left-associated, and the accumulation is strict. This means +-- that at each step, we force the accumulator value to WHNF. We also force the value +-- of the result of the function argument at each point, meaning that both arguments +-- of 'mappend' will be evaulated. +foldMapLPrimArray' :: forall a m. (Prim a, Monoid m) => (a -> m) -> PrimArray a -> m +{-# INLINE foldMapLPrimArray' #-} +foldMapLPrimArray' f = foldlPrimArray (\ !acc a -> let !fa = f $! a in acc `mappend` fa) mempty + -- | Lazy right-associated fold over the elements of a 'PrimArray'. {-# INLINE foldrPrimArray #-} foldrPrimArray :: forall a b. Prim a => (a -> b -> b) -> b -> PrimArray a -> b diff --git a/changelog.md b/changelog.md index ff38aa18..426fc728 100644 --- a/changelog.md +++ b/changelog.md @@ -29,7 +29,10 @@ ## Changes in version 0.6.4.1 - * Add instances for the following newtypes from `base`: + * Add `foldMapRPrimArray` , `foldMapLPrimArray`, `foldMapRPrimArray'`, and + `foldMapLPrimArray'` + + * Add `Prim` instances for the following newtypes from `base`: `Const`, `Identity`, `Down`, `Dual`, `Sum`, `Product`, `First`, `Last`, `Min`, `Max` diff --git a/test/primitive-tests.cabal b/test/primitive-tests.cabal index 1e037c8f..07524a15 100644 --- a/test/primitive-tests.cabal +++ b/test/primitive-tests.cabal @@ -38,7 +38,7 @@ test-suite test , tasty-quickcheck , tagged , transformers >= 0.3 - , quickcheck-classes >= 0.4.11.1 + , quickcheck-classes >= 0.4.14.2 ghc-options: -O2 source-repository head