diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-05 21:49:11 +0200 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-08 17:49:54 +0200 |
commit | 438dd1cbba13d35f3452b4dcef3f94ce9a216905 (patch) | |
tree | 0678edb3697fb53b5f38a6e80473e658961f4b53 /compiler/hsSyn/HsDecls.hs | |
parent | fe6848f544c2a14086bcef388c46f4070c22d287 (diff) | |
download | haskell-438dd1cbba13d35f3452b4dcef3f94ce9a216905.tar.gz |
WIP on Doing a combined Step 1 and 3 for Trees That Grow
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
Trees that grow extension points are added for
- ValBinds
- HsPat
- HsLit
- HsOverLit
- HsType
- HsTyVarBndr
- HsAppType
- FieldOcc
- AmbiguousFieldOcc
Updates haddock submodule
Test Plan: ./validate
Reviewers: shayan-najd, simonpj, austin, goldfire, bgamari
Subscribers: goldfire, rwbarton, thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D4147
Diffstat (limited to 'compiler/hsSyn/HsDecls.hs')
-rw-r--r-- | compiler/hsSyn/HsDecls.hs | 200 |
1 files changed, 101 insertions, 99 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 55d43fd058..3641e27f98 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -149,7 +149,7 @@ data HsDecl id -- (Includes quasi-quotes) | DocD (DocDecl) -- ^ Documentation comment declaration | RoleAnnotD (RoleAnnotDecl id) -- ^ Role annotation declaration -deriving instance (DataId id) => Data (HsDecl id) +deriving instance (DataIdLR id id) => Data (HsDecl id) -- NB: all top-level fixity decls are contained EITHER @@ -195,9 +195,9 @@ data HsGroup id hs_docs :: [LDocDecl] } -deriving instance (DataId id) => Data (HsGroup id) +deriving instance (DataIdLR id id) => Data (HsGroup id) -emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a +emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass a) emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } @@ -212,7 +212,8 @@ emptyGroup = HsGroup { hs_tyclds = [], hs_splcds = [], hs_docs = [] } -appendGroups :: HsGroup a -> HsGroup a -> HsGroup a +appendGroups :: HsGroup (GhcPass a) -> HsGroup (GhcPass a) + -> HsGroup (GhcPass a) appendGroups HsGroup { hs_valds = val_groups1, @@ -255,8 +256,8 @@ appendGroups hs_vects = vects1 ++ vects2, hs_docs = docs1 ++ docs2 } -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (HsDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (HsDecl (GhcPass p)) where ppr (TyClD dcl) = ppr dcl ppr (ValD binds) = ppr binds ppr (DefD def) = ppr def @@ -272,8 +273,8 @@ instance (SourceTextX pass, OutputableBndrId pass) ppr (DocD doc) = ppr doc ppr (RoleAnnotD ra) = ppr ra -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (HsGroup pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (HsGroup (GhcPass p)) where ppr (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls, hs_derivds = deriv_decls, @@ -315,10 +316,10 @@ data SpliceDecl id = SpliceDecl -- Top level splice (Located (HsSplice id)) SpliceExplicitFlag -deriving instance (DataId id) => Data (SpliceDecl id) +deriving instance (DataIdLR id id) => Data (SpliceDecl id) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (SpliceDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (SpliceDecl (GhcPass p)) where ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f {- @@ -538,7 +539,7 @@ data TyClDecl pass -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId id) => Data (TyClDecl id) +deriving instance (DataIdLR id id) => Data (TyClDecl id) -- Simple classifiers for TyClDecl @@ -633,17 +634,17 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) = hsTvbAllKinded tyvars && rhs_annotated rhs where rhs_annotated (L _ ty) = case ty of - HsParTy lty -> rhs_annotated lty - HsKindSig {} -> True - _ -> False + HsParTy _ lty -> rhs_annotated lty + HsKindSig {} -> True + _ -> False hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (TyClDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (TyClDecl (GhcPass p)) where ppr (FamDecl { tcdFam = decl }) = ppr decl ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity @@ -674,8 +675,8 @@ instance (SourceTextX pass, OutputableBndrId pass) <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context) <+> pprFundeps (map unLoc fds) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (TyClGroup pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (TyClGroup (GhcPass p)) where ppr (TyClGroup { group_tyclds = tyclds , group_roles = roles , group_instds = instds @@ -685,11 +686,11 @@ instance (SourceTextX pass, OutputableBndrId pass) ppr roles $$ ppr instds -pp_vanilla_decl_head :: (SourceTextX pass, OutputableBndrId pass) - => Located (IdP pass) - -> LHsQTyVars pass +pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Located (IdP (GhcPass p)) + -> LHsQTyVars (GhcPass p) -> LexicalFixity - -> HsContext pass + -> HsContext (GhcPass p) -> SDoc pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context = hsep [pprHsContext context, pp_tyvars tyvars] @@ -783,7 +784,7 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis] = TyClGroup { group_tyclds :: [LTyClDecl pass] , group_roles :: [LRoleAnnotDecl pass] , group_instds :: [LInstDecl pass] } -deriving instance (DataId id) => Data (TyClGroup id) +deriving instance (DataIdLR id id) => Data (TyClGroup id) emptyTyClGroup :: TyClGroup pass emptyTyClGroup = TyClGroup [] [] [] @@ -899,7 +900,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (FamilyResultSig pass) +deriving instance (DataIdLR pass pass) => Data (FamilyResultSig pass) -- | Located type Family Declaration type LFamilyDecl pass = Located (FamilyDecl pass) @@ -922,7 +923,7 @@ data FamilyDecl pass = FamilyDecl -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId id) => Data (FamilyDecl id) +deriving instance (DataIdLR id id) => Data (FamilyDecl id) -- | Located Injectivity Annotation type LInjectivityAnn pass = Located (InjectivityAnn pass) @@ -949,7 +950,7 @@ data FamilyInfo pass -- | 'Nothing' if we're in an hs-boot file and the user -- said "type family Foo x where .." | ClosedTypeFamily (Maybe [LTyFamInstEqn pass]) -deriving instance (DataId pass) => Data (FamilyInfo pass) +deriving instance (DataIdLR pass pass) => Data (FamilyInfo pass) -- | Does this family declaration have a complete, user-supplied kind signature? famDeclHasCusk :: Maybe Bool @@ -964,21 +965,21 @@ famDeclHasCusk mb_class_cusk _ = mb_class_cusk `orElse` True -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool -hasReturnKindSignature NoSig = False -hasReturnKindSignature (TyVarSig (L _ (UserTyVar _))) = False -hasReturnKindSignature _ = True +hasReturnKindSignature NoSig = False +hasReturnKindSignature (TyVarSig (L _ UserTyVar{})) = False +hasReturnKindSignature _ = True -- | Maybe return name of the result type variable resultVariableName :: FamilyResultSig a -> Maybe (IdP a) resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig resultVariableName _ = Nothing -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (FamilyDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (FamilyDecl (GhcPass p)) where ppr = pprFamilyDecl TopLevel -pprFamilyDecl :: (SourceTextX pass, OutputableBndrId pass) - => TopLevelFlag -> FamilyDecl pass -> SDoc +pprFamilyDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon , fdTyVars = tyvars , fdFixity = fixity @@ -1057,7 +1058,7 @@ data HsDataDefn pass -- The payload of a data type defn -- For details on above see note [Api annotations] in ApiAnnotation } -deriving instance (DataId id) => Data (HsDataDefn id) +deriving instance (DataIdLR id id) => Data (HsDataDefn id) -- | Haskell Deriving clause type HsDeriving pass = Located [LHsDerivingClause pass] @@ -1093,10 +1094,10 @@ data HsDerivingClause pass -- -- should produce a derived instance for @C [a] (T b)@. } -deriving instance (DataId id) => Data (HsDerivingClause id) +deriving instance (DataIdLR id id) => Data (HsDerivingClause id) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (HsDerivingClause pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (HsDerivingClause (GhcPass p)) where ppr (HsDerivingClause { deriv_clause_strategy = dcs , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" @@ -1176,7 +1177,7 @@ data ConDecl pass , con_doc :: Maybe LHsDocString -- ^ A possible Haddock comment. } -deriving instance (DataId pass) => Data (ConDecl pass) +deriving instance (DataIdLR pass pass) => Data (ConDecl pass) -- | Haskell data Constructor Declaration Details type HsConDeclDetails pass @@ -1204,7 +1205,7 @@ gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs) (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty (details, res_ty) -- See Note [Sorting out the result type] = case tau of - L _ (HsFunTy (L l (HsRecTy flds)) res_ty') + L _ (HsFunTy _ (L l (HsRecTy _ flds)) res_ty') -> (RecCon (L l flds), res_ty') _other -> (PrefixCon [], tau) @@ -1213,9 +1214,9 @@ hsConDeclArgTys (PrefixCon tys) = tys hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2] hsConDeclArgTys (RecCon flds) = map (cd_fld_type . unLoc) (unLoc flds) -pp_data_defn :: (SourceTextX pass, OutputableBndrId pass) - => (HsContext pass -> SDoc) -- Printing the header - -> HsDataDefn pass +pp_data_defn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => (HsContext (GhcPass p) -> SDoc) -- Printing the header + -> HsDataDefn (GhcPass p) -> SDoc pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context , dd_cType = mb_ct @@ -1237,26 +1238,27 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context Just kind -> dcolon <+> ppr kind pp_derivings (L _ ds) = vcat (map ppr ds) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (HsDataDefn pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (HsDataDefn (GhcPass p)) where ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d instance Outputable NewOrData where ppr NewType = text "newtype" ppr DataType = text "data" -pp_condecls :: (SourceTextX pass, OutputableBndrId pass) - => [LConDecl pass] -> SDoc +pp_condecls :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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 (SourceTextX pass, OutputableBndrId pass) - => Outputable (ConDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (ConDecl (GhcPass p)) where ppr = pprConDecl -pprConDecl :: (SourceTextX pass, OutputableBndrId pass) => ConDecl pass -> SDoc +pprConDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => ConDecl (GhcPass p) -> SDoc pprConDecl (ConDeclH98 { con_name = L _ con , con_qvars = mtvs , con_cxt = mcxt @@ -1381,7 +1383,7 @@ newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass } -- 'ApiAnnotation.AnnInstance', -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance DataId pass => Data (TyFamInstDecl pass) +deriving instance DataIdLR pass pass => Data (TyFamInstDecl pass) ----------------- Data family instances ------------- @@ -1399,7 +1401,7 @@ newtype DataFamInstDecl pass -- 'ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance DataId pass => Data (DataFamInstDecl pass) +deriving instance DataIdLR pass pass => Data (DataFamInstDecl pass) ----------------- Family instances (common types) ------------- @@ -1459,7 +1461,7 @@ data ClsInstDecl pass -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId id) => Data (ClsInstDecl id) +deriving instance (DataIdLR id id) => Data (ClsInstDecl id) ----------------- Instances of all kinds ------------- @@ -1475,14 +1477,14 @@ data InstDecl pass -- Both class and family instances { dfid_inst :: DataFamInstDecl pass } | TyFamInstD -- type family instance { tfid_inst :: TyFamInstDecl pass } -deriving instance (DataId id) => Data (InstDecl id) +deriving instance (DataIdLR id id) => Data (InstDecl id) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (TyFamInstDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (TyFamInstDecl (GhcPass p)) where ppr = pprTyFamInstDecl TopLevel -pprTyFamInstDecl :: (SourceTextX pass, OutputableBndrId pass) - => TopLevelFlag -> TyFamInstDecl pass -> SDoc +pprTyFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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 @@ -1490,16 +1492,16 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc ppr_instance_keyword TopLevel = text "instance" ppr_instance_keyword NotTopLevel = empty -ppr_fam_inst_eqn :: (SourceTextX pass, OutputableBndrId pass) - => TyFamInstEqn pass -> SDoc +ppr_fam_inst_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => TyFamInstEqn (GhcPass p) -> SDoc ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon , feqn_pats = pats , feqn_fixity = fixity , feqn_rhs = rhs }}) = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs -ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass) - => LTyFamDefltEqn pass -> SDoc +ppr_fam_deflt_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => LTyFamDefltEqn (GhcPass p) -> SDoc ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon , feqn_pats = tvs , feqn_fixity = fixity @@ -1507,12 +1509,12 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon = text "type" <+> pp_vanilla_decl_head tycon tvs fixity [] <+> equals <+> ppr rhs -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (DataFamInstDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (DataFamInstDecl (GhcPass p)) where ppr = pprDataFamInstDecl TopLevel -pprDataFamInstDecl :: (SourceTextX pass, OutputableBndrId pass) - => TopLevelFlag -> DataFamInstDecl pass -> SDoc +pprDataFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = tycon , feqn_pats = pats @@ -1528,12 +1530,12 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}}) = ppr nd -pprFamInstLHS :: (SourceTextX pass, OutputableBndrId pass) - => Located (IdP pass) - -> HsTyPats pass +pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Located (IdP (GhcPass p)) + -> HsTyPats (GhcPass p) -> LexicalFixity - -> HsContext pass - -> Maybe (LHsKind pass) + -> HsContext (GhcPass p) + -> Maybe (LHsKind (GhcPass p)) -> SDoc pprFamInstLHS thing typats fixity context mb_kind_sig -- explicit type patterns @@ -1553,8 +1555,8 @@ pprFamInstLHS thing typats fixity context mb_kind_sig | otherwise = empty -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (ClsInstDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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 @@ -1592,8 +1594,8 @@ ppOverlapPragma mb = maybe_stext (SourceText src) _ = text src <+> text "#-}" -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (InstDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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 @@ -1632,10 +1634,10 @@ data DerivDecl pass = DerivDecl -- For details on above see note [Api annotations] in ApiAnnotation } -deriving instance (DataId pass) => Data (DerivDecl pass) +deriving instance (DataIdLR pass pass) => Data (DerivDecl pass) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (DerivDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (DerivDecl (GhcPass p)) where ppr (DerivDecl { deriv_type = ty , deriv_strategy = ds , deriv_overlap_mode = o }) @@ -1667,10 +1669,10 @@ data DefaultDecl pass -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (DefaultDecl pass) +deriving instance (DataIdLR pass pass) => Data (DefaultDecl pass) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (DefaultDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (DefaultDecl (GhcPass p)) where ppr (DefaultDecl tys) = text "default" <+> parens (interpp'SP tys) @@ -1712,7 +1714,7 @@ data ForeignDecl pass -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (ForeignDecl pass) +deriving instance (DataIdLR pass pass) => Data (ForeignDecl pass) {- In both ForeignImport and ForeignExport: sig_ty is the type given in the Haskell code @@ -1773,8 +1775,8 @@ data ForeignExport = CExport (Located CExportSpec) -- contains the calling -- pretty printing of foreign declarations -- -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (ForeignDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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) @@ -1829,7 +1831,7 @@ type LRuleDecls pass = Located (RuleDecls pass) -- | Rule Declarations data RuleDecls pass = HsRules { rds_src :: SourceText , rds_rules :: [LRuleDecl pass] } -deriving instance (DataId pass) => Data (RuleDecls pass) +deriving instance (DataIdLR pass pass) => Data (RuleDecls pass) -- | Located Rule Declaration type LRuleDecl pass = Located (RuleDecl pass) @@ -1855,7 +1857,7 @@ data RuleDecl pass -- 'ApiAnnotation.AnnEqual', -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (RuleDecl pass) +deriving instance (DataIdLR pass pass) => Data (RuleDecl pass) flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls @@ -1872,7 +1874,7 @@ data RuleBndr pass -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (RuleBndr pass) +deriving instance (DataIdLR pass pass) => Data (RuleBndr pass) collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass] collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs] @@ -1880,14 +1882,14 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs] pprFullRuleName :: Located (SourceText, RuleName) -> SDoc pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (RuleDecls pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (RuleDecls (GhcPass p)) where ppr (HsRules st rules) = pprWithSourceText st (text "{-# RULES") <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}" -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (RuleDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (RuleDecl (GhcPass p)) where ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs) = sep [pprFullRuleName name <+> ppr act, nest 4 (pp_forall <+> pprExpr (unLoc lhs)), @@ -1896,8 +1898,8 @@ instance (SourceTextX pass, OutputableBndrId pass) pp_forall | null ns = empty | otherwise = forAllLit <+> fsep (map ppr ns) <> dot -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (RuleBndr pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (RuleBndr (GhcPass p)) where ppr (RuleBndr name) = ppr name ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty) @@ -1965,7 +1967,7 @@ data VectDecl pass (LHsSigType pass) | HsVectInstOut -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now ClsInst -deriving instance (DataId pass) => Data (VectDecl pass) +deriving instance (DataIdLR pass pass) => Data (VectDecl pass) lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name lvectDeclName (L _ (HsVect _ (L _ name) _)) = getName name @@ -1984,8 +1986,8 @@ lvectInstDecl (L _ (HsVectInstIn _)) = True lvectInstDecl (L _ (HsVectInstOut _)) = True lvectInstDecl _ = False -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (VectDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (VectDecl (GhcPass p)) where ppr (HsVect _ v rhs) = sep [text "{-# VECTORISE" <+> ppr v, nest 4 $ @@ -2104,10 +2106,10 @@ data AnnDecl pass = HsAnnotation -- 'ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId pass) => Data (AnnDecl pass) +deriving instance (DataIdLR pass pass) => Data (AnnDecl pass) -instance (SourceTextX pass, OutputableBndrId pass) - => Outputable (AnnDecl pass) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) + => Outputable (AnnDecl (GhcPass p)) where ppr (HsAnnotation _ provenance expr) = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"] |