[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ghc-internal: Eliminate GHC.Internal.Data.Kind
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 8 11:35:34 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00
ghc-internal: Eliminate GHC.Internal.Data.Kind
This was simply reexporting things from `ghc-prim`. Instead reexport
these directly from `Data.Kind`. Also add build ordering dependency to
work around #23942.
- - - - -
38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00
rts: Fix SET_HDR initialization of retainer set
This fixes a regression in retainer set profiling introduced by
b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit
the heap traversal word would be initialized by `SET_HDR` using
`LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling`
check in `LDV_RECORD_CREATE`, meaning that this initialization no longer
happened.
Given that this initialization was awkwardly indirectly anyways, I have
fixed this by explicitly initializating the heap traversal word to
`NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior,
but much more direct.
Fixes #24513.
- - - - -
d17e0cfc by Patrick at 2024-03-08T08:54:36+00: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
- - - - -
21c7494d by Ben Gamari at 2024-03-08T06:35:23-05:00
rts/linker: Enable GOT support on all platforms
There is nothing platform-dependent about our GOT implementation and
GOT support is needed by `T24171` on i386.
- - - - -
21 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
- libraries/base/src/Data/Kind.hs
- libraries/ghc-internal/ghc-internal.cabal
- rts/include/rts/storage/ClosureMacros.h
- rts/linker/Elf.c
- + testsuite/tests/hiefile/should_compile/T24493.hs
- + testsuite/tests/hiefile/should_compile/T24493.stderr
- testsuite/tests/hiefile/should_compile/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- 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,
=====================================
libraries/base/src/Data/Kind.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
-- |
--
@@ -19,4 +19,6 @@ module Data.Kind
FUN
) where
-import GHC.Internal.Data.Kind
\ No newline at end of file
+import GHC.Num.BigNat () -- for build ordering (#23942)
+import GHC.Prim (FUN)
+import GHC.Types (Type, Constraint)
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -120,7 +120,6 @@ Library
GHC.Internal.Data.Functor.Utils
GHC.Internal.Data.IORef
GHC.Internal.Data.Ix
- GHC.Internal.Data.Kind
GHC.Internal.Data.List
GHC.Internal.Data.Maybe
GHC.Internal.Data.Monoid
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -147,17 +147,10 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
#if defined(PROFILING)
/*
The following macro works for both retainer profiling and LDV profiling. For
- retainer profiling, 'era' remains 0, so by setting the 'ldvw' field we also set
- 'rs' to zero.
-
- Note that we don't have to bother handling the 'flip' bit properly[1] since the
- retainer profiling code will just set 'rs' to NULL upon visiting a closure with
- an invalid 'flip' bit anyways.
-
- See Note [Profiling heap traversal visited bit] for details.
-
- [1]: Technically we should set 'rs' to `NULL | flip`.
+ retainer profiling, we set 'trav' to 0, which is an invalid
+ RetainerSet.
*/
+
/*
MP: Various other places use the check era > 0 to check whether LDV profiling
is enabled. The use of these predicates here is the reason for including RtsFlags.h in
@@ -168,17 +161,14 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
*/
#define SET_PROF_HDR(c, ccs_) \
{ \
- (c)->header.prof.ccs = ccs_; \
- if (doingLDVProfiling()) { \
- LDV_RECORD_CREATE((c)); \
- } \
-\
- if (doingRetainerProfiling()) { \
- LDV_RECORD_CREATE((c)); \
- }; \
- if (doingErasProfiling()){ \
- ERA_RECORD_CREATE((c)); \
- }; \
+ (c)->header.prof.ccs = ccs_; \
+ if (doingLDVProfiling()) { \
+ LDV_RECORD_CREATE((c)); \
+ } else if (doingRetainerProfiling()) { \
+ (c)->header.prof.hp.trav = 0; \
+ } else if (doingErasProfiling()){ \
+ ERA_RECORD_CREATE((c)); \
+ } \
}
#else
=====================================
rts/linker/Elf.c
=====================================
@@ -101,10 +101,10 @@
# include <elf_abi.h>
#endif
+#include "elf_got.h"
+
#if defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)
-# define NEED_GOT
# define NEED_PLT
-# include "elf_got.h"
# include "elf_plt.h"
# include "elf_reloc.h"
#endif
@@ -798,7 +798,7 @@ ocGetNames_ELF ( ObjectCode* oc )
/* This is a non-empty .bss section. Allocate zeroed space for
it, and set its .sh_offset field such that
ehdrC + .sh_offset == addr_of_zeroed_space. */
-#if defined(NEED_GOT) || RTS_LINKER_USE_MMAP
+#if RTS_LINKER_USE_MMAP
if (USE_CONTIGUOUS_MMAP || RtsFlags.MiscFlags.linkerAlwaysPic) {
/* The space for bss sections is already preallocated */
CHECK(oc->bssBegin != NULL);
@@ -1113,13 +1113,11 @@ ocGetNames_ELF ( ObjectCode* oc )
}
}
-#if defined(NEED_GOT)
if(makeGot( oc ))
errorBelch("Failed to create GOT for %s",
oc->archiveMemberName
? oc->archiveMemberName
: oc->fileName);
-#endif
result = 1;
goto end;
@@ -1987,13 +1985,11 @@ ocResolve_ELF ( ObjectCode* oc )
}
}
-#if defined(NEED_GOT)
if(fillGot( oc ))
return 0;
/* silence warnings */
(void) shnum;
(void) shdr;
-#endif /* NEED_GOT */
#if defined(aarch64_HOST_ARCH)
/* use new relocation design */
=====================================
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/interface-stability/base-exports.stdout
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
{-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
module Data.Kind where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Constraint :: *
type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
type role FUN nominal representational representational
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
{-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
module Data.Kind where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Constraint :: *
type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
type role FUN nominal representational representational
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
{-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
module Data.Kind where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Constraint :: *
type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
type role FUN nominal representational representational
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
{-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
module Data.Kind where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Constraint :: *
type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
type role FUN nominal representational representational
=====================================
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/-/compare/acc39486d1b9b94a7378d08448b7450248131df5...21c7494d64fc83bcfbb3dbb4f8cb7965efb129cd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acc39486d1b9b94a7378d08448b7450248131df5...21c7494d64fc83bcfbb3dbb4f8cb7965efb129cd
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/20240308/3047f4a4/attachment-0001.html>
More information about the ghc-commits
mailing list