Add fmap/fmap rules
authorDavid Feuer <David.Feuer@gmail.com>
Tue, 18 Nov 2014 14:41:29 +0000 (09:41 -0500)
committerDavid Feuer <David.Feuer@gmail.com>
Tue, 18 Nov 2014 15:10:47 +0000 (10:10 -0500)
Specifically, fuse map, mapWithIndex, mapWithKey, etc., with each
other.

Data/IntMap/Base.hs
Data/IntMap/Strict.hs
Data/Map/Base.hs
Data/Map/Strict.hs
Data/Sequence.hs

index 007e41e..3832e1c 100644 (file)
@@ -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
index f1c363c..af44b2a 100644 (file)
@@ -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.
 --
index 89b851e..3911125 100644 (file)
@@ -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
index 8c7ea0f..6255e91 100644 (file)
@@ -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.
index 1c4e143..fe59172 100644 (file)
@@ -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.