[Git][ghc/ghc][wip/automatic-time-samples-base] 7 commits: Use lookupOccRn_maybe in TH.lookupName
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Jan 17 09:57:05 UTC 2024
Matthew Pickering pushed to branch wip/automatic-time-samples-base at Glasgow Haskell Compiler / GHC
Commits:
c5fc7304 by sheaf at 2024-01-15T14:15:29-05:00
Use lookupOccRn_maybe in TH.lookupName
When looking up a value, we want to be able to find both variables
and record fields. So we should not use the lookupSameOccRn_maybe
function, as we can't know ahead of time which record field namespace
a record field with the given textual name will belong to.
Fixes #24293
- - - - -
da908790 by Krzysztof Gogolewski at 2024-01-15T14:16:05-05:00
Make the build more strict on documentation errors
* Detect undefined labels. This can be tested by adding :ref:`nonexistent`
to a documentation rst file; attempting to build docs will fail.
Fixed the undefined label in `9.8.1-notes.rst`.
* Detect errors. While we have plenty of warnings, we can at least enforce
that Sphinx does not report errors.
Fixed the error in `required_type_arguments.rst`.
Unrelated change: I have documented that the `-dlint` enables
`-fcatch-nonexhaustive-cases`, as can be verified by checking
`enableDLint`.
- - - - -
5077416e by Javier Sagredo at 2024-01-16T15:40:06-05:00
Profiling: Adds an option to not start time profiling at startup
Using the functionality provided by
d89deeba47ce04a5198a71fa4cbc203fe2c90794, this patch creates a new rts
flag `--no-automatic-time-samples` which disables the time profiling
when starting a program. It is then expected that the user starts it
whenever it is needed.
Fixes #24337
- - - - -
5776008c by Matthew Pickering at 2024-01-16T15:40:42-05:00
eventlog: Fix off-by-one error in postIPE
We were missing the extra_comma from the calculation of the size of the
payload of postIPE. This was causing assertion failures when the event
would overflow the buffer by one byte, as ensureRoomForVariable event
would report there was enough space for `n` bytes but then we would
write `n + 1` bytes into the buffer.
Fixes #24287
- - - - -
66dc09b1 by Simon Peyton Jones at 2024-01-16T15:41:18-05:00
Improve SpecConstr (esp nofib/spectral/ansi)
This MR makes three improvements to SpecConstr: see #24282
* It fixes an outright (and recently-introduced) bug in `betterPat`, which
was wrongly forgetting to compare the lengths of the argument lists.
* It enhances ConVal to inclue a boolean for work-free-ness, so that the
envt can contain non-work-free constructor applications, so that we
can do more: see Note [ConVal work-free-ness]
* It rejigs `subsumePats` so that it doesn't reverse the list. This can
make a difference because, when patterns overlap, we arbitrarily pick
the first. There is no "right" way, but this retains the old
pre-subsumePats behaviour, thereby "fixing" the regression in #24282.
Nofib results
+========================================
| spectral/ansi -21.14%
| spectral/hartel/comp_lab_zift -0.12%
| spectral/hartel/parstof +0.09%
| spectral/last-piece -2.32%
| spectral/multiplier +6.03%
| spectral/para +0.60%
| spectral/simple -0.26%
+========================================
| geom mean -0.18%
+----------------------------------------
The regression in `multiplier` is sad, but it simply replicates GHC's
previous behaviour (e.g. GHC 9.6).
- - - - -
65da79b3 by Matthew Pickering at 2024-01-16T15:41:54-05:00
hadrian: Reduce Cabal verbosity
The comment claims that `simpleUserHooks` decrease verbosity, and it
does, but only for the `postConf` phase. The other phases are too
verbose with `-V`.
At the moment > 5000 lines of the build log are devoted to output from
`cabal copy`.
So I take the simple approach and just decrease the verbosity level
again.
If the output of `postConf` is essential then it would be better to
implement our own `UserHooks` which doesn't decrease the verbosity for
`postConf`.
Fixes #24338
- - - - -
df12553a by Matthew Pickering at 2024-01-17T09:56:17+00:00
base: Expose `--no-automatic-time-samples` in `GHC.RTS.Flags` API
This patch builds on 5077416e12cf480fb2048928aa51fa4c8fc22cf1 and
modifies the base API to reflect the new RTS flag.
Fixes #24337
- - - - -
27 changed files:
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Tc/Gen/Splice.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/9.8.1-notes.rst
- docs/users_guide/debugging.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/profiling.rst
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Rules/Documentation.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Profiling.hs
- libraries/base/src/GHC/RTS/Flags.hsc
- rts/Profiling.c
- rts/RtsFlags.c
- rts/eventlog/EventLog.c
- rts/include/rts/Flags.h
- 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/overloadedrecflds/should_compile/T24293.hs
- + testsuite/tests/overloadedrecflds/should_compile/T24293b.hs
- + testsuite/tests/overloadedrecflds/should_compile/T24293c.hs
- + testsuite/tests/overloadedrecflds/should_compile/T24293c.stderr
- testsuite/tests/overloadedrecflds/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -789,47 +789,70 @@ scTopBinds env (b:bs) = do { (usg, b', bs') <- scBind TopLevel env b $
* *
************************************************************************
-Note [Work-free values only in environment]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The sc_vals field keeps track of in-scope value bindings, so
-that if we come across (case x of Just y ->...) we can reduce the
-case from knowing that x is bound to a pair.
-
-But only *work-free* values are ok here. For example if the envt had
- x -> Just (expensive v)
-then we do NOT want to expand to
- let y = expensive v in ...
-because the x-binding still exists and we've now duplicated (expensive v).
-
-This seldom happens because let-bound constructor applications are
-ANF-ised, but it can happen as a result of on-the-fly transformations in
-SpecConstr itself. Here is #7865:
-
- let {
- a'_shr =
- case xs_af8 of _ {
- [] -> acc_af6;
- : ds_dgt [Dmd=<L,A>] ds_dgu [Dmd=<L,A>] ->
- (expensive x_af7, x_af7
- } } in
- let {
- ds_sht =
- case a'_shr of _ { (p'_afd, q'_afe) ->
- TSpecConstr_DoubleInline.recursive
- (GHC.Types.: @ GHC.Types.Int x_af7 wild_X6) (q'_afe, p'_afd)
- } } in
-
-When processed knowing that xs_af8 was bound to a cons, we simplify to
- a'_shr = (expensive x_af7, x_af7)
-and we do NOT want to inline that at the occurrence of a'_shr in ds_sht.
-(There are other occurrences of a'_shr.) No no no.
-
-It would be possible to do some on-the-fly ANF-ising, so that a'_shr turned
-into a work-free value again, thus
- a1 = expensive x_af7
- a'_shr = (a1, x_af7)
-but that's more work, so until its shown to be important I'm going to
-leave it for now.
+Note [ConVal work-free-ness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The sc_vals field keeps track of in-scope value bindings, and is used in
+two ways:
+
+(1) To do case-of-known-constructor in a case expression. E.g. if sc_vals
+ includes [x :-> ConVal Just e], then we can simplify
+ case x of Just y -> ...
+ with the case-of-known-constructor transformation. (Yes this is
+ done by the Simplifier, but SpecConstr creates new opportunities when
+ it makes a specialised RHS for a function.)
+
+ For (1) it is crucial that the arguments are /work-free/; see (CV1)
+ below.
+
+(2) To figure out call pattresns. E.g. if sc_vals includes
+ [x :-> ConVal Just e], and we have call (f x), then we might want
+ to specialise `f (Just _)`
+
+ For (2) it is /not/ important that the constructor arguments are work-free;
+ indeed, it would be bad to insist on that. For example
+ let x = Just <expensive>
+ in ....(f x)...
+ Here we want to specialise for `f (Just _)`, and we won't do so if we
+ don't allow [x :-> ConVal Just e] into the environment. Does this ever happen?
+ Yes: see #24282.
+
+ (Yes, the Simplifier will ANF that let-binding, but SpecConstr can
+ make more: see (CV1) for an example.)
+
+Wrinkle:
+
+(CV1) Why is work-free-ness important for (1)? In the example in (1) above, of `e` is
+ expensive, we do /not/ want to simplify
+ case x of { Just y -> ... } ==> let y = e in ...
+ because the x-binding still exists and we've now duplicated `e`.
+
+ This seldom happens because let-bound constructor applications are ANF-ised, but
+ it can happen as a result of on-the-fly transformations in SpecConstr itself.
+ Here is #7865:
+
+ let { a'_shr =
+ case xs_af8 of _ {
+ [] -> acc_af6;
+ : ds_dgt [Dmd=<L,A>] ds_dgu [Dmd=<L,A>] ->
+ (expensive x_af7, x_af7
+ } } in
+ let { ds_sht =
+ case a'_shr of _ { (p'_afd, q'_afe) ->
+ TSpecConstr_DoubleInline.recursive
+ (GHC.Types.: @ GHC.Types.Int x_af7 wild_X6) (q'_afe, p'_afd)
+ } } in
+
+ When processed knowing that xs_af8 was bound to a cons, we simplify to
+ a'_shr = (expensive x_af7, x_af7)
+ and we do NOT want to inline that at the occurrence of a'_shr in ds_sht.
+ (There are other occurrences of a'_shr.) No no no.
+
+ It would be possible to do some on-the-fly ANF-ising, so that a'_shr turned
+ into a work-free value again, thus
+ a1 = expensive x_af7
+ a'_shr = (a1, x_af7)
+ but that's more work, so until its shown to be important I'm going to
+ leave it for now.
Note [Making SpecConstr keener]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -910,10 +933,6 @@ data ScEnv = SCE { sc_opts :: !SpecConstrOpts,
sc_vals :: ValueEnv,
-- Domain is OutIds (*after* applying the substitution)
-- Used even for top-level bindings (but not imported ones)
- -- The range of the ValueEnv is *work-free* values
- -- such as (\x. blah), or (Just v)
- -- but NOT (Just (expensive v))
- -- See Note [Work-free values only in environment]
sc_annotations :: UniqFM Name SpecConstrAnnotation
}
@@ -922,14 +941,22 @@ data ScEnv = SCE { sc_opts :: !SpecConstrOpts,
type HowBoundEnv = VarEnv HowBound -- Domain is OutVars
---------------------
-type ValueEnv = IdEnv Value -- Domain is OutIds
-data Value = ConVal AltCon [CoreArg] -- _Saturated_ constructors
- -- The AltCon is never DEFAULT
- | LambdaVal -- Inlinable lambdas or PAPs
+type ValueEnv = IdEnv Value -- Domain is OutIds
+
+data Value = ConVal -- Constructor application
+ Bool -- True <=> all args are work-free
+ -- See Note [ConVal work-free-ness]
+ AltCon -- Never DEFAULT
+ [CoreArg] -- Saturates the constructor
+ | LambdaVal -- Inlinable lambdas or PAPs
instance Outputable Value where
- ppr (ConVal con args) = ppr con <+> interpp'SP args
- ppr LambdaVal = text "<Lambda>"
+ ppr LambdaVal = text "<Lambda>"
+ ppr (ConVal wf con args) = ppr con <> braces pp_wf <+> interpp'SP args
+ where
+ pp_wf | wf = text "wf"
+ | otherwise = text "not-wf"
+
---------------------
initScOpts :: DynFlags -> Module -> SpecConstrOpts
@@ -1058,11 +1085,10 @@ extendBndr env bndr = (env { sc_subst = subst' }, bndr')
(subst', bndr') = substBndr (sc_subst env) bndr
extendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv
-extendValEnv env _ Nothing = env
-extendValEnv env id (Just cv)
- | valueIsWorkFree cv -- Don't duplicate work!! #7865
- = env { sc_vals = extendVarEnv (sc_vals env) id cv }
-extendValEnv env _ _ = env
+extendValEnv env id mb_val
+ = case mb_val of
+ Nothing -> env
+ Just cv -> env { sc_vals = extendVarEnv (sc_vals env) id cv }
extendCaseBndrs :: ScEnv -> OutExpr -> OutId -> AltCon -> [Var] -> (ScEnv, [Var])
-- When we encounter
@@ -1089,8 +1115,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs
cval = case con of
DEFAULT -> Nothing
- LitAlt {} -> Just (ConVal con [])
- DataAlt {} -> Just (ConVal con vanilla_args)
+ LitAlt {} -> Just (ConVal True con [])
+ DataAlt {} -> Just (ConVal True con vanilla_args)
where
vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
varsToCoreExprs alt_bndrs
@@ -1497,8 +1523,11 @@ scExpr' env (Let bind body)
scExpr' env (Case scrut b ty alts)
= do { (scrut_usg, scrut') <- scExpr env scrut
; case isValue (sc_vals env) scrut' of
- Just (ConVal con args) -> sc_con_app con args scrut'
- _other -> sc_vanilla scrut_usg scrut'
+ Just (ConVal args_are_work_free con args)
+ | args_are_work_free -> sc_con_app con args scrut'
+ -- Don't duplicate work!! #7865
+ -- See Note [ConVal work-free-ness] (1)
+ _other -> sc_vanilla scrut_usg scrut'
}
where
sc_con_app con args scrut' -- Known constructor; simplify
@@ -2608,7 +2637,8 @@ argToPat1 env in_scope val_env (Cast arg co) arg_occ arg_str
-- Check for a constructor application
-- NB: this *precedes* the Var case, so that we catch nullary constrs
argToPat1 env in_scope val_env arg arg_occ _arg_str
- | Just (ConVal (DataAlt dc) args) <- isValue val_env arg
+ | Just (ConVal _wf (DataAlt dc) args) <- isValue val_env arg
+ -- Ignore `_wf` here; see Note [ConVal work-free-ness] (2)
, not (ignoreDataCon env dc) -- See Note [NoSpecConstr]
, Just arg_occs <- mb_scrut dc
= do { let (ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) args
@@ -2726,7 +2756,7 @@ wildCardPat ty str
isValue :: ValueEnv -> CoreExpr -> Maybe Value
isValue _env (Lit lit)
| litIsLifted lit = Nothing
- | otherwise = Just (ConVal (LitAlt lit) [])
+ | otherwise = Just (ConVal True (LitAlt lit) [])
isValue env (Var v)
| Just cval <- lookupVarEnv env v
@@ -2757,7 +2787,7 @@ isValue _env expr -- Maybe it's a constructor application
DataConWorkId con | args `lengthAtLeast` dataConRepArity con
-- Check saturated; might be > because the
-- arity excludes type args
- -> Just (ConVal (DataAlt con) args)
+ -> Just (ConVal (all exprIsWorkFree args) (DataAlt con) args)
DFunId {} -> Just LambdaVal
-- DFunId: see Note [Specialising on dictionaries]
@@ -2770,34 +2800,43 @@ isValue _env expr -- Maybe it's a constructor application
isValue _env _expr = Nothing
-valueIsWorkFree :: Value -> Bool
-valueIsWorkFree LambdaVal = True
-valueIsWorkFree (ConVal _ args) = all exprIsWorkFree args
-
betterPat :: InScopeSet -> CallPat -> CallPat -> Bool
-- pat1 f @a (Just @a (x::a))
-- is better than
-- pat2 f @Int (Just @Int (x::Int))
--- That is, we can instantiate pat1 to get pat2
+-- That is, we can instantiate pat1 to get pat2, using only type instantiate
-- See Note [Pattern duplicate elimination]
betterPat is (CP { cp_qvars = vs1, cp_args = as1 })
(CP { cp_qvars = vs2, cp_args = as2 })
+ | equalLength as1 as2
= case matchExprs ise vs1 as1 as2 of
Just (_, ms) -> all exprIsTrivial ms
Nothing -> False
+
+ | otherwise -- We must handle patterns of unequal length separately (#24282)
+ = False -- For the pattern with more args, the last arg is "interesting"
+ -- but the corresponding one on the other is "not interesting";
+ -- So we can't get from one to the other with only exprIsTrivial
+ -- instantiation. Example nofib/spectral/ansi, function `loop`:
+ -- P1: loop (I# x) (a : b)
+ -- P2: loop (I# y) -- Pattern eta-reduced
+ -- Neither is better than the other, in the sense of betterPat
where
ise = ISE (is `extendInScopeSetList` vs2) (const noUnfolding)
subsumePats :: InScopeSet -> [CallPat] -> [CallPat]
-- Remove any patterns subsumed by others
-- See Note [Pattern duplicate elimination]
-subsumePats is pats = foldr add [] pats
+-- Other than deleting subsumed patterns, this operation is a no-op;
+-- in particular it does not reverse the input. It should not matter
+-- but in #24282 it did; doing it this way keeps the existing behaviour.
+subsumePats is pats = foldl add [] pats
where
- add :: CallPat -> [CallPat] -> [CallPat]
- add ci [] = [ci]
- add ci1 (ci2:cis) | betterPat is ci2 ci1 = ci2:cis
- | betterPat is ci1 ci2 = ci1:cis
- | otherwise = ci2 : add ci1 cis
+ add :: [CallPat] -> CallPat -> [CallPat]
+ add [] ci = [ci]
+ add (ci1:cis) ci2 | betterPat is ci1 ci2 = ci1 : cis
+ | betterPat is ci2 ci1 = ci2 : cis
+ | otherwise = ci1 : add cis ci2
{-
Note [Pattern duplicate elimination]
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -605,10 +605,8 @@ isMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool
isMoreSpecific _ (BuiltinRule {}) _ = False
isMoreSpecific _ (Rule {}) (BuiltinRule {}) = True
isMoreSpecific in_scope (Rule { ru_bndrs = bndrs1, ru_args = args1 })
- (Rule { ru_bndrs = bndrs2, ru_args = args2
- , ru_name = rule_name2, ru_rhs = rhs2 })
- = isJust (matchN in_scope_env
- rule_name2 bndrs2 args2 args1 rhs2)
+ (Rule { ru_bndrs = bndrs2, ru_args = args2 })
+ = isJust (matchExprs in_scope_env bndrs2 args2 args1)
where
full_in_scope = in_scope `extendInScopeSetList` bndrs1
in_scope_env = ISE full_in_scope noUnfoldingFun
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -1983,8 +1983,12 @@ zipManyFloats :: [Floats] -> Floats
zipManyFloats = foldr zipFloats emptyFloats
mkNonRecFloat :: CorePrepEnv -> Demand -> Bool -> Id -> CpeRhs -> FloatingBind
-mkNonRecFloat env dmd is_unlifted bndr rhs = -- pprTraceWith "mkNonRecFloat" ppr $
- Float (NonRec bndr' rhs) bound info
+mkNonRecFloat env dmd is_unlifted bndr rhs
+ = -- pprTrace "mkNonRecFloat" (ppr bndr <+> ppr (bound,info)
+ -- <+> ppr is_lifted <+> ppr is_strict
+ -- <+> ppr ok_for_spec
+ -- $$ ppr rhs) $
+ Float (NonRec bndr' rhs) bound info
where
bndr' = setIdDemandInfo bndr dmd -- See Note [Pin demand info on floats]
(bound,info)
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1944,8 +1944,8 @@ lookupName :: Bool -- True <=> type namespace
-- False <=> value namespace
-> String -> TcM (Maybe TH.Name)
lookupName is_type_name s
- = do { mb_nm <- lookupSameOccRn_maybe rdr_name
- ; return (fmap reifyName mb_nm) }
+ = do { mb_nm <- lookupOccRn_maybe rdr_name
+ ; return (fmap (reifyName . greName) mb_nm) }
where
th_name = TH.mkName s -- Parses M.x into a base of 'x' and a module of 'M'
@@ -1960,6 +1960,12 @@ lookupName is_type_name s
| otherwise
= if isLexCon occ_fs then mkDataOccFS occ_fs
else mkVarOccFS occ_fs
+ -- NB: when we pick the variable namespace, we
+ -- might well obtain an identifier in a record
+ -- field namespace, as lookupOccRn_maybe looks in
+ -- record field namespaces when looking up variables.
+ -- This ensures we can look up record fields using
+ -- this function (#24293).
rdr_name = case TH.nameModule th_name of
Nothing -> mkRdrUnqual occ
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -140,6 +140,9 @@ Runtime system
See :ghc-ticket:`23340`.
:rts-flag:`--nonmoving-dense-allocator-count=⟨count⟩` has been added to fine-tune this behaviour.
+- Add a :rts-flag:`--no-automatic-time-samples` flag which stops time profiling samples being automatically started on
+ startup. Time profiling can be controlled manually using functions in ``GHC.Profiling``.
+
``base`` library
~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -256,7 +256,7 @@ Runtime system
- The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)``
in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree.
This represents the warning assigned to a certain export item,
- which is used for :ref:`deprecated-exports`.
+ which is used for deprecated exports (see :ref:`warning-deprecated-pragma`).
``ghc-heap`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1046,7 +1046,7 @@ Checking for consistency
:shortdesc: Enable several common internal sanity checkers
:type: dynamic
- :implies: -dcore-lint, -dstg-lint, -dcmm-lint, -dasm-lint, -fllvm-fill-undef-with-garbage, -debug
+ :implies: -dcore-lint, -dstg-lint, -dcmm-lint, -dasm-lint, -fllvm-fill-undef-with-garbage, -fcatch-nonexhaustive-cases, -debug
:since: 9.4.1
Turn on various heavy-weight intra-pass sanity-checking measures within GHC
=====================================
docs/users_guide/exts/required_type_arguments.rst
=====================================
@@ -281,8 +281,8 @@ to bind type variables::
const :: a -> b -> a -- implicit quantification
const :: forall a b. a -> b -> a -- explicit quantification
-Normally, implicit quantification is unaffected by term variables in scope:
-::
+Normally, implicit quantification is unaffected by term variables in scope: ::
+
f a = ... -- the LHS binds `a`
where const :: a -> b -> a
-- implicit quantification over `a` takes place
=====================================
docs/users_guide/profiling.rst
=====================================
@@ -1009,6 +1009,13 @@ There are three more options which relate to heap profiling:
option is enabled, it's expected that the user will manually start heap
profiling or request specific samples using functions from ``GHC.Profiling``.
+.. rts-flag:: --no-automatic-time-samples
+
+ :since: 9.10.1
+
+ Don't start time profiling from the start of program execution. If this
+ option is enabled, it's expected that the user will manually start time
+ profiling or request specific samples using functions from ``GHC.Profiling``.
.. rts-flag:: --null-eventlog-writer
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -194,11 +194,10 @@ copyPackage context at Context {..} = do
C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
[ "copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath, v ]
--- | Increase by 1 by because 'simpleUserHooks' calls 'lessVerbose'
shakeVerbosityToCabalFlag :: Verbosity -> String
shakeVerbosityToCabalFlag = \case
- Diagnostic -> "-v3"
- Verbose -> "-v2"
+ Diagnostic -> "-v2"
+ Verbose -> "-v1"
-- Normal levels should not produce output to stdout
Silent -> "-v0"
_ -> "-v1"
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -168,6 +168,12 @@ checkSphinxWarnings out = do
when ("reference target not found" `isInfixOf` log)
$ fail "Undefined reference targets found in Sphinx log."
+ when ("undefined label:" `isInfixOf` log)
+ $ fail "Undefined labels found in Sphinx log."
+
+ when ("ERROR:" `isInfixOf` log)
+ $ fail "Errors found in the Sphinx log."
+
-- | Check that all GHC flags are documented in the users guide.
checkUserGuideFlags :: FilePath -> Action ()
checkUserGuideFlags documentedFlagList = do
=====================================
libraries/base/changelog.md
=====================================
@@ -5,6 +5,8 @@
* Add `permutations` and `permutations1` to `Data.List.NonEmpty` ([CLC proposal #68](https://github.com/haskell/core-libraries-committee/issues/68))
* Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #175](https://github.com/haskell/core-libraries-committee/issues/175))
* Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4))
+ * Add `startTimeProfileAtStartup` to `GHC.RTS.Flags` to expose new RTS flag
+ `--no-automatic-heap-samples` in the Haskell API ([CLC proposal #243](https://github.com/haskell/core-libraries-committee/issues/243)).
* Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
* The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
* Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
=====================================
libraries/base/src/GHC/Profiling.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Base
foreign import ccall stopProfTimer :: IO ()
-- | Start attributing ticks to cost centres. This is called by the RTS on
--- startup.
+-- startup but can be disabled using the rts flag @--no-automatic-time-samples at .
--
-- @since 4.7.0.0
foreign import ccall startProfTimer :: IO ()
=====================================
libraries/base/src/GHC/RTS/Flags.hsc
=====================================
@@ -307,6 +307,7 @@ data ProfFlags = ProfFlags
, heapProfileInterval :: RtsTime -- ^ time between samples
, heapProfileIntervalTicks :: Word -- ^ ticks between samples (derived)
, startHeapProfileAtStartup :: Bool
+ , startTimeProfileAtStartup :: Bool
, showCCSOnException :: Bool
, maxRetainerSetSize :: Word
, ccsLength :: Word
@@ -626,6 +627,8 @@ getProfFlags = do
<*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
<*> (toBool <$>
(#{peek PROFILING_FLAGS, startHeapProfileAtStartup} ptr :: IO CBool))
+ <*> (toBool <$>
+ (#{peek PROFILING_FLAGS, startTimeProfileAtStartup} ptr :: IO CBool))
<*> (toBool <$>
(#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool))
<*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
=====================================
rts/Profiling.c
=====================================
@@ -296,8 +296,10 @@ void
initTimeProfiling(void)
{
traceProfBegin();
- /* Start ticking */
- startProfTimer();
+ if (RtsFlags.ProfFlags.startTimeProfileAtStartup) {
+ /* Start ticking */
+ startProfTimer();
+ }
};
void
=====================================
rts/RtsFlags.c
=====================================
@@ -216,6 +216,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.ProfFlags.doHeapProfile = false;
RtsFlags.ProfFlags.heapProfileInterval = USToTime(100000); // 100ms
RtsFlags.ProfFlags.startHeapProfileAtStartup = true;
+ RtsFlags.ProfFlags.startTimeProfileAtStartup = true;
#if defined(PROFILING)
RtsFlags.ProfFlags.showCCSOnException = false;
@@ -1154,6 +1155,12 @@ error = true;
RtsFlags.ProfFlags.startHeapProfileAtStartup = false;
break;
}
+ else if (strequal("no-automatic-time-samples",
+ &rts_argv[arg][2])) {
+ OPTION_SAFE;
+ RtsFlags.ProfFlags.startTimeProfileAtStartup = false;
+ break;
+ }
else {
OPTION_SAFE;
errorBelch("unknown RTS option: %s",rts_argv[arg]);
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -1438,7 +1438,8 @@ void postIPE(const InfoProvEnt *ipe)
// 8 for the info word
// 1 null after each string
// 1 colon between src_file and src_span
- StgWord len = 8+table_name_len+1+closure_desc_len+1+ty_desc_len+1+label_len+1+module_len+1+src_file_len+1+src_span_len+1;
+ StgWord extra_comma = 1;
+ StgWord len = 8+table_name_len+1+closure_desc_len+1+ty_desc_len+1+label_len+1+module_len+1+src_file_len+1+extra_comma+src_span_len+1;
CHECK(!ensureRoomForVariableEvent(&eventBuf, len));
postEventHeader(&eventBuf, EVENT_IPE);
postPayloadSize(&eventBuf, len);
=====================================
rts/include/rts/Flags.h
=====================================
@@ -148,6 +148,7 @@ typedef struct _PROFILING_FLAGS {
Time heapProfileInterval; /* time between samples */
uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */
bool startHeapProfileAtStartup; /* true if we start profiling from program startup */
+ bool startTimeProfileAtStartup; /* true if we start profiling from program startup */
bool showCCSOnException;
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9060,7 +9060,8 @@ module GHC.RTS.Flags where
type ParFlags :: *
data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool}
type ProfFlags :: *
- data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
+ data ProfFlags
+ = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, startTimeProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
type RTSFlags :: *
data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
type RtsTime :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -11838,7 +11838,8 @@ module GHC.RTS.Flags where
type ParFlags :: *
data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool}
type ProfFlags :: *
- data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
+ data ProfFlags
+ = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, startTimeProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
type RTSFlags :: *
data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
type RtsTime :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9284,7 +9284,8 @@ module GHC.RTS.Flags where
type ParFlags :: *
data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool}
type ProfFlags :: *
- data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
+ data ProfFlags
+ = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, startTimeProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
type RTSFlags :: *
data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
type RtsTime :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9064,7 +9064,7 @@ module GHC.RTS.Flags where
type ParFlags :: *
data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool}
type ProfFlags :: *
- data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
+ data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, startTimeProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
type RTSFlags :: *
data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
type RtsTime :: *
=====================================
testsuite/tests/overloadedrecflds/should_compile/T24293.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24293 where
+import Language.Haskell.TH
+
+data Cheval = Cheval { hibou :: Int }
+
+name = $(do
+ n <- lookupValueName "hibou"
+ pure $ LitE $ StringL $ show n)
=====================================
testsuite/tests/overloadedrecflds/should_compile/T24293b.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoFieldSelectors #-}
+module T24293b where
+import Language.Haskell.TH
+
+data Cheval = Cheval { hibou :: Int }
+
+hibou :: Bool
+hibou = False
+
+name = $(do
+ n <- lookupValueName "hibou"
+ pure $ LitE $ StringL $ show n)
=====================================
testsuite/tests/overloadedrecflds/should_compile/T24293c.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+module T24293c where
+import Language.Haskell.TH
+
+data Cheval = Cheval { hibou :: Int }
+data Agneau = Agneau { hibou :: Bool }
+
+name = $(do
+ n <- lookupValueName "hibou"
+ pure $ LitE $ StringL $ show n)
=====================================
testsuite/tests/overloadedrecflds/should_compile/T24293c.stderr
=====================================
@@ -0,0 +1,11 @@
+
+T24293c.hs:9:9: error: [GHC-87543]
+ • Ambiguous occurrence ‘hibou’.
+ It could refer to
+ either the field ‘hibou’ of record ‘Cheval’,
+ defined at T24293c.hs:6:24,
+ or the field ‘hibou’ of record ‘Agneau’,
+ defined at T24293c.hs:7:24.
+ • In the untyped splice:
+ $(do n <- lookupValueName "hibou"
+ pure $ LitE $ StringL $ show n)
=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -57,3 +57,6 @@ test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D'
test('T22424', req_th, compile, ['-this-unit-id="me"'])
test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0'])
test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0'])
+test('T24293', req_th, compile, [''])
+test('T24293b', req_th, compile, [''])
+test('T24293c', req_th, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c56ffd1f5e3fdf47af1306b4b255ef753832d8e...df12553ae7911d14a9534f411742721af280de12
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c56ffd1f5e3fdf47af1306b4b255ef753832d8e...df12553ae7911d14a9534f411742721af280de12
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/20240117/7dfb614f/attachment-0001.html>
More information about the ghc-commits
mailing list