[commit: packages/containers] cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394: Rewrite IntMap map so it can inline; define <$ (a4f439c)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:44:18 UTC 2017


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/a4f439cb7e0c038f49ca186863a25ae0319429e8

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

commit a4f439cb7e0c038f49ca186863a25ae0319429e8
Author: David Feuer <David.Feuer at gmail.com>
Date:   Mon Jul 25 11:34:38 2016 -0400

    Rewrite IntMap map so it can inline; define <$
    
    Previously, mapping a constant function would fill an `IntMap`
    with thunks.


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

a4f439cb7e0c038f49ca186863a25ae0319429e8
 Data/IntMap/Base.hs   | 17 ++++++++++++-----
 Data/IntMap/Strict.hs | 10 +++++-----
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 845a590..2a735bb 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -248,6 +248,7 @@ import Data.Utils.StrictPair
 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
                   DataType, mkDataType)
 import GHC.Exts (build)
+import Data.Functor ((<$))
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
 #endif
@@ -1330,11 +1331,11 @@ isSubmapOfBy _         Nil _           = True
 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
 
 map :: (a -> b) -> IntMap a -> IntMap b
-map f t
-  = case t of
-      Bin p m l r -> Bin p m (map f l) (map f r)
-      Tip k x     -> Tip k (f x)
-      Nil         -> Nil
+map f = go
+  where
+    go (Bin p m l r) = Bin p m (go l) (go r)
+    go (Tip k x)     = Tip k (f x)
+    go Nil           = Nil
 
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}
@@ -2096,6 +2097,12 @@ instance Ord a => Ord (IntMap a) where
 instance Functor IntMap where
     fmap = map
 
+#ifdef __GLASGOW_HASKELL__
+    a <$ Bin p m l r = Bin p m (a <$ l) (a <$ r)
+    a <$ Tip k _     = Tip k a
+    a <$ Nil         = Nil
+#endif
+
 {--------------------------------------------------------------------
   Show
 --------------------------------------------------------------------}
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
index 42d2340..d020e9f 100644
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -767,11 +767,11 @@ updateMin f = updateMinWithKey (const f)
 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
 
 map :: (a -> b) -> IntMap a -> IntMap b
-map f t
-  = case t of
-      Bin p m l r -> Bin p m (map f l) (map f r)
-      Tip k x     -> Tip k $! f x
-      Nil         -> Nil
+map f = go
+  where
+    go (Bin p m l r) = Bin p m (go l) (go r)
+    go (Tip k x)     = Tip k $! f x
+    go Nil           = Nil
 
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}



More information about the ghc-commits mailing list