[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Implement map/coerce for IntMap (ee3eb5f)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:34:55 UTC 2017


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

On branches: changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394,zip-devel
Link       : http://git.haskell.org/packages/containers.git/commitdiff/ee3eb5f19dbbd193e7c8b991c861f8568c7106d9

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

commit ee3eb5f19dbbd193e7c8b991c861f8568c7106d9
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue Nov 18 17:39:18 2014 -0500

    Implement map/coerce for IntMap
    
    I realized what I was doing with MIN_VERSION was kind of silly.
    The easy/sane thing to do is really to use __GLASGOW_HASKELL__
    for the coercion stuff.


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

ee3eb5f19dbbd193e7c8b991c861f8568c7106d9
 Data/IntMap/Base.hs                                | 23 +++++++++++++++-------
 Data/IntMap/Strict.hs                              | 12 ++++++++---
 tests-ghc/all.T                                    |  2 ++
 tests-ghc/{mapcoercemap.hs => mapcoerceintmap.hs}  |  8 ++++----
 ...{mapcoercemap.stdout => mapcoerceintmap.stdout} |  0
 .../{mapcoercemap.hs => mapcoerceintmapstrict.hs}  | 14 ++++++-------
 ...emap.stdout => mapcoerceintmapstrict.hs.stdout} |  0
 7 files changed, 38 insertions(+), 21 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 3832e1c..d5fd75a 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -9,6 +9,13 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
 #endif
+-- We use cabal-generated MIN_VERSION_base to adapt to changes of base.
+-- Nevertheless, as a convenience, we also allow compiling without cabal by
+-- defining trivial MIN_VERSION_base if needed.
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(major1,major2,minor) 0
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.IntMap.Base
@@ -240,6 +247,9 @@ import qualified GHC.Exts as GHCExts
 #endif
 import Text.Read
 #endif
+#if __GLASGOW_HASKELL__ >= 709
+import Data.Coerce
+#endif
 
 -- Use macros to define strictness of functions.
 -- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
@@ -247,13 +257,6 @@ import Text.Read
 -- want the compilers to be compiled by as many compilers as possible.
 #define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
 
--- We use cabal-generated MIN_VERSION_base to adapt to changes of base.
--- Nevertheless, as a convenience, we also allow compiling without cabal by
--- defining trivial MIN_VERSION_base if needed.
-#ifndef MIN_VERSION_base
-#define MIN_VERSION_base(major1,major2,minor) 0
-#endif
-
 
 -- A "Nat" is a natural machine word (an unsigned Int)
 type Nat = Word
@@ -1307,6 +1310,12 @@ map f t
 "map/map" forall f g xs . map f (map g xs) = map (f . g) xs
  #-}
 #endif
