diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 98e013489bc466666b9f38f66e4b842913485b3d..7bb6a49c656f275746c3f2a69ac940f7f50d60fa 100644
--- a/compiler/GHC.hs
+++ b/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:
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 1cc76ef267b8291fd9b7f18a8737d428a875a58e..6632cba73b53191d0601eb2f8af5f3ace19509e8 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/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
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 9e8490f3f815f3f282a7c223abfa485459c58b04..4dde13bc14fd3b521eec6c1912426b4afb01d42c 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/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
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 81fce1c6ec06a166e1c7f1ef9ed8d16ad9e1f5b6..e25cd3b7e1da928e5066d86ffe98d4046b6b4c70 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/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
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 4e091bd3d2381c83192084c8c2e9e915d263fe01..1dd424224846e84c0ba964f983d1471a6fb0f021 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/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
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index fa9ad5de74d93625a98735ff144a4318adef2d5e..500cd03c79661f25083340b563009a336484c037 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/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
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 57be821960e7c5253104d53ba22c6dfad62303a9..ea75fa9f5347985cc01eb48f5202bdbd45eccf74 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/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,
diff --git a/testsuite/tests/hiefile/should_compile/T24493.hs b/testsuite/tests/hiefile/should_compile/T24493.hs
new file mode 100644
index 0000000000000000000000000000000000000000..f258faae389a313f52abf06d51e794439bff6e4e
--- /dev/null
+++ b/testsuite/tests/hiefile/should_compile/T24493.hs
@@ -0,0 +1,3 @@
+module T24493 where
+
+go = "1"
diff --git a/testsuite/tests/hiefile/should_compile/T24493.stderr b/testsuite/tests/hiefile/should_compile/T24493.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..95456f325f26ea4955a3abbdbbc4bf02fa6a75ac
--- /dev/null
+++ b/testsuite/tests/hiefile/should_compile/T24493.stderr
@@ -0,0 +1,33 @@
+==================== HIE AST ====================
+File: T24493.hs
+Node@T24493.hs:(1,8)-(3,8): Source: From source
+ {(annotations: {(Module, Module)}), (types: []),
+ (identifier info: {})}
+
+ Node@T24493.hs:1:8-13: Source: From source
+ {(annotations: {}), (types: []),
+ (identifier info: {(module T24493, Details: Nothing {export})})}
+
+ Node@T24493.hs:3:1-8: Source: From source
+ {(annotations: {(FunBind, HsBindLR), (Match, Match),
+ (XHsBindsLR, HsBindLR)}),
+ (types: [0]), (identifier info: {})}
+
+ Node@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@T24493.hs:3:4-8: Source: From source
+ {(annotations: {(GRHS, GRHS)}), (types: []),
+ (identifier info: {})}
+
+ Node@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
diff --git a/testsuite/tests/hiefile/should_compile/all.T b/testsuite/tests/hiefile/should_compile/all.T
index 8b90f91376dd105e02e5205cc8962c0a9d6701f6..b7b347848443f5ae3db30e6d06ba5df009dc8d7c 100644
--- a/testsuite/tests/hiefile/should_compile/all.T
+++ b/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'])
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 5019e8ff98369369e881929273996d47fe398719..499420e27605a6cebf74012ef8e69b2ad97bd5fb 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/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}))))
+
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index 4fc563a56b78ca33b1ae2bca02af469c2bd07481..4a8e0723a23003b0998f76b54d41fc658b5825db 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/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}))))
diff --git a/utils/haddock b/utils/haddock
index 91f338a4f1ae59fd6ea482b73a27708113912d5d..730749b48c3d7b358f4fb07774a1ccfc1d63968a 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 91f338a4f1ae59fd6ea482b73a27708113912d5d
+Subproject commit 730749b48c3d7b358f4fb07774a1ccfc1d63968a