Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 7e1b4f4

Browse files
Use pattern match on 1 to reduce recursive function calls
1 parent 5b3da8f commit 7e1b4f4

File tree

3 files changed

+41
-9
lines changed

3 files changed

+41
-9
lines changed

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

Lines changed: 28 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3079,6 +3079,9 @@ mapMaybe f = mapMaybeWithKey (\_ x -> f x)
30793079

30803080
mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
30813081
mapMaybeWithKey _ Tip = Tip
3082+
mapMaybeWithKey f (Bin 1 kx x _ _) = case f kx x of
3083+
Just y -> Bin 1 kx y Tip Tip
3084+
Nothing -> Tip
30823085
mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
30833086
Just y -> link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
30843087
Nothing -> link2 (mapMaybeWithKey f l) (mapMaybeWithKey f r)
@@ -3091,7 +3094,7 @@ traverseMaybeWithKey :: Applicative f
30913094
traverseMaybeWithKey = go
30923095
where
30933096
go _ Tip = pure Tip
3094-
go f (Bin _ kx x TipTip) = maybe Tip (\x' -> Bin 1 kx x' Tip Tip) <$> f kx x
3097+
go f (Bin 1 kx x _ _) = maybe Tip (\x' -> Bin 1 kx x' Tip Tip) <$> f kx x
30953098
go f (Bin _ kx x l r) = liftA3 combine (go f l) (f kx x) (go f r)
30963099
where
30973100
combine !l' mx !r' = case mx of
@@ -3123,7 +3126,7 @@ mapEither f m
31233126
mapEitherWithKey :: (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
31243127
mapEitherWithKey f0 t0 = toPair $ go f0 t0
31253128
where
3126-
go _ Tip = (Tip :*: Tip)
3129+
go _ Tip = Tip :*: Tip
31273130
go f (Bin _ kx x l r) = case f kx x of
31283131
Left y -> link kx y l1 r1 :*: link2 l2 r2
31293132
Right z -> link2 l1 r1 :*: link kx z l2 r2
@@ -3141,6 +3144,7 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
31413144
map :: (a -> b) -> Map k a -> Map k b
31423145
map f = go where
31433146
go Tip = Tip
3147+
go (Bin 1 kx x _ _) = Bin 1 kx (f x) Tip Tip
31443148
go (Bin sx kx x l r) = Bin sx kx (f x) (go l) (go r)
31453149
-- We use a `go` function to allow `map` to inline. This makes
31463150
-- a big difference if someone uses `map (const x) m` instead
@@ -3161,6 +3165,7 @@ map f = go where
31613165

31623166
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
31633167
mapWithKey _ Tip = Tip
3168+
mapWithKey f (Bin 1 kx x _ _) = Bin 1 kx (f kx x) Tip Tip
31643169
mapWithKey f (Bin sx kx x l r) = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
31653170

31663171
#ifdef __GLASGOW_HASKELL__
@@ -3214,6 +3219,9 @@ mapAccumWithKey f a t
32143219
-- argument through the map in ascending order of keys.
32153220
mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
32163221
mapAccumL _ a Tip = (a,Tip)
3222+
mapAccumL f a (Bin 1 kx x _ _ ) =
3223+
let (a1,x') = f a kx x
3224+
in (a1,Bin 1 kx x' Tip Tip)
32173225
mapAccumL f a (Bin sx kx x l r) =
32183226
let (a1,l') = mapAccumL f a l
32193227
(a2,x') = f a1 kx x
@@ -3224,6 +3232,9 @@ mapAccumL f a (Bin sx kx x l r) =
32243232
-- argument through the map in descending order of keys.
32253233
mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
32263234
mapAccumRWithKey _ a Tip = (a,Tip)
3235+
mapAccumRWithKey f a (Bin 1 kx x _ _) =
3236+
let (a0,x') = f a kx x
3237+
in (a0,Bin 1 kx x' Tip Tip)
32273238
mapAccumRWithKey f a (Bin sx kx x l r) =
32283239
let (a1,r') = mapAccumRWithKey f a r
32293240
(a2,x') = f a1 kx x
@@ -3307,6 +3318,7 @@ foldr :: (a -> b -> b) -> b -> Map k a -> b
33073318
foldr f z = go z
33083319
where
33093320
go z' Tip = z'
3321+
go z' (Bin 1 _ x _ _) = f x z'
33103322
go z' (Bin _ _ x l r) = go (f x (go z' r)) l
33113323
{-# INLINE foldr #-}
33123324

@@ -3316,8 +3328,9 @@ foldr f z = go z
33163328
foldr' :: (a -> b -> b) -> b -> Map k a -> b
33173329
foldr' f z = go z
33183330
where
3319-
go !z' Tip = z'
3320-
go z' (Bin _ _ x l r) = go (f x $! go z' r) l
3331+
go !z' Tip = z'
3332+
go !z' (Bin 1 _ x _ _) = f x z'
3333+
go z' (Bin _ _ x l r) = go (f x $! go z' r) l
33213334
{-# INLINE foldr' #-}
33223335

33233336
-- | \(O(n)\). Fold the values in the map using the given left-associative
@@ -3333,6 +3346,7 @@ foldl :: (a -> b -> a) -> a -> Map k b -> a
33333346
foldl f z = go z
33343347
where
33353348
go z' Tip = z'
3349+
go z' (Bin 1 _ x _ _) = f z' x
33363350
go z' (Bin _ _ x l r) = go (f (go z' l) x) r
33373351
{-# INLINE foldl #-}
33383352

@@ -3342,8 +3356,9 @@ foldl f z = go z
33423356
foldl' :: (a -> b -> a) -> a -> Map k b -> a
33433357
foldl' f z = go z
33443358
where
3345-
go !z' Tip = z'
3346-
go z' (Bin _ _ x l r) =
3359+
go !z' Tip = z'
3360+
go !z' (Bin 1 _ x _ _) = f z' x
3361+
go z' (Bin _ _ x l r) =
33473362
let !z'' = go z' l
33483363
in go (f z'' x) r
33493364
{-# INLINE foldl' #-}
@@ -3361,7 +3376,8 @@ foldl' f z = go z
33613376
foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
33623377
foldrWithKey f z = go z
33633378
where
3364-
go z' Tip = z'
3379+
go z' Tip = z'
3380+
go z' (Bin 1 kx x _ _) = f kx x z'
33653381
go z' (Bin _ kx x l r) = go (f kx x (go z' r)) l
33663382
{-# INLINE foldrWithKey #-}
33673383

@@ -3372,7 +3388,8 @@ foldrWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b
33723388
foldrWithKey' f z = go z
33733389
where
33743390
go !z' Tip = z'
3375-
go z' (Bin _ kx x l r) = go (f kx x $! go z' r) l
3391+
go !z' (Bin 1 kx x _ _) = f kx x z'
3392+
go z' (Bin _ kx x l r) = go (f kx x $! go z' r) l
33763393
{-# INLINE foldrWithKey' #-}
33773394

33783395
-- | \(O(n)\). Fold the keys and values in the map using the given left-associative
@@ -3389,6 +3406,7 @@ foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
33893406
foldlWithKey f z = go z
33903407
where
33913408
go z' Tip = z'
3409+
go z' (Bin 1 kx x _ _) = f z' kx x
33923410
go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r
33933411
{-# INLINE foldlWithKey #-}
33943412

@@ -3399,6 +3417,7 @@ foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a
33993417
foldlWithKey' f z = go z
34003418
where
34013419
go !z' Tip = z'
3420+
go !z' (Bin 1 kx x _ _) = f z' kx x
34023421
go z' (Bin _ kx x l r) =
34033422
let !z'' = go z' l
34043423
in go (f z'' kx x) r
@@ -4393,6 +4412,7 @@ instance Functor (Map k) where
43934412
fmap f m = map f m
43944413
#ifdef __GLASGOW_HASKELL__
43954414
_ <$ Tip = Tip
4415+
a <$ (Bin 1 kx _ _ _) = Bin 1 kx a Tip Tip
43964416
a <$ (Bin sx kx _ l r) = Bin sx kx a (a <$ l) (a <$ r)
43974417
#endif
43984418

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

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1271,6 +1271,9 @@ mapMaybe f = mapMaybeWithKey (\_ x -> f x)
12711271

12721272
mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
12731273
mapMaybeWithKey _ Tip = Tip
1274+
mapMaybeWithKey f (Bin 1 kx x _ _) = case f kx x of
1275+
Just y -> y `seq` Bin 1 kx y Tip Tip
1276+
Nothing -> Tip
12741277
mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
12751278
Just y -> y `seq` link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
12761279
Nothing -> link2 (mapMaybeWithKey f l) (mapMaybeWithKey f r)
@@ -1284,7 +1287,7 @@ traverseMaybeWithKey :: Applicative f
12841287
traverseMaybeWithKey = go
12851288
where
12861289
go _ Tip = pure Tip
1287-
go f (Bin _ kx x TipTip) = maybe Tip (\ !x' -> Bin 1 kx x' Tip Tip) <$> f kx x
1290+
go f (Bin 1 kx x _ _) = maybe Tip (\ !x' -> Bin 1 kx x' Tip Tip) <$> f kx x
12881291
go f (Bin _ kx x l r) = liftA3 combine (go f l) (f kx x) (go f r)
12891292
where
12901293
combine !l' mx !r' = case mx of
@@ -1335,6 +1338,7 @@ map :: (a -> b) -> Map k a -> Map k b
13351338
map f = go
13361339
where
13371340
go Tip = Tip
1341+
go (Bin 1 kx x _ _) = let !x' = f x in Bin 1 kx x' Tip Tip
13381342
go (Bin sx kx x l r) = let !x' = f x in Bin sx kx x' (go l) (go r)
13391343
-- We use `go` to let `map` inline. This is important if `f` is a constant
13401344
-- function.
@@ -1354,6 +1358,9 @@ map f = go
13541358

13551359
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
13561360
mapWithKey _ Tip = Tip
1361+
mapWithKey f (Bin 1 kx x _ _) =
1362+
let x' = f kx x
1363+
in x' `seq` Bin 1 kx x' Tip Tip
13571364
mapWithKey f (Bin sx kx x l r) =
13581365
let x' = f kx x
13591366
in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
@@ -1416,6 +1423,9 @@ mapAccumWithKey f a t
14161423
-- argument through the map in ascending order of keys.
14171424
mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
14181425
mapAccumL _ a Tip = (a,Tip)
1426+
mapAccumL f a (Bin 1 kx x _ _) =
1427+
let (a1,x') = f a kx x
1428+
in x' `seq` (a1,Bin 1 kx x' Tip Tip)
14191429
mapAccumL f a (Bin sx kx x l r) =
14201430
let (a1,l') = mapAccumL f a l
14211431
(a2,x') = f a1 kx x

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1062,6 +1062,7 @@ foldl :: (a -> b -> a) -> a -> Set b -> a
10621062
foldl f z = go z
10631063
where
10641064
go z' Tip = z'
1065+
go z' (Bin 1 x _ _) = f z' x
10651066
go z' (Bin _ x l r) = go (f (go z' l) x) r
10661067
{-# INLINE foldl #-}
10671068

@@ -1072,6 +1073,7 @@ foldl' :: (a -> b -> a) -> a -> Set b -> a
10721073
foldl' f z = go z
10731074
where
10741075
go !z' Tip = z'
1076+
go !z' (Bin 1 x _ _) = f z' x
10751077
go z' (Bin _ x l r) =
10761078
let !z'' = go z' l
10771079
in go (f z'' x) r

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /