From a014c1d1145f91b2d8a609829a5a26e50f784ea4 Mon Sep 17 00:00:00 2001 From: David Beacham Date: Tue, 20 Feb 2024 13:21:40 +0000 Subject: [PATCH] NFData1,NFData2 instances (#767) --- containers/changelog.md | 3 +++ containers/src/Data/Graph.hs | 7 +++++- containers/src/Data/IntMap/Internal.hs | 10 ++++++++- containers/src/Data/Map/Internal.hs | 16 +++++++++++++- containers/src/Data/Sequence/Internal.hs | 28 +++++++++++++++++++++++- containers/src/Data/Set/Internal.hs | 9 +++++++- containers/src/Data/Tree.hs | 8 ++++++- 7 files changed, 75 insertions(+), 6 deletions(-) diff --git a/containers/changelog.md b/containers/changelog.md index c0e00aa83..cb42a9b1a 100644 --- a/containers/changelog.md +++ b/containers/changelog.md @@ -45,6 +45,9 @@ * Add `Data.Graph.flattenSCC1`. (Andreas Abel) +* `NFData1`, `NFData2` instances for `SCC`, `IntMap`, `Map`, `Sequence`, `Set`, + `Tree` and relevant internal dependencies (David Beacham) + ## 0.7 ### Breaking changes diff --git a/containers/src/Data/Graph.hs b/containers/src/Data/Graph.hs index 2c6417f53..619948688 100644 --- a/containers/src/Data/Graph.hs +++ b/containers/src/Data/Graph.hs @@ -118,7 +118,7 @@ import Data.Foldable as F #if MIN_VERSION_base(4,18,0) import qualified Data.Foldable1 as F1 #endif -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) import Data.Maybe import Data.Array #if USE_UNBOXED_ARRAYS @@ -235,6 +235,11 @@ instance NFData a => NFData (SCC a) where rnf (AcyclicSCC v) = rnf v rnf (NECyclicSCC vs) = rnf vs +-- | @since 0.7.1 +instance NFData1 SCC where + liftRnf rnfx (AcyclicSCC v) = rnfx v + liftRnf rnfx (NECyclicSCC vs) = liftRnf rnfx vs + -- | @since 0.5.4 instance Functor SCC where fmap f (AcyclicSCC v) = AcyclicSCC (f v) diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs index d1d483b44..41e4e1e20 100644 --- a/containers/src/Data/IntMap/Internal.hs +++ b/containers/src/Data/IntMap/Internal.hs @@ -294,7 +294,7 @@ import Data.Semigroup (Semigroup((<>))) import Data.Semigroup (stimesIdempotentMonoid) import Data.Functor.Classes -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) import Data.Bits import qualified Data.Foldable as Foldable import Data.Maybe (fromMaybe) @@ -518,6 +518,14 @@ instance NFData a => NFData (IntMap a) where rnf (Tip _ v) = rnf v rnf (Bin _ l r) = rnf l `seq` rnf r +-- | @since 0.7.1 +instance NFData1 IntMap where + liftRnf rnfx = go + where + go Nil = () + go (Tip _ v) = rnfx v + go (Bin _ l r) = go l `seq` go r + #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index 9263fff2f..51c8775f7 100644 --- a/containers/src/Data/Map/Internal.hs +++ b/containers/src/Data/Map/Internal.hs @@ -387,7 +387,7 @@ import Data.Semigroup (Arg(..), Semigroup(stimes)) import Data.Semigroup (Semigroup((<>))) #endif import Control.Applicative (Const (..)) -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf),NFData2(liftRnf2)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable import Data.Bifoldable @@ -4413,6 +4413,20 @@ instance (NFData k, NFData a) => NFData (Map k a) where rnf Tip = () rnf (Bin _ kx x l r) = rnf kx `seq` rnf x `seq` rnf l `seq` rnf r +-- | @since 0.7.1 +instance NFData k => NFData1 (Map k) where + liftRnf rnfx = go + where + go Tip = () + go (Bin _ kx x l r) = rnf kx `seq` rnfx x `seq` go l `seq` go r + +-- | @since 0.7.1 +instance NFData2 Map where + liftRnf2 rnfkx rnfx = go + where + go Tip = () + go (Bin _ kx x l r) = rnfkx kx `seq` rnfx x `seq` go l `seq` go r + {-------------------------------------------------------------------- Read --------------------------------------------------------------------} diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs index 2f9266ff1..1a6309b84 100644 --- a/containers/src/Data/Sequence/Internal.hs +++ b/containers/src/Data/Sequence/Internal.hs @@ -207,7 +207,7 @@ import Prelude () import Control.Applicative ((<$>), (<**>), Alternative, liftA3) import qualified Control.Applicative as Applicative -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) import Control.Monad (MonadPlus(..)) import Data.Monoid (Monoid(..)) import Data.Functor (Functor(..)) @@ -504,6 +504,10 @@ instance Traversable Seq where instance NFData a => NFData (Seq a) where rnf (Seq xs) = rnf xs +-- | @since 0.7.1 +instance NFData1 Seq where + liftRnf rnfx (Seq xs) = liftRnf (liftRnf rnfx) xs + instance Monad Seq where return = pure xs >>= f = foldl' add empty xs @@ -1170,6 +1174,12 @@ instance NFData a => NFData (FingerTree a) where rnf (Single x) = rnf x rnf (Deep _ pr m sf) = rnf pr `seq` rnf sf `seq` rnf m +-- | @since 0.7.1 +instance NFData1 FingerTree where + liftRnf _ EmptyT = () + liftRnf rnfx (Single x) = rnfx x + liftRnf rnfx (Deep _ pr m sf) = liftRnf rnfx pr `seq` liftRnf (liftRnf rnfx) m `seq` liftRnf rnfx sf + {-# INLINE deep #-} deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a deep pr m sf = Deep (size pr + size m + size sf) pr m sf @@ -1272,6 +1282,13 @@ instance NFData a => NFData (Digit a) where rnf (Three a b c) = rnf a `seq` rnf b `seq` rnf c rnf (Four a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d +-- | @since 0.7.1 +instance NFData1 Digit where + liftRnf rnfx (One a) = rnfx a + liftRnf rnfx (Two a b) = rnfx a `seq` rnfx b + liftRnf rnfx (Three a b c) = rnfx a `seq` rnfx b `seq` rnfx c + liftRnf rnfx (Four a b c d) = rnfx a `seq` rnfx b `seq` rnfx c `seq` rnfx d + instance Sized a => Sized (Digit a) where {-# INLINE size #-} size = foldl1 (+) . fmap size @@ -1350,6 +1367,11 @@ instance NFData a => NFData (Node a) where rnf (Node2 _ a b) = rnf a `seq` rnf b rnf (Node3 _ a b c) = rnf a `seq` rnf b `seq` rnf c +-- | @since 0.7.1 +instance NFData1 Node where + liftRnf rnfx (Node2 _ a b) = rnfx a `seq` rnfx b + liftRnf rnfx (Node3 _ a b c) = rnfx a `seq` rnfx b `seq` rnfx c + instance Sized (Node a) where size (Node2 v _ _) = v size (Node3 v _ _ _) = v @@ -1410,6 +1432,10 @@ instance Traversable Elem where instance NFData a => NFData (Elem a) where rnf (Elem x) = rnf x +-- | @since 0.7.1 +instance NFData1 Elem where + liftRnf rnfx (Elem x) = rnfx x + ------------------------------------------------------- -- Applicative construction ------------------------------------------------------- diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs index f1ec29c3a..38943fa63 100644 --- a/containers/src/Data/Set/Internal.hs +++ b/containers/src/Data/Set/Internal.hs @@ -248,7 +248,7 @@ import Data.Semigroup (stimesIdempotentMonoid, stimesIdempotent) import Data.Functor.Classes import Data.Functor.Identity (Identity) import qualified Data.Foldable as Foldable -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) import Utils.Containers.Internal.StrictPair import Utils.Containers.Internal.PtrEquality @@ -1334,6 +1334,13 @@ instance NFData a => NFData (Set a) where rnf Tip = () rnf (Bin _ y l r) = rnf y `seq` rnf l `seq` rnf r +-- | @since 0.7.1 +instance NFData1 Set where + liftRnf rnfx = go + where + go Tip = () + go (Bin _ y l r) = rnfx y `seq` go l `seq` go r + {-------------------------------------------------------------------- Split --------------------------------------------------------------------} diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs index a03926c27..949c1cfd8 100644 --- a/containers/src/Data/Tree.hs +++ b/containers/src/Data/Tree.hs @@ -61,7 +61,7 @@ import Control.Monad (liftM) import Control.Monad.Fix (MonadFix (..), fix) import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList, ViewL(..), ViewR(..), viewl, viewr) -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) #ifdef __GLASGOW_HASKELL__ import Data.Data (Data) @@ -300,6 +300,12 @@ foldlMap1 f g = -- Use a lambda to allow inlining with two arguments instance NFData a => NFData (Tree a) where rnf (Node x ts) = rnf x `seq` rnf ts +-- | @since 0.7.1 +instance NFData1 Tree where + liftRnf rnfx = go + where + go (Node x ts) = rnfx x `seq` liftRnf go ts + -- | @since 0.5.10.1 instance MonadZip Tree where mzipWith f (Node a as) (Node b bs)