[commit: packages/containers] cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394: Inline Map.map; define Map <$ (1a60452)

[git at git.haskell.org]

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

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/1a604529e2b7d9c67ef98605baac061e94203518

>---------------------------------------------------------------

commit 1a604529e2b7d9c67ef98605baac061e94203518
Author: David Feuer <David.Feuer at gmail.com>
Date:   Mon Jul 25 10:45:18 2016 -0400

    Inline Map.map; define Map <$
    
    Previously, `<$` would fill a map with thunks. Rewriting
    `map` so it can inline fixes this. Defined a custom `<$` anyway.
    
    Fixes #300


>---------------------------------------------------------------

1a604529e2b7d9c67ef98605baac061e94203518
 Data/Map/Base.hs   | 13 +++++++++++--
 Data/Map/Strict.hs |  9 +++++++--
 benchmarks/Map.hs  |  8 ++++++--
 changelog.md       |  4 +++-
 4 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index aa641f2..4157c17 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -1947,8 +1947,13 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
 
 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)
+map f = go where
+  go Tip = Tip
+  go (Bin sx kx x l r) = Bin sx kx (f x) (go l) (go r)
+-- We use a `go` function to allow `map` to inline. This makes
+-- a big difference if someone uses `map (const x) m` instead
+-- of `x <$ m`; it doesn't seem to do any harm.
+
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}
 {-# RULES
@@ -3023,6 +3028,10 @@ instance (Ord k, Ord v) => Ord (Map k v) where
 --------------------------------------------------------------------}
 instance Functor (Map k) where
   fmap f m  = map f m
+#if __GLASGOW_HASKELL__
+a <$ Tip = Tip
+a <$ (Bin sx kx _ l r) = Bin sx kx a (a <$ l) (a <$ r)
+#endif
 
 instance Traversable (Map k) where
   traverse f = traverseWithKey (\_ -> f)
diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs
index 21141fb..2258931 100644
--- a/Data/Map/Strict.hs
+++ b/Data/Map/Strict.hs
@@ -1013,8 +1013,13 @@ mapEitherWithKey f0 t0 = toPair $ go f0 t0
 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
 
 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)
+map f = go
+  where
+    go Tip = Tip
+    go (Bin sx kx x l r) = let !x' = f x in Bin sx kx x' (go l) (go r)
+-- We use `go` to let `map` inline. This is important if `f` is a constant
+-- function.
+
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}
 {-# RULES
diff --git a/benchmarks/Map.hs b/benchmarks/Map.hs
index f0ba0b4..1376e62 100644
--- a/benchmarks/Map.hs
+++ b/benchmarks/Map.hs
@@ -5,12 +5,13 @@ module Main where
 import Control.Applicative (Const(Const, getConst), pure)
 import Control.DeepSeq (rnf)
 import Control.Exception (evaluate)
-import Criterion.Main (bench, defaultMain, whnf)
+import Criterion.Main (bench, defaultMain, whnf, nf)
 import Data.Functor.Identity (Identity(..))
 import Data.List (foldl')
 import qualified Data.Map as M
 import Data.Map (alterF)
 import Data.Maybe (fromMaybe)
+import Data.Functor ((<$))
 #if __GLASGOW_HASKELL__ >= 708
 import Data.Coerce
 #endif
@@ -24,6 +25,10 @@ main = do
     defaultMain
         [ bench "lookup absent" $ whnf (lookup evens) m_odd
         , bench "lookup present" $ whnf (lookup evens) m_even
+        , bench "map" $ whnf (M.map (+ 1)) m
+        , bench "map really" $ nf (M.map (+ 2)) m
+        , bench "<$" $ whnf ((1 :: Int) <$) m
+        , bench "<$ really" $ nf ((2 :: Int) <$) m
         , bench "alterF lookup absent" $ whnf (atLookup evens) m_odd
         , bench "alterF lookup present" $ whnf (atLookup evens) m_even
         , bench "alterF no rules lookup absent" $ whnf (atLookupNoRules evens) m_odd
@@ -64,7 +69,6 @@ main = do
         , bench "insertLookupWithKey present" $ whnf (insLookupWithKey elems_even) m_even
         , bench "insertLookupWithKey' absent" $ whnf (insLookupWithKey' elems_even) m_odd
         , bench "insertLookupWithKey' present" $ whnf (insLookupWithKey' elems_even) m_even
-        , bench "map" $ whnf (M.map (+ 1)) m
         , bench "mapWithKey" $ whnf (M.mapWithKey (+)) m
         , bench "foldlWithKey" $ whnf (ins elems) m
 --         , bench "foldlWithKey'" $ whnf (M.foldlWithKey' sum 0) m
diff --git a/changelog.md b/changelog.md
index 9f3913e..a714e79 100644
--- a/changelog.md
+++ b/changelog.md
@@ -72,7 +72,9 @@
 
   * Add rewrite rules to fuse `fmap` with `reverse` for `Data.Sequence`.
 
-  * Speed up `adjust` for `Data.Map`.
+  * Speed up `adjust` for `Data.Map`. Allow `map` to inline, and
+    define a custom `(<$)`. This considerably improves mapping with
+    a constant function.
 
   * Remove non-essential laziness in `Data.Map.Lazy` implementation.