Commit e951f219 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

Use FlexibleInstances for `Outputable (* p)` instead of match-all instances...

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.
parent e0e04856
Pipeline #11912 failed with stages
in 47 seconds
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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)