1
- {-# LANGUAGE CPP #-}
2
- {-# LANGUAGE BangPatterns #-}
3
- {-# LANGUAGE DeriveLift #-}
4
- {-# LANGUAGE LambdaCase #-}
5
- {-# LANGUAGE MagicHash #-}
6
- {-# LANGUAGE PatternGuards #-}
7
- {-# LANGUAGE RoleAnnotations #-}
8
- {-# LANGUAGE ScopedTypeVariables #-}
9
- {-# LANGUAGE StandaloneDeriving #-}
1
+ {-# LANGUAGE BangPatterns #-}
2
+ {-# LANGUAGE CPP #-}
3
+ {-# LANGUAGE DeriveLift #-}
4
+ {-# LANGUAGE LambdaCase #-}
5
+ {-# LANGUAGE MagicHash #-}
6
+ {-# LANGUAGE PatternGuards #-}
7
+ {-# LANGUAGE RoleAnnotations #-}
8
+ {-# LANGUAGE ScopedTypeVariables #-}
9
+ {-# LANGUAGE StandaloneDeriving #-}
10
10
{-# LANGUAGE TemplateHaskellQuotes #-}
11
- {-# LANGUAGE TypeFamilies #-}
12
- {-# LANGUAGE UnboxedTuples #-}
13
- {-# LANGUAGE TypeInType #-}
14
- {-# LANGUAGE UnboxedSums #-}
11
+ {-# LANGUAGE TypeFamilies #-}
12
+ {-# LANGUAGE TypeInType #-}
13
+ {-# LANGUAGE UnboxedSums #-}
14
+ {-# LANGUAGE UnboxedTuples #-}
15
15
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
16
16
{-# OPTIONS_HADDOCK not-home #-}
17
17
@@ -140,39 +140,56 @@ module Data.HashMap.Internal
140
140
, adjust #
141
141
) where
142
142
143
- import Data.Semigroup (Semigroup (.. ), stimesIdempotentMonoid )
144
- import Control.DeepSeq (NFData (rnf ))
145
- import Control.Monad.ST (ST , runST )
146
- import Data.Bits ((.&.) , (.|.) , complement , popCount , unsafeShiftL , unsafeShiftR )
147
- import Data.Data
148
- import qualified Data.Foldable as Foldable
149
- import Data.Bifoldable
150
- import qualified Data.List as L
151
- import GHC.Exts ((==#) , build , reallyUnsafePtrEquality #, inline )
152
- import Prelude hiding (filter , foldl , foldr , lookup , map , null , pred )
153
- import Text.Read hiding (step )
154
-
155
- import qualified Data.HashMap.Internal.Array as A
156
- import qualified Data.Hashable as H
157
- import Data.Hashable (Hashable )
158
- import Data.HashMap.Internal.List (isPermutationBy , unorderedCompare )
159
-
160
- import GHC.Exts (isTrue #)
161
- import qualified GHC.Exts as Exts
162
-
143
+ import Control.Applicative (Const (.. ))
144
+ import Control.DeepSeq (NFData (.. ), NFData1 (.. ), NFData2 (.. ))
145
+ import Control.Monad.ST (ST , runST )
146
+ import Data.Bifoldable (Bifoldable (.. ))
147
+ import Data.Bits
148
+ ( complement
149
+ , popCount
150
+ , unsafeShiftL
151
+ , unsafeShiftR
152
+ , (.&.)
153
+ , (.|.)
154
+ )
155
+ import Data.Coerce (coerce )
156
+ import Data.Data (Constr , Data (.. ), DataType )
163
157
import Data.Functor.Classes
164
- import GHC.Stack
165
-
166
- import qualified Data.Hashable.Lifted as H
167
-
168
- import qualified Control.DeepSeq as NF
169
-
170
- import GHC.Exts (TYPE , Int (.. ), Int #)
158
+ ( Eq1 (.. )
159
+ , Eq2 (.. )
160
+ , Ord1 (.. )
161
+ , Ord2 (.. )
162
+ , Read1 (.. )
163
+ , Show1 (.. )
164
+ , Show2 (.. )
165
+ )
166
+ import Data.Functor.Identity (Identity (.. ))
167
+ import Data.HashMap.Internal.List (isPermutationBy , unorderedCompare )
168
+ import Data.Hashable (Hashable )
169
+ import Data.Hashable.Lifted (Hashable1 , Hashable2 )
170
+ import Data.Semigroup (Semigroup (.. ), stimesIdempotentMonoid )
171
+ import GHC.Exts (Int (.. ), Int #, TYPE , (==#) )
172
+ import GHC.Stack (HasCallStack )
173
+ import Prelude hiding
174
+ ( filter
175
+ , foldl
176
+ , foldr
177
+ , lookup
178
+ , map
179
+ , null
180
+ , pred
181
+ )
182
+ import Text.Read hiding (step )
171
183
172
- import Data.Functor.Identity (Identity (.. ))
173
- import Control.Applicative (Const (.. ))
174
- import Data.Coerce (coerce )
175
- import qualified Language.Haskell.TH.Syntax as TH
184
+ import qualified Data.Data as Data
185
+ import qualified Data.Foldable as Foldable
186
+ import qualified Data.Functor.Classes as FC
187
+ import qualified Data.HashMap.Internal.Array as A
188
+ import qualified Data.Hashable as H
189
+ import qualified Data.Hashable.Lifted as H
190
+ import qualified Data.List as L
191
+ import qualified GHC.Exts as Exts
192
+ import qualified Language.Haskell.TH.Syntax as TH
176
193
177
194
-- | A set of values. A set cannot contain duplicate values.
178
195
------------------------------------------------------------------------
@@ -196,11 +213,11 @@ instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
196
213
#endif
197
214
198
215
-- | @since 0.2.14.0
199
- instance NFData k => NF. NFData1 (Leaf k ) where
200
- liftRnf rnf2 = NF. liftRnf2 rnf rnf2
216
+ instance NFData k => NFData1 (Leaf k ) where
217
+ liftRnf rnf2 = liftRnf2 rnf rnf2
201
218
202
219
-- | @since 0.2.14.0
203
- instance NF. NFData2 Leaf where
220
+ instance NFData2 Leaf where
204
221
liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v
205
222
206
223
-- Invariant: The length of the 1st argument to 'Full' is
@@ -228,16 +245,16 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where
228
245
rnf (Collision _ ary) = rnf ary
229
246
230
247
-- | @since 0.2.14.0
231
- instance NFData k => NF. NFData1 (HashMap k ) where
232
- liftRnf rnf2 = NF. liftRnf2 rnf rnf2
248
+ instance NFData k => NFData1 (HashMap k ) where
249
+ liftRnf rnf2 = liftRnf2 rnf rnf2
233
250
234
251
-- | @since 0.2.14.0
235
- instance NF. NFData2 HashMap where
252
+ instance NFData2 HashMap where
236
253
liftRnf2 _ _ Empty = ()
237
- liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = NF. liftRnf (NF. liftRnf2 rnf1 rnf2) ary
238
- liftRnf2 rnf1 rnf2 (Leaf _ l) = NF. liftRnf2 rnf1 rnf2 l
239
- liftRnf2 rnf1 rnf2 (Full ary) = NF. liftRnf (NF. liftRnf2 rnf1 rnf2) ary
240
- liftRnf2 rnf1 rnf2 (Collision _ ary) = NF. liftRnf (NF. liftRnf2 rnf1 rnf2) ary
254
+ liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary
255
+ liftRnf2 rnf1 rnf2 (Leaf _ l) = liftRnf2 rnf1 rnf2 l
256
+ liftRnf2 rnf1 rnf2 (Full ary) = liftRnf (liftRnf2 rnf1 rnf2) ary
257
+ liftRnf2 rnf1 rnf2 (Collision _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary
241
258
242
259
instance Functor (HashMap k ) where
243
260
fmap = map
@@ -300,26 +317,26 @@ instance (Eq k, Hashable k) => Monoid (HashMap k v) where
300
317
instance (Data k , Data v , Eq k , Hashable k ) => Data (HashMap k v ) where
301
318
gfoldl f z m = z fromList `f` toList m
302
319
toConstr _ = fromListConstr
303
- gunfold k z c = case constrIndex c of
320
+ gunfold k z c = case Data. constrIndex c of
304
321
1 -> k (z fromList)
305
322
_ -> error " gunfold"
306
323
dataTypeOf _ = hashMapDataType
307
- dataCast1 f = gcast1 f
308
- dataCast2 f = gcast2 f
324
+ dataCast1 f = Data. gcast1 f
325
+ dataCast2 f = Data. gcast2 f
309
326
310
327
fromListConstr :: Constr
311
- fromListConstr = mkConstr hashMapDataType " fromList" [] Prefix
328
+ fromListConstr = Data. mkConstr hashMapDataType " fromList" [] Data. Prefix
312
329
313
330
hashMapDataType :: DataType
314
- hashMapDataType = mkDataType " Data.HashMap.Internal.HashMap" [fromListConstr]
331
+ hashMapDataType = Data. mkDataType " Data.HashMap.Internal.HashMap" [fromListConstr]
315
332
316
333
type Hash = Word
317
334
type Bitmap = Word
318
335
type Shift = Int
319
336
320
337
instance Show2 HashMap where
321
338
liftShowsPrec2 spk slk spv slv d m =
322
- showsUnaryWith (liftShowsPrec sp sl) " fromList" d (toList m)
339
+ FC. showsUnaryWith (liftShowsPrec sp sl) " fromList" d (toList m)
323
340
where
324
341
sp = liftShowsPrec2 spk slk spv slv
325
342
sl = liftShowList2 spk slk spv slv
@@ -328,8 +345,8 @@ instance Show k => Show1 (HashMap k) where
328
345
liftShowsPrec = liftShowsPrec2 showsPrec showList
329
346
330
347
instance (Eq k , Hashable k , Read k ) => Read1 (HashMap k ) where
331
- liftReadsPrec rp rl = readsData $
332
- readsUnaryWith (liftReadsPrec rp' rl') " fromList" fromList
348
+ liftReadsPrec rp rl = FC. readsData $
349
+ FC. readsUnaryWith (liftReadsPrec rp' rl') " fromList" fromList
333
350
where
334
351
rp' = liftReadsPrec rp rl
335
352
rl' = liftReadList rp rl
@@ -484,7 +501,7 @@ equalKeys = go
484
501
485
502
leafEq (L k1 _) (L k2 _) = k1 == k2
486
503
487
- instance H. Hashable2 HashMap where
504
+ instance Hashable2 HashMap where
488
505
liftHashWithSalt2 hk hv salt hm = go salt (toList' hm [] )
489
506
where
490
507
-- go :: Int -> [HashMap k v] -> Int
@@ -507,7 +524,7 @@ instance H.Hashable2 HashMap where
507
524
-- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]
508
525
arrayHashesSorted s = L. sort . L. map (hashLeafWithSalt s) . A. toList
509
526
510
- instance (Hashable k ) => H. Hashable1 (HashMap k ) where
527
+ instance (Hashable k ) => Hashable1 (HashMap k ) where
511
528
liftHashWithSalt = H. liftHashWithSalt2 H. hashWithSalt
512
529
513
530
instance (Hashable k , Hashable v ) => Hashable (HashMap k v ) where
@@ -1410,7 +1427,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
1410
1427
--
1411
1428
-- @since 0.2.12
1412
1429
isSubmapOf :: (Eq k , Hashable k , Eq v ) => HashMap k v -> HashMap k v -> Bool
1413
- isSubmapOf = (inline isSubmapOfBy) (==)
1430
+ isSubmapOf = (Exts. inline isSubmapOfBy) (==)
1414
1431
{-# INLINABLE isSubmapOf #-}
1415
1432
1416
1433
-- | /O(n*log m)/ Inclusion of maps with value comparison. A map is included in
@@ -2035,7 +2052,7 @@ elems = L.map snd . toList
2035
2052
-- | /O(n)/ Return a list of this map's elements. The list is
2036
2053
-- produced lazily. The order of its elements is unspecified.
2037
2054
toList :: HashMap k v -> [(k , v )]
2038
- toList t = build (\ c z -> foldrWithKey (curry c) z t)
2055
+ toList t = Exts. build (\ c z -> foldrWithKey (curry c) z t)
2039
2056
{-# INLINE toList #-}
2040
2057
2041
2058
-- | /O(n)/ Construct a map with the supplied mappings. If the list
@@ -2282,7 +2299,7 @@ fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren)
2282
2299
-- | Check if two the two arguments are the same value. N.B. This
2283
2300
-- function might give false negatives (due to GC moving objects.)
2284
2301
ptrEq :: a -> a -> Bool
2285
- ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1 # )
2302
+ ptrEq x y = Exts. isTrue# (Exts. reallyUnsafePtrEquality# x y ==# 1 # )
2286
2303
{-# INLINE ptrEq #-}
2287
2304
2288
2305
------------------------------------------------------------------------
0 commit comments