From b91798be48d9fa02610b419ccea15a7dfd663823 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Sat, 12 Mar 2022 00:07:56 +0000 Subject: hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. --- compiler/GHC/Iface/Ext/Ast.hs | 35 +++++++++++++++++++++++++++-------- compiler/GHC/Iface/Load.hs | 23 ++++++----------------- compiler/GHC/Iface/Make.hs | 22 ++++++++-------------- 3 files changed, 41 insertions(+), 39 deletions(-) (limited to 'compiler/GHC/Iface') diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 60885ae7ee..73ad2a09b7 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -205,7 +205,7 @@ call and just recurse directly in to the subexpressions. -- These synonyms match those defined in compiler/GHC.hs type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn] , Maybe [(LIE GhcRn, Avails)] - , Maybe LHsDocString ) + , Maybe (LHsDoc GhcRn) ) type TypecheckedSource = LHsBinds GhcTc @@ -316,12 +316,13 @@ getCompressedAsts ts rs top_ev_binds insts tcs = enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon] -> HieASTs Type -enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs = +enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs = runIdentity $ flip evalStateT initState $ flip runReaderT SourceInfo $ do tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts rasts <- processGrp hsGrp imps <- toHie $ filter (not . ideclImplicit . unLoc) imports exps <- toHie $ fmap (map $ IEC Export . fst) exports + docs <- toHie docs -- Add Instance bindings forM_ insts $ \i -> addUnlocatedEvBind (is_dfun i) (EvidenceVarBind (EvInstBind False (is_cls_nm i)) ModuleScope Nothing) @@ -341,6 +342,7 @@ enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs = , rasts , imps , exps + , docs ] modulify (HiePath file) xs' = do @@ -387,6 +389,7 @@ enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs = , toHie $ hs_warnds grp , toHie $ hs_annds grp , toHie $ hs_ruleds grp + , toHie $ hs_docs grp ] getRealSpanA :: SrcSpanAnn' ann -> Maybe Span @@ -1596,7 +1599,8 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where instance ToHie (LocatedA (ConDecl GhcRn)) where toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs - , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ } -> + , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ + , con_doc = doc} -> [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names , case outer_bndrs of HsOuterImplicit{hso_ximplicit = imp_vars} -> @@ -1607,6 +1611,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where , toHie ctx , toHie args , toHie typ + , toHie doc ] where rhsScope = combineScopes argsScope tyScope @@ -1617,11 +1622,13 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where tyScope = mkLScopeA typ resScope = ResolvedScopes [ctxScope, rhsScope] ConDeclH98 { con_name = name, con_ex_tvs = qvars - , con_mb_cxt = ctx, con_args = dets } -> + , con_mb_cxt = ctx, con_args = dets + , con_doc = doc} -> [ toHie $ C (Decl ConDec $ getRealSpan (locA span)) name , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars , toHie ctx , toHie dets + , toHie doc ] where rhsScope = combineScopes ctxScope argsScope @@ -1780,8 +1787,9 @@ instance ToHie (LocatedA (HsType GhcRn)) where HsSpliceTy _ a -> [ toHie $ L span a ] - HsDocTy _ a _ -> + HsDocTy _ a doc -> [ toHie a + , toHie doc ] HsBangTy _ _ ty -> [ toHie ty @@ -1832,9 +1840,10 @@ instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where instance ToHie (LocatedA (ConDeclField GhcRn)) where toHie (L span field) = concatM $ makeNode field (locA span) : case field of - ConDeclField _ fields typ _ -> + ConDeclField _ fields typ doc -> [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields , toHie typ + , toHie doc ] instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where @@ -2088,8 +2097,8 @@ instance ToHie (IEContext (LocatedA (IE GhcRn))) where IEModuleContents _ n -> [ toHie $ IEC c n ] - IEGroup _ _ _ -> [] - IEDoc _ _ -> [] + IEGroup _ _ d -> [toHie d] + IEDoc _ d -> [toHie d] IEDocNamed _ _ -> [] instance ToHie (IEContext (LIEWrappedName Name)) where @@ -2109,3 +2118,13 @@ instance ToHie (IEContext (Located FieldLabel)) where [ makeNode lbl span , toHie $ C (IEThing c) $ L span (flSelector lbl) ] + +instance ToHie (LocatedA (DocDecl GhcRn)) where + toHie (L span d) = concatM $ makeNodeA d span : case d of + DocCommentNext d -> [ toHie d ] + DocCommentPrev d -> [ toHie d ] + DocCommentNamed _ d -> [ toHie d ] + DocGroup _ d -> [ toHie d ] + +instance ToHie (LHsDoc GhcRn) where + toHie (L span d@(WithHsDocIdentifiers _ ids)) = concatM $ makeNode d span : [toHie $ map (C Use) ids] diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 0055cea807..18554fdc50 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -21,7 +21,7 @@ module GHC.Iface.Load ( -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, loadSrcInterface, loadSrcInterface_maybe, - loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule, + loadInterfaceForName, loadInterfaceForModule, -- IfM functions loadInterface, @@ -349,15 +349,6 @@ loadInterfaceForName doc name ; assertPpr (isExternalName name) (ppr name) $ initIfaceTcRn $ loadSysInterface doc (nameModule name) } --- | Only loads the interface for external non-local names. -loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface) -loadInterfaceForNameMaybe doc name - = do { this_mod <- getModule - ; if nameIsLocalOrFrom this_mod name || not (isExternalName name) - then return Nothing - else Just <$> (initIfaceTcRn $ loadSysInterface doc (nameModule name)) - } - -- | Loads the interface for a given Module. loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface loadInterfaceForModule doc m @@ -1025,7 +1016,7 @@ ghcPrimIface mi_decls = [], mi_fixities = fixities, mi_final_exts = (mi_final_exts empty_iface){ mi_fix_fn = mkIfaceFixCache fixities }, - mi_decl_docs = ghcPrimDeclDocs -- See Note [GHC.Prim Docs] + mi_docs = Just ghcPrimDeclDocs -- See Note [GHC.Prim Docs] } where empty_iface = emptyFullModIface gHC_PRIM @@ -1142,9 +1133,7 @@ pprModIface unit_state iface@ModIface{ mi_final_exts = exts } , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) , vcat (map ppr (mi_complete_matches iface)) - , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) - , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) - , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) + , text "docs:" $$ nest 2 (ppr (mi_docs iface)) , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface)) ] where @@ -1209,13 +1198,13 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable Warnings where +instance Outputable (Warnings pass) where ppr = pprWarns -pprWarns :: Warnings -> SDoc +pprWarns :: Warnings pass -> SDoc pprWarns NoWarnings = Outputable.empty pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings" +pprWarns (WarnSome prs) = text "Warnings:" <+> vcat (map pprWarning prs) where pprWarning (name, txt) = ppr name <+> ppr txt diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs index 19739ff3e3..7cf782a18d 100644 --- a/compiler/GHC/Iface/Make.hs +++ b/compiler/GHC/Iface/Make.hs @@ -125,12 +125,10 @@ mkPartialIface hsc_env mod_details mod_summary , mg_hpc_info = hpc_info , mg_safe_haskell = safe_mode , mg_trust_pkg = self_trust - , mg_doc_hdr = doc_hdr - , mg_decl_docs = decl_docs - , mg_arg_docs = arg_docs + , mg_docs = docs } = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust - safe_mode usages doc_hdr decl_docs arg_docs mod_summary mod_details + safe_mode usages docs mod_summary mod_details -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. @@ -222,34 +220,32 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged needed_links needed_pkgs - (doc_hdr', doc_map, arg_map) <- extractDocs tc_result + docs <- extractDocs (ms_hspp_opts mod_summary) tc_result let partial_iface = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info (imp_trust_own_pkg imports) safe_mode usages - doc_hdr' doc_map arg_map mod_summary + docs mod_summary mod_details mkFullIface hsc_env partial_iface Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv - -> NameEnv FixItem -> Warnings -> HpcInfo + -> NameEnv FixItem -> Warnings GhcRn -> HpcInfo -> Bool -> SafeHaskellMode -> [Usage] - -> Maybe HsDocString - -> DeclDocMap - -> ArgDocMap + -> Maybe Docs -> ModSummary -> ModDetails -> PartialModIface mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env src_warns hpc_info pkg_trust_req safe_mode usages - doc_hdr decl_docs arg_docs mod_summary + docs mod_summary ModDetails{ md_insts = insts, md_fam_insts = fam_insts, md_rules = rules, @@ -322,9 +318,7 @@ mkIface_ hsc_env mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, mi_complete_matches = icomplete_matches, - mi_doc_hdr = doc_hdr, - mi_decl_docs = decl_docs, - mi_arg_docs = arg_docs, + mi_docs = docs, mi_final_exts = (), mi_ext_fields = emptyExtensibleFields, mi_src_hash = ms_hs_hash mod_summary -- cgit v1.2.1