Commit 81aa3d1c authored by Simon Peyton Jones's avatar Simon Peyton Jones

Reduce use of instances in hs-boot files

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.
parent 7f71dbe3
......@@ -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.
......
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
......@@ -77,7 +77,7 @@ import VarSet
import BasicTypes
import DataCon
import TyCon
import {-# SOURCE #-} PatSyn
import PatSyn
import ForeignCall
import Outputable
import Module
......
......@@ -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)
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
......@@ -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 }
......
......@@ -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)
......
......@@ -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)
......@@ -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
......
......@@ -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
......
......@@ -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
{-
************************************************************************
......
......@@ -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
{-
%************************************************************************
......
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
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment