Reduce use of instances in hs-boot files
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 20 Apr 2016 11:26:03 +0000 (12:26 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 20 Apr 2016 11:58:41 +0000 (12:58 +0100)
Several things here

* GHC no longer allows user-written Typeable instances,
  so remove them from hs-boot files.

* Generally, reduce the use of instances in hs-boot files. They are
  hard to track.  Mainly this involves using pprType, pprKind etc
  instead of just ppr.  There were a lot of instances in hs-boot
  files that weren't needed at all.

* Take TyThing out of Eq; it was used in exactly one place (in
  InteractiveEval), and equality is too big a hammer for that.

14 files changed:
compiler/basicTypes/ConLike.hs
compiler/basicTypes/ConLike.hs-boot
compiler/basicTypes/IdInfo.hs
compiler/basicTypes/PatSyn.hs
compiler/basicTypes/PatSyn.hs-boot
compiler/basicTypes/Var.hs
compiler/hsSyn/HsExpr.hs-boot
compiler/hsSyn/HsPat.hs-boot
compiler/main/InteractiveEval.hs
compiler/types/Class.hs
compiler/types/CoAxiom.hs
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs-boot
compiler/types/TyCon.hs

index 69d1836..6fd7731 100644 (file)
@@ -36,7 +36,6 @@ import TyCoRep (Type, ThetaType)
 import Var
 import Type (mkTyConApp)
 
-import Data.Function (on)
 import qualified Data.Data as Data
 import qualified Data.Typeable
 
@@ -62,8 +61,10 @@ data ConLike = RealDataCon DataCon
 -}
 
 instance Eq ConLike where
-    (==) = (==) `on` getUnique
-    (/=) = (/=) `on` getUnique
+    (==) = eqConLike
+
+eqConLike :: ConLike -> ConLike -> Bool
+eqConLike x y = getUnique x == getUnique y
 
 -- There used to be an Ord ConLike instance here that used Unique for ordering.
 -- It was intentionally removed to prevent determinism problems.
index c915364..1badc8d 100644 (file)
@@ -1,17 +1,9 @@
 module ConLike where
