[commit: packages/containers] cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394: Clean up Typeable; derive more Generic (9f54bd0)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:43:43 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/9f54bd0d59f2a1dcb19d73e40f8d6eeb7f028fa7

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

commit 9f54bd0d59f2a1dcb19d73e40f8d6eeb7f028fa7
Author: David Feuer <David.Feuer at gmail.com>
Date:   Sat Jun 11 00:02:58 2016 -0400

    Clean up Typeable; derive more Generic
    
    * Remove gunk apparently intended to support `Typeable` for
    Hugs.
    
    * Derive `Generic` and `Generic1` for `Data.Sequence.ViewL`
    and `Data.Sequence.ViewR`.


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

9f54bd0d59f2a1dcb19d73e40f8d6eeb7f028fa7
 Data/IntMap/Base.hs  |  2 +-
 Data/IntSet/Base.hs  |  2 +-
 Data/Map/Base.hs     |  2 +-
 Data/Sequence.hs     | 38 +++++++++++++++++++++++++++++---------
 Data/Set/Base.hs     |  2 +-
 Data/Tree.hs         |  2 +-
 changelog.md         |  3 ++-
 include/containers.h | 24 +++++++++---------------
 8 files changed, 45 insertions(+), 30 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index a585328..845a590 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -2126,7 +2126,7 @@ instance (Read e) => Read (IntMap e) where
   Typeable
 --------------------------------------------------------------------}
 
-INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
+INSTANCE_TYPEABLE1(IntMap)
 
 {--------------------------------------------------------------------
   Helpers
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
index 3ceb303..aa94471 100644
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -1075,7 +1075,7 @@ instance Read IntSet where
   Typeable
 --------------------------------------------------------------------}
 
-INSTANCE_TYPEABLE0(IntSet,intSetTc,"IntSet")
+INSTANCE_TYPEABLE0(IntSet)
 
 {--------------------------------------------------------------------
   NFData
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index b86df31..8febcbf 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -3124,7 +3124,7 @@ withEmpty bars = "   ":bars
   Typeable
 --------------------------------------------------------------------}
 
-INSTANCE_TYPEABLE2(Map,mapTc,"Map")
+INSTANCE_TYPEABLE2(Map)
 
 {--------------------------------------------------------------------
   Assertions
diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index d0d7ff1..9b8ce23 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -12,6 +12,9 @@
 #if __GLASGOW_HASKELL__ >= 703
 {-# LANGUAGE Trustworthy #-}
 #endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+#endif
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
 #endif
@@ -229,6 +232,11 @@ import Text.Read (Lexeme(Ident), lexP, parens, prec,
 import Data.Data
 import Data.String (IsString(..))
 #endif
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics (Generic, Generic1)
+#elif __GLASGOW_HASKELL__ >= 702
+import GHC.Generics (Generic)
+#endif
 
 -- Array stuff, with GHC.Arr on GHC
 import Data.Array (Ix, Array)
@@ -735,7 +743,7 @@ instance Semigroup.Semigroup (Seq a) where
     (<>)    = (><)
 #endif
 
-INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
+INSTANCE_TYPEABLE1(Seq)
 
 #if __GLASGOW_HASKELL__
 instance Data a => Data (Seq a) where
@@ -1607,13 +1615,19 @@ data ViewRTree a = SnocRTree (FingerTree a) a | EmptyRTree
 data ViewL a
     = EmptyL        -- ^ empty sequence
     | a :< Seq a    -- ^ leftmost element and the rest of the sequence
-#if __GLASGOW_HASKELL__
-    deriving (Eq, Ord, Show, Read, Data)
-#else
     deriving (Eq, Ord, Show, Read)
+
+#if __GLASGOW_HASKELL__
+deriving instance Data a => Data (ViewL a)
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+deriving instance Generic1 ViewL
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (ViewL a)
 #endif
 
-INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
+INSTANCE_TYPEABLE1(ViewL)
 
 instance Functor ViewL where
     {-# INLINE fmap #-}
@@ -1666,13 +1680,19 @@ data ViewR a
     = EmptyR        -- ^ empty sequence
     | Seq a :> a    -- ^ the sequence minus the rightmost element,
             -- and the rightmost element
-#if __GLASGOW_HASKELL__
-    deriving (Eq, Ord, Show, Read, Data)
-#else
     deriving (Eq, Ord, Show, Read)
+
+#if __GLASGOW_HASKELL__
+deriving instance Data a => Data (ViewR a)
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+deriving instance Generic1 ViewR
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (ViewR a)
 #endif
 
-INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
+INSTANCE_TYPEABLE1(ViewR)
 
 instance Functor ViewR where
     {-# INLINE fmap #-}
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index b141022..92bfc1d 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -988,7 +988,7 @@ instance (Read a, Ord a) => Read (Set a) where
   Typeable/Data
 --------------------------------------------------------------------}
 
-INSTANCE_TYPEABLE1(Set,setTc,"Set")
+INSTANCE_TYPEABLE1(Set)
 
 {--------------------------------------------------------------------
   NFData
diff --git a/Data/Tree.hs b/Data/Tree.hs
index f4cf2e9..d6d2726 100644
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -83,7 +83,7 @@ data Tree a = Node {
 #endif
 type Forest a = [Tree a]
 
-INSTANCE_TYPEABLE1(Tree,treeTc,"Tree")
+INSTANCE_TYPEABLE1(Tree)
 
 instance Functor Tree where
     fmap = fmapTree
diff --git a/changelog.md b/changelog.md
index 874f13a..4afe114 100644
--- a/changelog.md
+++ b/changelog.md
@@ -30,7 +30,8 @@
   * Add `(!?)`, `lookup`, `chunksOf`, `cycleTaking`, `insertAt`, `deleteAt`, `intersperse`,
     `foldMapWithIndex`, and `traverseWithIndex` for `Data.Sequence`.
 
-  * Derive `Generic` and `Generic1` for `Data.Tree`.
+  * Derive `Generic` and `Generic1` for `Data.Tree.Tree`, `Data.Sequence.ViewL`,
+    and `Data.Sequence.ViewR`.
 
   * Add `foldTree` for `Data.Tree`. (Thanks, Daniel Wagner!)
 
diff --git a/include/containers.h b/include/containers.h
index b2d6e63..273c1b2 100644
--- a/include/containers.h
+++ b/include/containers.h
@@ -16,23 +16,17 @@
  * Define INSTANCE_TYPEABLE[0-2]
  */
 #if __GLASGOW_HASKELL__ >= 707
-#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
-#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon
-#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable tycon
 #elif defined(__GLASGOW_HASKELL__)
-#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
-#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon
-#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon
+#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable1 tycon
+#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable2 tycon
 #else
-#define INSTANCE_TYPEABLE0(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \
-  instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }
-#define INSTANCE_TYPEABLE1(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \
-  instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \
-  instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }
-#define INSTANCE_TYPEABLE2(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \
-  instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \
-  instance Typeable a => Typeable1 (tycon a) where { typeOf1 = typeOf1Default }; \
-  instance (Typeable a, Typeable b) => Typeable (tycon a b) where { typeOf = typeOfDefault }
+#define INSTANCE_TYPEABLE0(tycon)
+#define INSTANCE_TYPEABLE1(tycon)
+#define INSTANCE_TYPEABLE2(tycon)
 #endif
 
 /*



More information about the ghc-commits mailing list