Skip to content
Open
70 changes: 70 additions & 0 deletions Data/Primitive/PrimArray.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,10 @@ module Data.Primitive.PrimArray
, foldlPrimArray
, foldlPrimArray'
, foldlPrimArrayM'
, foldMapRPrimArray
, foldMapLPrimArray
, foldMapRPrimArray'
, foldMapLPrimArray'
-- * Effectful Folding
, traversePrimArray_
, itraversePrimArray_
Expand Down Expand Up @@ -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
Expand Down
5 changes: 4 additions & 1 deletion changelog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`

Expand Down
2 changes: 1 addition & 1 deletion test/primitive-tests.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down