[Git][ghc/ghc][master] HieAst: add module name #24493
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Mar 9 08:41:17 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00
HieAst: add module name #24493
The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst.
It should fix #24493.
The following have been done:
1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))`
To store the located module name information.
2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information.
3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests.
4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53
- - - - -
13 changed files:
- compiler/GHC.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Monad.hs
- + testsuite/tests/hiefile/should_compile/T24493.hs
- + testsuite/tests/hiefile/should_compile/T24493.stderr
- testsuite/tests/hiefile/should_compile/all.T
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- utils/haddock
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -1157,7 +1157,7 @@ instance DesugaredMod DesugaredModule where
type ParsedSource = Located (HsModule GhcPs)
type RenamedSource = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
- Maybe (LHsDoc GhcRn))
+ Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))
type TypecheckedSource = LHsBinds GhcTc
-- NOTE:
=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -63,12 +63,12 @@ extractDocs dflags
, tcg_imports = import_avails
, tcg_insts = insts
, tcg_fam_insts = fam_insts
- , tcg_doc_hdr = mb_doc_hdr
+ , tcg_hdr_info = mb_hdr_info
, tcg_th_docs = th_docs_var
, tcg_type_env = ty_env
} = do
th_docs <- liftIO $ readIORef th_docs_var
- let doc_hdr = (unLoc <$> mb_doc_hdr)
+ let doc_hdr = unLoc <$> fst mb_hdr_info
ExtractedTHDocs th_hdr th_decl_docs th_arg_docs th_inst_docs = extractTHDocs th_docs
mod_docs
= Docs
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -210,7 +210,8 @@ 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 (LHsDoc GhcRn) )
+ , Maybe (LHsDoc GhcRn)
+ , Maybe (XRec GhcRn ModuleName) )
type TypecheckedSource = LHsBinds GhcTc
@@ -321,8 +322,9 @@ getCompressedAsts ts rs top_ev_binds insts tcs =
enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon]
-> HieASTs Type
-enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs =
+enrichHie ts (hsGrp, imports, exports, docs, modName) ev_bs insts tcs =
runIdentity $ flip evalStateT initState $ flip runReaderT SourceInfo $ do
+ modName <- toHie (IEC Export <$> modName)
tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
rasts <- processGrp hsGrp
imps <- toHie $ filter (not . ideclImplicit . ideclExt . unLoc) imports
@@ -344,7 +346,8 @@ enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs =
(realSrcSpanEnd $ nodeSpan (NE.last children))
flat_asts = concat
- [ tasts
+ [ modName
+ , tasts
, rasts
, imps
, exps
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -297,8 +297,8 @@ tcRnModuleTcRnM hsc_env mod_sum
-- We will rename it properly after renaming everything else so that
-- haddock can link the identifiers
; tcg_env <- return (tcg_env
- { tcg_doc_hdr = fmap (\(WithHsDocIdentifiers str _) -> WithHsDocIdentifiers str [])
- <$> maybe_doc_hdr })
+ { tcg_hdr_info = (fmap (\(WithHsDocIdentifiers str _) -> WithHsDocIdentifiers str [])
+ <$> maybe_doc_hdr , maybe_mod ) })
; -- If the whole module is warned about or deprecated
-- (via mod_deprec) record that in tcg_warns. If we do thereby add
-- a WarnAll, it will override any subsequent deprecations added to tcg_warns
@@ -347,7 +347,7 @@ tcRnModuleTcRnM hsc_env mod_sum
-- Rename the module header properly after we have renamed everything else
; maybe_doc_hdr <- traverse rnLHsDoc maybe_doc_hdr;
; tcg_env <- return (tcg_env
- { tcg_doc_hdr = maybe_doc_hdr })
+ { tcg_hdr_info = (maybe_doc_hdr, maybe_mod) })
; -- add extra source files to tcg_dependent_files
addDependentFiles src_files
@@ -3115,14 +3115,15 @@ runRenamerPlugin gbl_env hs_group = do
-- exception/signal an error.
type RenamedStuff =
(Maybe (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
- Maybe (LHsDoc GhcRn)))
+ Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)))
-- | Extract the renamed information from TcGblEnv.
getRenamedStuff :: TcGblEnv -> RenamedStuff
getRenamedStuff tc_result
= fmap (\decls -> ( decls, tcg_rn_imports tc_result
- , tcg_rn_exports tc_result, tcg_doc_hdr tc_result ) )
+ , tcg_rn_exports tc_result, doc_hdr, name_hdr ))
(tcg_rn_decls tc_result)
+ where (doc_hdr, name_hdr) = tcg_hdr_info tc_result
runTypecheckerPlugin :: ModSummary -> TcGblEnv -> TcM TcGblEnv
runTypecheckerPlugin sum gbl_env = do
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -605,7 +605,9 @@ data TcGblEnv
tcg_fords :: [LForeignDecl GhcTc], -- ...Foreign import & exports
tcg_patsyns :: [PatSyn], -- ...Pattern synonyms
- tcg_doc_hdr :: Maybe (LHsDoc GhcRn), -- ^ Maybe Haddock header docs
+ tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)),
+ -- ^ Maybe Haddock header docs and Maybe located module name
+
tcg_hpc :: !AnyHpcUsage, -- ^ @True@ if any part of the
-- prog uses hpc instrumentation.
-- NB. BangPattern is to fix a leak, see #15111
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -523,8 +523,8 @@ mergeSignatures
tcg_rn_decls = tcg_rn_decls orig_tcg_env,
-- Annotations
tcg_ann_env = tcg_ann_env orig_tcg_env,
- -- Documentation header
- tcg_doc_hdr = tcg_doc_hdr orig_tcg_env
+ -- Documentation header and located module name
+ tcg_hdr_info = tcg_hdr_info orig_tcg_env
-- tcg_dus?
-- tcg_th_used = tcg_th_used orig_tcg_env,
-- tcg_th_splice_used = tcg_th_splice_used orig_tcg_env
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -346,7 +346,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_merged = [],
tcg_dfun_n = dfun_n_var,
tcg_keep = keep_var,
- tcg_doc_hdr = Nothing,
+ tcg_hdr_info = (Nothing,Nothing),
tcg_hpc = False,
tcg_main = Nothing,
tcg_self_boot = NoSelfBoot,
=====================================
testsuite/tests/hiefile/should_compile/T24493.hs
=====================================
@@ -0,0 +1,3 @@
+module T24493 where
+
+go = "1"
=====================================
testsuite/tests/hiefile/should_compile/T24493.stderr
=====================================
@@ -0,0 +1,33 @@
+==================== HIE AST ====================
+File: T24493.hs
+Node at T24493.hs:(1,8)-(3,8): Source: From source
+ {(annotations: {(Module, Module)}), (types: []),
+ (identifier info: {})}
+
+ Node at T24493.hs:1:8-13: Source: From source
+ {(annotations: {}), (types: []),
+ (identifier info: {(module T24493, Details: Nothing {export})})}
+
+ Node at T24493.hs:3:1-8: Source: From source
+ {(annotations: {(FunBind, HsBindLR), (Match, Match),
+ (XHsBindsLR, HsBindLR)}),
+ (types: [0]), (identifier info: {})}
+
+ Node at T24493.hs:3:1-2: Source: From source
+ {(annotations: {}), (types: []),
+ (identifier info: {(name T24493.go, Details: Just 0 {LHS of a match group,
+ regular value bound with scope: ModuleScope bound at: T24493.hs:3:1-8})})}
+
+ Node at T24493.hs:3:4-8: Source: From source
+ {(annotations: {(GRHS, GRHS)}), (types: []),
+ (identifier info: {})}
+
+ Node at T24493.hs:3:6-8: Source: From source
+ {(annotations: {(HsLit, HsExpr)}), (types: [0]),
+ (identifier info: {})}
+
+
+
+
+Got valid scopes
+Got no roundtrip errors
\ No newline at end of file
=====================================
testsuite/tests/hiefile/should_compile/all.T
=====================================
@@ -23,3 +23,4 @@ test('Scopes', normal, compile, ['-fno-code -fwrite-ide-
test('ScopesBug', expect_broken(18425), compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('T18425', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('T22416', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
+test('T24493', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info -ddump-hie'])
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -2,7 +2,7 @@
==================== Renamer ====================
(Just
- ((,,,)
+ ((,,,,)
(HsGroup
(NoExtField)
(XValBindsLR
@@ -2367,6 +2367,16 @@
{Name: GHC.Types.Type})))
(Nothing)))])))))]
(Nothing)
- (Nothing)))
+ (Nothing)
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { DumpRenamedAst.hs:4:8-21 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: DumpRenamedAst}))))
+
=====================================
testsuite/tests/parser/should_compile/T14189.stderr
=====================================
@@ -2,7 +2,7 @@
==================== Renamer ====================
(Just
- ((,,,)
+ ((,,,,)
(HsGroup
(NoExtField)
(XValBindsLR
@@ -316,6 +316,13 @@
[{Name: T14189.MyType}
,{Name: T14189.f}
,{Name: T14189.NT}])])])
- (Nothing)))
-
-
+ (Nothing)
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { T14189.hs:1:8-13 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: T14189}))))
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 91f338a4f1ae59fd6ea482b73a27708113912d5d
+Subproject commit 730749b48c3d7b358f4fb07774a1ccfc1d63968a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfb197e3dee6781978a8143d686f0fb593614e52
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfb197e3dee6781978a8143d686f0fb593614e52
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240309/bc3a5e38/attachment-0001.html>
More information about the ghc-commits
mailing list