diff options
Diffstat (limited to 'compiler/GHC/Rename/Module.hs')
| -rw-r--r-- | compiler/GHC/Rename/Module.hs | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index b46528c6ed..9fbbcacdab 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -13,7 +13,7 @@ Main pass of renamer -} module GHC.Rename.Module ( - rnSrcDecls, addTcgDUs, findSplice + rnSrcDecls, addTcgDUs, findSplice, rnWarningTxt ) where import GHC.Prelude @@ -27,6 +27,7 @@ import GHC.Types.FieldLabel import GHC.Types.Name.Reader import GHC.Rename.HsType import GHC.Rename.Bind +import GHC.Rename.Doc import GHC.Rename.Env import GHC.Rename.Utils ( mapFvRn, bindLocalNames , checkDupRdrNamesN, bindLocalNamesFV @@ -205,6 +206,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ; (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ; (rn_splice_decls, src_fvs7) <- rnList rnSpliceDecl splice_decls ; + rn_docs <- traverse rnLDocDecl docs ; last_tcg_env <- getGblEnv ; -- (I) Compute the results and return @@ -220,7 +222,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, hs_annds = rn_ann_decls, hs_defds = rn_default_decls, hs_ruleds = rn_rule_decls, - hs_docs = docs } ; + hs_docs = rn_docs } ; tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ; other_def = (Just (mkNameSet tcf_bndrs), emptyNameSet) ; @@ -264,7 +266,7 @@ gather them together. -} -- checks that the deprecations are defined locally, and that there are no duplicates -rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM Warnings +rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM (Warnings GhcRn) rnSrcWarnDecls _ [] = return NoWarnings @@ -284,13 +286,23 @@ rnSrcWarnDecls bndr_set decls' -- ensures that the names are defined locally = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc) rdr_names - ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] } + ; txt' <- rnWarningTxt txt + ; return [(rdrNameOcc rdr, txt') | (rdr, _) <- names] } what = text "deprecation" warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning _ ns _)) -> ns) decls +rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn) +rnWarningTxt (WarningTxt st wst) = do + wst' <- traverse (traverse rnHsDoc) wst + pure (WarningTxt st wst') +rnWarningTxt (DeprecatedTxt st wst) = do + wst' <- traverse (traverse rnHsDoc) wst + pure (DeprecatedTxt st wst') + + findDupRdrNames :: [LocatedN RdrName] -> [NonEmpty (LocatedN RdrName)] findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y)) @@ -1878,11 +1890,12 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, -- and the methods are already in scope ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs + ; docs' <- traverse rnLDocDecl docs ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls', tcdTyVars = tyvars', tcdFixity = fixity, tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs', - tcdDocs = docs, tcdCExt = all_fvs }, + tcdDocs = docs', tcdCExt = all_fvs }, all_fvs ) } where cls_doc = ClassDeclCtx lcls @@ -2328,10 +2341,11 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs [ text "ex_tvs:" <+> ppr ex_tvs , text "new_ex_dqtvs':" <+> ppr new_ex_tvs ]) + ; mb_doc' <- traverse rnLHsDoc mb_doc ; return (decl { con_ext = noAnn , con_name = new_name, con_ex_tvs = new_ex_tvs , con_mb_cxt = new_context, con_args = new_args - , con_doc = mb_doc + , con_doc = mb_doc' , con_forall = forall_ }, -- Remove when #18311 is fixed all_fvs) }} @@ -2372,10 +2386,11 @@ rnConDecl (ConDeclGADT { con_names = names ; traceRn "rnConDecl (ConDeclGADT)" (ppr names $$ ppr outer_bndrs') + ; new_mb_doc <- traverse rnLHsDoc mb_doc ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt , con_g_args = new_args, con_res_ty = new_res_ty - , con_doc = mb_doc }, + , con_doc = new_mb_doc }, all_fvs) } } rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs) |