NFData1, NFData2 instances (#992)

Author: dbeacham

containers/changelog.md

@@ -69,6 +69,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

containers/src/Data/Graph.hs

@@ -121,7 +121,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
@@ -245,6 +245,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)

containers/src/Data/IntMap/Internal.hs

@@ -290,7 +290,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)
@@ -511,6 +511,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__
 
 {--------------------------------------------------------------------

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
@@ -4440,6 +4440,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
 --------------------------------------------------------------------}

containers/src/Data/Sequence/Internal.hs

@@ -208,7 +208,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(..))
@@ -518,6 +518,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
@@ -1227,6 +1231,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
@@ -1329,6 +1339,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
@@ -1407,6 +1424,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
@@ -1467,6 +1489,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
 -------------------------------------------------------

containers/src/Data/Set/Internal.hs

@@ -243,7 +243,7 @@ import Data.Semigroup (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 Data.List.NonEmpty (NonEmpty(..))
 
 import Utils.Containers.Internal.StrictPair
@@ -1404,6 +1404,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
 --------------------------------------------------------------------}

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)
@@ -301,6 +301,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)