Address deprecation warnings

Data/HashMap/Internal.hs

@@ -4,12 +4,12 @@
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MagicHash             #-}
 {-# LANGUAGE PatternGuards         #-}
+{-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE RoleAnnotations       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE StandaloneDeriving    #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeInType            #-}
 {-# LANGUAGE UnboxedSums           #-}
 {-# LANGUAGE UnboxedTuples         #-}
 {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
@@ -166,7 +166,7 @@ import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare)
 import Data.Semigroup             (Semigroup (..), stimesIdempotentMonoid)
 import GHC.Exts                   (Int (..), Int#, TYPE, (==#))
 import GHC.Stack                  (HasCallStack)
-import Prelude                    hiding (Foldable(..), filter, lookup, map,
+import Prelude                    hiding (Foldable (..), filter, lookup, map,
                                    pred)
 import Text.Read                  hiding (step)
 
@@ -1948,13 +1948,14 @@ intersectionArrayBy f !b1 !b2 !ary1 !ary2
 intersectionCollisions :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> Hash -> Hash -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> HashMap k v3
 intersectionCollisions f h1 h2 ary1 ary2
   | h1 == h2 = runST $ do
-    mary2 <- A.thaw ary2 0 $ A.length ary2
-    mary <- A.new_ $ min (A.length ary1) (A.length ary2)
+    let !n2 = A.length ary2
+    mary2 <- A.thaw ary2 0 n2
+    mary <- A.new_ $ min (A.length ary1) n2
     let go i j
-          | i >= A.length ary1 || j >= A.lengthM mary2 = pure j
+          | i >= A.length ary1 || j >= n2 = pure j
           | otherwise = do
             L k1 v1 <- A.indexM ary1 i
-            searchSwap k1 j mary2 >>= \case
+            searchSwap mary2 n2 k1 j >>= \case
               Just (L _k2 v2) -> do
                 let !(# v3 #) = f k1 v1 v2
                 A.write mary j $ L k1 v3
@@ -1978,18 +1979,18 @@ intersectionCollisions f h1 h2 ary1 ary2
 -- undefined 2 1 4
 -- @
 -- We don't actually need to write undefined, we just have to make sure that the next search starts 1 after the current one.
-searchSwap :: Eq k => k -> Int -> A.MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
-searchSwap toFind start = go start toFind start
+searchSwap :: Eq k => A.MArray s (Leaf k v) -> Int -> k -> Int -> ST s (Maybe (Leaf k v))
+searchSwap mary n toFind start = go start toFind start
   where
-    go i0 k i mary
-      | i >= A.lengthM mary = pure Nothing
+    go i0 k i
+      | i >= n = pure Nothing
       | otherwise = do
         l@(L k' _v) <- A.read mary i
         if k == k'
           then do
             A.write mary i =<< A.read mary i0
             pure $ Just l
-          else go i0 k (i + 1) mary
+          else go i0 k (i + 1)
 {-# INLINE searchSwap #-}
 
 ------------------------------------------------------------------------

Data/HashMap/Internal/Array.hs

@@ -80,26 +80,28 @@ module Data.HashMap.Internal.Array
     , shrink
     ) where
 
-import Control.Applicative (liftA2)
+import Control.Applicative (Applicative (..))
 import Control.DeepSeq     (NFData (..), NFData1 (..))
 import Control.Monad       ((>=>))
 import Control.Monad.ST    (runST, stToIO)
 import GHC.Exts            (Int (..), SmallArray#, SmallMutableArray#,
                             cloneSmallMutableArray#, copySmallArray#,
-                            copySmallMutableArray#, indexSmallArray#,
-                            newSmallArray#, readSmallArray#,
+                            copySmallMutableArray#, getSizeofSmallMutableArray#,
+                            indexSmallArray#, newSmallArray#, readSmallArray#,
                             reallyUnsafePtrEquality#, sizeofSmallArray#,
-                            sizeofSmallMutableArray#, tagToEnum#,
-                            thawSmallArray#, unsafeCoerce#,
+                            tagToEnum#, thawSmallArray#, unsafeCoerce#,
                             unsafeFreezeSmallArray#, unsafeThawSmallArray#,
                             writeSmallArray#)
 import GHC.ST              (ST (..))
-import Prelude             hiding (Foldable(..), all, filter,
+import Prelude             hiding (Applicative (..), Foldable (..), all, filter,
                             map, read, traverse)
 
 import qualified GHC.Exts                   as Exts
 import qualified Language.Haskell.TH.Syntax as TH
+
 #if defined(ASSERTS)
+import GHC.Exts (sizeofSmallMutableArray#)
+
 import qualified Prelude
 #endif
 
@@ -158,10 +160,19 @@ data MArray s a = MArray {
       unMArray :: !(SmallMutableArray# s a)
     }
 
-lengthM :: MArray s a -> Int
-lengthM mary = I# (sizeofSmallMutableArray# (unMArray mary))
+lengthM :: MArray s a -> ST s Int
+lengthM (MArray ary) = ST $ \s ->
+  case getSizeofSmallMutableArray# ary s of
+    (# s', n #) -> (# s', I# n #)
 {-# INLINE lengthM #-}
 
+#if defined(ASSERTS)
+-- | Unsafe. Only for use in the @CHECK_*@ pragmas.
+unsafeLengthM :: MArray s a -> Int
+unsafeLengthM mary = I# (sizeofSmallMutableArray# (unMArray mary))
+{-# INLINE unsafeLengthM #-}
+#endif
+
 ------------------------------------------------------------------------
 
 instance NFData a => NFData (Array a) where
@@ -211,7 +222,7 @@ new_ n = new n undefinedElem
 shrink :: MArray s a -> Int -> ST s (MArray s a)
 shrink mary _n@(I# n#) =
   CHECK_GT("shrink", _n, (0 :: Int))
-  CHECK_LE("shrink", _n, (lengthM mary))
+  CHECK_LE("shrink", _n, (unsafeLengthM mary))
   ST $ \s -> case Exts.shrinkSmallMutableArray# (unMArray mary) n# s of
     s' -> (# s', mary #)
 {-# INLINE shrink #-}
@@ -242,13 +253,13 @@ pair x y = run $ do
 
 read :: MArray s a -> Int -> ST s a
 read ary _i@(I# i#) = ST $ \ s ->
-    CHECK_BOUNDS("read", lengthM ary, _i)
+    CHECK_BOUNDS("read", unsafeLengthM ary, _i)
         readSmallArray# (unMArray ary) i# s
 {-# INLINE read #-}
 
 write :: MArray s a -> Int -> a -> ST s ()
 write ary _i@(I# i#) b = ST $ \ s ->
-    CHECK_BOUNDS("write", lengthM ary, _i)
+    CHECK_BOUNDS("write", unsafeLengthM ary, _i)
         case writeSmallArray# (unMArray ary) i# b s of
             s' -> (# s' , () #)
 {-# INLINE write #-}
@@ -291,24 +302,24 @@ run act = runST $ act >>= unsafeFreeze
 copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
 copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
     CHECK_LE("copy", _sidx + _n, length src)
-    CHECK_LE("copy", _didx + _n, lengthM dst)
+    CHECK_LE("copy", _didx + _n, unsafeLengthM dst)
         ST $ \ s# ->
         case copySmallArray# (unArray src) sidx# (unMArray dst) didx# n# s# of
             s2 -> (# s2, () #)
 
 -- | Unsafely copy the elements of an array. Array bounds are not checked.
 copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
 copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
-    CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
-    CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
+    CHECK_BOUNDS("copyM: src", unsafeLengthM src, _sidx + _n - 1)
+    CHECK_BOUNDS("copyM: dst", unsafeLengthM dst, _didx + _n - 1)
     ST $ \ s# ->
     case copySmallMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of
         s2 -> (# s2, () #)
 
 cloneM :: MArray s a -> Int -> Int -> ST s (MArray s a)
 cloneM _mary@(MArray mary#) _off@(I# off#) _len@(I# len#) =
-    CHECK_BOUNDS("cloneM_off", lengthM _mary, _off)
-    CHECK_BOUNDS("cloneM_end", lengthM _mary, _off + _len - 1)
+    CHECK_BOUNDS("cloneM_off", unsafeLengthM _mary, _off)
+    CHECK_BOUNDS("cloneM_end", unsafeLengthM _mary, _off + _len - 1)
     ST $ \ s ->
     case cloneSmallMutableArray# mary# off# len# s of
       (# s', mary'# #) -> (# s', MArray mary'# #)

benchmarks/Benchmarks.hs

@@ -9,12 +9,12 @@ module Main where
 
 import Control.DeepSeq       (NFData (..))
 import Data.Bits             ((.&.))
+import Data.Foldable         (Foldable (..))
 import Data.Functor.Identity (Identity (..))
 import Data.Hashable         (Hashable, hash)
-import Data.List             (foldl')
 import Data.Maybe            (fromMaybe)
 import GHC.Generics          (Generic)
-import Prelude               hiding (lookup)
+import Prelude               hiding (Foldable (..), lookup)
 import Test.Tasty.Bench      (bench, bgroup, defaultMain, env, nf, whnf)
 
 import qualified Data.ByteString        as BS

tests/Main.hs

@@ -1,7 +1,7 @@
 module Main (main) where
 
 import GHC.IO.Encoding (setLocaleEncoding, utf8)
-import Test.Tasty (defaultMain, testGroup)
+import Test.Tasty      (defaultMain, testGroup)
 
 import qualified Properties
 import qualified Regressions

tests/Regressions.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE UnboxedTuples       #-}
+{-# OPTIONS_GHC -Wno-x-partial #-}
 module Regressions (tests) where
 
 import Control.Exception     (evaluate)

tests/Strictness.hs

@@ -4,7 +4,7 @@ module Strictness (tests) where
 
 import Control.Arrow                (second)
 import Control.Monad                (guard)
-import Data.Foldable                (foldl')
+import Data.Foldable                (Foldable (..))
 import Data.Hashable                (Hashable)
 import Data.HashMap.Strict          (HashMap)
 import Data.Maybe                   (fromMaybe, isJust)
@@ -17,6 +17,8 @@ import Test.Tasty.QuickCheck        (testProperty)
 import Text.Show.Functions          ()
 import Util.Key                     (Key)
 
+import Prelude hiding (Foldable (..))
+
 import qualified Data.HashMap.Strict as HM
 
 instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where