author David Feuer Tue, 18 Nov 2014 14:41:29 +0000 (09:41 -0500) committer David Feuer Tue, 18 Nov 2014 15:10:47 +0000 (10:10 -0500)
Specifically, fuse map, mapWithIndex, mapWithKey, etc., with each
other.

 Data/IntMap/Base.hs patch | blob | history Data/IntMap/Strict.hs patch | blob | history Data/Map/Base.hs patch | blob | history Data/Map/Strict.hs patch | blob | history Data/Sequence.hs patch | blob | history

index 007e41e..3832e1c 100644 (file)
@@ -1301,6 +1301,13 @@ map f t
Tip k x     -> Tip k (f x)
Nil         -> Nil

+{-# NOINLINE  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

+{-# NOINLINE  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

+{-# NOINLINE  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

+{-# NOINLINE  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)
+{-# NOINLINE  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  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)

+{-# NOINLINE  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)
+{-# NOINLINE  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  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)
+
+{-# NOINLINE  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)
+{-# NOINLINE  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  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)

+{-# NOINLINE  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.