Repository : ssh://[email protected]/containers On branch : ghc-head Link : http://git.haskell.org/?p=packages/containers.git;a=commit;h=f1f58da8fcb65c715b6ca06ce4c1039b4c81d9d0
>--------------------------------------------------------------- commit f1f58da8fcb65c715b6ca06ce4c1039b4c81d9d0 Author: Edward Kmett <[email protected]> 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 {-------------------------------------------------------------------- _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