+#if __GLASGOW_HASKELL__ >= 709
+-- Safe coercions were introduced in 7.8, but did not play well with RULES yet.
+{-# RULES
+"map/coerce" map coerce = coerce
+ #-}
+#endif
 
 -- | /O(n)/. Map a function over all values in the map.
 --
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
index af44b2a..d7f45f7 100644
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -1,7 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#elif !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
+#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
 {-# LANGUAGE Trustworthy #-}
 #endif
 -----------------------------------------------------------------------------
@@ -262,6 +260,9 @@ import qualified Data.IntSet.Base as IntSet
 import Data.Utils.BitUtil
 import Data.Utils.StrictFold
 import Data.Utils.StrictPair
+#if __GLASGOW_HASKELL__ >= 709
+import Data.Coerce
+#endif
 
 -- $strictness
 --
@@ -724,6 +725,11 @@ map f t
 "map/map" forall f g xs . map f (map g xs) = map (f . g) xs
  #-}
 #endif
+#if __GLASGOW_HASKELL__ >= 709
+{-# RULES
+"map/coerce" map coerce = coerce
+ #-}
+#endif
 
 -- | /O(n)/. Map a function over all values in the map.
 --
diff --git a/tests-ghc/all.T b/tests-ghc/all.T
index 6a8a339..eba1dcc 100644
--- a/tests-ghc/all.T
+++ b/tests-ghc/all.T
@@ -8,3 +8,5 @@ test('sequence001', normal, compile_and_run, ['-package containers'])
 test('mapcoerceseq', when(compiler_ge('ghc','7.9')), compile_and_run, ['-package containers'])
 test('mapcoercemap', when(compiler_ge('ghc','7.9')), compile_and_run, ['-package containers'])
 test('mapcoercesmap', when(compiler_ge('ghc','7.9')), compile_and_run, ['-package containers'])
+test('mapcoerceintmap', when(compiler_ge('ghc','7.9')), compile_and_run, ['-package containers'])
+test('mapcoerceintmapstrict', when(compiler_ge('ghc','7.9')), compile_and_run, ['-package containers'])
diff --git a/tests-ghc/mapcoercemap.hs b/tests-ghc/mapcoerceintmap.hs
similarity index 76%
copy from tests-ghc/mapcoercemap.hs
copy to tests-ghc/mapcoerceintmap.hs
index 6dd336d..ded48c7 100644
--- a/tests-ghc/mapcoercemap.hs
+++ b/tests-ghc/mapcoerceintmap.hs
@@ -2,15 +2,15 @@
 
 import GHC.Exts hiding (fromList)
 import Unsafe.Coerce
-import Data.Map
+import Data.IntMap.Lazy
 
 newtype Age = Age Int
 
-fooAge :: Map Int Int -> Map Int Age
+fooAge :: IntMap Int -> IntMap Age
 fooAge = fmap Age
-fooCoerce :: Map Int Int -> Map Int Age
+fooCoerce :: IntMap Int -> IntMap Age
 fooCoerce = fmap coerce
-fooUnsafeCoerce :: Map Int Int -> Map Int Age
+fooUnsafeCoerce :: IntMap Int -> IntMap Age
 fooUnsafeCoerce = fmap unsafeCoerce
 
 same :: a -> b -> IO ()
diff --git a/tests-ghc/mapcoercemap.stdout b/tests-ghc/mapcoerceintmap.stdout
similarity index 100%
copy from tests-ghc/mapcoercemap.stdout
copy to tests-ghc/mapcoerceintmap.stdout
diff --git a/tests-ghc/mapcoercemap.hs b/tests-ghc/mapcoerceintmapstrict.hs
similarity index 61%
copy from tests-ghc/mapcoercemap.hs
copy to tests-ghc/mapcoerceintmapstrict.hs
index 6dd336d..2e97004 100644
--- a/tests-ghc/mapcoercemap.hs
+++ b/tests-ghc/mapcoerceintmapstrict.hs
@@ -2,16 +2,16 @@
 
 import GHC.Exts hiding (fromList)
 import Unsafe.Coerce
-import Data.Map
+import Data.IntMap.Strict as IM
 
 newtype Age = Age Int
 
-fooAge :: Map Int Int -> Map Int Age
-fooAge = fmap Age
-fooCoerce :: Map Int Int -> Map Int Age
-fooCoerce = fmap coerce
-fooUnsafeCoerce :: Map Int Int -> Map Int Age
-fooUnsafeCoerce = fmap unsafeCoerce
+fooAge :: IntMap Int -> IntMap Age
+fooAge = IM.map Age
+fooCoerce :: IntMap Int -> IntMap Age
+fooCoerce = IM.map coerce
+fooUnsafeCoerce :: IntMap Int -> IntMap Age
+fooUnsafeCoerce = IM.map unsafeCoerce
 
 same :: a -> b -> IO ()
 same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of
diff --git a/tests-ghc/mapcoercemap.stdout b/tests-ghc/mapcoerceintmapstrict.hs.stdout
similarity index 100%
copy from tests-ghc/mapcoercemap.stdout
copy to tests-ghc/mapcoerceintmapstrict.hs.stdout



More information about the ghc-commits mailing list