Skip to content

Commit 51ef2cf

Browse files
meooow25meooow25
authored
Use binCheck{L,R} where possible (#1136)
* Shorten "Left", "Right" in IntMap to L, R. * binCheckL and binCheckR are used to skip Nil checks where the invariants guarantee that a tree is non-Nil. * Benchmarks show minor improvements.
1 parent 97156ef commit 51ef2cf

File tree

3 files changed

+109
-97
lines changed

3 files changed

+109
-97
lines changed

‎containers/src/Data/IntMap/Internal.hs

Lines changed: 55 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,8 @@ module Data.IntMap.Internal (
288288
, link
289289
, linkKey
290290
, bin
291-
, binCheckLeft
292-
, binCheckRight
291+
, binCheckL
292+
, binCheckR
293293
, MonoState(..)
294294
, Stack(..)
295295
, ascLinkTop
@@ -954,8 +954,8 @@ insertLookupWithKey _ k x Nil = (Nothing,Tip k x)
954954
delete :: Key -> IntMap a -> IntMap a
955955
delete !k t@(Bin p l r)
956956
| nomatch k p = t
957-
| left k p = binCheckLeft p (delete k l) r
958-
| otherwise = binCheckRight p l (delete k r)
957+
| left k p = binCheckL p (delete k l) r
958+
| otherwise = binCheckR p l (delete k r)
959959
delete k t@(Tip ky _)
960960
| k == ky = Nil
961961
| otherwise = t
@@ -1014,8 +1014,8 @@ update f
10141014

10151015
updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
10161016
updateWithKey f !k (Bin p l r)
1017-
| left k p = binCheckLeft p (updateWithKey f k l) r
1018-
| otherwise = binCheckRight p l (updateWithKey f k r)
1017+
| left k p = binCheckL p (updateWithKey f k l) r
1018+
| otherwise = binCheckR p l (updateWithKey f k r)
10191019
updateWithKey f k t@(Tip ky y)
10201020
| k == ky = case (f k y) of
10211021
Just y' -> Tip ky y'
@@ -1036,9 +1036,9 @@ updateWithKey _ _ Nil = Nil
10361036
updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
10371037
updateLookupWithKey f !k (Bin p l r)
10381038
| left k p = let !(found,l') = updateLookupWithKey f k l
1039-
in (found,binCheckLeft p l' r)
1039+
in (found,binCheckL p l' r)
10401040
| otherwise = let !(found,r') = updateLookupWithKey f k r
1041-
in (found,binCheckRight p l r')
1041+
in (found,binCheckR p l r')
10421042
updateLookupWithKey f k t@(Tip ky y)
10431043
| k==ky = case (f k y) of
10441044
Just y' -> (Just y,Tip ky y')
@@ -1056,8 +1056,8 @@ alter f !k t@(Bin p l r)
10561056
| nomatch k p = case f Nothing of
10571057
Nothing -> t
10581058
Just x -> linkKey k (Tip k x) p t
1059-
| left k p = binCheckLeft p (alter f k l) r
1060-
| otherwise = binCheckRight p l (alter f k r)
1059+
| left k p = binCheckL p (alter f k l) r
1060+
| otherwise = binCheckR p l (alter f k r)
10611061
alter f k t@(Tip ky y)
10621062
| k==ky = case f (Just y) of
10631063
Just x -> Tip ky x
@@ -1211,8 +1211,8 @@ differenceWithKey f m1 m2
12111211
-- @since 0.5.8
12121212
withoutKeys :: IntMap a -> IntSet -> IntMap a
12131213
withoutKeys t1@(Bin p1 l1 r1) t2@(IntSet.Bin p2 l2 r2) = case treeTreeBranch p1 p2 of
1214-
ABL -> binCheckLeft p1 (withoutKeys l1 t2) r1
1215-
ABR -> binCheckRight p1 l1 (withoutKeys r1 t2)
1214+
ABL -> binCheckL p1 (withoutKeys l1 t2) r1
1215+
ABR -> binCheckR p1 l1 (withoutKeys r1 t2)
12161216
BAL -> withoutKeys t1 l2
12171217
BAR -> withoutKeys t1 r2
12181218
EQL -> bin p1 (withoutKeys l1 l2) (withoutKeys r1 r2)
@@ -1232,8 +1232,8 @@ withoutKeysTip t@(Bin p l r) !p2 !bm2
12321232
then restrictBM t (complement bm2)
12331233
else t
12341234
| nomatch p2 p = t
1235-
| left p2 p = binCheckLeft p (withoutKeysTip l p2 bm2) r
1236-
| otherwise = binCheckRight p l (withoutKeysTip r p2 bm2)
1235+
| left p2 p = binCheckL p (withoutKeysTip l p2 bm2) r
1236+
| otherwise = binCheckR p l (withoutKeysTip r p2 bm2)
12371237
withoutKeysTip t@(Tip kx _) !p2 !bm2
12381238
| IntSet.prefixOf kx == p2 && IntSet.bitmapOf kx .&. bm2 /= 0 = Nil
12391239
| otherwise = t
@@ -1358,10 +1358,10 @@ intersectionWithKey f m1 m2
13581358
symmetricDifference :: IntMap a -> IntMap a -> IntMap a
13591359
symmetricDifference t1@(Bin p1 l1 r1) t2@(Bin p2 l2 r2) =
13601360
case treeTreeBranch p1 p2 of
1361-
ABL -> bin p1 (symmetricDifference l1 t2) r1
1362-
ABR -> bin p1 l1 (symmetricDifference r1 t2)
1363-
BAL -> bin p2 (symmetricDifference t1 l2) r2
1364-
BAR -> bin p2 l2 (symmetricDifference t1 r2)
1361+
ABL -> binCheckL p1 (symmetricDifference l1 t2) r1
1362+
ABR -> binCheckR p1 l1 (symmetricDifference r1 t2)
1363+
BAL -> binCheckL p2 (symmetricDifference t1 l2) r2
1364+
BAR -> binCheckR p2 l2 (symmetricDifference t1 r2)
13651365
EQL -> bin p1 (symmetricDifference l1 l2) (symmetricDifference r1 r2)
13661366
NOM -> link (unPrefix p1) t1 (unPrefix p2) t2
13671367
symmetricDifference t1@(Bin _ _ _) t2@(Tip k2 _) = symDiffTip t2 k2 t1
@@ -1374,8 +1374,8 @@ symDiffTip !t1 !k1 = go
13741374
where
13751375
go t2@(Bin p2 l2 r2)
13761376
| nomatch k1 p2 = linkKey k1 t1 p2 t2
1377-
| left k1 p2 = bin p2 (go l2) r2
1378-
| otherwise = bin p2 l2 (go r2)
1377+
| left k1 p2 = binCheckL p2 (go l2) r2
1378+
| otherwise = binCheckR p2 l2 (go r2)
13791379
go t2@(Tip k2 _)
13801380
| k1 == k2 = Nil
13811381
| otherwise = link k1 t1 k2 t2
@@ -2204,10 +2204,10 @@ mergeA
22042204

22052205
updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
22062206
updateMinWithKey f t =
2207-
case t of Bin p l r | signBranch p -> binCheckRight p l (go f r)
2207+
case t of Bin p l r | signBranch p -> binCheckR p l (go f r)
22082208
_ -> go f t
22092209
where
2210-
go f' (Bin p l r) = binCheckLeft p (go f' l) r
2210+
go f' (Bin p l r) = binCheckL p (go f' l) r
22112211
go f' (Tip k y) = case f' k y of
22122212
Just y' -> Tip k y'
22132213
Nothing -> Nil
@@ -2220,10 +2220,10 @@ updateMinWithKey f t =
22202220

22212221
updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
22222222
updateMaxWithKey f t =
2223-
case t of Bin p l r | signBranch p -> binCheckLeft p (go f l) r
2223+
case t of Bin p l r | signBranch p -> binCheckL p (go f l) r
22242224
_ -> go f t
22252225
where
2226-
go f' (Bin p l r) = binCheckRight p l (go f' r)
2226+
go f' (Bin p l r) = binCheckR p l (go f' r)
22272227
go f' (Tip k y) = case f' k y of
22282228
Just y' -> Tip k y'
22292229
Nothing -> Nil
@@ -2250,11 +2250,11 @@ maxViewWithKeySure t =
22502250
case t of
22512251
Nil -> error "maxViewWithKeySure Nil"
22522252
Bin p l r | signBranch p ->
2253-
case go l of View k a l' -> View k a (binCheckLeft p l' r)
2253+
case go l of View k a l' -> View k a (binCheckL p l' r)
22542254
_ -> go t
22552255
where
22562256
go (Bin p l r) =
2257-
case go r of View k a r' -> View k a (binCheckRight p l r')
2257+
case go r of View k a r' -> View k a (binCheckR p l r')
22582258
go (Tip k y) = View k y Nil
22592259
go Nil = error "maxViewWithKey_go Nil"
22602260
-- See note on NOINLINE at minViewWithKeySure
@@ -2284,11 +2284,11 @@ minViewWithKeySure t =
22842284
Nil -> error "minViewWithKeySure Nil"
22852285
Bin p l r | signBranch p ->
22862286
case go r of
2287-
View k a r' -> View k a (binCheckRight p l r')
2287+
View k a r' -> View k a (binCheckR p l r')
22882288
_ -> go t
22892289
where
22902290
go (Bin p l r) =
2291-
case go l of View k a l' -> View k a (binCheckLeft p l' r)
2291+
case go l of View k a l' -> View k a (binCheckL p l' r)
22922292
go (Tip k y) = View k y Nil
22932293
go Nil = error "minViewWithKey_go Nil"
22942294
-- There's never anything significant to be gained by inlining
@@ -2758,12 +2758,12 @@ takeWhileAntitone predicate t =
27582758
Bin p l r
27592759
| signBranch p ->
27602760
if predicate 0 -- handle negative numbers.
2761-
then bin p (go predicate l) r
2761+
then binCheckL p (go predicate l) r
27622762
else go predicate r
27632763
_ -> go predicate t
27642764
where
27652765
go predicate' (Bin p l r)
2766-
| predicate' (unPrefix p) = bin p l (go predicate' r)
2766+
| predicate' (unPrefix p) = binCheckR p l (go predicate' r)
27672767
| otherwise = go predicate' l
27682768
go predicate' t'@(Tip ky _)
27692769
| predicate' ky = t'
@@ -2787,12 +2787,12 @@ dropWhileAntitone predicate t =
27872787
| signBranch p ->
27882788
if predicate 0 -- handle negative numbers.
27892789
then go predicate l
2790-
else bin p l (go predicate r)
2790+
else binCheckR p l (go predicate r)
27912791
_ -> go predicate t
27922792
where
27932793
go predicate' (Bin p l r)
27942794
| predicate' (unPrefix p) = go predicate' r
2795-
| otherwise = bin p (go predicate' l) r
2795+
| otherwise = binCheckL p (go predicate' l) r
27962796
go predicate' t'@(Tip ky _)
27972797
| predicate' ky = Nil
27982798
| otherwise = t'
@@ -2819,21 +2819,21 @@ spanAntitone predicate t =
28192819
then
28202820
case go predicate l of
28212821
(lt :*: gt) ->
2822-
let !lt' = bin p lt r
2822+
let !lt' = binCheckL p lt r
28232823
in (lt', gt)
28242824
else
28252825
case go predicate r of
28262826
(lt :*: gt) ->
2827-
let !gt' = bin p l gt
2827+
let !gt' = binCheckR p l gt
28282828
in (lt, gt')
28292829
_ -> case go predicate t of
28302830
(lt :*: gt) -> (lt, gt)
28312831
where
28322832
go predicate' (Bin p l r)
28332833
| predicate' (unPrefix p)
2834-
= case go predicate' r of (lt :*: gt) -> bin p l lt :*: gt
2834+
= case go predicate' r of (lt :*: gt) -> binCheckR p l lt :*: gt
28352835
| otherwise
2836-
= case go predicate' l of (lt :*: gt) -> lt :*: bin p gt r
2836+
= case go predicate' l of (lt :*: gt) -> lt :*: binCheckL p gt r
28372837
go predicate' t'@(Tip ky _)
28382838
| predicate' ky = (t' :*: Nil)
28392839
| otherwise = (Nil :*: t')
@@ -2914,20 +2914,20 @@ split k t =
29142914
then
29152915
case go k l of
29162916
(lt :*: gt) ->
2917-
let !lt' = bin p lt r
2917+
let !lt' = binCheckL p lt r
29182918
in (lt', gt)
29192919
else
29202920
case go k r of
29212921
(lt :*: gt) ->
2922-
let !gt' = bin p l gt
2922+
let !gt' = binCheckR p l gt
29232923
in (lt, gt')
29242924
_ -> case go k t of
29252925
(lt :*: gt) -> (lt, gt)
29262926
where
29272927
go !k' t'@(Bin p l r)
29282928
| nomatch k' p = if k' < unPrefix p then Nil :*: t' else t' :*: Nil
2929-
| left k' p = case go k' l of (lt :*: gt) -> lt :*: bin p gt r
2930-
| otherwise = case go k' r of (lt :*: gt) -> bin p l lt :*: gt
2929+
| left k' p = case go k' l of (lt :*: gt) -> lt :*: binCheckL p gt r
2930+
| otherwise = case go k' r of (lt :*: gt) -> binCheckR p l lt :*: gt
29312931
go k' t'@(Tip ky _)
29322932
| k' > ky = (t' :*: Nil)
29332933
| k' < ky = (Nil :*: t')
@@ -2961,8 +2961,8 @@ splitLookup k t =
29612961
Bin p l r
29622962
| signBranch p ->
29632963
if k >= 0 -- handle negative numbers.
2964-
then mapLT (flip (bin p) r) (go k l)
2965-
else mapGT (bin p l) (go k r)
2964+
then mapLT (\l' -> binCheckL p l' r) (go k l)
2965+
else mapGT (binCheckR p l) (go k r)
29662966
_ -> go k t
29672967
of SplitLookup lt fnd gt -> (lt, fnd, gt)
29682968
where
@@ -2971,8 +2971,8 @@ splitLookup k t =
29712971
if k' < unPrefix p
29722972
then SplitLookup Nil Nothing t'
29732973
else SplitLookup t' Nothing Nil
2974-
| left k' p = mapGT (flip (bin p) r) (go k' l)
2975-
| otherwise = mapLT (bin p l) (go k' r)
2974+
| left k' p = mapGT (\l' -> binCheckL p l' r) (go k' l)
2975+
| otherwise = mapLT (binCheckR p l) (go k' r)
29762976
go k' t'@(Tip ky y)
29772977
| k' > ky = SplitLookup t' Nothing Nil
29782978
| k' < ky = SplitLookup Nil Nothing t'
@@ -3666,17 +3666,17 @@ bin _ Nil r = r
36663666
bin p l r = Bin p l r
36673667
{-# INLINE bin #-}
36683668

3669-
-- binCheckLeft only checks that the left subtree is non-empty
3670-
binCheckLeft :: Prefix -> IntMap a -> IntMap a -> IntMap a
3671-
binCheckLeft _ Nil r = r
3672-
binCheckLeft p l r = Bin p l r
3673-
{-# INLINE binCheckLeft #-}
3674-
3675-
-- binCheckRight only checks that the right subtree is non-empty
3676-
binCheckRight :: Prefix -> IntMap a -> IntMap a -> IntMap a
3677-
binCheckRight _ l Nil = l
3678-
binCheckRight p l r = Bin p l r
3679-
{-# INLINE binCheckRight #-}
3669+
-- binCheckL only checks that the left subtree is non-empty
3670+
binCheckL :: Prefix -> IntMap a -> IntMap a -> IntMap a
3671+
binCheckL _ Nil r = r
3672+
binCheckL p l r = Bin p l r
3673+
{-# INLINE binCheckL #-}
3674+
3675+
-- binCheckR only checks that the right subtree is non-empty
3676+
binCheckR :: Prefix -> IntMap a -> IntMap a -> IntMap a
3677+
binCheckR _ l Nil = l
3678+
binCheckR p l r = Bin p l r
3679+
{-# INLINE binCheckR #-}
36803680

36813681
{--------------------------------------------------------------------
36823682
Utilities

‎containers/src/Data/IntMap/Strict/Internal.hs

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -237,8 +237,8 @@ import Data.IntSet.Internal.IntTreeCommons
237237
import Data.IntMap.Internal
238238
( IntMap (..)
239239
, bin
240-
, binCheckLeft
241-
, binCheckRight
240+
, binCheckL
241+
, binCheckR
242242
, link
243243
, linkKey
244244
, MonoState(..)
@@ -498,8 +498,8 @@ updateWithKey f !k t =
498498
case t of
499499
Bin p l r
500500
| nomatch k p -> t
501-
| left k p -> binCheckLeft p (updateWithKey f k l) r
502-
| otherwise -> binCheckRight p l (updateWithKey f k r)
501+
| left k p -> binCheckL p (updateWithKey f k l) r
502+
| otherwise -> binCheckR p l (updateWithKey f k r)
503503
Tip ky y
504504
| k==ky -> case f k y of
505505
Just !y' -> Tip ky y'
@@ -524,8 +524,8 @@ updateLookupWithKey f0 !k0 t0 = toPair $ go f0 k0 t0
524524
case t of
525525
Bin p l r
526526
| nomatch k p -> (Nothing :*: t)
527-
| left k p -> let (found :*: l') = go f k l in (found :*: binCheckLeft p l' r)
528-
| otherwise -> let (found :*: r') = go f k r in (found :*: binCheckRight p l r')
527+
| left k p -> let (found :*: l') = go f k l in (found :*: binCheckL p l' r)
528+
| otherwise -> let (found :*: r') = go f k r in (found :*: binCheckR p l r')
529529
Tip ky y
530530
| k==ky -> case f k y of
531531
Just !y' -> (Just y :*: Tip ky y')
@@ -545,8 +545,8 @@ alter f !k t =
545545
| nomatch k p -> case f Nothing of
546546
Nothing -> t
547547
Just !x -> linkKey k (Tip k x) p t
548-
| left k p -> binCheckLeft p (alter f k l) r
549-
| otherwise -> binCheckRight p l (alter f k r)
548+
| left k p -> binCheckL p (alter f k l) r
549+
| otherwise -> binCheckR p l (alter f k r)
550550
Tip ky y
551551
| k==ky -> case f (Just y) of
552552
Just !x -> Tip ky x
@@ -744,10 +744,10 @@ mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2
744744

745745
updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
746746
updateMinWithKey f t =
747-
case t of Bin p l r | signBranch p -> binCheckRight p l (go f r)
747+
case t of Bin p l r | signBranch p -> binCheckR p l (go f r)
748748
_ -> go f t
749749
where
750-
go f' (Bin p l r) = binCheckLeft p (go f' l) r
750+
go f' (Bin p l r) = binCheckL p (go f' l) r
751751
go f' (Tip k y) = case f' k y of
752752
Just !y' -> Tip k y'
753753
Nothing -> Nil
@@ -760,10 +760,10 @@ updateMinWithKey f t =
760760

761761
updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
762762
updateMaxWithKey f t =
763-
case t of Bin p l r | signBranch p -> binCheckLeft p (go f l) r
763+
case t of Bin p l r | signBranch p -> binCheckL p (go f l) r
764764
_ -> go f t
765765
where
766-
go f' (Bin p l r) = binCheckRight p l (go f' r)
766+
go f' (Bin p l r) = binCheckR p l (go f' r)
767767
go f' (Tip k y) = case f' k y of
768768
Just !y' -> Tip k y'
769769
Nothing -> Nil

0 commit comments

Comments
 (0)