summaryrefslogtreecommitdiff
path: root/compiler/hsSyn/HsDecls.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/hsSyn/HsDecls.hs')
-rw-r--r--compiler/hsSyn/HsDecls.hs85
1 files changed, 52 insertions, 33 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 55f3b73686..0ff36aa712 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -48,7 +48,7 @@ module HsDecls (
-- ** Deriving strategies
DerivStrategy(..), LDerivStrategy, derivStrategyName,
-- ** @RULE@ declarations
- LRuleDecls,RuleDecls(..),RuleDecl(..), LRuleDecl, HsRuleRn(..),
+ LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),
RuleBndr(..),LRuleBndr,
collectRuleBndrSigTys,
flattenRuleDecls, pprFullRuleName,
@@ -1528,9 +1528,12 @@ type HsTyPats pass = [LHsType pass]
{- Note [Family instance declaration binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For ordinary data/type family instances, the feqn_pats field of FamEqn stores
-the LHS type (and kind) patterns. These type patterns can of course contain
-type (and kind) variables, which are bound in the hsib_vars field of the
-HsImplicitBndrs in FamInstEqn. Note in particular
+the LHS type (and kind) patterns. Any type (and kind) variables contained
+in these type patterns are bound in the hsib_vars field of the HsImplicitBndrs
+in FamInstEqn depending on whether or not an explicit forall is present. In
+the case of an explicit forall, the hsib_vars only includes kind variables not
+bound in the forall. Otherwise, all type (and kind) variables are bound in
+the hsib_vars. In the latter case, note that in particular
* The hsib_vars *includes* any anonymous wildcards. For example
type instance F a _ = a
@@ -1616,6 +1619,7 @@ data FamEqn pass pats rhs
= FamEqn
{ feqn_ext :: XCFamEqn pass pats rhs
, feqn_tycon :: Located (IdP pass)
+ , feqn_bndrs :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars
, feqn_pats :: pats
, feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
, feqn_rhs :: rhs
@@ -1701,10 +1705,11 @@ ppr_instance_keyword NotTopLevel = empty
ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))
=> TyFamInstEqn (GhcPass p) -> SDoc
ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon
+ , feqn_bndrs = bndrs
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = rhs }})
- = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
+ = pprFamInstLHS tycon bndrs pats fixity [] Nothing <+> equals <+> ppr rhs
ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x
ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x
@@ -1726,13 +1731,14 @@ pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))
=> TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_tycon = tycon
+ , feqn_bndrs = bndrs
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = defn }}})
= pp_data_defn pp_hdr defn
where
pp_hdr ctxt = ppr_instance_keyword top_lvl
- <+> pprFamInstLHS tycon pats fixity ctxt Nothing
+ <+> pprFamInstLHS tycon bndrs pats fixity ctxt Nothing
-- No need to pass an explicit kind signature to
-- pprFamInstLHS here, since pp_data_defn already
-- pretty-prints that. See #14817.
@@ -1755,14 +1761,16 @@ pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))
pprFamInstLHS :: (OutputableBndrId (GhcPass p))
=> Located (IdP (GhcPass p))
+ -> Maybe [LHsTyVarBndr (GhcPass p)]
-> HsTyPats (GhcPass p)
-> LexicalFixity
-> HsContext (GhcPass p)
-> Maybe (LHsKind (GhcPass p))
-> SDoc
-pprFamInstLHS thing typats fixity context mb_kind_sig
+pprFamInstLHS thing bndrs typats fixity context mb_kind_sig
-- explicit type patterns
- = hsep [ pprHsContext context, pp_pats typats, pp_kind_sig ]
+ = hsep [ pprHsContext context, pprHsExplicitForAll bndrs
+ , pp_pats typats, pp_kind_sig ]
where
pp_pats (patl:patr:pats)
| Infix <- fixity
@@ -2139,24 +2147,27 @@ type LRuleDecl pass = Located (RuleDecl pass)
-- | Rule Declaration
data RuleDecl pass
- = HsRule -- Source rule
- (XHsRule pass) -- After renamer, free-vars from the LHS and RHS
- (Located (SourceText,RuleName)) -- Rule name
- -- Note [Pragma source text] in BasicTypes
- Activation
- [LRuleBndr pass] -- Forall'd vars; after typechecking this
- -- includes tyvars
- (Located (HsExpr pass)) -- LHS
- (Located (HsExpr pass)) -- RHS
- -- ^
- -- - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
- -- 'ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnClose',
- -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
- -- 'ApiAnnotation.AnnEqual',
-
- -- For details on above see note [Api annotations] in ApiAnnotation
+ = HsRule -- Source rule
+ { rd_ext :: XHsRule pass
+ -- ^ After renamer, free-vars from the LHS and RHS
+ , rd_name :: Located (SourceText,RuleName)
+ -- ^ Note [Pragma source text] in BasicTypes
+ , rd_act :: Activation
+ , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]
+ -- ^ Forall'd type vars
+ , rd_tmvs :: [LRuleBndr pass]
+ -- ^ Forall'd term vars, before typechecking; after typechecking
+ -- this includes all forall'd vars
+ , rd_lhs :: Located (HsExpr pass)
+ , rd_rhs :: Located (HsExpr pass)
+ }
+ -- ^
+ -- - 'ApiAnnotation.AnnKeywordId' :
+ -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
+ -- 'ApiAnnotation.AnnVal',
+ -- 'ApiAnnotation.AnnClose',
+ -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
+ -- 'ApiAnnotation.AnnEqual',
| XRuleDecl (XXRuleDecl pass)
data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
@@ -2195,21 +2206,29 @@ 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
- ppr (HsRules _ st rules)
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecls 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
- ppr (HsRule _ name act ns lhs rhs)
+ ppr (HsRule { rd_name = name
+ , rd_act = act
+ , rd_tyvs = tys
+ , rd_tmvs = tms
+ , rd_lhs = lhs
+ , rd_rhs = rhs })
= sep [pprFullRuleName name <+> ppr act,
- nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
+ nest 4 (pp_forall_ty tys <+> pp_forall_tm tys
+ <+> pprExpr (unLoc lhs)),
nest 6 (equals <+> pprExpr (unLoc rhs)) ]
where
- pp_forall | null ns = empty
- | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
+ pp_forall_ty Nothing = empty
+ pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot
+ pp_forall_tm Nothing | null tms = empty
+ pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot
ppr (XRuleDecl x) = ppr x
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where