[commit: packages/containers] develop-0.6, develop-0.6-questionable, master, zip-devel: Add fmap/fmap rules (352c73d)

git at git.haskell.org git at git.haskell.org
Sun Dec 20 16:21:32 UTC 2015


Repository : ssh://git@git.haskell.org/containers

On branches: develop-0.6,develop-0.6-questionable,master,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