-import Data.Typeable
-import Name (NamedThing)
 import {-# SOURCE #-} DataCon (DataCon)
 import {-# SOURCE #-} PatSyn (PatSyn)
-import Outputable
-import Data.Data (Data)
+import Name ( Name )
 
 data ConLike = RealDataCon DataCon
              | PatSynCon PatSyn
 
-instance Eq ConLike
-instance Typeable ConLike
-instance NamedThing ConLike
-instance Data ConLike
-instance Outputable ConLike
-instance OutputableBndr ConLike
+conLikeName :: ConLike -> Name
index 849aea3..2113cd4 100644 (file)
@@ -77,7 +77,7 @@ import VarSet
 import BasicTypes
 import DataCon
 import TyCon
-import {-# SOURCE #-} PatSyn
+import PatSyn
 import ForeignCall
 import Outputable
 import Module
index e722879..b54a11d 100644 (file)
@@ -25,7 +25,6 @@ module PatSyn (
 #include "HsVersions.h"
 
 import Type
-import TcType( mkSpecSigmaTy )
 import Name
 import Outputable
 import Unique
@@ -436,5 +435,7 @@ pprPatSynType (MkPatSyn { psUnivTyVars = univ_tvs,  psReqTheta  = req_theta
         , ppWhen insert_empty_ctxt $ parens empty <+> darrow
         , pprType sigma_ty ]
   where
-    sigma_ty = mkSpecSigmaTy ex_tvs prov_theta $ mkFunTys orig_args orig_res_ty
+    sigma_ty = mkForAllTys (mkNamedBinders Specified ex_tvs) $
+               mkFunTys prov_theta $
+               mkFunTys orig_args orig_res_ty
     insert_empty_ctxt = null req_theta && not (null prov_theta && null ex_tvs)
index 07f24a5..1a79159 100644 (file)
@@ -1,9 +1,5 @@
 module PatSyn where
-import Name( NamedThing )
-import Data.Typeable ( Typeable )
-import Data.Data ( Data )
-import Outputable ( Outputable, OutputableBndr )
-import Unique ( Uniquable )
+
 import BasicTypes (Arity)
 import {-# SOURCE #-} TyCoRep (Type)
 import Var (TyVar)
@@ -15,14 +11,3 @@ patSynArity :: PatSyn -> Arity
 patSynInstArgTys :: PatSyn -> [Type] -> [Type]
 patSynExTyVars :: PatSyn -> [TyVar]
 patSynName :: PatSyn -> Name
-
-
-
-instance Eq PatSyn
-instance Ord PatSyn
-instance NamedThing PatSyn
-instance Outputable PatSyn
-instance OutputableBndr PatSyn
-instance Uniquable PatSyn
-instance Typeable PatSyn
-instance Data PatSyn
index d6bd609..e641976 100644 (file)
@@ -70,7 +70,7 @@ module Var (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}   TyCoRep( Type, Kind )
+import {-# SOURCE #-}   TyCoRep( Type, Kind, pprKind )
 import {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )
 import {-# SOURCE #-}   IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails, vanillaIdInfo, pprIdDetails )
 
@@ -237,7 +237,7 @@ instance Outputable Var where
             getPprStyle $ \ppr_style ->
             if |  debugStyle ppr_style && (not (gopt Opt_SuppressVarKinds dflags))
                  -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>
-                          dcolon <+> ppr (tyVarKind var))
+                          dcolon <+> pprKind (tyVarKind var))
                |  otherwise
                  -> ppr (varName var) <> ppr_debug var ppr_style
 
@@ -349,7 +349,7 @@ mkTcTyVar name kind details
 tcTyVarDetails :: TyVar -> TcTyVarDetails
 tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details
 tcTyVarDetails (TyVar {})                            = vanillaSkolemTv
-tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var <+> dcolon <+> ppr (tyVarKind var))
+tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var <+> dcolon <+> pprKind (tyVarKind var))
 
 setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
 setTcTyVarDetails tv details = tv { tc_tv_details = details }
index 7eeddd4..ff4b2bc 100644 (file)
@@ -26,12 +26,6 @@ data MatchGroup (a :: *) (body :: *)
 data GRHSs (a :: *) (body :: *)
 data SyntaxExpr (i :: *)
 
-instance Typeable HsSplice
-instance Typeable HsExpr
-instance Typeable MatchGroup
-instance Typeable GRHSs
-instance Typeable SyntaxExpr
-
 instance (DataId id) => Data (HsSplice id)
 instance (DataId id) => Data (HsExpr id)
 instance (DataId id) => Data (HsCmd id)
index c6ab5a5..6e000e3 100644 (file)
@@ -16,7 +16,5 @@ type role Pat nominal
 data Pat (i :: *)
 type LPat i = Located (Pat i)
 
-instance Typeable Pat
-
 instance (DataId id) => Data (Pat id)
 instance (OutputableBndr name) => Outputable (Pat name)
index d23fffe..e2b4c68 100644 (file)
@@ -402,8 +402,10 @@ resumeExec canLogSpan step
 
         -- remove any bindings created since the breakpoint from the
         -- linker's environment
-        let new_names = map getName (filter (`notElem` resume_tmp_te)
-                                           (ic_tythings ic))
+        let old_names = map getName resume_tmp_te
+            new_names = [ n | thing <- ic_tythings ic
+                            , let n = getName thing
+                            , not (n `elem` old_names) ]
         liftIO $ Linker.deleteFromLinkEnv new_names
 
         case r of
index 3337f0e..09c8da9 100644 (file)
@@ -24,7 +24,7 @@ module Class (
 #include "HsVersions.h"
 
 import {-# SOURCE #-} TyCon     ( TyCon, tyConName, tyConUnique )
-import {-# SOURCE #-} TyCoRep   ( Type, PredType )
+import {-# SOURCE #-} TyCoRep   ( Type, PredType, pprType )
 import Var
 import Name
 import BasicTypes
@@ -301,7 +301,7 @@ pprDefMethInfo :: DefMethInfo -> SDoc
 pprDefMethInfo Nothing                  = empty   -- No default method
 pprDefMethInfo (Just (n, VanillaDM))    = text "Default method" <+> ppr n
 pprDefMethInfo (Just (n, GenericDM ty)) = text "Generic default method"
-                                          <+> ppr n <+> dcolon <+> ppr ty
+                                          <+> ppr n <+> dcolon <+> pprType ty
 
 pprFundeps :: Outputable a => [FunDep a] -> SDoc
 pprFundeps []  = empty
index 3d00b14..fd5187c 100644 (file)
@@ -29,7 +29,7 @@ module CoAxiom (
        BuiltInSynFamily(..), trivialBuiltInFamily
        ) where
 
-import {-# SOURCE #-} TyCoRep ( Type )
+import {-# SOURCE #-} TyCoRep ( Type, pprType )
 import {-# SOURCE #-} TyCon ( TyCon )
 import Outputable
 import FastString
@@ -414,8 +414,9 @@ instance Outputable CoAxBranch where
   ppr (CoAxBranch { cab_loc = loc
                   , cab_lhs = lhs
                   , cab_rhs = rhs }) =
-    text "CoAxBranch" <+> parens (ppr loc) <> colon <+> ppr lhs <+>
-    text "=>" <+> ppr rhs
+    text "CoAxBranch" <+> parens (ppr loc) <> colon
+      <+> brackets (fsep (punctuate comma (map pprType lhs)))
+      <+> text "=>" <+> pprType rhs
 
 {-
 ************************************************************************
index 9033c30..ebbc386 100644 (file)
@@ -134,7 +134,7 @@ import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy
    -- Transitively pulls in a LOT of stuff, better to break the loop
 
 import {-# SOURCE #-} Coercion
-import {-# SOURCE #-} ConLike ( ConLike(..) )
+import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )
 import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedTy )
 
 -- friends:
@@ -1563,7 +1563,6 @@ data TyThing
   | AConLike ConLike
   | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]
   | ACoAxiom (CoAxiom Branched)
-  deriving (Eq)
 
 instance Outputable TyThing where
   ppr = pprTyThing
@@ -1585,7 +1584,7 @@ instance NamedThing TyThing where       -- Can't put this with the type
   getName (AnId id)     = getName id    -- decl, because the DataCon instance
   getName (ATyCon tc)   = getName tc    -- isn't visible there
   getName (ACoAxiom cc) = getName cc
-  getName (AConLike cl) = getName cl
+  getName (AConLike cl) = conLikeName cl
 
 {-
 %************************************************************************
index 5236bcc..0bcd9b3 100644 (file)
@@ -1,7 +1,7 @@
 module TyCoRep where
 
-import Outputable (Outputable)
-import Data.Data (Data,Typeable)
+import Outputable ( SDoc )
+import Data.Data  ( Data )
 
 data Type
 data TyBinder
@@ -17,6 +17,9 @@ type PredType = Type
 type Kind = Type
 type ThetaType = [PredType]
 
-instance Outputable Type
-instance Typeable Type
+pprKind :: Kind -> SDoc
+pprType :: Type -> SDoc
+
 instance Data Type
+  -- To support Data instances in CoAxiom
+
index 787da10..5a54690 100644 (file)
@@ -110,7 +110,7 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, mkForAllTys )
+import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkForAllTys )
 import {-# SOURCE #-} TysWiredIn  ( runtimeRepTyCon, constraintKind
                                   , vecCountTyCon, vecElemTyCon, liftedTypeKind )
 import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars, dataConFieldLabels )
@@ -750,8 +750,8 @@ instance Outputable AlgTyConFlav where
     ppr (VanillaAlgTyCon {})        = text "Vanilla ADT"
     ppr (UnboxedAlgTyCon {})        = text "Unboxed ADT"
     ppr (ClassTyCon cls _)          = text "Class parent" <+> ppr cls
-    ppr (DataFamInstTyCon _ tc tys) =
-        text "Family parent (family instance)" <+> ppr tc <+> sep (map ppr tys)
+    ppr (DataFamInstTyCon _ tc tys) = text "Family parent (family instance)"
+                                      <+> ppr tc <+> sep (map pprType tys)
 
 -- | Checks the invariants of a 'AlgTyConFlav' given the appropriate type class
 -- name, if any