Inline Map.map; define Map <$
authorDavid Feuer <David.Feuer@gmail.com>
Mon, 25 Jul 2016 14:45:18 +0000 (10:45 -0400)
committerDavid Feuer <David.Feuer@gmail.com>
Mon, 25 Jul 2016 14:50:53 +0000 (10:50 -0400)
Previously, `<$` would fill a map with thunks. Rewriting
`map` so it can inline fixes this. Defined a custom `<$` anyway.

Fixes #300

Data/Map/Base.hs
Data/Map/Strict.hs
benchmarks/Map.hs
changelog.md

index aa641f2..4157c17 100644 (file)
@@ -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)
index 21141fb..2258931 100644 (file)
@@ -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
index f0ba0b4..1376e62 100644 (file)
@@ -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
index 9f3913e..a714e79 100644 (file)
@@ -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.