Repository : ssh://git@git.haskell.org/containers
On branch : ghc-head
Link : http://git.haskell.org/?p=packages/containers.git;a=commit;h=f1f58da8fcb65c715b6ca06ce4c1039b4c81d9d0
>---------------------------------------------------------------
commit f1f58da8fcb65c715b6ca06ce4c1039b4c81d9d0
Author: Edward Kmett <ekmett at gmail.com>
Date: Sat Nov 24 20:26:52 2012 -0500
Allow `gunfold' on Map, IntMap, Set, and IntSet using virtual constructors.
* Original Proposal: http://www.haskell.org/pipermail/libraries/2012-August/018366.html
>---------------------------------------------------------------
f1f58da8fcb65c715b6ca06ce4c1039b4c81d9d0
Data/IntMap/Base.hs | 20 ++++++++++++++------
Data/IntSet/Base.hs | 18 +++++++++++++-----
Data/Map/Base.hs | 16 ++++++++++++----
Data/Set/Base.hs | 16 ++++++++++++----
4 files changed, 51 insertions(+), 19 deletions(-)
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index ba963f1..d15d7c6 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -227,7 +227,7 @@ import Data.StrictPair
#if __GLASGOW_HASKELL__
import Text.Read
-import Data.Data (Data(..), mkNoRepType)
+import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType)
#endif
#if __GLASGOW_HASKELL__
@@ -342,14 +342,22 @@ instance NFData a => NFData (IntMap a) where
--------------------------------------------------------------------}
-- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
+-- We provide limited reflection services for the sake of data abstraction.
instance Data a => Data (IntMap a) where
gfoldl f z im = z fromList `f` (toList im)
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Data.IntMap.IntMap"
- dataCast1 f = gcast1 f
+ toConstr _ = fromListConstr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z fromList)
+ _ -> error "gunfold"
+ dataTypeOf _ = intMapDataType
+ dataCast1 f = gcast1 f
+
+fromListConstr :: Constr
+fromListConstr = mkConstr intMapDataType "fromList" [] Prefix
+
+intMapDataType :: DataType
+intMapDataType = mkDataType "Data.IntMap.Base.IntMap" [fromListConstr]
#endif
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
index d674aeb..c13b8ee 100644
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -172,7 +172,7 @@ import Data.StrictPair
#if __GLASGOW_HASKELL__
import Text.Read
-import Data.Data (Data(..), mkNoRepType)
+import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType)
#endif
#if __GLASGOW_HASKELL__
@@ -274,13 +274,21 @@ instance Monoid IntSet where
--------------------------------------------------------------------}
-- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
+-- We provide limited reflection services for the sake of data abstraction.
instance Data IntSet where
gfoldl f z is = z fromList `f` (toList is)
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Data.IntSet.IntSet"
+ toConstr _ = fromListConstr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z fromList)
+ _ -> error "gunfold"
+ dataTypeOf _ = intSetDataType
+
+fromListConstr :: Constr
+fromListConstr = mkConstr intSetDataType "fromList" [] Prefix
+
+intSetDataType :: DataType
+intSetDataType = mkDataType "Data.IntSet.Base.IntSet" [fromListConstr]
#endif
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index f393cc7..ca581d6 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -335,15 +335,23 @@ instance (Ord k) => Monoid (Map k v) where
--------------------------------------------------------------------}
-- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
+-- We provide limited reflection services for the sake of data abstraction.
instance (Data k, Data a, Ord k) => Data (Map k a) where
gfoldl f z m = z fromList `f` toList m
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Data.Map.Map"
+ toConstr _ = fromListConstr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z fromList)
+ _ -> error "gunfold"
+ dataTypeOf _ = mapDataType
dataCast2 f = gcast2 f
+fromListConstr :: Constr
+fromListConstr = mkConstr mapDataType "fromList" [] Prefix
+
+mapDataType :: DataType
+mapDataType = mkDataType "Data.Map.Base.Map" [fromListConstr]
+
#endif
{--------------------------------------------------------------------
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index 3d451b4..8d42247 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -248,15 +248,23 @@ instance Foldable.Foldable Set where
--------------------------------------------------------------------}
-- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
+-- We provide limited reflection services for the sake of data abstraction.
instance (Data a, Ord a) => Data (Set a) where
gfoldl f z set = z fromList `f` (toList set)
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Data.Set.Set"
+ toConstr _ = fromListConstr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z fromList)
+ _ -> error "gunfold"
+ dataTypeOf _ = setDataType
dataCast1 f = gcast1 f
+fromListConstr :: Constr
+fromListConstr = mkConstr setDataType "fromList" [] Prefix
+
+setDataType :: DataType
+setDataType = mkDataType "Data.Set.Base.Set" [fromListConstr]
+
#endif
{--------------------------------------------------------------------