Skip to content

Commit b2c1c79

Browse files
committed
Merge pull request #69 from treeowl/fmapfmap
Add fmap/fmap rules
2 parents e083f68 + 352c73d commit b2c1c79

File tree

5 files changed

+95
-5
lines changed

5 files changed

+95
-5
lines changed

Data/IntMap/Base.hs

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1301,6 +1301,13 @@ map f t
13011301
Tip k x -> Tip k (f x)
13021302
Nil -> Nil
13031303

1304+
#ifdef __GLASGOW_HASKELL__
1305+
{-# NOINLINE [1] map #-}
1306+
{-# RULES
1307+
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
1308+
#-}
1309+
#endif
1310+
13041311
-- | /O(n)/. Map a function over all values in the map.
13051312
--
13061313
-- > let f key x = (show key) ++ ":" ++ x
@@ -1313,6 +1320,18 @@ mapWithKey f t
13131320
Tip k x -> Tip k (f k x)
13141321
Nil -> Nil
13151322

1323+
#ifdef __GLASGOW_HASKELL__
1324+
{-# NOINLINE [1] mapWithKey #-}
1325+
{-# RULES
1326+
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
1327+
mapWithKey (\k a -> f k (g k a)) xs
1328+
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
1329+
mapWithKey (\k a -> f k (g a)) xs
1330+
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
1331+
mapWithKey (\k a -> f (g k a)) xs
1332+
#-}
1333+
#endif
1334+
13161335
-- | /O(n)/.
13171336
-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
13181337
-- That is, behaves exactly like a regular 'traverse' except that the traversing

Data/IntMap/Strict.hs

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -718,6 +718,13 @@ map f t
718718
Tip k x -> Tip k $! f x
719719
Nil -> Nil
720720

721+
#ifdef __GLASGOW_HASKELL__
722+
{-# NOINLINE [1] map #-}
723+
{-# RULES
724+
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
725+
#-}
726+
#endif
727+
721728
-- | /O(n)/. Map a function over all values in the map.
722729
--
723730
-- > let f key x = (show key) ++ ":" ++ x
@@ -730,6 +737,18 @@ mapWithKey f t
730737
Tip k x -> Tip k $! f k x
731738
Nil -> Nil
732739

740+
#ifdef __GLASGOW_HASKELL__
741+
{-# NOINLINE [1] mapWithKey #-}
742+
{-# RULES
743+
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
744+
mapWithKey (\k a -> f k (g k a)) xs
745+
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
746+
mapWithKey (\k a -> f k (g a)) xs
747+
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
748+
mapWithKey (\k a -> f (g k a)) xs
749+
#-}
750+
#endif
751+
733752
-- | /O(n)/. The function @'mapAccum'@ threads an accumulating
734753
-- argument through the map in ascending order of keys.
735754
--

Data/Map/Base.hs

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1662,10 +1662,15 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
16621662
map :: (a -> b) -> Map k a -> Map k b
16631663
map _ Tip = Tip
16641664
map f (Bin sx kx x l r) = Bin sx kx (f x) (map f l) (map f r)
1665+
#ifdef __GLASGOW_HASKELL__
1666+
{-# NOINLINE [1] map #-}
1667+
{-# RULES
1668+
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
1669+
#-}
1670+
#endif
16651671
#if MIN_VERSION_base(4,8,0)
16661672
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
16671673
-- well enough with RULES to do what we want.
1668-
{-# NOINLINE [1] map #-}
16691674
{-# RULES
16701675
"map/coerce" map coerce = coerce
16711676
#-}
@@ -1680,6 +1685,18 @@ mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
16801685
mapWithKey _ Tip = Tip
16811686
mapWithKey f (Bin sx kx x l r) = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
16821687

1688+
#ifdef __GLASGOW_HASKELL__
1689+
{-# NOINLINE [1] mapWithKey #-}
1690+
{-# RULES
1691+
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
1692+
mapWithKey (\k a -> f k (g k a)) xs
1693+
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
1694+
mapWithKey (\k a -> f k (g a)) xs
1695+
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
1696+
mapWithKey (\k a -> f (g k a)) xs
1697+
#-}
1698+
#endif
1699+
16831700
-- | /O(n)/.
16841701
-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
16851702
-- That is, behaves exactly like a regular 'traverse' except that the traversing

Data/Map/Strict.hs

Lines changed: 21 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -935,10 +935,15 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
935935
map :: (a -> b) -> Map k a -> Map k b
936936
map _ Tip = Tip
937937
map f (Bin sx kx x l r) = let x' = f x in x' `seq` Bin sx kx x' (map f l) (map f r)
938+
#ifdef __GLASGOW_HASKELL__
939+
{-# NOINLINE [1] map #-}
940+
{-# RULES
941+
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
942+
#-}
943+
#endif
938944
#if MIN_VERSION_base(4,8,0)
939945
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
940946
-- well enough with RULES to do what we want.
941-
{-# NOINLINE [1] map #-}
942947
{-# RULES
943948
"mapSeq/coerce" map coerce = coerce
944949
#-}
@@ -951,8 +956,21 @@ map f (Bin sx kx x l r) = let x' = f x in x' `seq` Bin sx kx x' (map f l) (map f
951956

952957
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
953958
mapWithKey _ Tip = Tip
954-
mapWithKey f (Bin sx kx x l r) = let x' = f kx x
955-
in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
959+
mapWithKey f (Bin sx kx x l r) =
960+
let x' = f kx x
961+
in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
962+
963+
#ifdef __GLASGOW_HASKELL__
964+
{-# NOINLINE [1] mapWithKey #-}
965+
{-# RULES
966+
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
967+
mapWithKey (\k a -> f k (g k a)) xs
968+
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
969+
mapWithKey (\k a -> f k (g a)) xs
970+
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
971+
mapWithKey (\k a -> f (g k a)) xs
972+
#-}
973+
#endif
956974

957975
-- | /O(n)/. The function 'mapAccum' threads an accumulating
958976
-- argument through the map in ascending order of keys.

Data/Sequence.hs

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -191,10 +191,15 @@ instance Functor Seq where
191191

192192
fmapSeq :: (a -> b) -> Seq a -> Seq b
193193
fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
194+
#ifdef __GLASGOW_HASKELL__
195+
{-# NOINLINE [1] fmapSeq #-}
196+
{-# RULES
197+
"fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs
198+
#-}
199+
#endif
194200
#if MIN_VERSION_base(4,8,0)
195201
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
196202
-- well enough with RULES to do what we want.
197-
{-# NOINLINE [1] fmapSeq #-}
198203
{-# RULES
199204
"fmapSeq/coerce" fmapSeq coerce = coerce
200205
#-}
@@ -1265,6 +1270,18 @@ adjustDigit f i (Four a b c d)
12651270
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
12661271
mapWithIndex f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs)
12671272

1273+
#ifdef __GLASGOW_HASKELL__
1274+
{-# NOINLINE [1] mapWithIndex #-}
1275+
{-# RULES
1276+
"mapWithIndex/mapWithIndex" forall f g xs . mapWithIndex f (mapWithIndex g xs) =
1277+
mapWithIndex (\k a -> f k (g k a)) xs
1278+
"mapWithIndex/fmapSeq" forall f g xs . mapWithIndex f (fmapSeq g xs) =
1279+
mapWithIndex (\k a -> f k (g a)) xs
1280+
"fmapSeq/mapWithIndex" forall f g xs . fmapSeq f (mapWithIndex g xs) =
1281+
mapWithIndex (\k a -> f (g k a)) xs
1282+
#-}
1283+
#endif
1284+
12681285
-- Splitting
12691286

12701287
-- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.

0 commit comments

Comments
 (0)