[commit: packages/containers] develop-0.6, develop-0.6-questionable, master, zip-devel: Implement map/coerce for IntMap (ee3eb5f)
git at git.haskell.org
git at git.haskell.org
Fri Jan 23 22:39:59 UTC 2015
Repository : ssh://git@git.haskell.org/containers
On branches: develop-0.6,develop-0.6-questionable,master,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