[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Add fmap/fmap rules (352c73d)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:34:51 UTC 2017
Repository : ssh://git@git.haskell.org/containers
On branches: changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394,zip-devel
Link : http://git.haskell.org/packages/containers.git/commitdiff/352c73dca04572fc843417518b9f5dd684c1792c
>---------------------------------------------------------------
commit 352c73dca04572fc843417518b9f5dd684c1792c
Author: David Feuer <David.Feuer at gmail.com>
Date: Tue Nov 18 09:41:29 2014 -0500
Add fmap/fmap rules
Specifically, fuse map, mapWithIndex, mapWithKey, etc., with each
other.
>---------------------------------------------------------------
352c73dca04572fc843417518b9f5dd684c1792c
Data/IntMap/Base.hs | 19 +++++++++++++++++++
Data/IntMap/Strict.hs | 19 +++++++++++++++++++
Data/Map/Base.hs | 19 ++++++++++++++++++-
Data/Map/Strict.hs | 24 +++++++++++++++++++++---
Data/Sequence.hs | 19 ++++++++++++++++++-
5 files changed, 95 insertions(+), 5 deletions(-)
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 007e41e..3832e1c 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -1301,6 +1301,13 @@ map f t
Tip k x -> Tip k (f x)
Nil -> Nil
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] map #-}
+{-# RULES
+"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
+ #-}
+#endif
+
-- | /O(n)/. Map a function over all values in the map.
--
-- > let f key x = (show key) ++ ":" ++ x
@@ -1313,6 +1320,18 @@ mapWithKey f t
Tip k x -> Tip k (f k x)
Nil -> Nil
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] mapWithKey #-}
+{-# RULES
+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+ mapWithKey (\k a -> f k (g k a)) xs
+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+ mapWithKey (\k a -> f k (g a)) xs
+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+ mapWithKey (\k a -> f (g k a)) xs
+ #-}
+#endif
+
-- | /O(n)/.
-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
-- That is, behaves exactly like a regular 'traverse' except that the traversing
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
index f1c363c..af44b2a 100644
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -718,6 +718,13 @@ map f t
Tip k x -> Tip k $! f x
Nil -> Nil
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] map #-}
+{-# RULES
+"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
+ #-}
+#endif
+
-- | /O(n)/. Map a function over all values in the map.
--
-- > let f key x = (show key) ++ ":" ++ x
@@ -730,6 +737,18 @@ mapWithKey f t
Tip k x -> Tip k $! f k x
Nil -> Nil
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] mapWithKey #-}
+{-# RULES
+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+ mapWithKey (\k a -> f k (g k a)) xs
+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+ mapWithKey (\k a -> f k (g a)) xs
+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+ mapWithKey (\k a -> f (g k a)) xs
+ #-}
+#endif
+
-- | /O(n)/. The function @'mapAccum'@ threads an accumulating
-- argument through the map in ascending order of keys.
--
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 89b851e..3911125 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -1662,10 +1662,15 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
map :: (a -> b) -> Map k a -> Map k b
map _ Tip = Tip
map f (Bin sx kx x l r) = Bin sx kx (f x) (map f l) (map f r)
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] map #-}
+{-# RULES
+"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
+ #-}
+#endif
#if MIN_VERSION_base(4,8,0)
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
-- well enough with RULES to do what we want.
-{-# NOINLINE [1] map #-}
{-# RULES
"map/coerce" map coerce = coerce
#-}
@@ -1680,6 +1685,18 @@ mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey _ Tip = Tip
mapWithKey f (Bin sx kx x l r) = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] mapWithKey #-}
+{-# RULES
+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+ mapWithKey (\k a -> f k (g k a)) xs
+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+ mapWithKey (\k a -> f k (g a)) xs
+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+ mapWithKey (\k a -> f (g k a)) xs
+ #-}
+#endif
+
-- | /O(n)/.
-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
-- That is, behaves exactly like a regular 'traverse' except that the traversing
diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs
index 8c7ea0f..6255e91 100644
--- a/Data/Map/Strict.hs
+++ b/Data/Map/Strict.hs
@@ -935,10 +935,15 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
map :: (a -> b) -> Map k a -> Map k b
map _ Tip = Tip
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)
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] map #-}
+{-# RULES
+"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
+ #-}
+#endif
#if MIN_VERSION_base(4,8,0)
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
-- well enough with RULES to do what we want.
-{-# NOINLINE [1] map #-}
{-# RULES
"mapSeq/coerce" map coerce = coerce
#-}
@@ -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
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey _ Tip = Tip
-mapWithKey f (Bin sx kx x l r) = let x' = f kx x
- in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
+mapWithKey f (Bin sx kx x l r) =
+ let x' = f kx x
+ in x' `seq` Bin sx kx x' (mapWithKey f l) (mapWithKey f r)
+
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] mapWithKey #-}
+{-# RULES
+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+ mapWithKey (\k a -> f k (g k a)) xs
+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+ mapWithKey (\k a -> f k (g a)) xs
+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+ mapWithKey (\k a -> f (g k a)) xs
+ #-}
+#endif
-- | /O(n)/. The function 'mapAccum' threads an accumulating
-- argument through the map in ascending order of keys.
diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 1c4e143..fe59172 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -191,10 +191,15 @@ instance Functor Seq where
fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] fmapSeq #-}
+{-# RULES
+"fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs
+ #-}
+#endif
#if MIN_VERSION_base(4,8,0)
-- Safe coercions were introduced in 4.7.0, but I am not sure if they played
-- well enough with RULES to do what we want.
-{-# NOINLINE [1] fmapSeq #-}
{-# RULES
"fmapSeq/coerce" fmapSeq coerce = coerce
#-}
@@ -1265,6 +1270,18 @@ adjustDigit f i (Four a b c d)
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs)
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] mapWithIndex #-}
+{-# RULES
+"mapWithIndex/mapWithIndex" forall f g xs . mapWithIndex f (mapWithIndex g xs) =
+ mapWithIndex (\k a -> f k (g k a)) xs
+"mapWithIndex/fmapSeq" forall f g xs . mapWithIndex f (fmapSeq g xs) =
+ mapWithIndex (\k a -> f k (g a)) xs
+"fmapSeq/mapWithIndex" forall f g xs . fmapSeq f (mapWithIndex g xs) =
+ mapWithIndex (\k a -> f (g k a)) xs
+ #-}
+#endif
+
-- Splitting
-- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
More information about the ghc-commits
mailing list