Skip to content

Commit 3d07305

Browse files
sjakobisjakobi
committed
Address deprecation warnings
Fixes #505
1 parent db40495 commit 3d07305

File tree

2 files changed

+39
-27
lines changed

2 files changed

+39
-27
lines changed

‎Data/HashMap/Internal.hs‎

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,12 @@
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE MagicHash #-}
66
{-# LANGUAGE PatternGuards #-}
7+
{-# LANGUAGE PolyKinds #-}
78
{-# LANGUAGE RoleAnnotations #-}
89
{-# LANGUAGE ScopedTypeVariables #-}
910
{-# LANGUAGE StandaloneDeriving #-}
1011
{-# LANGUAGE TemplateHaskellQuotes #-}
1112
{-# LANGUAGE TypeFamilies #-}
12-
{-# LANGUAGE TypeInType #-}
1313
{-# LANGUAGE UnboxedSums #-}
1414
{-# LANGUAGE UnboxedTuples #-}
1515
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
@@ -166,7 +166,7 @@ import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare)
166166
import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid)
167167
import GHC.Exts (Int (..), Int#, TYPE, (==#))
168168
import GHC.Stack (HasCallStack)
169-
import Prelude hiding (Foldable(..), filter, lookup, map,
169+
import Prelude hiding (Foldable (..), filter, lookup, map,
170170
pred)
171171
import Text.Read hiding (step)
172172

@@ -1948,13 +1948,14 @@ intersectionArrayBy f !b1 !b2 !ary1 !ary2
19481948
intersectionCollisions :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> Hash -> Hash -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> HashMap k v3
19491949
intersectionCollisions f h1 h2 ary1 ary2
19501950
| h1 == h2 = runST $ do
1951-
mary2 <- A.thaw ary2 0 $ A.length ary2
1952-
mary <- A.new_ $ min (A.length ary1) (A.length ary2)
1951+
let !n2 = A.length ary2
1952+
mary2 <- A.thaw ary2 0 n2
1953+
mary <- A.new_ $ min (A.length ary1) n2
19531954
let go i j
1954-
| i >= A.length ary1 || j >= A.lengthM mary2 = pure j
1955+
| i >= A.length ary1 || j >= n2 = pure j
19551956
| otherwise = do
19561957
L k1 v1 <- A.indexM ary1 i
1957-
searchSwap k1 j mary2 >>= \case
1958+
searchSwap mary2 n2 k1 j >>= \case
19581959
Just (L _k2 v2) -> do
19591960
let !(# v3 #) = f k1 v1 v2
19601961
A.write mary j $ L k1 v3
@@ -1978,18 +1979,18 @@ intersectionCollisions f h1 h2 ary1 ary2
19781979
-- undefined 2 1 4
19791980
-- @
19801981
-- We don't actually need to write undefined, we just have to make sure that the next search starts 1 after the current one.
1981-
searchSwap :: Eq k => k -> Int -> A.MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))
1982-
searchSwap toFind start = go start toFind start
1982+
searchSwap :: Eq k => A.MArray s (Leaf k v) -> Int -> k -> Int -> ST s (Maybe (Leaf k v))
1983+
searchSwap mary n toFind start = go start toFind start
19831984
where
1984-
go i0 k i mary
1985-
| i >= A.lengthM mary = pure Nothing
1985+
go i0 k i
1986+
| i >= n = pure Nothing
19861987
| otherwise = do
19871988
l@(L k' _v) <- A.read mary i
19881989
if k == k'
19891990
then do
19901991
A.write mary i =<< A.read mary i0
19911992
pure $ Just l
1992-
else go i0 k (i + 1) mary
1993+
else go i0 k (i + 1)
19931994
{-# INLINE searchSwap #-}
19941995

19951996
------------------------------------------------------------------------

‎Data/HashMap/Internal/Array.hs‎

Lines changed: 27 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -86,20 +86,21 @@ import Control.Monad ((>=>))
8686
import Control.Monad.ST (runST, stToIO)
8787
import GHC.Exts (Int (..), SmallArray#, SmallMutableArray#,
8888
cloneSmallMutableArray#, copySmallArray#,
89-
copySmallMutableArray#, indexSmallArray#,
90-
newSmallArray#, readSmallArray#,
89+
copySmallMutableArray#, getSizeofSmallMutableArray#,
90+
indexSmallArray#, newSmallArray#, readSmallArray#,
9191
reallyUnsafePtrEquality#, sizeofSmallArray#,
92-
sizeofSmallMutableArray#, tagToEnum#,
93-
thawSmallArray#, unsafeCoerce#,
92+
tagToEnum#, thawSmallArray#, unsafeCoerce#,
9493
unsafeFreezeSmallArray#, unsafeThawSmallArray#,
9594
writeSmallArray#)
9695
import GHC.ST (ST (..))
97-
import Prelude hiding (Foldable(..), all, filter,
98-
map, read, traverse)
96+
import Prelude hiding (Foldable (..), all, filter, map, read,
97+
traverse)
9998

10099
import qualified GHC.Exts as Exts
101100
import qualified Language.Haskell.TH.Syntax as TH
102101
#if defined(ASSERTS)
102+
import GHC.Exts (sizeofSmallMutableArray#)
103+
103104
import qualified Prelude
104105
#endif
105106

@@ -158,10 +159,20 @@ data MArray s a = MArray {
158159
unMArray :: !(SmallMutableArray# s a)
159160
}
160161

161-
lengthM :: MArray s a -> Int
162-
lengthM mary = I# (sizeofSmallMutableArray# (unMArray mary))
162+
lengthM :: MArray s a -> ST s Int
163+
lengthM (MArray ary) =
164+
ST $ \s ->
165+
case getSizeofSmallMutableArray# ary s of
166+
(# s', n #) -> (# s', I# n #)
163167
{-# INLINE lengthM #-}
164168

169+
#if defined(ASSERTS)
170+
-- | Unsafe. Only for use in the @CHECK_*@ pragmas.
171+
unsafeLengthM :: MArray s a -> Int
172+
unsafeLengthM mary = I# (sizeofSmallMutableArray# (unMArray mary))
173+
{-# INLINE unsafeLengthM #-}
174+
#endif
175+
165176
------------------------------------------------------------------------
166177

167178
instance NFData a => NFData (Array a) where
@@ -211,7 +222,7 @@ new_ n = new n undefinedElem
211222
shrink :: MArray s a -> Int -> ST s (MArray s a)
212223
shrink mary _n@(I# n#) =
213224
CHECK_GT("shrink", _n, (0 :: Int))
214-
CHECK_LE("shrink", _n, (lengthM mary))
225+
CHECK_LE("shrink", _n, (unsafeLengthM mary))
215226
ST $ \s -> case Exts.shrinkSmallMutableArray# (unMArray mary) n# s of
216227
s' -> (# s', mary #)
217228
{-# INLINE shrink #-}
@@ -242,13 +253,13 @@ pair x y = run $ do
242253

243254
read :: MArray s a -> Int -> ST s a
244255
read ary _i@(I# i#) = ST $ \ s ->
245-
CHECK_BOUNDS("read", lengthM ary, _i)
256+
CHECK_BOUNDS("read", unsafeLengthM ary, _i)
246257
readSmallArray# (unMArray ary) i# s
247258
{-# INLINE read #-}
248259

249260
write :: MArray s a -> Int -> a -> ST s ()
250261
write ary _i@(I# i#) b = ST $ \ s ->
251-
CHECK_BOUNDS("write", lengthM ary, _i)
262+
CHECK_BOUNDS("write", unsafeLengthM ary, _i)
252263
case writeSmallArray# (unMArray ary) i# b s of
253264
s' -> (# s' , () #)
254265
{-# INLINE write #-}
@@ -291,24 +302,24 @@ run act = runST $ act >>= unsafeFreeze
291302
copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
292303
copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
293304
CHECK_LE("copy", _sidx + _n, length src)
294-
CHECK_LE("copy", _didx + _n, lengthM dst)
305+
CHECK_LE("copy", _didx + _n, unsafeLengthM dst)
295306
ST $ \ s# ->
296307
case copySmallArray# (unArray src) sidx# (unMArray dst) didx# n# s# of
297308
s2 -> (# s2, () #)
298309

299310
-- | Unsafely copy the elements of an array. Array bounds are not checked.
300311
copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
301312
copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
302-
CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
303-
CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
313+
CHECK_BOUNDS("copyM: src", unsafeLengthM src, _sidx + _n - 1)
314+
CHECK_BOUNDS("copyM: dst", unsafeLengthM dst, _didx + _n - 1)
304315
ST $ \ s# ->
305316
case copySmallMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of
306317
s2 -> (# s2, () #)
307318

308319
cloneM :: MArray s a -> Int -> Int -> ST s (MArray s a)
309320
cloneM _mary@(MArray mary#) _off@(I# off#) _len@(I# len#) =
310-
CHECK_BOUNDS("cloneM_off", lengthM _mary, _off)
311-
CHECK_BOUNDS("cloneM_end", lengthM _mary, _off + _len - 1)
321+
CHECK_BOUNDS("cloneM_off", unsafeLengthM _mary, _off)
322+
CHECK_BOUNDS("cloneM_end", unsafeLengthM _mary, _off + _len - 1)
312323
ST $ \ s ->
313324
case cloneSmallMutableArray# mary# off# len# s of
314325
(# s', mary'# #) -> (# s', MArray mary'# #)

0 commit comments

Comments
 (0)