Skip to content

Commit f55d60f

Browse files
rockbmbrockbmb
committed
Replace '(Int, Array a)' by strict tuple datatype
1 parent 52cab04 commit f55d60f

File tree

3 files changed

+47
-33
lines changed

3 files changed

+47
-33
lines changed

‎Data/HashMap/Array.hs‎

Lines changed: 15 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@
77
module Data.HashMap.Array
88
( Array
99
, MArray
10+
, RunRes (..)
11+
, RunResA
12+
, RunResM
1013

1114
-- * Creation
1215
, new
@@ -230,15 +233,22 @@ unsafeThaw ary
230233
(# s', mary #) -> (# s', marray mary (length ary) #)
231234
{-# INLINE unsafeThaw #-}
232235

236+
-- | Helper datatype used in 'runInternal' and 'updateWithInternal'
237+
data RunRes f e = RunRes {-# UNPACK #-} !Int !(f e)
238+
239+
type RunResA e = RunRes Array e
240+
241+
type RunResM s e = RunRes (MArray s) e
242+
233243
run :: (forall s . ST s (MArray s e)) -> Array e
234244
run act = runST $ act >>= unsafeFreeze
235245
{-# INLINE run #-}
236246

237-
runInternal :: (forall s . ST s (Int, MArray s e)) -> (Int, Array e)
247+
runInternal :: (forall s . ST s (RunResM s e)) -> RunResA e
238248
runInternal act = runST $ do
239-
(s, mary) <- act
249+
RunRes s mary <- act
240250
ary <- unsafeFreeze mary
241-
return (s, ary)
251+
return (RunRes s ary)
242252
{-# INLINE runInternal #-}
243253

244254
run2 :: (forall s. ST s (MArray s e, a)) -> (Array e, a)
@@ -309,10 +319,10 @@ updateWith' ary idx f = update ary idx $! f (index ary idx)
309319
-- | /O(n)/ Update the element at the given positio in this array, by
310320
-- applying a function to it. Evaluates the element to WHNF before
311321
-- inserting it into the array.
312-
updateWithInternal' :: Array e -> Int -> (e -> (Int, e)) -> (Int, Array e)
322+
updateWithInternal' :: Array e -> Int -> (e -> (Int, e)) -> RunResA e
313323
updateWithInternal' ary idx f =
314324
let (!sz, !e) = f (index ary idx)
315-
in (sz, update ary idx e)
325+
in RunRes sz (update ary idx e)
316326
{-# INLINE updateWithInternal' #-}
317327

318328
-- | /O(1)/ Update the element at the given position in this array,

‎Data/HashMap/Base.hs‎

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -930,7 +930,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
930930
-- branch vs. branch
931931
go s !sz (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
932932
let b' = b1 .|. b2
933-
(dsz, ary') =
933+
A.RunRes dsz ary' =
934934
unionArrayByInternal sz
935935
(go (s+bitsPerSubkey))
936936
b1
@@ -939,7 +939,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
939939
ary2
940940
in (dsz, bitmapIndexedOrFull b' ary')
941941
go s !sz (BitmapIndexed b1 ary1) (Full ary2) =
942-
let (dsz, ary') =
942+
let A.RunRes dsz ary' =
943943
unionArrayByInternal sz
944944
(go (s+bitsPerSubkey))
945945
b1
@@ -948,7 +948,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
948948
ary2
949949
in (dsz, Full ary')
950950
go s !sz (Full ary1) (BitmapIndexed b2 ary2) =
951-
let (dsz, ary') =
951+
let A.RunRes dsz ary' =
952952
unionArrayByInternal sz
953953
(go (s+bitsPerSubkey))
954954
fullNodeMask
@@ -957,7 +957,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
957957
ary2
958958
in (dsz, Full ary')
959959
go s !sz (Full ary1) (Full ary2) =
960-
let (dsz, ary') =
960+
let A.RunRes dsz ary' =
961961
unionArrayByInternal sz
962962
(go (s+bitsPerSubkey))
963963
fullNodeMask
@@ -970,8 +970,9 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
970970
| b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
971971
b' = b1 .|. m2
972972
in (sz, bitmapIndexedOrFull b' ary')
973-
| otherwise = let (dsz, ary') = A.updateWithInternal' ary1 i $ \st1 ->
974-
go (s+bitsPerSubkey) sz st1 t2
973+
| otherwise = let A.RunRes dsz ary' =
974+
A.updateWithInternal' ary1 i $ \st1 ->
975+
go (s+bitsPerSubkey) sz st1 t2
975976
in (dsz, BitmapIndexed b1 ary')
976977
where
977978
h2 = leafHashCode t2
@@ -981,24 +982,25 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
981982
| b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
982983
b' = b2 .|. m1
983984
in (sz, bitmapIndexedOrFull b' ary')
984-
| otherwise = let (dsz, ary') = A.updateWithInternal' ary2 i $ \st2 ->
985-
go (s+bitsPerSubkey) sz t1 st2
985+
| otherwise = let A.RunRes dsz ary'=
986+
A.updateWithInternal' ary2 i $ \st2 ->
987+
go (s+bitsPerSubkey) sz t1 st2
986988
in (dsz, BitmapIndexed b2 ary')
987989
where
988990
h1 = leafHashCode t1
989991
m1 = mask h1 s
990992
i = sparseIndex b2 m1
991993
go s !sz (Full ary1) t2 =
992-
let h2 = leafHashCode t2
993-
i = index h2 s
994-
(dsz, ary') =
994+
let h2 = leafHashCode t2
995+
i = index h2 s
996+
A.RunRes dsz ary' =
995997
update16WithInternal' ary1 i $ \st1 ->
996998
go (s+bitsPerSubkey) sz st1 t2
997999
in (dsz, Full ary')
9981000
go s !sz t1 (Full ary2) =
999-
let h1 = leafHashCode t1
1000-
i = index h1 s
1001-
(dsz, ary') =
1001+
let h1 = leafHashCode t1
1002+
i = index h1 s
1003+
A.RunRes dsz ary' =
10021004
update16WithInternal' ary2 i $ \st2 ->
10031005
go (s+bitsPerSubkey) sz t1 st2
10041006
in (dsz, Full ary')
@@ -1053,7 +1055,7 @@ unionArrayByInternal
10531055
-> Bitmap
10541056
-> A.Array a
10551057
-> A.Array a
1056-
-> (Int, A.Array a)
1058+
-> A.RunResA a
10571059
unionArrayByInternal siz f b1 b2 ary1 ary2 = A.runInternal $ do
10581060
let b' = b1 .|. b2
10591061
mary <- A.new_ (popCount b')
@@ -1074,7 +1076,7 @@ unionArrayByInternal siz f b1 b2 ary1 ary2 = A.runInternal $ do
10741076
A.write mary i =<< A.indexM ary2 i2
10751077
go sz (i+1) (i1 ) (i2+1) (m `unsafeShiftL` 1)
10761078
d <- go siz 0 0 0 (b' .&. negate b') -- XXX: b' must be non-zero
1077-
return (d, mary)
1079+
return (A.RunRes d mary)
10781080
-- TODO: For the case where b1 .&. b2 == b1, i.e. when one is a
10791081
-- subset of the other, we could use a slightly simpler algorithm,
10801082
-- where we copy one array, and then update.
@@ -1508,10 +1510,10 @@ update16With' ary idx f = update16 ary idx $! f (A.index ary idx)
15081510
{-# INLINE update16With' #-}
15091511

15101512
-- | /O(n)/ Update the element at the given position in this array, by applying a function to it.
1511-
update16WithInternal' :: A.Array e -> Int -> (e -> (Int, e)) -> (Int, A.Array e)
1513+
update16WithInternal' :: A.Array e -> Int -> (e -> (Int, e)) -> A.RunResA e
15121514
update16WithInternal' ary idx f =
15131515
let (s, x) = f $! A.index ary idx
1514-
in (s, update16 ary idx x)
1516+
in A.RunRes s (update16 ary idx x)
15151517
{-# INLINE update16WithInternal' #-}
15161518

15171519
-- | Unsafely clone an array of 16 elements. The length of the input

‎Data/HashMap/Strict.hs‎

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -363,7 +363,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
363363
-- branch vs. branch
364364
go s !sz (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
365365
let b' = b1 .|. b2
366-
(dsz, ary') =
366+
A.RunRes dsz ary' =
367367
unionArrayByInternal sz
368368
(go (s+bitsPerSubkey))
369369
b1
@@ -372,7 +372,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
372372
ary2
373373
in (dsz, bitmapIndexedOrFull b' ary')
374374
go s !sz (BitmapIndexed b1 ary1) (Full ary2) =
375-
let (dsz, ary') =
375+
let A.RunRes dsz ary' =
376376
unionArrayByInternal sz
377377
(go (s+bitsPerSubkey))
378378
b1
@@ -381,7 +381,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
381381
ary2
382382
in (dsz, Full ary')
383383
go s !sz (Full ary1) (BitmapIndexed b2 ary2) =
384-
let (dsz, ary') =
384+
let A.RunRes dsz ary' =
385385
unionArrayByInternal sz
386386
(go (s+bitsPerSubkey))
387387
fullNodeMask
@@ -390,7 +390,7 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
390390
ary2
391391
in (dsz, Full ary')
392392
go s !sz (Full ary1) (Full ary2) =
393-
let (dsz, ary') =
393+
let A.RunRes dsz ary' =
394394
unionArrayByInternal sz
395395
(go (s+bitsPerSubkey))
396396
fullNodeMask
@@ -403,8 +403,9 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
403403
| b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
404404
b' = b1 .|. m2
405405
in (sz, bitmapIndexedOrFull b' ary')
406-
| otherwise = let (dsz, ary') = A.updateWithInternal' ary1 i $ \st1 ->
407-
go (s+bitsPerSubkey) sz st1 t2
406+
| otherwise = let A.RunRes dsz ary' =
407+
A.updateWithInternal' ary1 i $ \st1 ->
408+
go (s+bitsPerSubkey) sz st1 t2
408409
in (dsz, BitmapIndexed b1 ary')
409410
where
410411
h2 = leafHashCode t2
@@ -414,8 +415,9 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
414415
| b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
415416
b' = b2 .|. m1
416417
in (sz, bitmapIndexedOrFull b' ary')
417-
| otherwise = let (dsz, ary') = A.updateWithInternal' ary2 i $ \st2 ->
418-
go (s+bitsPerSubkey) sz t1 st2
418+
| otherwise = let A.RunRes dsz ary' =
419+
A.updateWithInternal' ary2 i $ \st2 ->
420+
go (s+bitsPerSubkey) sz t1 st2
419421
in (dsz, BitmapIndexed b2 ary')
420422
where
421423
h1 = leafHashCode t1
@@ -424,14 +426,14 @@ unionWithKeyInternal f hm1 (HashMap siz hm2) = go 0 siz hm1 hm2
424426
go s !sz (Full ary1) t2 =
425427
let h2 = leafHashCode t2
426428
i = index h2 s
427-
(dsz, ary') =
429+
A.RunRes dsz ary' =
428430
update16WithInternal' ary1 i $ \st1 ->
429431
go (s+bitsPerSubkey) sz st1 t2
430432
in (dsz, Full ary')
431433
go s !sz t1 (Full ary2) =
432434
let h1 = leafHashCode t1
433435
i = index h1 s
434-
(dsz, ary') =
436+
A.RunRes dsz ary' =
435437
update16WithInternal' ary2 i $ \st2 ->
436438
go (s+bitsPerSubkey) sz t1 st2
437439
in (dsz, Full ary')

0 commit comments

Comments
 (0)