[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jul 11 07:37:12 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8e11630e by jade at 2023-07-10T16:58:40-04:00
Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007)
As suggested in #20007 and implemented in !8895, trying to import type operators
will suggest a fix to use the 'type' keyword, without considering whether
ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces
is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled,
alongside the suggestion of adding the 'type' keyword.
- - - - -
61b1932e by sheaf at 2023-07-10T16:59:26-04:00
tyThingLocalGREs: include all DataCons for RecFlds
The GREInfo for a record field should include the collection of all
the data constructors of the parent TyCon that have this record field.
This information was being incorrectly computed in the tyThingLocalGREs
function for a DataCon, as we were not taking into account other
DataCons with the same parent TyCon.
Fixes #23546
- - - - -
e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00
EPA: Simplify GHC/Parser.y comb3
A follow up to !10743
- - - - -
ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00
Document that compareByteArrays# is available since ghc-prim-0.5.2.0
- - - - -
4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00
Revert "Bump text submodule"
This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a.
This commit requires that we bootstrap with ghc-9.4, which we do not
require until #23195 has been completed.
Subsequently this has broken nighty jobs such as the rocky8 job which in
turn has broken nightly releases.
- - - - -
03a6d5aa by Ben Gamari at 2023-07-11T03:36:54-04:00
compiler: Fingerprint more code generation flags
Previously our recompilation check was quite inconsistent in its
coverage of non-optimisation code generation flags. Specifically, we
failed to account for most flags that would affect the behavior of
generated code in ways that might affect the result of a program's
execution (e.g. `-feager-blackholing`, `-fstrict-dicts`)
Closes #23369.
- - - - -
a5473949 by Ben Gamari at 2023-07-11T03:36:54-04:00
compiler: Record original thunk info tables on stack
Here we introduce a new code generation option, `-forig-thunk-info`,
which ensures that an `stg_orig_thunk_info` frame is pushed before every
update frame. This can be invaluable when debugging thunk cycles and
similar.
See Note [Original thunk info table frames] for details.
Closes #23255.
- - - - -
e96c949e by Jaro Reinders at 2023-07-11T03:36:55-04:00
Fix wrong MIN_VERSION_GLASGOW_HASKELL macros
I forgot to change these after rebasing.
- - - - -
28 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp/Flags.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Names.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/TyThing.hs
- compiler/cbits/genSym.c
- docs/users_guide/debugging.rst
- libraries/text
- rts/RtsSymbols.c
- rts/StgMiscClosures.cmm
- rts/include/rts/storage/Closures.h
- rts/include/stg/MiscClosures.h
- + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs
- + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/module/T20007.hs
- + testsuite/tests/module/T20007.stderr
- testsuite/tests/module/all.T
- utils/deriveConstants/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1953,7 +1953,9 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp
specified ranges, but this is not checked. Returns an 'Int#'
less than, equal to, or greater than zero if the range is found,
respectively, to be byte-wise lexicographically less than, to
- match, or be greater than the second range.}
+ match, or be greater than the second range.
+
+ @since 0.5.2.0}
with
can_fail = True
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.Cmm.CLabel (
mkDirty_MUT_VAR_Label,
mkMUT_VAR_CLEAN_infoLabel,
mkNonmovingWriteBarrierEnabledLabel,
+ mkOrigThunkInfoLabel,
mkUpdInfoLabel,
mkBHUpdInfoLabel,
mkIndStaticInfoLabel,
@@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
-- Constructing Cmm Labels
mkDirty_MUT_VAR_Label,
mkNonmovingWriteBarrierEnabledLabel,
- mkUpdInfoLabel,
+ mkOrigThunkInfoLabel, mkUpdInfoLabel,
mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
mkMAP_DIRTY_infoLabel,
@@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label,
mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
mkNonmovingWriteBarrierEnabledLabel
= CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
+mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo
mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo
mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
, stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags
, stgToCmmSCCProfiling = sccProfilingEnabled dflags
, stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags
+ , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags
, stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags
, stgToCmmOmitYields = gopt Opt_OmitYields dflags
, stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -5,6 +5,7 @@ module GHC.Driver.Flags
, GeneralFlag(..)
, Language(..)
, optimisationFlags
+ , codeGenFlags
-- * Warnings
, WarningGroup(..)
@@ -337,6 +338,7 @@ data GeneralFlag
| Opt_IgnoreHpcChanges
| Opt_ExcessPrecision
| Opt_EagerBlackHoling
+ | Opt_OrigThunkInfo
| Opt_NoHsMain
| Opt_SplitSections
| Opt_StgStats
@@ -484,15 +486,11 @@ data GeneralFlag
| Opt_G_NoOptCoercion
deriving (Eq, Show, Enum)
--- Check whether a flag should be considered an "optimisation flag"
--- for purposes of recompilation avoidance (see
--- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is
--- not a guarantee that the flag has no other effect. We could, and
--- perhaps should, separate out the flags that have some minor impact on
--- program semantics and/or error behavior (e.g., assertions), but
--- then we'd need to go to extra trouble (and an additional flag)
--- to allow users to ignore the optimisation level even though that
--- means ignoring some change.
+-- | The set of flags which affect optimisation for the purposes of
+-- recompilation avoidance. Specifically, these include flags which
+-- affect code generation but not the semantics of the program.
+--
+-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags)
optimisationFlags :: EnumSet GeneralFlag
optimisationFlags = EnumSet.fromList
[ Opt_CallArity
@@ -524,16 +522,12 @@ optimisationFlags = EnumSet.fromList
, Opt_EnableRewriteRules
, Opt_RegsGraph
, Opt_RegsIterative
- , Opt_PedanticBottoms
, Opt_LlvmTBAA
- , Opt_LlvmFillUndefWithGarbage
, Opt_IrrefutableTuples
, Opt_CmmSink
, Opt_CmmElimCommonBlocks
, Opt_AsmShortcutting
- , Opt_OmitYields
, Opt_FunToThunk
- , Opt_DictsStrict
, Opt_DmdTxDictSel
, Opt_Loopification
, Opt_CfgBlocklayout
@@ -542,8 +536,48 @@ optimisationFlags = EnumSet.fromList
, Opt_WorkerWrapper
, Opt_WorkerWrapperUnlift
, Opt_SolveConstantDicts
+ ]
+
+-- | The set of flags which affect code generation and can change a program's
+-- runtime behavior (other than performance). These include flags which affect:
+--
+-- * user visible debugging information (e.g. info table provenance)
+-- * the ability to catch runtime errors (e.g. -fignore-asserts)
+-- * the runtime result of the program (e.g. -fomit-yields)
+-- * which code or interface file declarations are emitted
+--
+-- We also considered placing flags which affect asympototic space behavior
+-- (e.g. -ffull-laziness) however this would mean that changing optimisation
+-- levels would trigger recompilation even with -fignore-optim-changes,
+-- regressing #13604.
+--
+-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place
+-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and
+-- therefore would also break #13604.
+--
+-- See #23369.
+codeGenFlags :: EnumSet GeneralFlag
+codeGenFlags = EnumSet.fromList
+ [ -- Flags that affect runtime result
+ Opt_EagerBlackHoling
+ , Opt_ExcessPrecision
+ , Opt_DictsStrict
+ , Opt_PedanticBottoms
+ , Opt_OmitYields
+
+ -- Flags that affect generated code
+ , Opt_ExposeAllUnfoldings
+ , Opt_NoTypeableBinds
+
+ -- Flags that affect catching of runtime errors
, Opt_CatchNonexhaustiveCases
- , Opt_IgnoreAsserts
+ , Opt_LlvmFillUndefWithGarbage
+ , Opt_DoTagInferenceChecks
+
+ -- Flags that affect debugging information
+ , Opt_DistinctConstructorTables
+ , Opt_InfoTableMap
+ , Opt_OrigThunkInfo
]
data WarningFlag =
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -66,6 +66,7 @@ module GHC.Driver.Session (
makeDynFlagsConsistent,
positionIndependent,
optimisationFlags,
+ codeGenFlags,
setFlagsFromEnvFile,
pprDynFlagsDiff,
flagSpecOf,
@@ -2346,6 +2347,7 @@ fFlagsDeps = [
flagSpec "do-eta-reduction" Opt_DoEtaReduction,
flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion,
flagSpec "eager-blackholing" Opt_EagerBlackHoling,
+ flagSpec "orig-thunk-info" Opt_OrigThunkInfo,
flagSpec "embed-manifest" Opt_EmbedManifest,
flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules,
flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings,
=====================================
compiler/GHC/Iface/Recomp/Flags.hs
=====================================
@@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio =
ticky =
map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag]
- flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters))
+ -- Other flags which affect code generation
+ codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags)
+
+ flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters))
in -- pprTrace "flags" (ppr flags) $
computeFingerprint nameio flags
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) }
-- No longer allow things like [] and (,,,) to be exported
-- They are built in syntax, always available
export :: { OrdList (LIE GhcPs) }
- : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> }
+ : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> }
; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)
; return $ unitOL $ reLocA $ sL span $ impExp } }
- | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+ | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $>
; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }
; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3))
; return $ unitOL $ reLocA $ locImpExp } }
- | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+ | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $>
in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) }
maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
@@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs }
, cid_tyfam_insts = ats
, cid_overlap_mode = $2
, cid_datafam_insts = adts }
- ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4)
+ ; acsA (\cs -> L (comb3 $1 $3 $4)
(ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs }))
} }
@@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }
at_decl_cls :: { LHsDecl GhcPs }
: -- data family declarations, with optional 'family' keyword
'data' opt_family type opt_datafam_kind_sig
- {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3
+ {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3
(snd $ unLoc $4) Nothing
(mj AnnData $1:$2++(fst $ unLoc $4))) }
@@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs }
-- (can't use opt_instance because you get shift/reduce errors
| 'type' type opt_at_kind_inj_sig
{% liftM mkTyClD
- (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2
+ (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2
(fst . snd $ unLoc $3)
(snd . snd $ unLoc $3)
(mj AnnType $1:(fst $ unLoc $3)) )}
| 'type' 'family' type opt_at_kind_inj_sig
{% liftM mkTyClD
- (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3
+ (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3
(fst . snd $ unLoc $4)
(snd . snd $ unLoc $4)
(mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))}
@@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs }
role_annot :: { LRoleAnnotDecl GhcPs }
role_annot : 'type' 'role' oqtycon maybe_roles
- {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4))
+ {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4))
[mj AnnType $1,mj AnnRole $2] }
-- Reversed!
@@ -2594,7 +2594,7 @@ decl :: { LHsDecl GhcPs }
rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }
: '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 ->
do { let L l (bs, csw) = adaptWhereBinds $3
- ; let loc = (comb3 $1 (reLoc $2) (L l bs))
+ ; let loc = (comb3 $1 $2 (L l bs))
; acs (\cs ->
sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2)
bs)) } }
@@ -2907,7 +2907,7 @@ aexp :: { ECP }
| 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->
return $ ECP $
$4 >>= \ $4 ->
- mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4
+ mkHsCasePV (comb3 $1 $3 $4) $2 $4
(EpAnnHsCase (glAA $1) (glAA $3) []) }
-- QualifiedDo.
| DO stmtlist {% do
@@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst = lexStringLiteral parseIdentifier
comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan
comb2 a b = a `seq` b `seq` combineHasLocs a b
-comb3 :: Located a -> Located b -> Located c -> SrcSpan
+comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan
comb3 a b c = a `seq` b `seq` c `seq`
- combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
-
-comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan
-comb3A a b c = a `seq` b `seq` c `seq`
- combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c))
-
-comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan
-comb3N a b c = a `seq` b `seq` c `seq`
- combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c))
+ combineSrcSpans (getHasLoc a) (combineHasLocs b c)
comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -2139,11 +2139,12 @@ badImportItemErr
-> TcRn ImportLookupReason
badImportItemErr iface decl_spec ie sub avails = do
patsyns_enabled <- xoptM LangExt.PatternSynonyms
- pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled)
+ expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
+ pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled)
where
- importErrorKind
+ importErrorKind expl_ns_enabled
| any checkIfTyCon avails = case sub of
- BadImportIsParent -> BadImportAvailTyCon
+ BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled
BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
| any checkIfVarName avails = BadImportAvailVar
| Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con)
=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -730,7 +730,8 @@ setupUpdate closure_info node body
lbl | bh = mkBHUpdInfoLabel
| otherwise = mkUpdInfoLabel
- pushUpdateFrame lbl (CmmReg (CmmLocal node)) body
+ pushOrigThunkInfoFrame closure_info
+ $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body
| otherwise -- A static closure
= do { tickyUpdateBhCaf closure_info
@@ -738,7 +739,8 @@ setupUpdate closure_info node body
; if closureUpdReqd closure_info
then do -- Blackhole the (updatable) CAF:
{ upd_closure <- link_caf node
- ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body }
+ ; pushOrigThunkInfoFrame closure_info
+ $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body }
else do {tickyUpdateFrameOmitted; body}
}
@@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body
= do
updfr <- getUpdFrameOff
profile <- getProfile
- let
- hdr = fixedHdrSize profile
+ let hdr = fixedHdrSize profile
frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile)
--
emitUpdateFrame (CmmStackSlot Old frame) lbl updatee
@@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do
emitStore (cmmOffset platform frame off_updatee) updatee
initUpdFrameProf frame
+-----------------------------------------------------------------------------
+-- Original thunk info table frames
+--
+-- Note [Original thunk info table frames]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very
+-- useful to know which thunks the program is in the process of evaluating.
+-- However, in the case of updateable thunks this can be very difficult
+-- to determine since the process of blackholing overwrites the thunk's
+-- info table pointer.
+--
+-- To help in such situations we provide the -forig-thunk-info flag. This enables
+-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to
+-- accompany each update frame. As the name suggests, this frame captures the
+-- the original info table of the thunk being updated. The entry code for these
+-- frames has no operational effects; the frames merely exist as breadcrumbs
+-- for debugging.
+
+pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode ()
+pushOrigThunkInfoFrame closure_info body = do
+ cfg <- getStgToCmmConfig
+ if stgToCmmOrigThunkInfo cfg
+ then do_it
+ else body
+ where
+ orig_itbl = mkLblExpr (closureInfoLabel closure_info)
+ do_it = do
+ updfr <- getUpdFrameOff
+ profile <- getProfile
+ let platform = profilePlatform profile
+ hdr = fixedHdrSize profile
+ orig_info_frame_sz =
+ hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile)
+ off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile)
+ frame_off = updfr + orig_info_frame_sz
+ frame = CmmStackSlot Old frame_off
+ --
+ emitStore frame (mkLblExpr mkOrigThunkInfoLabel)
+ emitStore (cmmOffset platform frame off_orig_info) orig_itbl
+ withUpdFrameOff frame_off body
+
-----------------------------------------------------------------------------
-- Entering a CAF
--
=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig
, stgToCmmFastPAPCalls :: !Bool -- ^
, stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled
, stgToCmmEagerBlackHole :: !Bool -- ^
+ , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update.
, stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping
-- Info Tables to Source Positions]
, stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3108,7 +3108,9 @@ instance Diagnostic TcRnMessage where
in case k of
BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
BadImportNotExported -> noHints
- BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
+ BadImportAvailTyCon ex_ns ->
+ [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns]
+ ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
BadImportNotExportedSubordinates{} -> noHints
TcRnImportLookup{}
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5263,7 +5263,9 @@ data BadImportKind
-- | Module does not export...
= BadImportNotExported
-- | Missing @type@ keyword when importing a type.
- | BadImportAvailTyCon
+ -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+)
+ -- Then we want to suggest using `import TypeLits( type (+) )`
+ | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled?
-- | Trying to import a data constructor directly, e.g.
-- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@
| BadImportAvailDataCon OccName
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -310,12 +310,12 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods)
| (mod,imv) <- NE.toList mods
])
pprImportSuggestion occ_name (CouldAddTypeKeyword mod)
- = vcat [ text "Add the" <+> quotes (text "type")
+ = vcat [ text "Add the" <+> quotes (text "type")
<+> text "keyword to the import statement:"
- , nest 2 $ text "import"
+ , nest 2 $ text "import"
<+> ppr mod
<+> parens_sp (text "type" <+> pprPrefixOcc occ_name)
- ]
+ ]
where
parens_sp d = parens (space <> d <> space)
pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod)
=====================================
compiler/GHC/Types/TyThing.hs
=====================================
@@ -28,6 +28,7 @@ where
import GHC.Prelude
+import GHC.Types.GREInfo
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.Var
@@ -52,6 +53,11 @@ import Control.Monad ( liftM )
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
+import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
+import Data.List ( intersect )
+
+
{-
Note [ATyCon for classes]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -301,15 +307,24 @@ tyThingLocalGREs ty_thing =
| dc <- dcs
, let con_info = conLikeConInfo (RealDataCon dc) ]
AConLike con ->
- let par = case con of
- PatSynCon {} -> NoParent
- -- NoParent for local pattern synonyms as per
- -- Note [Parents] in GHC.Types.Name.Reader.
- RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc
- in
- myself par :
- mkLocalFieldGREs par
- [(conLikeConLikeName con, conLikeConInfo con)]
+ let (par, cons_flds) = case con of
+ PatSynCon {} ->
+ (NoParent, [(conLikeConLikeName con, conLikeConInfo con)])
+ -- NB: NoParent for local pattern synonyms, as per
+ -- Note [Parents] in GHC.Types.Name.Reader.
+ RealDataCon dc1 ->
+ (ParentIs $ tyConName $ dataConTyCon dc1
+ , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds))
+ | dc <- tyConDataCons $ dataConTyCon dc1
+ -- Go through all the data constructors of the parent TyCon,
+ -- to ensure that all the record fields have the correct set
+ -- of parent data constructors. See #23546.
+ , let con_info = conLikeConInfo (RealDataCon dc)
+ , ConHasRecordFields flds0 <- [con_info]
+ , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc
+ , fld:flds <- [flds1]
+ ])
+ in myself par : mkLocalFieldGREs par cons_flds
AnId id
| RecSelId { sel_tycon = RecSelData tc } <- idDetails id
-> [ myself (ParentIs $ tyConName tc) ]
=====================================
compiler/cbits/genSym.c
=====================================
@@ -9,7 +9,7 @@
//
// The CPP is thus about the RTS version GHC is linked against, and not the
// version of the GHC being built.
-#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0)
+#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)
HsWord64 ghc_unique_counter64 = 0;
#endif
#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
@@ -18,7 +18,7 @@ HsInt ghc_unique_inc = 1;
// This function has been added to the RTS. Here we pessimistically assume
// that a threaded RTS is used. This function is only used for bootstrapping.
-#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0)
+#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)
EXTERN_INLINE StgWord64
atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
{
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1115,6 +1115,18 @@ Checking for consistency
cases. This is helpful when debugging demand analysis or type checker bugs
which can sometimes manifest as segmentation faults.
+.. ghc-flag:: -forig-thunk-info
+ :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry
+ :type: dynamic
+
+ When debugging cyclic thunks it can be helpful to know the original
+ info table of a thunk being evaluated. This flag enables code generation logic
+ to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside
+ the usual update frame; such ``orig_thunk`` frames have no operational
+ effect but capture the original info table of the updated thunk for inspection
+ by debugging tools. See ``Note [Original thunk info table frames]`` in
+ ``GHC.StgToCmm.Bind`` for details.
+
.. ghc-flag:: -fcheck-prim-bounds
:shortdesc: Instrument array primops with bounds checks.
:type: dynamic
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f
+Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e
=====================================
rts/RtsSymbols.c
=====================================
@@ -870,7 +870,8 @@ extern char **environ;
SymI_HasDataProto(stg_unpack_cstring_utf8_info) \
SymI_HasDataProto(stg_upd_frame_info) \
SymI_HasDataProto(stg_bh_upd_frame_info) \
- SymI_HasProto(suspendThread) \
+ SymI_HasDataProto(stg_orig_thunk_info_frame_info) \
+ SymI_HasProto(suspendThread) \
SymI_HasDataProto(stg_takeMVarzh) \
SymI_HasDataProto(stg_readMVarzh) \
SymI_HasDataProto(stg_threadStatuszh) \
@@ -878,7 +879,7 @@ extern char **environ;
SymI_HasDataProto(stg_tryTakeMVarzh) \
SymI_HasDataProto(stg_tryReadMVarzh) \
SymI_HasDataProto(stg_unmaskAsyncExceptionszh) \
- SymI_HasProto(unloadObj) \
+ SymI_HasProto(unloadObj) \
SymI_HasDataProto(stg_unsafeThawArrayzh) \
SymI_HasDataProto(stg_waitReadzh) \
SymI_HasDataProto(stg_waitWritezh) \
@@ -892,7 +893,7 @@ extern char **environ;
SymI_NeedsProto(stg_interp_constr5_entry) \
SymI_NeedsProto(stg_interp_constr6_entry) \
SymI_NeedsProto(stg_interp_constr7_entry) \
- SymI_HasDataProto(stg_arg_bitmaps) \
+ SymI_HasDataProto(stg_arg_bitmaps) \
SymI_HasProto(large_alloc_lim) \
SymI_HasProto(g0) \
SymI_HasProto(allocate) \
=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info;
import CLOSURE stg_ret_v_info;
#endif
+/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */
+INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL,
+ W_ info_ptr,
+ W_ thunk_info_ptr)
+ /* no args => explicit stack */
+{
+ unwind Sp = W_[Sp + WDS(2)];
+ Sp_adj(2);
+ jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live!
+}
+
/* ----------------------------------------------------------------------------
Stack underflow
------------------------------------------------------------------------- */
=====================================
rts/include/rts/storage/Closures.h
=====================================
@@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame {
StgClosure *updatee;
} StgUpdateFrame;
+// Thunk update frame
+//
+// Closure types: RET_SMALL
+typedef struct _StgOrigThunkInfoFrame {
+ StgHeader header;
+ StgInfoTable *info_ptr;
+} StgOrigThunkInfoFrame;
// Closure types: RET_SMALL
typedef struct {
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -52,6 +52,7 @@ RTS_RET(stg_upd_frame);
RTS_RET(stg_bh_upd_frame);
RTS_RET(stg_marked_upd_frame);
RTS_RET(stg_noupd_frame);
+RTS_RET(stg_orig_thunk_info_frame);
RTS_RET(stg_catch_frame);
RTS_RET(stg_catch_retry_frame);
RTS_RET(stg_atomically_frame);
=====================================
testsuite/tests/codeGen/should_run/OrigThunkInfo.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+xs = iterate (+1) 0
+ten = xs !! 10
+main = print ten
=====================================
testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout
=====================================
@@ -0,0 +1,2 @@
+10
+
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways)
,unless(arch('x86_64'), skip)],compile_and_run,[''])
test('T22798', normal, compile_and_run, ['-fregs-graph'])
test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds'])
+test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info'])
=====================================
testsuite/tests/module/T20007.hs
=====================================
@@ -0,0 +1 @@
+import Data.Type.Equality ( (~) )
=====================================
testsuite/tests/module/T20007.stderr
=====================================
@@ -0,0 +1,8 @@
+
+T20007.hs:1:29: [GHC-56449]
+ In the import of ‘Data.Type.Equality’:
+ an item called ‘(~)’ is exported, but it is a type.
+ Suggested fixes:
+ Use ExplicitNamespaces
+ Add the ‘type’ keyword to the import statement:
+ import Data.Type.Equality ( type (~) )
=====================================
testsuite/tests/module/all.T
=====================================
@@ -298,3 +298,4 @@ test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T
test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0'])
test('T21826', normal, compile_fail, [''])
+test('T20007', normal, compile_fail, [''])
=====================================
utils/deriveConstants/Main.hs
=====================================
@@ -437,6 +437,7 @@ wanteds os = concat
,structField Both "StgEntCounter" "entry_count"
,closureSize Both "StgUpdateFrame"
+ ,closureSize Both "StgOrigThunkInfoFrame"
,closureSize C "StgCatchFrame"
,closureSize C "StgStopFrame"
,closureSize C "StgDeadThreadFrame"
@@ -479,6 +480,7 @@ wanteds os = concat
,structSize C "StgTSOProfInfo"
,closureField Both "StgUpdateFrame" "updatee"
+ ,closureField Both "StgOrigThunkInfoFrame" "info_ptr"
,closureField C "StgCatchFrame" "handler"
,closureField C "StgCatchFrame" "exceptions_blocked"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3593014222e996d67390d56cb9118772de5eef0...e96c949e48b373a2f235b33955884e64e9825a18
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3593014222e996d67390d56cb9118772de5eef0...e96c949e48b373a2f235b33955884e64e9825a18
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/20230711/d837570c/attachment-0001.html>
More information about the ghc-commits
mailing list