add more NFData instances

Author: LightAndLight

Data/HashMap/Internal.hs

@@ -146,7 +146,7 @@ import Data.Word (Word)
 #if __GLASGOW_HASKELL__ >= 711
 import Data.Semigroup (Semigroup((<>)))
 #endif
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf), NFData2(liftRnf2), NFData1(liftRnf))
 import Control.Monad.ST (ST)
 import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR)
 import Data.Data hiding (Typeable)
@@ -201,6 +201,12 @@ data Leaf k v = L !k v
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
 
+instance NFData k => NFData1 (Leaf k) where
+    liftRnf rnf2 = liftRnf2 rnf rnf2
+
+instance NFData2 Leaf where
+    liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v
+
 -- Invariant: The length of the 1st argument to 'Full' is
 -- 2^bitsPerSubkey
 
@@ -223,6 +229,16 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf (Full ary)            = rnf ary
     rnf (Collision _ ary)     = rnf ary
 
+instance NFData k => NFData1 (HashMap k) where
+    liftRnf rnf2 = liftRnf2 rnf rnf2
+
+instance NFData2 HashMap where
+    liftRnf2 _ _ Empty                       = ()
+    liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary
+    liftRnf2 rnf1 rnf2 (Leaf _ l)            = liftRnf2 rnf1 rnf2 l
+    liftRnf2 rnf1 rnf2 (Full ary)            = liftRnf (liftRnf2 rnf1 rnf2) ary
+    liftRnf2 rnf1 rnf2 (Collision _ ary)     = liftRnf (liftRnf2 rnf1 rnf2) ary
+
 instance Functor (HashMap k) where
     fmap = map
 

Data/HashMap/Internal/Array.hs

@@ -250,6 +250,19 @@ rnfArray ary0 = go ary0 n0 0
 -- relevant rnf is strict, or in case it actually isn't.
 {-# INLINE rnfArray #-}
 
+instance NFData1 Array where
+    liftRnf = liftRnfArray
+
+liftRnfArray :: (a -> ()) -> Array a -> ()
+liftRnfArray rnf0 ary0 = go ary0 n0 0
+  where
+    n0 = length ary0
+    go !ary !n !i
+        | i >= n = ()
+        | (# x #) <- index# ary i
+        = rnf0 x `seq` go ary n (i+1)
+{-# INLINE liftRnfArray #-}
+
 -- | Create a new mutable array of specified size, in the specified
 -- state thread, with each element containing the specified initial
 -- value.

Data/HashSet/Internal.hs

@@ -92,7 +92,7 @@ module Data.HashSet.Internal
     , keysSet
     ) where
 
-import Control.DeepSeq (NFData(..))
+import Control.DeepSeq (NFData(..), NFData1(..), NFData2 (liftRnf2))
 import Data.Data hiding (Typeable)
 import Data.HashMap.Internal
   ( HashMap, foldMapWithKey, foldlWithKey, foldrWithKey
@@ -138,6 +138,9 @@ instance (NFData a) => NFData (HashSet a) where
     rnf = rnf . asMap
     {-# INLINE rnf #-}
 
+instance NFData1 HashSet where
+    liftRnf rnf1 = liftRnf2 rnf1 rnf . asMap
+
 -- | Note that, in the presence of hash collisions, equal @HashSet@s may
 -- behave differently, i.e. substitutivity may be violated:
 --