diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index f83cb14cf67d268711aa517aaa33624566f88b2f..e22c46ba3aec1016703aec04afefb9be0ad51259 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -8,8 +8,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -248,9 +246,6 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
 import GHC.Exts (build)
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
-import GHC.Generics hiding (Prefix, prec, (:*:))
-import qualified GHC.Generics as Generics
-
 #endif
 import Text.Read
 #endif
@@ -420,39 +415,6 @@ intMapDataType = mkDataType "Data.IntMap.Base.IntMap" [fromListConstr]
 
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-
-{--------------------------------------------------------------------
-  A Generic instance
---------------------------------------------------------------------}
-
--- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
-type LP k = [] Generics.:.: Rec1 ((,) k)
-type Rep1IntMap = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (LP Key)))
-
-instance Generic1 IntMap where
-  type Rep1 IntMap = Rep1IntMap
-  from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
-  to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
-
-data D1IntMap
-data C1IntMap
-
-instance Datatype D1IntMap where
-  datatypeName _ = "IntMap"
-  moduleName   _ = "Data.IntMap.Base"
-
-instance Constructor C1IntMap  where
-  conName _ = "IntMap.fromList"
-
-type Rep0IntMap a = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (Rec0 [(Key, a)])))
-
-instance Generic (IntMap a) where
-  type Rep (IntMap a) = Rep0IntMap a
-  from m = M1 (M1 (M1 (K1 $ toList m)))
-  to (M1 (M1 (M1 (K1 l)))) = fromList l
-#endif
-
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
@@ -1617,7 +1579,7 @@ split k t =
   case t of
       Bin _ m l r
           | m < 0 -> if k >= 0 -- handle negative numbers.
-                     then case go k l of (lt :*: gt) -> let lt' = union r lt
+                     then case go k l of (lt :*: gt) -> let lt' = union r lt 
                                                         in lt' `seq` (lt', gt)
                      else case go k r of (lt :*: gt) -> let gt' = union gt l
                                                         in gt' `seq` (lt, gt')
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
index 1efed08128004a05839c474d2f8a364d9627f67d..3df44cb05dde5b26a1c04a7332ad24a2d9ff489d 100644
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -7,7 +7,6 @@
 #endif
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -193,7 +192,6 @@ import Text.Read
 import GHC.Exts (Int(..), build)
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
-import GHC.Generics hiding (Prefix, prec, (:*:))
 #endif
 import GHC.Prim (indexInt8OffAddr#)
 #endif
@@ -288,31 +286,6 @@ intSetDataType = mkDataType "Data.IntSet.Base.IntSet" [fromListConstr]
 
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-
-{--------------------------------------------------------------------
-  A Generic instance
---------------------------------------------------------------------}
-
-type Rep0IntSet = D1 D1IntSet (C1 C1IntSet (S1 NoSelector (Rec0 [Key])))
-
-instance Generic IntSet where
-    type Rep IntSet = Rep0IntSet
-    from s = M1 (M1 (M1 (K1 $ toList s)))
-    to (M1 (M1 (M1 (K1 t)))) = fromList t
-
-data D1IntSet
-data C1IntSet
-
-instance Datatype D1IntSet where
-    datatypeName _ = "IntSet"
-    moduleName   _ = "Data.IntSet.Base"
-
-instance Constructor C1IntSet where
-    conName     _ = "IntSet"
-    conIsRecord _ = False
-#endif
-
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 4fdbc58164a93b3af93446aa09c49977a54f9ce3..63931aa5c4111fe99d422304e871534f146fe9b6 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -8,8 +8,6 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -295,8 +293,6 @@ import Data.Utils.StrictPair
 import GHC.Exts ( build )
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
-import GHC.Generics hiding (Prefix, prec, (:*:))
-import qualified GHC.Generics as Generics
 #endif
 import Text.Read
 import Data.Data
@@ -381,39 +377,7 @@ fromListConstr = mkConstr mapDataType "fromList" [] Prefix
 
 mapDataType :: DataType
 mapDataType = mkDataType "Data.Map.Base.Map" [fromListConstr]
-#endif
-
-#if __GLASGOW_HASKELL__ >= 708
-
-{--------------------------------------------------------------------
-  A Generic instance
---------------------------------------------------------------------}
-
--- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
-type LP k = [] Generics.:.: Rec1 ((,) k)
-type Rep1Map k = D1 D1Map (C1 C1Map (S1 NoSelector (LP k)))
-
-instance (Eq k, Ord k) => Generic1 (Map k) where
-  type Rep1 (Map k) = Rep1Map k
-  from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
-  to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
-
-data D1Map
-data C1Map
-
-instance Datatype D1Map where
-  datatypeName _ = "Map"
-  moduleName   _ = "Data.Map.Base"
-
-instance Constructor C1Map  where
-  conName _ = "Map.fromList"
-
-type Rep0Map k v = D1 D1Map (C1 C1Map (S1 NoSelector (Rec0 [(k, v)])))
 
-instance (Eq k, Ord k) => Generic (Map k v) where
-  type Rep (Map k v) = Rep0Map k v
-  from m = M1 (M1 (M1 (K1 $ toList m)))
-  to (M1 (M1 (M1 (K1 l)))) = fromList l
 #endif
 
 {--------------------------------------------------------------------
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index 47efe85086bd3d18f7cc6ed84eebd28734386763..0be2af288a902971cfabda5c6ee85e16073ed311 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -8,8 +8,6 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -215,7 +213,6 @@ import Data.Utils.StrictPair
 import GHC.Exts ( build )
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
-import GHC.Generics hiding (Prefix, prec, (:*:))
 #endif
 import Text.Read
 import Data.Data
@@ -334,29 +331,6 @@ setDataType = mkDataType "Data.Set.Base.Set" [fromListConstr]
 
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-
-{--------------------------------------------------------------------
-  A Generic instance
---------------------------------------------------------------------}
-data D1Set
-data C1Set
-
-instance Datatype D1Set where
-  datatypeName _ = "Set"
-  moduleName   _ = "Data.Set.Base"
-
-instance Constructor C1Set  where
-  conName _ = "Set.fromList"
-
-type Rep0Set a = D1 D1Set (C1 C1Set (S1 NoSelector (Rec0 [a])))
-
-instance (Eq a, Ord a) => Generic (Set a) where
-  type Rep (Set a) = Rep0Set a
-  from s = M1 (M1 (M1 (K1 $ toList s)))
-  to (M1 (M1 (M1 (K1 l)))) = fromList l
-#endif
-
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}