summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs/Decls.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Hs/Decls.hs')
-rw-r--r--compiler/GHC/Hs/Decls.hs107
1 files changed, 54 insertions, 53 deletions
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)
View Lorry Controller Status