summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2019-10-25 11:20:48 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-10-28 09:22:35 -0400
commite951f219597a3e8209abd62f85c717865f7445ca (patch)
treef1036c6a31758fb835179fc147ab4830c0b61c20
parente0e0485634d9a047b43da958c09e3bf6c5937c0f (diff)
downloadhaskell-e951f219597a3e8209abd62f85c717865f7445ca.tar.gz
Use FlexibleInstances for `Outputable (* p)` instead of match-all instances with equality constraints
In #17304, Richard and Simon dicovered that using `-XFlexibleInstances` for `Outputable` instances of AST data types means users can provide orphan `Outputable` instances for passes other than `GhcPass`. Type inference doesn't currently to suffer, and Richard gave an example in #17304 that shows how rare a case would be where the slightly worse type inference would matter. So I went ahead with the refactoring, attempting to fix #17304.
-rw-r--r--compiler/GHC/Hs.hs2
-rw-r--r--compiler/GHC/Hs/Binds.hs48
-rw-r--r--compiler/GHC/Hs/Decls.hs107
-rw-r--r--compiler/GHC/Hs/Expr.hs114
-rw-r--r--compiler/GHC/Hs/Expr.hs-boot19
-rw-r--r--compiler/GHC/Hs/Extension.hs18
-rw-r--r--compiler/GHC/Hs/ImpExp.hs7
-rw-r--r--compiler/GHC/Hs/Lit.hs7
-rw-r--r--compiler/GHC/Hs/Pat.hs14
-rw-r--r--compiler/GHC/Hs/Pat.hs-boot3
-rw-r--r--compiler/GHC/Hs/Types.hs52
-rw-r--r--compiler/parser/RdrHsSyn.hs11
-rw-r--r--compiler/typecheck/TcAnnotations.hs2
-rw-r--r--compiler/typecheck/TcBinds.hs4
-rw-r--r--compiler/typecheck/TcEnv.hs4
-rw-r--r--compiler/typecheck/TcRnExports.hs2
m---------utils/haddock0
17 files changed, 209 insertions, 205 deletions
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index aa345f1476..103539a41b 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -118,7 +118,7 @@ deriving instance Data (HsModule GhcPs)
deriving instance Data (HsModule GhcRn)
deriving instance Data (HsModule GhcTc)
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsModule p) where
+instance (OutputableBndrId p) => Outputable (HsModule (GhcPass p)) where
ppr (HsModule Nothing _ imports decls _ mbDoc)
= pp_mb mbDoc $$ pp_nonnull imports
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 01c10b1ea1..3089f042a7 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -11,6 +11,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -617,17 +618,15 @@ Specifically,
it's just an error thunk
-}
-instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
- OutputableBndrId idL, OutputableBndrId idR)
- => Outputable (HsLocalBindsLR idL idR) where
+instance (OutputableBndrId pl, OutputableBndrId pr)
+ => Outputable (HsLocalBindsLR (GhcPass pl) (GhcPass pr)) where
ppr (HsValBinds _ bs) = ppr bs
ppr (HsIPBinds _ bs) = ppr bs
ppr (EmptyLocalBinds _) = empty
ppr (XHsLocalBindsLR x) = ppr x
-instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
- OutputableBndrId idL, OutputableBndrId idR)
- => Outputable (HsValBindsLR idL idR) where
+instance (OutputableBndrId pl, OutputableBndrId pr)
+ => Outputable (HsValBindsLR (GhcPass pl) (GhcPass pr)) where
ppr (ValBinds _ binds sigs)
= pprDeclList (pprLHsBindsForUser binds sigs)
@@ -642,15 +641,15 @@ instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
pp_rec Recursive = text "rec"
pp_rec NonRecursive = text "nonrec"
-pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+pprLHsBinds :: (OutputableBndrId idL, OutputableBndrId idR)
=> LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds binds
| isEmptyLHsBinds binds = empty
| otherwise = pprDeclList (map ppr (bagToList binds))
-pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),
- OutputableBndrId (GhcPass idR),
- OutputableBndrId (GhcPass id2))
+pprLHsBindsForUser :: (OutputableBndrId idL,
+ OutputableBndrId idR,
+ OutputableBndrId id2)
=> LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
-- pprLHsBindsForUser is different to pprLHsBinds because
-- a) No braces: 'let' and 'where' include a list of HsBindGroups
@@ -725,12 +724,11 @@ plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
plusHsValBinds _ _
= panic "HsBinds.plusHsValBinds"
-instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
- OutputableBndrId idL, OutputableBndrId idR)
- => Outputable (HsBindLR idL idR) where
+instance (OutputableBndrId pl, OutputableBndrId pr)
+ => Outputable (HsBindLR (GhcPass pl) (GhcPass pr)) where
ppr mbind = ppr_monobind mbind
-ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+ppr_monobind :: (OutputableBndrId idL, OutputableBndrId idR)
=> HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
@@ -766,16 +764,16 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
pprLHsBinds val_binds
ppr_monobind (XHsBindsLR x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
+instance OutputableBndrId p => Outputable (ABExport (GhcPass p)) where
ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
= vcat [ ppr gbl <+> text "<=" <+> ppr lcl
, nest 2 (pprTcSpecPrags prags)
, nest 2 (text "wrap:" <+> ppr wrap)]
ppr (XABExport x) = ppr x
-instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,
- Outputable (XXPatSynBind idL idR))
- => Outputable (PatSynBind idL idR) where
+instance (OutputableBndrId l, OutputableBndrId r,
+ Outputable (XXPatSynBind (GhcPass l) (GhcPass r)))
+ => Outputable (PatSynBind (GhcPass l) (GhcPass r)) where
ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
psb_dir = dir })
= ppr_lhs <+> ppr_rhs
@@ -866,13 +864,13 @@ data IPBind id
type instance XCIPBind (GhcPass p) = NoExtField
type instance XXIPBind (GhcPass p) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsIPBinds p) where
+instance OutputableBndrId p
+ => Outputable (HsIPBinds (GhcPass p)) where
ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)
$$ whenPprDebug (ppr ds)
ppr (XHsIPBinds x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
+instance OutputableBndrId p => Outputable (IPBind (GhcPass p)) where
ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
where name = case lr of
Left (L _ ip) -> pprBndr LetBind ip
@@ -1168,10 +1166,10 @@ signatures. Since some of the signatures contain a list of names, testing for
equality is not enough -- we have to check if they overlap.
-}
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where
+instance OutputableBndrId p => Outputable (Sig (GhcPass p)) where
ppr sig = ppr_sig sig
-ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc
+ppr_sig :: (OutputableBndrId p) => Sig (GhcPass p) -> SDoc
ppr_sig (TypeSig _ vars ty) = pprVarSig (map unLoc vars) (ppr ty)
ppr_sig (ClassOpSig _ is_deflt vars ty)
| is_deflt = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
@@ -1204,8 +1202,8 @@ ppr_sig (CompleteMatchSig _ src cs mty)
opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
ppr_sig (XSig x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (FixitySig p) where
+instance OutputableBndrId p
+ => Outputable (FixitySig (GhcPass p)) where
ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
where
pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index c43a27cef2..f095a3ffeb 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -7,6 +7,7 @@
DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -274,7 +275,7 @@ appendGroups
hs_docs = docs1 ++ docs2 }
appendGroups _ _ = panic "appendGroups"
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
+instance (OutputableBndrId p) => Outputable (HsDecl (GhcPass p)) where
ppr (TyClD _ dcl) = ppr dcl
ppr (ValD _ binds) = ppr binds
ppr (DefD _ def) = ppr def
@@ -291,7 +292,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
ppr (RoleAnnotD _ ra) = ppr ra
ppr (XHsDecl x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
+instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where
ppr (HsGroup { hs_valds = val_decls,
hs_tyclds = tycl_decls,
hs_derivds = deriv_decls,
@@ -340,8 +341,8 @@ data SpliceDecl p
type instance XSpliceDecl (GhcPass _) = NoExtField
type instance XXSpliceDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (SpliceDecl p) where
+instance OutputableBndrId p
+ => Outputable (SpliceDecl (GhcPass p)) where
ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
ppr (XSpliceDecl x) = ppr x
@@ -707,7 +708,7 @@ hsDeclHasCusk (XTyClDecl nec) = noExtCon nec
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
+instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where
ppr (FamDecl { tcdFam = decl }) = ppr decl
ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
@@ -740,8 +741,8 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
ppr (XTyClDecl x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (TyClGroup p) where
+instance OutputableBndrId p
+ => Outputable (TyClGroup (GhcPass p)) where
ppr (TyClGroup { group_tyclds = tyclds
, group_roles = roles
, group_kisigs = kisigs
@@ -755,7 +756,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
ppr instds
ppr (XTyClGroup x) = ppr x
-pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
+pp_vanilla_decl_head :: (OutputableBndrId p)
=> Located (IdP (GhcPass p))
-> LHsQTyVars (GhcPass p)
-> LexicalFixity
@@ -1105,11 +1106,11 @@ resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
resultVariableName _ = Nothing
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (FamilyDecl p) where
+instance OutputableBndrId p
+ => Outputable (FamilyDecl (GhcPass p)) where
ppr = pprFamilyDecl TopLevel
-pprFamilyDecl :: (OutputableBndrId (GhcPass p))
+pprFamilyDecl :: (OutputableBndrId p)
=> TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
, fdTyVars = tyvars
@@ -1238,8 +1239,8 @@ data HsDerivingClause pass
type instance XCHsDerivingClause (GhcPass _) = NoExtField
type instance XXHsDerivingClause (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsDerivingClause p) where
+instance OutputableBndrId p
+ => Outputable (HsDerivingClause (GhcPass p)) where
ppr (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ dct })
= hsep [ text "deriving"
@@ -1439,7 +1440,7 @@ hsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]
hsConDeclTheta Nothing = []
hsConDeclTheta (Just (L _ theta)) = theta
-pp_data_defn :: (OutputableBndrId (GhcPass p))
+pp_data_defn :: (OutputableBndrId p)
=> (LHsContext (GhcPass p) -> SDoc) -- Printing the header
-> HsDataDefn (GhcPass p)
-> SDoc
@@ -1464,12 +1465,12 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context
pp_derivings (L _ ds) = vcat (map ppr ds)
pp_data_defn _ (XHsDataDefn x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsDataDefn p) where
+instance OutputableBndrId p
+ => Outputable (HsDataDefn (GhcPass p)) where
ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (StandaloneKindSig p) where
+instance OutputableBndrId p
+ => Outputable (StandaloneKindSig (GhcPass p)) where
ppr (StandaloneKindSig _ v ki) = text "type" <+> ppr v <+> text "::" <+> ppr ki
ppr (XStandaloneKindSig nec) = noExtCon nec
@@ -1477,16 +1478,16 @@ instance Outputable NewOrData where
ppr NewType = text "newtype"
ppr DataType = text "data"
-pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc
+pp_condecls :: (OutputableBndrId p) => [LConDecl (GhcPass p)] -> SDoc
pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
= hang (text "where") 2 (vcat (map ppr cs))
pp_condecls cs -- In H98 syntax
= equals <+> sep (punctuate (text " |") (map ppr cs))
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where
+instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where
ppr = pprConDecl
-pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc
+pprConDecl :: (OutputableBndrId p) => ConDecl (GhcPass p) -> SDoc
pprConDecl (ConDeclH98 { con_name = L _ con
, con_ex_tvs = ex_tvs
, con_mb_cxt = mcxt
@@ -1726,11 +1727,11 @@ type instance XDataFamInstD (GhcPass _) = NoExtField
type instance XTyFamInstD (GhcPass _) = NoExtField
type instance XXInstDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (TyFamInstDecl p) where
+instance OutputableBndrId p
+ => Outputable (TyFamInstDecl (GhcPass p)) where
ppr = pprTyFamInstDecl TopLevel
-pprTyFamInstDecl :: (OutputableBndrId (GhcPass p))
+pprTyFamInstDecl :: (OutputableBndrId p)
=> TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
= text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
@@ -1739,11 +1740,11 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc
ppr_instance_keyword TopLevel = text "instance"
ppr_instance_keyword NotTopLevel = empty
-pprTyFamDefltDecl :: (OutputableBndrId (GhcPass p))
+pprTyFamDefltDecl :: (OutputableBndrId p)
=> TyFamDefltDecl (GhcPass p) -> SDoc
pprTyFamDefltDecl = pprTyFamInstDecl NotTopLevel
-ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))
+ppr_fam_inst_eqn :: (OutputableBndrId p)
=> TyFamInstEqn (GhcPass p) -> SDoc
ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ tycon
, feqn_bndrs = bndrs
@@ -1754,11 +1755,11 @@ ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ tycon
ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x
ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (DataFamInstDecl p) where
+instance OutputableBndrId p
+ => Outputable (DataFamInstDecl (GhcPass p)) where
ppr = pprDataFamInstDecl TopLevel
-pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))
+pprDataFamInstDecl :: (OutputableBndrId p)
=> TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_tycon = L _ tycon
@@ -1789,7 +1790,7 @@ pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))
pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))
= ppr x
-pprHsFamInstLHS :: (OutputableBndrId (GhcPass p))
+pprHsFamInstLHS :: (OutputableBndrId p)
=> IdP (GhcPass p)
-> Maybe [LHsTyVarBndr (GhcPass p)]
-> HsTyPats (GhcPass p)
@@ -1811,8 +1812,8 @@ pprHsFamInstLHS thing bndrs typats fixity mb_ctxt
pp_pats pats = hsep [ pprPrefixOcc thing
, hsep (map ppr pats)]
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (ClsInstDecl p) where
+instance OutputableBndrId p
+ => Outputable (ClsInstDecl (GhcPass p)) where
ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
, cid_sigs = sigs, cid_tyfam_insts = ats
, cid_overlap_mode = mbOverlap
@@ -1831,8 +1832,8 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
<+> ppr inst_ty
ppr (XClsInstDecl x) = ppr x
-ppDerivStrategy :: (p ~ GhcPass pass, OutputableBndrId p)
- => Maybe (LDerivStrategy p) -> SDoc
+ppDerivStrategy :: OutputableBndrId p
+ => Maybe (LDerivStrategy (GhcPass p)) -> SDoc
ppDerivStrategy mb =
case mb of
Nothing -> empty
@@ -1852,7 +1853,7 @@ ppOverlapPragma mb =
maybe_stext (SourceText src) _ = text src <+> text "#-}"
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
+instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where
ppr (ClsInstD { cid_inst = decl }) = ppr decl
ppr (TyFamInstD { tfid_inst = decl }) = ppr decl
ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
@@ -1911,8 +1912,8 @@ data DerivDecl pass = DerivDecl
type instance XCDerivDecl (GhcPass _) = NoExtField
type instance XXDerivDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (DerivDecl p) where
+instance OutputableBndrId p
+ => Outputable (DerivDecl (GhcPass p)) where
ppr (DerivDecl { deriv_type = ty
, deriv_strategy = ds
, deriv_overlap_mode = o })
@@ -1951,8 +1952,8 @@ type instance XViaStrategy GhcPs = LHsSigType GhcPs
type instance XViaStrategy GhcRn = LHsSigType GhcRn
type instance XViaStrategy GhcTc = Type
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (DerivStrategy p) where
+instance OutputableBndrId p
+ => Outputable (DerivStrategy (GhcPass p)) where
ppr StockStrategy = text "stock"
ppr AnyclassStrategy = text "anyclass"
ppr NewtypeStrategy = text "newtype"
@@ -2009,8 +2010,8 @@ data DefaultDecl pass
type instance XCDefaultDecl (GhcPass _) = NoExtField
type instance XXDefaultDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (DefaultDecl p) where
+instance OutputableBndrId p
+ => Outputable (DefaultDecl (GhcPass p)) where
ppr (DefaultDecl _ tys)
= text "default" <+> parens (interpp'SP tys)
ppr (XDefaultDecl x) = ppr x
@@ -2117,8 +2118,8 @@ data ForeignExport = CExport (Located CExportSpec) -- contains the calling
-- pretty printing of foreign declarations
--
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (ForeignDecl p) where
+instance OutputableBndrId p
+ => Outputable (ForeignDecl (GhcPass p)) where
ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
= hang (text "foreign import" <+> ppr fimport <+> ppr n)
2 (dcolon <+> ppr ty)
@@ -2244,14 +2245,14 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecls p) where
+instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where
ppr (HsRules { rds_src = st
, rds_rules = rules })
= pprWithSourceText st (text "{-# RULES")
<+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
ppr (XRuleDecls x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
+instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where
ppr (HsRule { rd_name = name
, rd_act = act
, rd_tyvs = tys
@@ -2269,7 +2270,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot
ppr (XRuleDecl x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
+instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where
ppr (RuleBndr _ name) = ppr name
ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)
ppr (XRuleBndr x) = ppr x
@@ -2338,15 +2339,15 @@ type instance XWarning (GhcPass _) = NoExtField
type instance XXWarnDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass,OutputableBndr (IdP p))
- => Outputable (WarnDecls p) where
+instance OutputableBndr (IdP (GhcPass p))
+ => Outputable (WarnDecls (GhcPass p)) where
ppr (Warnings _ (SourceText src) decls)
= text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"
ppr (XWarnDecls x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndr (IdP p))
- => Outputable (WarnDecl p) where
+instance OutputableBndr (IdP (GhcPass p))
+ => Outputable (WarnDecl (GhcPass p)) where
ppr (Warning _ thing txt)
= hsep ( punctuate comma (map ppr thing))
<+> ppr txt
@@ -2379,7 +2380,7 @@ data AnnDecl pass = HsAnnotation
type instance XHsAnnotation (GhcPass _) = NoExtField
type instance XXAnnDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
+instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where
ppr (HsAnnotation _ _ provenance expr)
= hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
ppr (XAnnDecl x) = ppr x
@@ -2432,8 +2433,8 @@ data RoleAnnotDecl pass
type instance XCRoleAnnotDecl (GhcPass _) = NoExtField
type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndr (IdP p))
- => Outputable (RoleAnnotDecl p) where
+instance OutputableBndr (IdP (GhcPass p))
+ => Outputable (RoleAnnotDecl (GhcPass p)) where
ppr (RoleAnnotDecl _ ltycon roles)
= text "type role" <+> pprPrefixOcc (unLoc ltycon) <+>
hsep (map (pp_role . unLoc) roles)
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 91c532d2d9..7a9caa8c6e 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -133,8 +134,8 @@ mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name
-- don't care about filling in syn_arg_wraps because we're clearly
-- not past the typechecker
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (SyntaxExpr p) where
+instance OutputableBndrId p
+ => Outputable (SyntaxExpr (GhcPass p)) where
ppr (SyntaxExpr { syn_expr = expr
, syn_arg_wraps = arg_wraps
, syn_res_wrap = res_wrap })
@@ -811,16 +812,16 @@ an empty ExplicitList when -XOverloadedLists.
See also #13680, which requested [] @Int to work.
-}
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where
+instance (OutputableBndrId p) => Outputable (HsExpr (GhcPass p)) where
ppr expr = pprExpr expr
-----------------------
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
-- the underscore versions do not
-pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+pprLExpr :: (OutputableBndrId p) => LHsExpr (GhcPass p) -> SDoc
pprLExpr (L _ e) = pprExpr e
-pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
+pprExpr :: (OutputableBndrId p) => HsExpr (GhcPass p) -> SDoc
pprExpr e | isAtomicHsExpr e || isQuietHsExpr e = ppr_expr e
| otherwise = pprDeeper (ppr_expr e)
@@ -835,15 +836,15 @@ isQuietHsExpr (HsAppType {}) = True
isQuietHsExpr (OpApp {}) = True
isQuietHsExpr _ = False
-pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+pprBinds :: (OutputableBndrId idL, OutputableBndrId idR)
=> HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprBinds b = pprDeeper (ppr b)
-----------------------
-ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+ppr_lexpr :: (OutputableBndrId p) => LHsExpr (GhcPass p) -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
-ppr_expr :: forall p. (OutputableBndrId (GhcPass p))
+ppr_expr :: forall p. (OutputableBndrId p)
=> HsExpr (GhcPass p) -> SDoc
ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v
ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc uv
@@ -1029,7 +1030,7 @@ ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
ppr_expr (HsRecFld _ f) = ppr f
ppr_expr (XExpr x) = ppr x
-ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc
+ppr_infix_expr :: (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc
ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
ppr_infix_expr (HsConLikeOut _ c) = Just (pprInfixOcc (conLikeName c))
ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f)
@@ -1037,7 +1038,7 @@ ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)
ppr_infix_expr (HsWrap _ _ e) = ppr_infix_expr e
ppr_infix_expr _ = Nothing
-ppr_apps :: (OutputableBndrId (GhcPass p))
+ppr_apps :: (OutputableBndrId p)
=> HsExpr (GhcPass p)
-> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
-> SDoc
@@ -1069,18 +1070,18 @@ fixities should do the job, except in debug mode (-dppr-debug) so we
can see the structure of the parse tree.
-}
-pprDebugParendExpr :: (OutputableBndrId (GhcPass p))
+pprDebugParendExpr :: (OutputableBndrId p)
=> PprPrec -> LHsExpr (GhcPass p) -> SDoc
pprDebugParendExpr p expr
= getPprStyle (\sty ->
if debugStyle sty then pprParendLExpr p expr
else pprLExpr expr)
-pprParendLExpr :: (OutputableBndrId (GhcPass p))
+pprParendLExpr :: (OutputableBndrId p)
=> PprPrec -> LHsExpr (GhcPass p) -> SDoc
pprParendLExpr p (L _ e) = pprParendExpr p e
-pprParendExpr :: (OutputableBndrId (GhcPass p))
+pprParendExpr :: (OutputableBndrId p)
=> PprPrec -> HsExpr (GhcPass p) -> SDoc
pprParendExpr p expr
| hsExprNeedsParens p expr = parens (pprExpr expr)
@@ -1316,16 +1317,16 @@ type instance XCmdTop GhcTc = CmdTopTc
type instance XXCmdTop (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
+instance (OutputableBndrId p) => Outputable (HsCmd (GhcPass p)) where
ppr cmd = pprCmd cmd
-----------------------
-- pprCmd and pprLCmd call pprDeeper;
-- the underscore versions do not
-pprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
+pprLCmd :: (OutputableBndrId p) => LHsCmd (GhcPass p) -> SDoc
pprLCmd (L _ c) = pprCmd c
-pprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
+pprCmd :: (OutputableBndrId p) => HsCmd (GhcPass p) -> SDoc
pprCmd c | isQuietHsCmd c = ppr_cmd c
| otherwise = pprDeeper (ppr_cmd c)
@@ -1339,10 +1340,10 @@ isQuietHsCmd (HsCmdApp {}) = True
isQuietHsCmd _ = False
-----------------------
-ppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
+ppr_lcmd :: (OutputableBndrId p) => LHsCmd (GhcPass p) -> SDoc
ppr_lcmd c = ppr_cmd (unLoc c)
-ppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
+ppr_cmd :: forall p. (OutputableBndrId p) => HsCmd (GhcPass p) -> SDoc
ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
ppr_cmd (HsCmdApp _ c e)
@@ -1404,12 +1405,12 @@ ppr_cmd (HsCmdArrForm _ op _ _ args)
4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
ppr_cmd (XCmd x) = ppr x
-pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc
+pprCmdArg :: (OutputableBndrId p) => HsCmdTop (GhcPass p) -> SDoc
pprCmdArg (HsCmdTop _ cmd)
= ppr_lcmd cmd
pprCmdArg (XCmdTop x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmdTop p) where
+instance (OutputableBndrId p) => Outputable (HsCmdTop (GhcPass p)) where
ppr = pprCmdArg
{-
@@ -1485,8 +1486,8 @@ data Match p body
type instance XCMatch (GhcPass _) b = NoExtField
type instance XXMatch (GhcPass _) b = NoExtCon
-instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
- => Outputable (Match idR body) where
+instance (OutputableBndrId pr, Outputable body)
+ => Outputable (Match (GhcPass pr) body) where
ppr = pprMatch
{-
@@ -1591,7 +1592,7 @@ type instance XXGRHS (GhcPass _) b = NoExtCon
-- We know the list must have at least one @Match@ in it.
-pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprMatches :: (OutputableBndrId idR, Outputable body)
=> MatchGroup (GhcPass idR) body -> SDoc
pprMatches MG { mg_alts = matches }
= vcat (map pprMatch (map unLoc (unLoc matches)))
@@ -1599,20 +1600,20 @@ pprMatches MG { mg_alts = matches }
pprMatches (XMatchGroup x) = ppr x
-- Exported to GHC.Hs.Binds, which can't see the defn of HsMatchContext
-pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprFunBind :: (OutputableBndrId idR, Outputable body)
=> MatchGroup (GhcPass idR) body -> SDoc
pprFunBind matches = pprMatches matches
-- Exported to GHC.Hs.Binds, which can't see the defn of HsMatchContext
-pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
- OutputableBndrId (GhcPass p),
+pprPatBind :: forall bndr p body. (OutputableBndrId bndr,
+ OutputableBndrId p,
Outputable body)
=> LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
pprPatBind pat (grhss)
= sep [ppr pat,
nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]
-pprMatch :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprMatch :: (OutputableBndrId idR, Outputable body)
=> Match (GhcPass idR) body -> SDoc
pprMatch match
= sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)
@@ -1650,7 +1651,7 @@ pprMatch match
(pat1:pats1) = m_pats match
(pat2:pats2) = pats1
-pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprGRHSs :: (OutputableBndrId idR, Outputable body)
=> HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc
pprGRHSs ctxt (GRHSs _ grhss (L _ binds))
= vcat (map (pprGRHS ctxt . unLoc) grhss)
@@ -1660,7 +1661,7 @@ pprGRHSs ctxt (GRHSs _ grhss (L _ binds))
(text "where" $$ nest 4 (pprBinds binds))
pprGRHSs _ (XGRHSs x) = ppr x
-pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprGRHS :: (OutputableBndrId idR, Outputable body)
=> HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc
pprGRHS ctxt (GRHS _ [] body)
= pp_rhs ctxt body
@@ -2104,14 +2105,13 @@ instance (Outputable (StmtLR idL idL (LHsExpr idL)),
ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts
ppr (XParStmtBlock x) = ppr x
-instance (idL ~ GhcPass pl,idR ~ GhcPass pr,
- OutputableBndrId idL, OutputableBndrId idR,
+instance (OutputableBndrId pl, OutputableBndrId pr,
Outputable body)
- => Outputable (StmtLR idL idR body) where
+ => Outputable (StmtLR (GhcPass pl) (GhcPass pr) body) where
ppr stmt = pprStmt stmt
-pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),
- OutputableBndrId (GhcPass idR),
+pprStmt :: forall idL idR body . (OutputableBndrId idL,
+ OutputableBndrId idR,
Outputable body)
=> (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc
pprStmt (LastStmt _ expr ret_stripped _)
@@ -2190,7 +2190,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
pprStmt (XStmtLR x) = ppr x
-pprTransformStmt :: (OutputableBndrId (GhcPass p))
+pprTransformStmt :: (OutputableBndrId p)
=> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
-> Maybe (LHsExpr (GhcPass p)) -> SDoc
pprTransformStmt bndrs using by
@@ -2208,7 +2208,7 @@ pprBy :: Outputable body => Maybe body -> SDoc
pprBy Nothing = empty
pprBy (Just e) = text "by" <+> ppr e
-pprDo :: (OutputableBndrId (GhcPass p), Outputable body)
+pprDo :: (OutputableBndrId p, Outputable body)
=> HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc
pprDo DoExpr stmts = text "do" <+> ppr_do_stmts stmts
pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts
@@ -2218,13 +2218,13 @@ pprDo ListComp stmts = brackets $ pprComp stmts
pprDo MonadComp stmts = brackets $ pprComp stmts
pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
-ppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),
+ppr_do_stmts :: (OutputableBndrId idL, OutputableBndrId idR,
Outputable body)
=> [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc
-- Print a bunch of do stmts
ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
-pprComp :: (OutputableBndrId (GhcPass p), Outputable body)
+pprComp :: (OutputableBndrId p, Outputable body)
=> [LStmt (GhcPass p) body] -> SDoc
pprComp quals -- Prints: body | qual1, ..., qualn
| Just (initStmts, L _ (LastStmt _ body _ _)) <- snocView quals
@@ -2239,7 +2239,7 @@ pprComp quals -- Prints: body | qual1, ..., qualn
| otherwise
= pprPanic "pprComp" (pprQuals quals)
-pprQuals :: (OutputableBndrId (GhcPass p), Outputable body)
+pprQuals :: (OutputableBndrId p, Outputable body)
=> [LStmt (GhcPass p) body] -> SDoc
-- Show list comprehension qualifiers separated by commas
pprQuals quals = interpp'SP quals
@@ -2429,31 +2429,31 @@ splices. In contrast, when pretty printing the output of the type checker, we
sense, although I hate to add another constructor to HsExpr.
-}
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsSplicedThing p) where
+instance OutputableBndrId p
+ => Outputable (HsSplicedThing (GhcPass p)) where
ppr (HsSplicedExpr e) = ppr_expr e
ppr (HsSplicedTy t) = ppr t
ppr (HsSplicedPat p) = ppr p
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsSplice p) where
+instance (OutputableBndrId p) => Outputable (HsSplice (GhcPass p)) where
ppr s = pprSplice s
-pprPendingSplice :: (OutputableBndrId (GhcPass p))
+pprPendingSplice :: (OutputableBndrId p)
=> SplicePointName -> LHsExpr (GhcPass p) -> SDoc
pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
-pprSpliceDecl :: (OutputableBndrId (GhcPass p))
+pprSpliceDecl :: (OutputableBndrId p)
=> HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
pprSpliceDecl e ExplicitSplice = text "$(" <> ppr_splice_decl e <> text ")"
pprSpliceDecl e ImplicitSplice = ppr_splice_decl e
-ppr_splice_decl :: (OutputableBndrId (GhcPass p))
+ppr_splice_decl :: (OutputableBndrId p)
=> HsSplice (GhcPass p) -> SDoc
ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
ppr_splice_decl e = pprSplice e
-pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
+pprSplice :: (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc
pprSplice (HsTypedSplice _ HasParens n e)
= ppr_splice (text "$$(") n e (text ")")
pprSplice (HsTypedSplice _ HasDollar n e)
@@ -2476,7 +2476,7 @@ ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>
char '[' <> ppr quoter <> vbar <>
ppr quote <> text "|]"
-ppr_splice :: (OutputableBndrId (GhcPass p))
+ppr_splice :: (OutputableBndrId p)
=> SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc
ppr_splice herald n e trail
= herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail
@@ -2506,12 +2506,12 @@ isTypedBracket :: HsBracket id -> Bool
isTypedBracket (TExpBr {}) = True
isTypedBracket _ = False
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsBracket p) where
+instance OutputableBndrId p
+ => Outputable (HsBracket (GhcPass p)) where
ppr = pprHsBracket
-pprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc
+pprHsBracket :: (OutputableBndrId p) => HsBracket (GhcPass p) -> SDoc
pprHsBracket (ExpBr _ e) = thBrackets empty (ppr e)
pprHsBracket (PatBr _ p) = thBrackets (char 'p') (ppr p)
pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
@@ -2557,8 +2557,8 @@ data ArithSeqInfo id
(LHsExpr id)
-- AZ: Sould ArithSeqInfo have a TTG extension?
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (ArithSeqInfo p) where
+instance OutputableBndrId p
+ => Outputable (ArithSeqInfo (GhcPass p)) where
ppr (From e1) = hcat [ppr e1, pp_dotdot]
ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
ppr (FromTo e1 e3) = hcat [ppr e1, pp_dotdot, ppr e3]
@@ -2748,8 +2748,8 @@ pprStmtContext (TransStmtCtxt c) =
ifPprDebug (sep [text "transformed branch of", pprAStmtContext c])
(pprStmtContext c)
-instance (Outputable p, Outputable (NameOrRdrName p))
- => Outputable (HsStmtContext p) where
+instance (Outputable (GhcPass p), Outputable (NameOrRdrName (GhcPass p)))
+ => Outputable (HsStmtContext (GhcPass p)) where
ppr = pprStmtContext
-- Used to generate the string for a *runtime* error message
@@ -2776,7 +2776,7 @@ matchContextErrString (StmtCtxt MDoExpr) = text "'mdo' block"
matchContextErrString (StmtCtxt ListComp) = text "list comprehension"
matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension"
-pprMatchInCtxt :: (OutputableBndrId (GhcPass idR),
+pprMatchInCtxt :: (OutputableBndrId idR,
-- TODO:AZ these constraints do not make sense
Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),
Outputable body)
@@ -2785,8 +2785,8 @@ pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match)
<> colon)
4 (pprMatch match)
-pprStmtInCtxt :: (OutputableBndrId (GhcPass idL),
- OutputableBndrId (GhcPass idR),
+pprStmtInCtxt :: (OutputableBndrId idL,
+ OutputableBndrId idR,
Outputable body)
=> HsStmtContext (IdP (GhcPass idL))
-> StmtLR (GhcPass idL) (GhcPass idR) body
diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot
index 8fd8f3857a..03029d1d05 100644
--- a/compiler/GHC/Hs/Expr.hs-boot
+++ b/compiler/GHC/Hs/Expr.hs-boot
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -28,24 +29,24 @@ data MatchGroup (a :: *) (body :: *)
data GRHSs (a :: *) (body :: *)
data SyntaxExpr (i :: *)
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p)
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p)
+instance OutputableBndrId p => Outputable (HsExpr (GhcPass p))
+instance OutputableBndrId p => Outputable (HsCmd (GhcPass p))
type LHsExpr a = Located (HsExpr a)
-pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+pprLExpr :: (OutputableBndrId p) => LHsExpr (GhcPass p) -> SDoc
-pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
+pprExpr :: (OutputableBndrId p) => HsExpr (GhcPass p) -> SDoc
-pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
+pprSplice :: (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc
-pprSpliceDecl :: (OutputableBndrId (GhcPass p))
+pprSpliceDecl :: (OutputableBndrId p)
=> HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
-pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
- OutputableBndrId (GhcPass p),
+pprPatBind :: forall bndr p body. (OutputableBndrId bndr,
+ OutputableBndrId p,
Outputable body)
=> LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
-pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
+pprFunBind :: (OutputableBndrId idR, Outputable body)
=> MatchGroup (GhcPass idR) body -> SDoc
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index 35afc5f8d3..b73855eb7a 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -1162,13 +1162,13 @@ type OutputableX p = -- See Note [OutputableX]
-- ----------------------------------------------------------------------
-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
--- the @id@ and the 'NameOrRdrName' type for it
-type OutputableBndrId id =
- ( OutputableBndr (NameOrRdrName (IdP id))
- , OutputableBndr (IdP id)
- , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id)))
- , OutputableBndr (IdP (NoGhcTc id))
- , NoGhcTc id ~ NoGhcTc (NoGhcTc id)
- , OutputableX id
- , OutputableX (NoGhcTc id)
+-- the @p@ and the 'NameOrRdrName' type for it
+type OutputableBndrId pass =
+ ( OutputableBndr (NameOrRdrName (IdP (GhcPass pass)))
+ , OutputableBndr (IdP (GhcPass pass))
+ , OutputableBndr (NameOrRdrName (IdP (NoGhcTc (GhcPass pass))))
+ , OutputableBndr (IdP (NoGhcTc (GhcPass pass)))
+ , NoGhcTc (GhcPass pass) ~ NoGhcTc (NoGhcTc (GhcPass pass))
+ , OutputableX (GhcPass pass)
+ , OutputableX (NoGhcTc (GhcPass pass))
)
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 56d1691ac4..32cc3b21a9 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -8,6 +8,7 @@ GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
@@ -125,8 +126,8 @@ simpleImportDecl mn = ImportDecl {
ideclHiding = Nothing
}
-instance (p ~ GhcPass pass,OutputableBndrId p)
- => Outputable (ImportDecl p) where
+instance OutputableBndrId p
+ => Outputable (ImportDecl (GhcPass p)) where
ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
, ideclPkgQual = pkg
, ideclSource = from, ideclSafe = safe
@@ -322,7 +323,7 @@ replaceWrappedName (IEType (L l _)) n = IEType (L l n)
replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
-instance (p ~ GhcPass pass,OutputableBndrId p) => Outputable (IE p) where
+instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
ppr (IEVar _ var) = ppr (unLoc var)
ppr (IEThingAbs _ thing) = ppr (unLoc thing)
ppr (IEThingAll _ thing) = hcat [ppr (unLoc thing), text "(..)"]
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index ab30de87ac..963bf0e2c0 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -9,6 +9,7 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -227,7 +228,7 @@ instance Ord OverLitVal where
compare (HsIsString _ _) (HsFractional _) = GT
-- Instance specific to GhcPs, need the SourceText
-instance p ~ GhcPass pass => Outputable (HsLit p) where
+instance Outputable (HsLit (GhcPass p)) where
ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
ppr (HsString st s) = pprWithSourceText st (pprHsString s)
@@ -249,8 +250,8 @@ pp_st_suffix NoSourceText _ doc = doc
pp_st_suffix (SourceText st) suffix _ = text st <> suffix
-- in debug mode, print the expression that it's resolved to, too
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsOverLit p) where
+instance OutputableBndrId p
+ => Outputable (HsOverLit (GhcPass p)) where
ppr (OverLit {ol_val=val, ol_witness=witness})
= ppr val <+> (whenPprDebug (parens (pprExpr witness)))
ppr (XOverLit x) = ppr x
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index fe8a4e88d5..25b0a1e184 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -504,7 +504,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
************************************************************************
-}
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p) where
+instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
ppr = pprPat
pprPatBndr :: OutputableBndr name => name -> SDoc
@@ -516,11 +516,11 @@ pprPatBndr var -- Print with type info if -dppr-debug is on
else
pprPrefixOcc var
-pprParendLPat :: (OutputableBndrId (GhcPass p))
+pprParendLPat :: (OutputableBndrId p)
=> PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat p = pprParendPat p . unLoc
-pprParendPat :: (OutputableBndrId (GhcPass p))
+pprParendPat :: (OutputableBndrId p)
=> PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
if need_parens dflags pat
@@ -535,7 +535,7 @@ pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
-- But otherwise the CoPat is discarded, so it
-- is the pattern inside that matters. Sigh.
-pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc
+pprPat :: (OutputableBndrId p) => Pat (GhcPass p) -> SDoc
pprPat (VarPat _ lvar) = pprPatBndr (unLoc lvar)
pprPat (WildPat _) = char '_'
pprPat (LazyPat _ pat) = char '~' <> pprParendLPat appPrec pat
@@ -577,12 +577,12 @@ pprPat (ConPatOut { pat_con = con
pprPat (XPat x) = ppr x
-pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))
+pprUserCon :: (OutputableBndr con, OutputableBndrId p)
=> con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
pprUserCon c details = pprPrefixOcc c <+> pprConArgs details
-pprConArgs :: (OutputableBndrId (GhcPass p))
+pprConArgs :: (OutputableBndrId p)
=> HsConPatDetails (GhcPass p) -> SDoc
pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats)
pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1
@@ -696,7 +696,7 @@ looksLazyPat (VarPat {}) = False
looksLazyPat (WildPat {}) = False
looksLazyPat _ = True
-isIrrefutableHsPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> Bool
+isIrrefutableHsPat :: (OutputableBndrId p) => LPat (GhcPass p) -> Bool
-- (isIrrefutableHsPat p) is true if matching against p cannot fail,
-- in the sense of falling through to the next pattern.
-- (NB: this is not quite the same as the (silly) defn
diff --git a/compiler/GHC/Hs/Pat.hs-boot b/compiler/GHC/Hs/Pat.hs-boot
index 801f481879..fc5671c27a 100644
--- a/compiler/GHC/Hs/Pat.hs-boot
+++ b/compiler/GHC/Hs/Pat.hs-boot
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
@@ -15,4 +16,4 @@ type role Pat nominal
data Pat (i :: *)
type LPat i = Pat i
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p)
+instance (OutputableBndrId p) => Outputable (Pat (GhcPass p))
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index 04fd1ee8e6..cd5e59745b 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -901,8 +901,8 @@ data ConDeclField pass -- Record fields have Haddoc docs on them
type instance XConDeclField (GhcPass _) = NoExtField
type instance XXConDeclField (GhcPass _) = NoExtCon
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (ConDeclField p) where
+instance OutputableBndrId p
+ => Outputable (ConDeclField (GhcPass p)) where
ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty
ppr (XConDeclField x) = ppr x
@@ -1377,8 +1377,8 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass
| XFieldOcc
(XXFieldOcc pass)
-deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p)
-deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)
+deriving instance Eq (XCFieldOcc (GhcPass p)) => Eq (FieldOcc (GhcPass p))
+deriving instance Ord (XCFieldOcc (GhcPass p)) => Ord (FieldOcc (GhcPass p))
type instance XCFieldOcc GhcPs = NoExtField
type instance XCFieldOcc GhcRn = Name
@@ -1420,10 +1420,10 @@ type instance XAmbiguous GhcTc = Id
type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon
-instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where
+instance Outputable (AmbiguousFieldOcc (GhcPass p)) where
ppr = ppr . rdrNameAmbiguousFieldOcc
-instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where
+instance OutputableBndr (AmbiguousFieldOcc (GhcPass p)) where
pprInfixOcc = pprInfixOcc . rdrNameAmbiguousFieldOcc
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
@@ -1459,30 +1459,30 @@ ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec
************************************************************************
-}
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsType p) where
+instance OutputableBndrId p => Outputable (HsType (GhcPass p)) where
ppr ty = pprHsType ty
instance Outputable HsTyLit where
ppr = ppr_tylit
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (LHsQTyVars p) where
+instance OutputableBndrId p
+ => Outputable (LHsQTyVars (GhcPass p)) where
ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
ppr (XLHsQTyVars x) = ppr x
-instance (p ~ GhcPass pass, OutputableBndrId p)
- => Outputable (HsTyVarBndr p) where
+instance OutputableBndrId p
+ => Outputable (HsTyVarBndr (GhcPass p)) where
ppr (UserTyVar _ n) = ppr n
ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
ppr (XTyVarBndr nec) = noExtCon nec
-instance (p ~ GhcPass pass,Outputable thing)
- => Outputable (HsImplicitBndrs p thing) where
+instance Outputable thing
+ => Outputable (HsImplicitBndrs (GhcPass p) thing) where
ppr (HsIB { hsib_body = ty }) = ppr ty
ppr (XHsImplicitBndrs x) = ppr x
-instance (p ~ GhcPass pass,Outputable thing)
- => Outputable (HsWildCardBndrs p thing) where
+instance Outputable thing
+ => Outputable (HsWildCardBndrs (GhcPass p) thing) where
ppr (HsWC { hswc_body = ty }) = ppr ty
ppr (XHsWildCardBndrs x) = ppr x
@@ -1491,7 +1491,7 @@ pprAnonWildCard = char '_'
-- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@
-- only when @-dppr-debug@ is enabled.
-pprHsForAll :: (OutputableBndrId (GhcPass p))
+pprHsForAll :: (OutputableBndrId p)
=> ForallVisFlag -> [LHsTyVarBndr (GhcPass p)]
-> LHsContext (GhcPass p) -> SDoc
pprHsForAll = pprHsForAllExtra Nothing
@@ -1503,7 +1503,7 @@ pprHsForAll = pprHsForAllExtra Nothing
-- function for this is needed, as the extra-constraints wildcard is removed
-- from the actual context and type, and stored in a separate field, thus just
-- printing the type will not print the extra-constraints wildcard.
-pprHsForAllExtra :: (OutputableBndrId (GhcPass p))
+pprHsForAllExtra :: (OutputableBndrId p)
=> Maybe SrcSpan -> ForallVisFlag
-> [LHsTyVarBndr (GhcPass p)]
-> LHsContext (GhcPass p) -> SDoc
@@ -1517,7 +1517,7 @@ pprHsForAllExtra extra fvf qtvs cxt
-- | Version of 'pprHsForAll' or 'pprHsForAllExtra' that will always print
-- @forall.@ when passed @Just []@. Prints nothing if passed 'Nothing'
-pprHsExplicitForAll :: (OutputableBndrId (GhcPass p))
+pprHsExplicitForAll :: (OutputableBndrId p)
=> ForallVisFlag
-> Maybe [LHsTyVarBndr (GhcPass p)] -> SDoc
pprHsExplicitForAll fvf (Just qtvs) = forAllLit <+> interppSP qtvs
@@ -1530,14 +1530,14 @@ ppr_forall_separator :: ForallVisFlag -> SDoc
ppr_forall_separator ForallVis = space <> arrow
ppr_forall_separator ForallInvis = dot
-pprLHsContext :: (OutputableBndrId (GhcPass p))
+pprLHsContext :: (OutputableBndrId p)
=> LHsContext (GhcPass p) -> SDoc
pprLHsContext lctxt
| null (unLoc lctxt) = empty
| otherwise = pprLHsContextAlways lctxt
-- For use in a HsQualTy, which always gets printed if it exists.
-pprLHsContextAlways :: (OutputableBndrId (GhcPass p))
+pprLHsContextAlways :: (OutputableBndrId p)
=> LHsContext (GhcPass p) -> SDoc
pprLHsContextAlways (L _ ctxt)
= case ctxt of
@@ -1546,7 +1546,7 @@ pprLHsContextAlways (L _ ctxt)
_ -> parens (interpp'SP ctxt) <+> darrow
-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@
-pprLHsContextExtra :: (OutputableBndrId (GhcPass p))
+pprLHsContextExtra :: (OutputableBndrId p)
=> Bool -> LHsContext (GhcPass p) -> SDoc
pprLHsContextExtra show_extra lctxt@(L _ ctxt)
| not show_extra = pprLHsContext lctxt
@@ -1555,7 +1555,7 @@ pprLHsContextExtra show_extra lctxt@(L _ ctxt)
where
ctxt' = map ppr ctxt ++ [char '_']
-pprConDeclFields :: (OutputableBndrId (GhcPass p))
+pprConDeclFields :: (OutputableBndrId p)
=> [LConDeclField (GhcPass p)] -> SDoc
pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
where
@@ -1581,13 +1581,13 @@ seems like the Right Thing anyway.)
-- Printing works more-or-less as for Types
-pprHsType :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc
+pprHsType :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
pprHsType ty = ppr_mono_ty ty
-ppr_mono_lty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> SDoc
+ppr_mono_lty :: (OutputableBndrId p) => LHsType (GhcPass p) -> SDoc
ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
-ppr_mono_ty :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc
+ppr_mono_ty :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
ppr_mono_ty (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs, hst_body = ty })
= sep [pprHsForAll fvf tvs noLHsContext, ppr_mono_lty ty]
@@ -1644,7 +1644,7 @@ ppr_mono_ty (HsDocTy _ ty doc)
ppr_mono_ty (XHsType t) = ppr t
--------------------------
-ppr_fun_ty :: (OutputableBndrId (GhcPass p))
+ppr_fun_ty :: (OutputableBndrId p)
=> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
ppr_fun_ty ty1 ty2
= let p1 = ppr_mono_lty ty1
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 911bda1efb..cb70078fd3 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ViewPatterns #-}
@@ -2119,7 +2120,7 @@ patBuilderBang bang p =
cL (bang `combineSrcSpans` getLoc p) $
PatBuilderBang bang p
-instance p ~ GhcPs => Outputable (PatBuilder p) where
+instance Outputable (PatBuilder GhcPs) where
ppr (PatBuilderPat p) = ppr p
ppr (PatBuilderBang _ (L _ p)) = text "!" <+> ppr p
ppr (PatBuilderPar (L _ p)) = parens (ppr p)
@@ -2128,8 +2129,8 @@ instance p ~ GhcPs => Outputable (PatBuilder p) where
ppr (PatBuilderVar v) = ppr v
ppr (PatBuilderOverLit l) = ppr l
-instance p ~ GhcPs => DisambECP (PatBuilder p) where
- type Body (PatBuilder p) = PatBuilder
+instance DisambECP (PatBuilder GhcPs) where
+ type Body (PatBuilder GhcPs) = PatBuilder
ecpFromCmd' (dL-> L l c) =
addFatalError l $
text "Command syntax in pattern:" <+> ppr c
@@ -2140,13 +2141,13 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where
text "Lambda-syntax in pattern." $$
text "Pattern matching on functions is not possible."
mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
- type InfixOp (PatBuilder p) = RdrName
+ type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp m = m
mkHsOpAppPV l p1 op p2 = do
warnSpaceAfterBang op (getLoc p2)
return $ cL l $ PatBuilderOpApp p1 op p2
mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
- type FunArg (PatBuilder p) = PatBuilder p
+ type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
superFunArg m = m
mkHsAppPV l p1 p2 = return $ cL l (PatBuilderApp p1 p2)
mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern"
diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs
index b3736ed7bb..b2b9a6ffb8 100644
--- a/compiler/typecheck/TcAnnotations.hs
+++ b/compiler/typecheck/TcAnnotations.hs
@@ -74,6 +74,6 @@ annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod
-annCtxt :: (OutputableBndrId (GhcPass p)) => AnnDecl (GhcPass p) -> SDoc
+annCtxt :: (OutputableBndrId p) => AnnDecl (GhcPass p) -> SDoc
annCtxt ann
= hang (text "In the annotation:") 2 (ppr ann)
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index dc701d360b..af2ed4b7e1 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -498,7 +498,7 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds
recursivePatSynErr ::
- OutputableBndrId (GhcPass p) =>
+ OutputableBndrId p =>
SrcSpan -- ^ The location of the first pattern synonym binding
-- (for error reporting)
-> LHsBinds (GhcPass p)
@@ -1722,7 +1722,7 @@ isClosedBndrGroup type_env binds
-- This one is called on LHS, when pat and grhss are both Name
-- and on RHS, when pat is TcId and grhss is still Name
-patMonoBindsCtxt :: (OutputableBndrId (GhcPass p), Outputable body)
+patMonoBindsCtxt :: (OutputableBndrId p, Outputable body)
=> LPat (GhcPass p) -> GRHSs GhcRn body -> SDoc
patMonoBindsCtxt pat grhss
= hang (text "In a pattern binding:") 2 (pprPatBind pat grhss)
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index 6f1ab3f19e..d9bd893dc5 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -942,11 +942,11 @@ data InstBindings a
-- Used only to improve error messages
}
-instance (OutputableBndrId (GhcPass a))
+instance (OutputableBndrId a)
=> Outputable (InstInfo (GhcPass a)) where
ppr = pprInstInfoDetails
-pprInstInfoDetails :: (OutputableBndrId (GhcPass a))
+pprInstInfoDetails :: (OutputableBndrId a)
=> InstInfo (GhcPass a) -> SDoc
pprInstInfoDetails info
= hang (pprInstanceHdr (iSpec info) <+> text "where")
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index 0b405d3c9e..af8ba09a65 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -778,7 +778,7 @@ exportErrCtxt herald exp =
text "In the" <+> text (herald ++ ":") <+> ppr exp
-addExportErrCtxt :: (OutputableBndrId (GhcPass p))
+addExportErrCtxt :: (OutputableBndrId p)
=> IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt ie = addErrCtxt exportCtxt
where
diff --git a/utils/haddock b/utils/haddock
-Subproject f0b5a2043ff6c527e55fab228d37ee698ce8726
+Subproject fad111e9d3de1a2e86837d3e6f72fe0cf2f6c0a