diff options
Diffstat (limited to 'compiler/hsSyn/HsDecls.hs')
-rw-r--r-- | compiler/hsSyn/HsDecls.hs | 154 |
1 files changed, 76 insertions, 78 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 0d906cb68d..55d43fd058 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -195,7 +195,7 @@ data HsGroup id hs_docs :: [LDocDecl] } -deriving instance (DataIdLR id id) => Data (HsGroup id) +deriving instance (DataId id) => Data (HsGroup id) emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } @@ -212,8 +212,7 @@ emptyGroup = HsGroup { hs_tyclds = [], hs_splcds = [], hs_docs = [] } -appendGroups :: HsGroup (GhcPass a) -> HsGroup (GhcPass a) - -> HsGroup (GhcPass a) +appendGroups :: HsGroup a -> HsGroup a -> HsGroup a appendGroups HsGroup { hs_valds = val_groups1, @@ -256,8 +255,8 @@ appendGroups hs_vects = vects1 ++ vects2, hs_docs = docs1 ++ docs2 } -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (HsDecl pass) where ppr (TyClD dcl) = ppr dcl ppr (ValD binds) = ppr binds ppr (DefD def) = ppr def @@ -273,8 +272,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) ppr (DocD doc) = ppr doc ppr (RoleAnnotD ra) = ppr ra -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsGroup (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (HsGroup pass) where ppr (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls, hs_derivds = deriv_decls, @@ -318,8 +317,8 @@ data SpliceDecl id SpliceExplicitFlag deriving instance (DataId id) => Data (SpliceDecl id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (SpliceDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (SpliceDecl pass) where ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f {- @@ -634,17 +633,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 (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (TyClDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (TyClDecl pass) where ppr (FamDecl { tcdFam = decl }) = ppr decl ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity @@ -675,8 +674,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context) <+> pprFundeps (map unLoc fds) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (TyClGroup (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (TyClGroup pass) where ppr (TyClGroup { group_tyclds = tyclds , group_roles = roles , group_instds = instds @@ -686,11 +685,11 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) ppr roles $$ ppr instds -pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Located (IdP (GhcPass p)) - -> LHsQTyVars (GhcPass p) +pp_vanilla_decl_head :: (SourceTextX pass, OutputableBndrId pass) + => Located (IdP pass) + -> LHsQTyVars pass -> LexicalFixity - -> HsContext (GhcPass p) + -> HsContext pass -> SDoc pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context = hsep [pprHsContext context, pp_tyvars tyvars] @@ -965,21 +964,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 (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (FamilyDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (FamilyDecl pass) where ppr = pprFamilyDecl TopLevel -pprFamilyDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc +pprFamilyDecl :: (SourceTextX pass, OutputableBndrId pass) + => TopLevelFlag -> FamilyDecl pass -> SDoc pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon , fdTyVars = tyvars , fdFixity = fixity @@ -1096,8 +1095,8 @@ data HsDerivingClause pass } deriving instance (DataId id) => Data (HsDerivingClause id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsDerivingClause (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (HsDerivingClause pass) where ppr (HsDerivingClause { deriv_clause_strategy = dcs , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" @@ -1205,7 +1204,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) @@ -1214,9 +1213,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 (GhcPass p), OutputableBndrId (GhcPass p)) - => (HsContext (GhcPass p) -> SDoc) -- Printing the header - -> HsDataDefn (GhcPass p) +pp_data_defn :: (SourceTextX pass, OutputableBndrId pass) + => (HsContext pass -> SDoc) -- Printing the header + -> HsDataDefn pass -> SDoc pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context , dd_cType = mb_ct @@ -1238,27 +1237,26 @@ 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 (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsDataDefn (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (HsDataDefn pass) 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 (GhcPass p), OutputableBndrId (GhcPass p)) - => [LConDecl (GhcPass p)] -> SDoc +pp_condecls :: (SourceTextX pass, OutputableBndrId pass) + => [LConDecl pass] -> 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 (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (ConDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (ConDecl pass) where ppr = pprConDecl -pprConDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => ConDecl (GhcPass p) -> SDoc +pprConDecl :: (SourceTextX pass, OutputableBndrId pass) => ConDecl pass -> SDoc pprConDecl (ConDeclH98 { con_name = L _ con , con_qvars = mtvs , con_cxt = mcxt @@ -1479,12 +1477,12 @@ data InstDecl pass -- Both class and family instances { tfid_inst :: TyFamInstDecl pass } deriving instance (DataId id) => Data (InstDecl id) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (TyFamInstDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (TyFamInstDecl pass) where ppr = pprTyFamInstDecl TopLevel -pprTyFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc +pprTyFamInstDecl :: (SourceTextX pass, OutputableBndrId pass) + => TopLevelFlag -> TyFamInstDecl pass -> SDoc pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn }) = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn @@ -1492,16 +1490,16 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc ppr_instance_keyword TopLevel = text "instance" ppr_instance_keyword NotTopLevel = empty -ppr_fam_inst_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => TyFamInstEqn (GhcPass p) -> SDoc +ppr_fam_inst_eqn :: (SourceTextX pass, OutputableBndrId pass) + => TyFamInstEqn pass -> 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 (GhcPass p), OutputableBndrId (GhcPass p)) - => LTyFamDefltEqn (GhcPass p) -> SDoc +ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass) + => LTyFamDefltEqn pass -> SDoc ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon , feqn_pats = tvs , feqn_fixity = fixity @@ -1509,12 +1507,12 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon = text "type" <+> pp_vanilla_decl_head tycon tvs fixity [] <+> equals <+> ppr rhs -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (DataFamInstDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (DataFamInstDecl pass) where ppr = pprDataFamInstDecl TopLevel -pprDataFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc +pprDataFamInstDecl :: (SourceTextX pass, OutputableBndrId pass) + => TopLevelFlag -> DataFamInstDecl pass -> SDoc pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = tycon , feqn_pats = pats @@ -1530,12 +1528,12 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}}) = ppr nd -pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Located (IdP (GhcPass p)) - -> HsTyPats (GhcPass p) +pprFamInstLHS :: (SourceTextX pass, OutputableBndrId pass) + => Located (IdP pass) + -> HsTyPats pass -> LexicalFixity - -> HsContext (GhcPass p) - -> Maybe (LHsKind (GhcPass p)) + -> HsContext pass + -> Maybe (LHsKind pass) -> SDoc pprFamInstLHS thing typats fixity context mb_kind_sig -- explicit type patterns @@ -1555,8 +1553,8 @@ pprFamInstLHS thing typats fixity context mb_kind_sig | otherwise = empty -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (ClsInstDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (ClsInstDecl pass) where ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds , cid_sigs = sigs, cid_tyfam_insts = ats , cid_overlap_mode = mbOverlap @@ -1594,8 +1592,8 @@ ppOverlapPragma mb = maybe_stext (SourceText src) _ = text src <+> text "#-}" -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (InstDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (InstDecl pass) where ppr (ClsInstD { cid_inst = decl }) = ppr decl ppr (TyFamInstD { tfid_inst = decl }) = ppr decl ppr (DataFamInstD { dfid_inst = decl }) = ppr decl @@ -1636,8 +1634,8 @@ data DerivDecl pass = DerivDecl } deriving instance (DataId pass) => Data (DerivDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (DerivDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (DerivDecl pass) where ppr (DerivDecl { deriv_type = ty , deriv_strategy = ds , deriv_overlap_mode = o }) @@ -1671,8 +1669,8 @@ data DefaultDecl pass -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataId pass) => Data (DefaultDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (DefaultDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (DefaultDecl pass) where ppr (DefaultDecl tys) = text "default" <+> parens (interpp'SP tys) @@ -1775,8 +1773,8 @@ data ForeignExport = CExport (Located CExportSpec) -- contains the calling -- pretty printing of foreign declarations -- -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (ForeignDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (ForeignDecl pass) 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) @@ -1882,14 +1880,14 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs] pprFullRuleName :: Located (SourceText, RuleName) -> SDoc pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (RuleDecls (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (RuleDecls pass) where ppr (HsRules st rules) = pprWithSourceText st (text "{-# RULES") <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}" -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (RuleDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (RuleDecl pass) where ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs) = sep [pprFullRuleName name <+> ppr act, nest 4 (pp_forall <+> pprExpr (unLoc lhs)), @@ -1898,8 +1896,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) pp_forall | null ns = empty | otherwise = forAllLit <+> fsep (map ppr ns) <> dot -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (RuleBndr (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (RuleBndr pass) where ppr (RuleBndr name) = ppr name ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty) @@ -1986,8 +1984,8 @@ lvectInstDecl (L _ (HsVectInstIn _)) = True lvectInstDecl (L _ (HsVectInstOut _)) = True lvectInstDecl _ = False -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (VectDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (VectDecl pass) where ppr (HsVect _ v rhs) = sep [text "{-# VECTORISE" <+> ppr v, nest 4 $ @@ -2108,8 +2106,8 @@ data AnnDecl pass = HsAnnotation -- For details on above see note [Api annotations] in ApiAnnotation deriving instance (DataId pass) => Data (AnnDecl pass) -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (AnnDecl (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (AnnDecl pass) where ppr (HsAnnotation _ provenance expr) = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"] |