[Git][ghc/ghc][wip/sjakobi/T16720] 3 commits: testsuite: Don't list unexpected failures twice in the summary
by Simon Jakobi (＠sjakobi2) 17 Jun '26
by Simon Jakobi (＠sjakobi2) 17 Jun '26
17 Jun '26
Simon Jakobi pushed to branch wip/sjakobi/T16720 at Glasgow Haskell Compiler / GHC
Commits:
b4e9e1ab by Simon Jakobi at 2026-06-17T13:15:40+02:00
testsuite: Don't list unexpected failures twice in the summary
Previously a failing test could appear in three places in the summary:
its repeated output (=====> header), a separate 'Unexpected failures:'
directory list, and the concise TEST= rerun line. Collapse this so each
failing case is shown once, and place the repeated output where readers
look for it:
- When the output is shown (at most MAX_SUMMARY_OUTPUT_TESTS failures),
the =====> header is the only per-test listing; the test's directory
is folded into it and the separate directory list is dropped.
- When the output is omitted (too many failures), the failures are
listed in the directory list instead.
The repeated failure output and the TEST= rerun line are printed directly
above the SUMMARY counts: the verbose output blends with the run's inline
output, and TEST= sits right where the counts begin. The TEST= line always
includes the failures, so it is shown even when their output is.
Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com>
- - - - -
3979543d by Simon Jakobi at 2026-06-17T13:15:55+02:00
testsuite: Bundle identical failure output across ways
A test that fails identically in several ways (e.g. normal and g1) now
shares a single output block in the summary, with the ways collected in
the header, rather than repeating the same captured output once per way.
Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com>
- - - - -
16d64293 by Simon Jakobi at 2026-06-17T13:34:58+02:00
testsuite: Show a stable source-relative directory in failure output
The failure-output summary derived the test's directory from opts.testdir,
which is relative to wherever make was invoked, so e.g. a test under
codeGen/should_run would show as should_run/... when make ran from codeGen/.
Record the directory as the test's source directory relative to the GHC
source root instead, so it reads the same regardless of the make working
directory and works for out-of-tree suites like libraries/base/tests. Drop
the now-redundant run-dir leaf (it just repeated the test name) and the
obsolete tempdir-stripping that the old /tmp-prefixed paths needed.
Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com>
- - - - -
1 changed file:
- testsuite/driver/testlib.py
Changes:
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1493,6 +1493,14 @@ def _newTestDir(name: TestName, opts: TestOptions, tempdir, dir):
opts.testdir_raw = Path(os.path.join(tempdir, testdir, name + testdir_suffix))
opts.compiler_always_flags = config.compiler_always_flags
+def _result_directory(opts: TestOptions) -> str:
+ # The test's source directory, relative to the GHC source root, so it reads
+ # the same regardless of which directory `make` was invoked from.
+ try:
+ return os.path.relpath(opts.srcdir, config.top.parent)
+ except Exception:
+ return ''
+
# -----------------------------------------------------------------------------
# Actually doing tests
@@ -1817,7 +1825,7 @@ async def do_test(name: TestName,
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
- directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
+ directory = _result_directory(opts)
if way in opts.fragile_ways:
if_verbose(1, '*** fragile test %s resulted in %s' % (full_name, 'pass' if result.passed else 'fail'))
@@ -1868,7 +1876,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
# so we need to take care not to blow up with the wrong way
# and report the actual reason for the failure.
try:
- directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
+ directory = _result_directory(opts)
except:
directory = ''
full_name = '%s(%s)' % (name, way)
@@ -1881,7 +1889,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
def framework_warn(name: TestName, way: WayName, reason: str) -> None:
opts = getTestOpts()
- directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
+ directory = _result_directory(opts)
full_name = name + '(' + way + ')'
if_verbose(1, '*** framework warning for %s %s ' % (full_name, reason))
t.framework_warnings.append(TestResult(directory, name, reason, way))
@@ -3531,17 +3539,17 @@ def summary(t: TestRun, file: TextIO, color=False, junit_path: Optional[Path]=No
file.write('\n')
+ too_many_failures = len(t.unexpected_failures) > MAX_SUMMARY_OUTPUT_TESTS
+
if t.unexpected_failures:
- if len(t.unexpected_failures) > MAX_SUMMARY_OUTPUT_TESTS:
- # junit.xml only exists when a path was requested (e.g. in CI); don't
- # point at a file that a local run never wrote.
- where = 'see {}'.format(junit_path) if junit_path \
- else 'rerun them individually'
- file.write('Output of {} unexpected failures omitted (limit {}); {}.\n\n'
- .format(len(t.unexpected_failures), MAX_SUMMARY_OUTPUT_TESTS, where))
- else:
+ if not too_many_failures:
file.write('Output of unexpected failures:\n\n')
printTestOutputSummary(file, t.unexpected_failures, color, junit_path)
+ else:
+ where = '; see {}'.format(junit_path) if junit_path else ''
+ file.write('Unexpected failures (output omitted, more than {}{}):\n'
+ .format(MAX_SUMMARY_OUTPUT_TESTS, where))
+ printTestInfosSummary(file, t.unexpected_failures)
printUnexpectedTests(file,
[t.unexpected_passes, t.unexpected_failures,
@@ -3593,10 +3601,6 @@ def summary(t: TestRun, file: TextIO, color=False, junit_path: Optional[Path]=No
file.write('Unexpected passes:\n')
printTestInfosSummary(file, t.unexpected_passes)
- if t.unexpected_failures:
- file.write('Unexpected failures:\n')
- printTestInfosSummary(file, t.unexpected_failures)
-
if t.unexpected_stat_failures:
file.write('Unexpected stat failures:\n')
printTestInfosSummary(file, t.unexpected_stat_failures)
@@ -3634,8 +3638,15 @@ def printTestOutputSummary(file: TextIO, testInfos, color: bool=False,
# Repeat failing tests' captured output in the summary, so one needn't
# hunt for it earlier in a possibly very long log; see #16720.
where = ', see {}'.format(junit_path) if junit_path else ''
- for result in sorted(testInfos, key=lambda r: (r.testname.lower(), r.way, r.directory)):
- header = '=====> {}({}) [{}]'.format(result.testname, result.way, result.reason)
+ # Tests that fail identically in several ways (e.g. normal and g1) share one
+ # output block, with the ways collected in the header.
+ groups = collections.OrderedDict() # type: ignore
+ for result in sorted(testInfos, key=lambda r: (r.testname.lower(), r.directory, r.way)):
+ key = (result.testname, result.directory, result.reason, result.stdout, result.stderr)
+ groups.setdefault(key, (result, []))[1].append(result.way)
+ for result, ways in groups.values():
+ header = '=====> {}({}) ({}) [{}]'.format(
+ result.testname, ', '.join(ways), result.directory + os.sep, result.reason)
if color:
header = colored(Color.RED, header)
file.write(header + '\n')
@@ -3654,19 +3665,15 @@ def printTestOutputSummary(file: TextIO, testInfos, color: bool=False,
# cannot represent; replace rather than crash (cf safe_print).
enc = getattr(file, 'encoding', None) or 'utf-8'
file.write(s.encode(enc, errors='replace').decode(enc))
- file.write('\n')
footer = '<===== end of output of unexpected failures'
if color:
footer = colored(Color.RED, footer)
file.write(footer + '\n\n')
def printTestInfosSummary(file: TextIO, testInfos):
- maxDirLen = max(len(tr.directory) for tr in testInfos)
for result in sorted(testInfos, key=lambda r: (r.testname.lower(), r.way, r.directory)):
- directory = result.directory.ljust(maxDirLen)
- file.write(' {directory} {r.testname} [{r.reason}] ({r.way})\n'.format(
- r = result,
- directory = directory))
+ path = os.path.join(result.directory, result.testname)
+ file.write(' {path} [{r.reason}] ({r.way})\n'.format(r=result, path=path))
file.write('\n')
def modify_lines(s: str, f: Callable[[str], str]) -> str:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e538a38453c42403de99feb70206ae…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e538a38453c42403de99feb70206ae…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
17 Jun '26
Simon Jakobi pushed new branch wip/sjakobi/T26665-fr at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/T26665-fr
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Seed the simplifier's in-scope set for open expressions
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4671c126 by Sebastian Graf at 2026-06-17T05:35:55-04:00
Seed the simplifier's in-scope set for open expressions
simplifyExpr simplifies expressions typed at the GHCi prompt and the
results of Template Haskell splices. Such an expression may be open: at a
GHCi debugger breakpoint its free variables include RuntimeUnk skolems
standing for as-yet-unknown types.
The simplifier began with an in-scope set holding only the wildcard
binder, so when it instantiated the unsafeCoerce# wrapper that GHCi
builds around a result, it formed a substitution whose range mentioned a
free skolem that was not in scope. That breaks the substitution invariant
and, in a compiler built with assertions, trips substTy's sanity check.
Seed the initial in-scope set with the free variables of the expression.
For a closed expression this adds nothing.
See Note [Seed the in-scope set for open expressions].
Fixes #17833 and its duplicate #21118.
- - - - -
3 changed files:
- + changelog.d/T17833
- compiler/GHC/Core/Opt/Simplify.hs
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
changelog.d/T17833
=====================================
@@ -0,0 +1,11 @@
+section: compiler
+synopsis: Fix a Simplifier panic on open expressions (e.g. in the GHCi debugger)
+issues: #17833 #21118
+mrs: !16187
+description: {
+ ``simplifyExpr`` now seeds the Simplifier's in-scope set with the free
+ variables of the expression being simplified, restoring the invariant that the
+ in-scope set contains all of an expression's free variables. This fixes a panic
+ (a failed ``substTy`` assertion) when an open expression reaches the Simplifier,
+ as can happen for expressions entered in the GHCi debugger.
+}
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Core.Rules
import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr )
import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize )
+import GHC.Core.FVs ( exprFreeVars )
import GHC.Core.Utils ( mkTicks, stripTicksTop )
import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult )
import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules )
@@ -74,7 +75,10 @@ simplifyExpr logger euc opts expr
; let fam_envs = ( eps_fam_inst_env eps
, extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts
)
- simpl_env = mkSimplEnv (se_mode opts) fam_envs
+ -- See Note [Seed the in-scope set for open expressions]
+ simpl_env = setInScopeSet base_env
+ (getInScope base_env `extendInScopeSetSet` exprFreeVars expr)
+ base_env = mkSimplEnv (se_mode opts) fam_envs
top_env_cfg = se_top_env_cfg opts
read_eps_rules = eps_rule_base <$> eucEPS euc
read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules
@@ -94,6 +98,49 @@ simplifyExpr logger euc opts expr
; return expr'
}
+{- Note [Seed the in-scope set for open expressions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+An invariant of the Simplifier is that the in-scope set contains all the free
+variables of the expression being simplified. Why? So that the Simplifier
+never invents a "fresh" binder that accidentally captures one of those free
+variables.
+
+'simplifyExpr' establishes that invariant by initialising the in-scope set with
+the free variables of the expression it is given. For a closed expression this
+adds nothing.
+
+But how can 'simplifyExpr' be handed an /open/ expression in the first place?
+The whole-module pipeline never does so: 'simplifyPgm' only ever simplifies
+closed bindings. The one caller that can is 'hscCompileCoreExpr' (in
+GHC.Driver.Main.Passes), which compiles a single Core expression, and is itself
+reached from just two places:
+
+ * GHCi, for an expression typed at the prompt, and in particular in the
+ debugger (see below);
+ * Template Haskell, when running a splice (see GHC.Tc.Gen.Splice).
+
+So this is never on the critical path for mainstream compilation.
+
+Here is how the debugger hands us an open expression (test break006). We are
+stopped at a breakpoint in
+ mymap f (x:xs) = f x : ...
+where the debugger knows that 'x :: Int' but not yet the result type of 'f'. So
+it invents a RuntimeUnk skolem 'a' and gives 'f :: Int -> a'. The user then
+types
+ let y = f x
+GHCi type-checks that and, to hand the result back to the interpreter (see
+GHC.Tc.Module.tcGhciStmts), wraps it as
+ returnIO @[Any] [unsafeCoerce# @LiftedRep @LiftedRep @a @Any y]
+in which the skolem 'a' is free.
+
+When the Simplifier instantiates that 'unsafeCoerce#', it builds a substitution
+mapping unsafeCoerce#'s quantified type variables to (LiftedRep, LiftedRep, a,
+Any), whose range therefore mentions 'a'. The in-scope set of a substitution
+must contain the free variables of its range (see Note [The substitution
+invariant] in GHC.Core.TyCo.Subst). Without the seeding above that invariant is
+broken, and in a compiler built with assertions substTy's sanity check fails
+(#17833, and its duplicate #21118). -}
+
simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
-- ^ Simplifies an expression by doing occurrence analysis, then simplification,
-- and repeating (twice currently), because one pass alone leaves tons of crud.
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -52,8 +52,7 @@ test('break002', extra_files(['../Test2.hs']), ghci_script, ['break002.script'])
test('break003', extra_files(['../Test3.hs']), ghci_script, ['break003.script'])
test('break005', extra_files(['../QSort.hs']), ghci_script, ['break005.script'])
test('break006',
- [ when(compiler_debugged(), expect_broken(17833)),
- extra_files(['../Test3.hs'])],
+ [extra_files(['../Test3.hs'])],
ghci_script,
['break006.script'])
test('break007', extra_files(['Break007.hs']), ghci_script, ['break007.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4671c126599b791c231abf094666203…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4671c126599b791c231abf094666203…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] tag inference: don't confuse functions with their return values
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
7fe4f2ec by Luite Stegeman at 2026-06-17T05:35:09-04:00
tag inference: don't confuse functions with their return values
inferTagRhs was mixing up taggedness for closures and return values
for function closures. We really shouldn't assign TagTuple to a
properly tagged function returning a tuple.
We fix this by keeping track of functions (TagFun) separately from
values (TagVal) and keeping track of their return value. TagFun is
also used for join points.
fixes #27005
- - - - -
22 changed files:
- + changelog.d/tag-inference-27005
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/EnforceEpt/Rewrite.hs
- compiler/GHC/Stg/EnforceEpt/TagSig.hs
- compiler/GHC/Stg/EnforceEpt/Types.hs
- testsuite/tests/core-to-stg/T14895.stderr
- testsuite/tests/simplCore/should_compile/T4201.stdout
- + testsuite/tests/simplCore/should_run/T27005.hs
- + testsuite/tests/simplCore/should_run/T27005.stdout
- + testsuite/tests/simplCore/should_run/T27005_aux.hs
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/simplStg/should_compile/T24806.hs
- testsuite/tests/simplStg/should_compile/T24806.stderr
- + testsuite/tests/simplStg/should_compile/T27005b.hs
- + testsuite/tests/simplStg/should_compile/T27005b.stderr
- testsuite/tests/simplStg/should_compile/all.T
- testsuite/tests/simplStg/should_compile/inferTags004.hs
- testsuite/tests/simplStg/should_compile/inferTags004.stderr
- + testsuite/tests/simplStg/should_run/T27005a.hs
- + testsuite/tests/simplStg/should_run/T27005a.stdout
- testsuite/tests/simplStg/should_run/all.T
Changes:
=====================================
changelog.d/tag-inference-27005
=====================================
@@ -0,0 +1,8 @@
+section: compiler
+synopsis: Eliminate redundant thunks introduced by tag inference.
+description: {
+ Tag inference is now more precise in tracking function results, eliminating
+ redundant thunks for certain functions that return an unboxed tuple.
+}
+issues: #27005
+mrs: !15688
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -3252,7 +3252,7 @@ That is in STG after tag inference we get:
Str=<1L><ML>,
Unf=OtherCon []] =
{} \r [x y]
- case x<TagProper> of x' [Occ=Once1] {
+ case x<TagVal[TagEPT]> of x' [Occ=Once1] {
__DEFAULT ->
case y of y' [Occ=Once1] {
__DEFAULT ->
@@ -3277,8 +3277,8 @@ But if we add an extra eval on `y` during worker/wrapper we this this:
Str=<1L><!L>,
Unf=OtherCon []] =
{} \r [x y]
- case y<TagProper> of y' [Occ=Once1] { __DEFAULT ->
- case x<TagProper> of x' [Occ=Once1] {
+ case y<TagVal[TagEPT]> of y' [Occ=Once1] { __DEFAULT ->
+ case x<TagVal[TagEPT]> of x' [Occ=Once1] {
__DEFAULT ->
case Find.$wmyPred y' of pred_y [Occ=Once1] {
__DEFAULT ->
=====================================
compiler/GHC/Stg/EnforceEpt.hs
=====================================
@@ -40,9 +40,6 @@ A pointer is Evaluated and Properly Tagged (EPT) when the pointer
A binder is EPT when all the runtime pointers it binds are EPT.
-Note that a lifted EPT pointer will never point to a thunk, nor will it be
-tagged `000` (meaning "might be a thunk").
-
See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/rts/haskell-execution…
for more information on pointer tagging.
@@ -57,11 +54,15 @@ Examples:
* In practice, GHC also guarantees that strict fields (and others) are EPT;
see Note [EPT enforcement].
-Caveat:
-Currently, the proper tag for builtin *unlifted* data types such as `Array#` is
-not `001` but `000`, which is not a proper tag for lifted data.
-This means that UnliftedRep is not a proper sub-rep of LiftedRep.
-SG thinks it would be good to fix this; see #21792.
+Wrinkles:
+
+EPT1: The proper tag for builtin *unlifted* data types such as `Array#` is
+ not `001` but `000`, which is not a proper tag for lifted data.
+ This means that UnliftedRep is not a proper sub-rep of LiftedRep.
+ SG thinks it would be good to fix this; see #21792.
+EPT2: The proper tag for PAPs is `000`, so there are values from lifted data types
+ that are EPT with a zero tag.
+EPT3: Non-pointer values don't have a tag at all, but we still treat them as EPT.
Note [EPT enforcement]
~~~~~~~~~~~~~~~~~~~~~~
@@ -261,18 +262,39 @@ might destroy the EPT Invariant, hence we need to enforce the EPT invariant
{- Note [TagInfo of functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The purpose of tag inference is really to figure out when we don't have to enter
-value closures. There the meaning of the tag is fairly obvious.
-For functions we never make use of the tag info so we have two choices:
-* Treat them as TagDunno
-* Treat them as TagProper (as they *are* tagged with their arity) and be really
- careful to make sure we still enter them when needed.
-As it makes little difference for runtime performance I've treated functions as TagDunno in a few places where
-it made the code simpler. But besides implementation complexity there isn't any reason
-why we couldn't be more rigorous in dealing with functions.
-
-NB: It turned in #21193 that PAPs get tag zero, so the tag check can't be omitted for functions.
-So option two isn't really an option without reworking this anyway.
+'TagFun' represents an evaluated function and carries the return-value TagInfo
+for saturated calls. See Note [TagSig and TagInfo] in GHC.Stg.EnforceEpt.TagSig.
+
+Join points (StgLetNoEscape) are treated like functions: they are jumped to,
+never entered via a closure pointer. Even nullary join points get TagFun
+rather than TagVal TagDunno, so their return-value info flows through.
+
+Additionally we also special case bottoming functions.
+See Note [Bottom functions are TagBottoming].
+
+Function values when properly tagged have either their arity, 1 for very large
+arities, or zero for PAPs (#21193) as tag. However the runtime currently doesn't
+maintain the EPT status of function pointers. So while we keep track of
+evaluated function binders using 'TagFun' this has a weaker guarantee than for
+values. For functions it only represents a pointer to an evaluated function, but
+doesn't give any guarantee about the function's pointer tag.
+
+Sadly because PAPs get tag zero (#21193), other issues in the RTS (#21193) and
+the potential of over/underapplication of arguments, even evaluated function
+binders still require inspection of their closure before they can be applied.
+That is, even if we have
+
+ case f of f' -> ... f' x ...
+
+the code for `f' x` can't be made meaningfully more efficient by knowing `f'` is
+already evaluated.
+
+However tracking evaluation status for functions is still worthwhile, as we rely
+on the EPT pass to force strict constructor fields. For an application
+`StrictJust f` we would usually insert an eval of `f` around the constructor
+application. However if we infer `f` to be already evaluated we can avoid this,
+which was a significant performance benefit in #27005. Similarly we can still
+turn redundant eval-cases on functions into a no-op.
Note [EPT enforcement debugging]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -361,7 +383,6 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders
inferTags :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders]
inferTags for_bytecode binds =
- -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $
snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds)
-----------------------
@@ -389,18 +410,20 @@ inferTagExpr env (StgApp fun args)
!fun_arity = idArity fun
info
-- It's important that we check for bottoms before all else.
- -- See Note [Bottom functions are TagTagged] and #24806 for why.
+ -- See Note [Bottom functions are TagBottoming] and #24806 for why.
| isDeadEndAppSig (idDmdSig fun) (length args)
- = TagTagged
+ = TagBottoming
| fun_arity == 0 -- Unknown arity => Thunk or unknown call
= TagDunno
- | Just (TagSig res_info) <- tagSigInfo (idInfo fun)
+ -- Imported function with known return tag
+ | Just (TagFun res_info) <- tagSigInfo (idInfo fun)
, fun_arity == length args -- Saturated
= res_info
- | Just (TagSig res_info) <- lookupSig env fun
+ -- Local function with known return tag
+ | Just res_info <- lookupReturnInfo env fun
, fun_arity == length args -- Saturated
= res_info
@@ -412,7 +435,7 @@ inferTagExpr env (StgConApp con cn args tys)
= (inferConTag env con args, StgConApp con cn args tys)
inferTagExpr _ (StgLit l)
- = (TagTagged, StgLit l)
+ = (TagEPT, StgLit l)
inferTagExpr env (StgTick tick body)
= (info, StgTick tick body')
@@ -446,7 +469,7 @@ inferTagExpr in_env (StgCase scrut bndr ty alts)
mk_bndr :: BinderP p -> TagInfo -> (Id, TagSig)
mk_bndr tup_bndr tup_info =
-- pprTrace "mk_ubx_bndr_info" ( ppr bndr <+> ppr info ) $
- (getBinderId in_env tup_bndr, TagSig tup_info)
+ (getBinderId in_env tup_bndr, TagVal tup_info)
-- no case binder in alt_env here, unboxed tuple binders are dead after unarise
alt_env = extendSigEnv in_env bndrs'
(info, rhs') = inferTagExpr alt_env rhs
@@ -478,16 +501,16 @@ inferTagExpr in_env (StgCase scrut bndr ty alts)
, let (alt_env,bndrs') = addAltBndrInfo case_env con bndrs
(info, rhs') = inferTagExpr alt_env rhs
]
- alt_info = foldr combineAltInfo TagTagged infos
+ alt_info = foldr combineAltInfo TagBottoming infos
in ( alt_info, StgCase scrut' bndr' ty alts')
where
-- Single unboxed tuple alternative
scrut_infos bndrs = case scrut_info of
- TagTagged -> Just $ replicate (length bndrs) TagProper
+ TagBottoming -> Just $ replicate (length bndrs) TagBottoming
TagTuple infos -> Just infos
_ -> Nothing
(scrut_info, scrut') = inferTagExpr in_env scrut
- bndr' = (getBinderId in_env bndr, TagSig TagProper)
+ bndr' = (getBinderId in_env bndr, TagVal TagEPT)
-- Compute binder sigs based on the constructors strict fields.
-- NB: Not used if we have tuple info from the scrutinee.
@@ -503,7 +526,7 @@ addAltBndrInfo env (DataAlt con) bndrs
mk_bndr :: (BinderP p -> StrictnessMark -> (Id, TagSig))
mk_bndr bndr mark
| isUnliftedType (idType id) || isMarkedStrict mark
- = (id, TagSig TagProper)
+ = (id, TagVal TagEPT)
| otherwise
= noSig env bndr
where
@@ -523,7 +546,7 @@ inferTagBind in_env (StgNonRec bndr rhs)
(env', StgNonRec (id, out_sig) rhs')
where
id = getBinderId in_env bndr
- (in_sig,rhs') = inferTagRhs id in_env rhs
+ (in_sig, rhs') = inferTagRhs id in_env rhs
out_sig = mkLetSig in_env in_sig
env' = extendSigEnv in_env [(id, out_sig)]
@@ -536,13 +559,12 @@ inferTagBind in_env (StgRec pairs)
init_sigs = map (initSig) $ zip in_ids rhss
(out_env, pairs') = go in_env init_sigs rhss
- go :: forall q. (OutputableInferPass q , InferExtEq q) => TagEnv q -> [TagSig] -> [GenStgRhs q]
- -> (TagSigEnv, [((Id,TagSig), GenStgRhs 'InferTaggedBinders)])
+ go :: forall q. (OutputableInferPass q , InferExtEq q)
+ => TagEnv q -> [TagSig] -> [GenStgRhs q]
+ -> (TagSigEnv, [((Id,TagSig), GenStgRhs 'InferTaggedBinders)])
go go_env in_sigs go_rhss
- -- | pprTrace "go" (ppr in_ids $$ ppr in_sigs $$ ppr out_sigs $$ ppr rhss') False
- -- = undefined
| in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss')
- | otherwise = go env' out_sigs rhss'
+ | otherwise = go env' out_sigs rhss'
where
in_bndrs = in_ids `zip` in_sigs
out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive
@@ -552,25 +574,28 @@ inferTagBind in_env (StgRec pairs)
anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders)
anaRhs bnd rhs =
- let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs
+ let (sig_rhs, rhs') = inferTagRhs bnd rhs_env rhs
in (mkLetSig go_env sig_rhs, rhs')
updateBndr :: (Id,TagSig) -> (Id,TagSig)
updateBndr (v,sig) = (setIdTagSig v sig, sig)
+-- Initial signature for the fixpoint loop.
initSig :: forall p. (Id, GenStgRhs p) -> TagSig
--- Initial signature for the fixpoint loop
-initSig (_bndr, StgRhsCon {}) = TagSig TagTagged
-initSig (bndr, StgRhsClosure _ _ _ _ _ _) =
- fromMaybe defaultSig (idTagSig_maybe bndr)
- where defaultSig = (TagSig TagTagged)
-
-{- Note [Bottom functions are TagTagged]
+initSig (_bndr, StgRhsCon {})
+ = TagVal TagBottoming
+initSig (bndr, StgRhsClosure _ _ _ bndrs _ _)
+ | notNull bndrs || isJoinId bndr
+ = fromMaybe (TagFun TagBottoming) (idTagSig_maybe bndr)
+ | otherwise -- thunk
+ = fromMaybe (TagVal TagBottoming) (idTagSig_maybe bndr)
+
+{- Note [Bottom functions are TagBottoming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have a function with two branches with one
being bottom, and the other returning a tagged
-unboxed tuple what is the result? We give it TagTagged!
+unboxed tuple what is the result? We give it TagBottoming!
To answer why consider this function:
foo :: Bool -> (# Bool, Bool #)
@@ -585,7 +610,7 @@ branches are tagged.
This is safe because the function is still always called/entered as long
as it's applied to arguments. Since the function will never return we can give
it safely any tag sig we like.
-So we give it TagTagged, as it allows the combined tag sig of the case expression
+So we give it TagBottoming, as it allows the combined tag sig of the case expression
to be the combination of all non-bottoming branches.
NB: After the analysis is done we go back to treating bottoming functions as
@@ -603,13 +628,20 @@ inferTagRhs :: forall p.
-> GenStgRhs p -- ^
-> (TagSig, GenStgRhs 'InferTaggedBinders)
inferTagRhs bnd_id in_env (StgRhsClosure ext cc upd bndrs body typ)
- | isDeadEndId bnd_id && (notNull) bndrs
- -- See Note [Bottom functions are TagTagged]
- = (TagSig TagTagged, StgRhsClosure ext cc upd out_bndrs body' typ)
- | otherwise
- = --pprTrace "inferTagRhsClosure" (ppr (_top, _grp_ids, env,info')) $
- (TagSig info', StgRhsClosure ext cc upd out_bndrs body' typ)
+ | isDeadEndId bnd_id && is_fun_or_join
+ -- See Note [Bottom functions are TagBottoming]
+ = ( TagFun TagBottoming
+ , StgRhsClosure ext cc upd out_bndrs body' typ)
+ | is_fun_or_join
+ = ( TagFun info
+ , StgRhsClosure ext cc upd out_bndrs body' typ)
+ | otherwise -- thunk (never a join point)
+ = ( TagVal TagDunno
+ , StgRhsClosure ext cc upd out_bndrs body' typ)
where
+ -- Join points are treated like functions. See Note [TagInfo of functions]
+ is_fun_or_join = notNull bndrs || isJoinId bnd_id
+
out_bndrs
| Just marks <- idCbvMarks_maybe bnd_id
-- Sometimes an we eta-expand foo with additional arguments after ww, and we also trim
@@ -620,37 +652,29 @@ inferTagRhs bnd_id in_env (StgRhsClosure ext cc upd bndrs body typ)
env' = extendSigEnv in_env out_bndrs
(info, body') = inferTagExpr env' body
- info'
- -- It's a thunk
- | null bndrs
- = TagDunno
- -- TODO: We could preserve tuple fields for thunks
- -- as well. But likely not worth the complexity.
-
- | otherwise = info
mkArgSig :: BinderP p -> CbvMark -> (Id,TagSig)
mkArgSig bndp mark =
let id = getBinderId in_env bndp
tag = case mark of
- MarkedCbv -> TagProper
+ MarkedCbv -> TagEPT
_
- | isUnliftedType (idType id) -> TagProper
+ | isUnliftedType (idType id) -> TagEPT
| otherwise -> TagDunno
- in (id, TagSig tag)
+ in (id, TagVal tag)
inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args typ)
-- Constructors, which have untagged arguments to strict fields
-- become thunks. We encode this by giving changing RhsCon nodes the info TagDunno
= --pprTrace "inferTagRhsCon" (ppr grp_ids) $
- (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args typ)
+ (TagVal (inferConTag env con args), StgRhsCon cc con cn ticks args typ)
-- Adjust let semantics to the targeted backend.
-- See Note [EPT enforcement for interpreted code]
mkLetSig :: TagEnv p -> TagSig -> TagSig
mkLetSig env in_sig
- | for_bytecode = TagSig TagDunno
- | otherwise = in_sig
+ | for_bytecode = TagVal TagDunno
+ | otherwise = in_sig
where
for_bytecode = te_bytecode env
@@ -658,52 +682,53 @@ mkLetSig env in_sig
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor
or a StgConApp expression.
-Usually these will simply be TagProper. But there are exceptions.
+Usually these will simply be TagEPT. But there are exceptions.
If any of the fields in the constructor are strict, but any argument to these
fields is not tagged then we will have to case on the argument before storing
in the constructor. Which means for let bindings the RHS turns into a thunk
which obviously is no longer properly tagged.
For example we might start with:
- let x<TagDunno> = f ...
- let c<TagProper> = StrictPair x True
+ let x<TagVal[TagDunno]> = f ...
+ let c<TagVal[TagEPT]> = StrictPair x True
But we know during the rewrite stage x will need to be evaluated in the RHS
of `c` so we will infer:
- let x<TagDunno> = f ...
- let c<TagDunno> = StrictPair x True
+ let x<TagVal[TagDunno]> = f ...
+ let c<TagVal[TagDunno]> = StrictPair x True
Which in the rewrite stage will then be rewritten into:
- let x<TagDunno> = f ...
- let c<TagDunno> = case x of x' -> StrictPair x' True
+ let x<TagVal[TagDunno]> = f ...
+ let c<TagVal[TagDunno]> = case x of x' -> StrictPair x' True
The other exception is unboxed tuples. These will get a TagTuple
signature with a list of TagInfo about their individual binders
as argument. As example:
- let c<TagProper> = True
- let x<TagDunno> = ...
- let f<?> z = case z of z'<TagProper> -> (# c, x #)
+ let c<TagVal[TagEPT]> = True
+ let x<TagVal[TagDunno]> = ...
+ let f<?> z = case z of z'<TagVal[TagEPT]> -> (# c, x #)
-Here we will infer for f the Signature <TagTuple[TagProper,TagDunno]>.
+Here we will infer for f the Signature <TagFun[TagTuple[TagEPT,TagDunno]]>.
This information will be used if we scrutinize a saturated application of
`f` in order to determine the taggedness of the result.
That is for `case f x of (# r1,r2 #) -> rhs` we can infer
-r1<TagProper> and r2<TagDunno> which allows us to skip all tag checks on `r1`
+r1<TagVal[TagEPT]> and r2<TagVal[TagDunno]> which allows us to skip all tag checks on `r1`
in `rhs`.
Things get a bit more complicated with nesting:
- let closeFd<TagTuple[...]> = ...
+ let closeFd<TagFun[...]> = ...
let f x = ...
case x of
_ -> Solo# closeFd
-The "natural" signature for the Solo# branch in `f` would be <TagTuple[TagTuple[...]]>.
-But we flatten this out to <TagTuple[TagDunno]> for the time being as it improves compile
-time and there doesn't seem to huge benefit to doing differently.
+We only keep track of function return types for bindings, not values:
+TagInfo has no constructor for "function with return info". Therefore the
+signature of `f` becomes <TagFun[TagTuple[TagEPT]]>. We lose the information
+about the return type of `closeFd`.
-}
@@ -721,7 +746,7 @@ inferConTag env con args
-- text "info:" <> ppr info) $
info
where
- info = if any arg_needs_eval strictArgs then TagDunno else TagProper
+ info = if any arg_needs_eval strictArgs then TagDunno else TagEPT
strictArgs = zipEqual args (dataConRuntimeRepStrictness con) :: ([(StgArg, StrictnessMark)])
arg_needs_eval (arg,strict)
-- lazy args
@@ -730,10 +755,10 @@ inferConTag env con args
-- banged args need to be tagged, or require eval
= not (isTaggedInfo tag)
- flatten_arg_tag (TagTagged) = TagProper
- flatten_arg_tag (TagProper ) = TagProper
- flatten_arg_tag (TagTuple _) = TagDunno -- See Note [Constructor TagSigs]
- flatten_arg_tag (TagDunno) = TagDunno
+ flatten_arg_tag TagBottoming = TagEPT
+ flatten_arg_tag TagEPT = TagEPT
+ flatten_arg_tag (TagTuple _) = TagDunno -- See Note [Constructor TagSigs]
+ flatten_arg_tag TagDunno = TagDunno
collectExportInfo :: [GenStgTopBinding 'InferTaggedBinders] -> NameEnv TagSig
@@ -746,15 +771,14 @@ collectExportInfo binds =
collect (StgTopLifted bnd) =
case bnd of
StgNonRec (id,sig) _rhs
- | TagSig TagDunno <- sig -> []
+ | TagVal TagDunno <- sig -> []
+ | TagVal TagBottoming <- sig -> []
| otherwise -> [(idName id,sig)]
StgRec bnds -> collectRec bnds
collectRec :: [(BinderP 'InferTaggedBinders, rhs)] -> [(Name,TagSig)]
collectRec [] = []
- collectRec (bnd:bnds)
- | (p,_rhs) <- bnd
- , (id,sig) <- p
- , TagSig TagDunno <- sig
- = (idName id,sig) : collectRec bnds
- | otherwise = collectRec bnds
+ collectRec (((id,sig), _rhs) : bnds)
+ | TagVal TagDunno <- sig = collectRec bnds
+ | TagVal TagBottoming <- sig = collectRec bnds
+ | otherwise = (idName id, sig) : collectRec bnds
=====================================
compiler/GHC/Stg/EnforceEpt/Rewrite.hs
=====================================
@@ -239,14 +239,14 @@ For this reason we assert that we are running in interactive mode if a lookup fa
-}
isTagged :: Id -> RM Bool
isTagged v
- -- See Note [Bottom functions are TagTagged]
+ -- See Note [Bottom functions are TagBottoming]
| isDeadEndId v = pure False
| otherwise = do
this_mod <- getMod
-- See Note [Tag inference for interactive contexts]
let lookupDefault v = assertPpr (isInteractiveModule this_mod)
(text "unknown Id:" <> ppr this_mod <+> ppr v)
- (TagSig TagDunno)
+ (TagVal TagDunno)
case nameIsLocalOrFrom this_mod (idName v) of
True
| definitelyUnliftedType (idType v)
@@ -257,12 +257,11 @@ isTagged v
!s <- getMap
let !sig = lookupWithDefaultUFM s (lookupDefault v) v
return $ case sig of
- TagSig info ->
- case info of
- TagDunno -> False
- TagProper -> True
- TagTagged -> True
- TagTuple _ -> True -- Consider unboxed tuples tagged.
+ TagFun _ -> True -- function closure is tagged
+ TagVal TagDunno -> False
+ TagVal TagEPT -> True
+ TagVal TagBottoming -> True
+ TagVal (TagTuple _) -> True -- Consider unboxed tuples tagged.
-- Imported
False -> return $!
-- Determine whether it is tagged from the LFInfo of the imported id.
@@ -279,7 +278,7 @@ isTagged v
-> True
LFUnknown {}
-> False
- LFUnlifted {}
+ LFUnlifted {} -- Unboxed, tagging irrelevant
-> True
LFLetNoEscape {}
-- Shouldn't be possible. I don't think we can export letNoEscapes
@@ -385,7 +384,7 @@ rewriteArg (lit@StgLitArg{}) = return lit
rewriteId :: Id -> RM Id
rewriteId v = do
!is_tagged <- isTagged v
- if is_tagged then return $! setIdTagSig v (TagSig TagProper)
+ if is_tagged then return $! setIdTagSig v (TagVal TagEPT)
else return v
rewriteExpr :: GenStgExpr 'InferTaggedBinders -> RM (GenStgExpr 'CodeGen)
=====================================
compiler/GHC/Stg/EnforceEpt/TagSig.hs
=====================================
@@ -16,65 +16,119 @@ import GHC.Types.Name.Env( NameEnv )
import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Utils.Panic.Plain
-import Data.Coerce
-- | Information to be exposed in interface files which is produced
-- by the stg2stg passes.
type StgCgInfos = NameEnv TagSig
-newtype TagSig -- The signature for each binding, this is a newtype as we might
- -- want to track more information in the future.
- = TagSig TagInfo
+-- Note [TagSig and TagInfo]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- 'TagSig' describes a *binding*; 'TagInfo' describes a *runtime value*.
+--
+-- A binding denotes either a value or a function:
+--
+-- * 'TagVal' i — the binding holds a value whose runtime shape is 'i'.
+-- 'i' covers thunks (TagDunno), evaluated/tagged heap
+-- pointers (TagEPT), unboxed tuples (TagTuple), and
+-- bottoming computations (TagBottoming).
+--
+-- * 'TagFun' i — the binding is a function or join point. A function
+-- closure is always EPT. 'i' describes what a
+-- *saturated call* returns.
+-- See Note [TagInfo of functions] in GHC.Stg.EnforceEpt.
+--
+-- This split keeps 'combineAltInfo' at the value level: case alternatives
+-- combine 'TagInfo', not 'TagSig'. An alternative that returns a function
+-- closure gets 'TagEPT' (closure pointer is tagged) with no tracked return
+-- info — the return info only matters once the function is applied, and at
+-- that point it's looked up from the binding's 'TagSig' via
+-- 'lookupReturnInfo'.
+
+-- | The signature attached to a binding.
+data TagSig
+ = TagVal TagInfo -- ^ A value binding (thunk, constructor, etc.)
+ | TagFun TagInfo -- ^ A function/join-point binding; carries the
+ -- TagInfo of saturated-call return values.
+ -- See Note [TagInfo of functions].
deriving (Eq)
+-- Note [TagInfo lattice]
+-- ~~~~~~~~~~~~~~~~~~~~~~
+-- The TagInfo lattice describes what we know about whether a runtime value
+-- is properly tagged (pointer tag bits set for heap pointers):
+--
+-- TagBottoming (bottom) ⊑ {TagEPT, TagTuple _} ⊑ TagDunno (top)
+--
+-- TagBottoming is the identity element for 'combineAltInfo': it is used as
+-- the initial signature in fixpoint loops and for dead-end (bottoming)
+-- computations, since their return value can be given any tag — they never
+-- actually return.
+
+-- | What we know about a runtime value.
data TagInfo
- = TagDunno -- We don't know anything about the tag.
- | TagTuple [TagInfo] -- Represents a function/thunk which when evaluated
- -- will return a Unboxed tuple whos components have
- -- the given TagInfos.
- | TagProper -- Heap pointer to properly-tagged value
- | TagTagged -- Bottom of the domain.
+ = TagDunno -- ^ We don't know anything about the tag.
+ | TagTuple [TagInfo] -- ^ An unboxed tuple with taginfo for each element.
+ | TagEPT -- ^ An evaluated and properly tagged value.
+ -- See Note [Evaluated and Properly Tagged].
+ | TagBottoming -- ^ Bottom of the domain.
+ -- See Note [Bottom functions are TagBottoming] in GHC.Stg.EnforceEpt.
deriving (Eq)
instance Outputable TagInfo where
- ppr TagTagged = text "TagTagged"
- ppr TagDunno = text "TagDunno"
- ppr TagProper = text "TagProper"
- ppr (TagTuple tis) = text "TagTuple" <> brackets (pprWithCommas ppr tis)
+ ppr TagBottoming = text "TagBottoming"
+ ppr TagDunno = text "TagDunno"
+ ppr TagEPT = text "TagEPT"
+ ppr (TagTuple tis) = text "TagTuple" <> brackets (pprWithCommas ppr tis)
instance Binary TagInfo where
- put_ bh TagDunno = putByte bh 1
+ put_ bh TagDunno = putByte bh 1
put_ bh (TagTuple flds) = putByte bh 2 >> put_ bh flds
- put_ bh TagProper = putByte bh 3
- put_ bh TagTagged = putByte bh 4
+ put_ bh TagEPT = putByte bh 3
+ put_ bh TagBottoming = putByte bh 4
get bh = do tag <- getByte bh
case tag of 1 -> return TagDunno
2 -> TagTuple <$> get bh
- 3 -> return TagProper
- 4 -> return TagTagged
+ 3 -> return TagEPT
+ 4 -> return TagBottoming
_ -> panic ("get TagInfo " ++ show tag)
instance Outputable TagSig where
- ppr (TagSig ti) = char '<' <> ppr ti <> char '>'
+ ppr (TagVal ti) = char '<' <> text "TagVal" <> brackets (ppr ti) <> char '>'
+ ppr (TagFun ti) = char '<' <> text "TagFun" <> brackets (ppr ti) <> char '>'
+
instance OutputableBndr (Id,TagSig) where
pprInfixOcc = ppr
pprPrefixOcc = ppr
instance Binary TagSig where
- put_ bh (TagSig sig) = put_ bh sig
- get bh = pure TagSig <*> get bh
+ put_ bh (TagVal ti) = putByte bh 1 >> put_ bh ti
+ put_ bh (TagFun ti) = putByte bh 2 >> put_ bh ti
+ get bh = do tag <- getByte bh
+ case tag of 1 -> TagVal <$> get bh
+ 2 -> TagFun <$> get bh
+ _ -> panic ("get TagSig " ++ show tag)
+-- | Is the given binding known to be properly tagged (or irrelevant, as for
+-- unboxed values and bottoming computations)?
isTaggedSig :: TagSig -> Bool
-isTaggedSig (TagSig TagProper) = True
-isTaggedSig (TagSig TagTagged) = True
-isTaggedSig _ = False
+isTaggedSig (TagFun _) = True
+isTaggedSig (TagVal ti) = isTaggedInfo ti
+
+-- | Is the given value-level tag known to be properly tagged?
+-- NB: unboxed tuples are *not* treated as tagged here; they are handled
+-- specially by the rewriter (which considers them already evaluated).
+isTaggedInfo :: TagInfo -> Bool
+isTaggedInfo TagEPT = True
+isTaggedInfo TagBottoming = True
+isTaggedInfo _ = False
seqTagSig :: TagSig -> ()
-seqTagSig = coerce seqTagInfo
+seqTagSig (TagVal ti) = seqTagInfo ti
+seqTagSig (TagFun ti) = seqTagInfo ti
seqTagInfo :: TagInfo -> ()
-seqTagInfo TagTagged = ()
+seqTagInfo TagBottoming = ()
seqTagInfo TagDunno = ()
-seqTagInfo TagProper = ()
-seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis
+seqTagInfo TagEPT = ()
+seqTagInfo (TagTuple tis) = foldl' (\_unit info -> seqTagInfo info) () tis
=====================================
compiler/GHC/Stg/EnforceEpt/Types.hs
=====================================
@@ -35,15 +35,23 @@ type InferStgExpr = GenStgExpr 'InferTaggedBinders
type InferStgRhs = GenStgRhs 'InferTaggedBinders
type InferStgAlt = GenStgAlt 'InferTaggedBinders
+-- | Combine TagInfo from the alternatives of a case expression.
+-- Note that this operates at the value level: case alternatives return
+-- values. See Note [TagSig and TagInfo].
combineAltInfo :: TagInfo -> TagInfo -> TagInfo
-combineAltInfo TagDunno _ = TagDunno
-combineAltInfo _ TagDunno = TagDunno
-combineAltInfo (TagTuple {}) TagProper = TagDunno -- This can happen with rep-polymorphic result, see #26107
-combineAltInfo TagProper (TagTuple {}) = TagDunno -- This can happen with rep-polymorphic result, see #26107
-combineAltInfo TagProper TagProper = TagProper
+combineAltInfo TagBottoming ti = ti
+combineAltInfo ti TagBottoming = ti
+combineAltInfo TagDunno TagDunno = TagDunno
+combineAltInfo TagDunno TagEPT = TagDunno
+combineAltInfo TagDunno (TagTuple {}) = TagDunno
+combineAltInfo TagEPT TagDunno = TagDunno
+combineAltInfo (TagTuple {}) TagDunno = TagDunno
+combineAltInfo TagEPT TagEPT = TagEPT
+-- TagEPT/TagTuple are incompatible (can arise with rep-polymorphic
+-- results, see #26107); fall through to TagDunno.
+combineAltInfo TagEPT (TagTuple {}) = TagDunno
+combineAltInfo (TagTuple {}) TagEPT = TagDunno
combineAltInfo (TagTuple is1) (TagTuple is2) = TagTuple (zipWithEqual combineAltInfo is1 is2)
-combineAltInfo (TagTagged) ti = ti
-combineAltInfo ti TagTagged = ti
type TagSigEnv = IdEnv TagSig
data TagEnv p = TE { te_env :: TagSigEnv
@@ -75,48 +83,58 @@ makeTagged env = TE { te_env = te_env env
noSig :: TagEnv p -> BinderP p -> (Id, TagSig)
noSig env bndr
- | isUnliftedType (idType var) = (var, TagSig TagProper)
- | otherwise = (var, TagSig TagDunno)
+ | isUnliftedType (idType var) = (var, TagVal TagEPT)
+ | otherwise = (var, TagVal TagDunno)
where
var = getBinderId env bndr
--- | Look up a sig in the given env
-lookupSig :: TagEnv p -> Id -> Maybe TagSig
-lookupSig env fun = lookupVarEnv (te_env env) fun
-
--- | Look up a sig in the env or derive it from information
--- in the arg itself.
+-- | Look up the return-value tag of a function for saturated call analysis.
+-- Returns 'Just retInfo' if the function binding has a 'TagFun' signature,
+-- 'Nothing' otherwise.
+lookupReturnInfo :: TagEnv p -> Id -> Maybe TagInfo
+lookupReturnInfo env fun = case lookupVarEnv (te_env env) fun of
+ Just (TagFun ret_info) -> Just ret_info
+ Just (TagVal _) -> Nothing
+ Nothing -> Nothing
+
+-- | Look up a value-level tag for an argument: either from the env (where
+-- a function-typed argument flattens to TagEPT — its closure is tagged)
+-- or derived from information on the variable itself.
lookupInfo :: TagEnv p -> StgArg -> TagInfo
lookupInfo env (StgVarArg var)
-- Nullary data constructors like True, False
| Just dc <- isDataConWorkId_maybe var
, isNullaryRepDataCon dc
, not for_bytecode
- = TagProper
+ = TagEPT
| isUnliftedType (idType var)
- = TagProper
+ = TagEPT
- -- Variables in the environment.
- | Just (TagSig info) <- lookupVarEnv (te_env env) var
- = info
+ -- Variables in the environment. A function binding flattens to TagEPT
+ -- since a function closure pointer is properly tagged; its return info
+ -- is not relevant when the function is used as a value.
+ | Just sig <- lookupVarEnv (te_env env) var
+ = case sig of
+ TagVal info -> info
+ TagFun _ -> TagEPT
| Just lf_info <- idLFInfo_maybe var
, not for_bytecode
= case lf_info of
-- Function, tagged (with arity)
LFReEntrant {}
- -> TagProper
+ -> TagEPT
-- Thunks need to be entered.
LFThunk {}
-> TagDunno
-- Constructors, already tagged.
LFCon {}
- -> TagProper
+ -> TagEPT
LFUnknown {}
-> TagDunno
LFUnlifted {}
- -> TagProper
+ -> TagEPT
-- Shouldn't be possible. I don't think we can export letNoEscapes
LFLetNoEscape {} -> panic "LFLetNoEscape exported"
@@ -126,19 +144,13 @@ lookupInfo env (StgVarArg var)
for_bytecode = te_bytecode env
lookupInfo _ (StgLitArg {})
- = TagProper
+ = TagEPT
isDunnoSig :: TagSig -> Bool
-isDunnoSig (TagSig TagDunno) = True
-isDunnoSig (TagSig TagProper) = False
-isDunnoSig (TagSig TagTuple{}) = False
-isDunnoSig (TagSig TagTagged{}) = False
-
-isTaggedInfo :: TagInfo -> Bool
-isTaggedInfo TagProper = True
-isTaggedInfo TagTagged = True
-isTaggedInfo _ = False
+isDunnoSig (TagVal TagDunno) = True
+isDunnoSig _ = False
+-- | Extend the tag environment.
extendSigEnv :: TagEnv p -> [(Id,TagSig)] -> TagEnv p
extendSigEnv env@(TE { te_env = sig_env }) bndrs
= env { te_env = extendVarEnvList sig_env bndrs }
=====================================
testsuite/tests/core-to-stg/T14895.stderr
=====================================
@@ -8,7 +8,7 @@ T14895.go
[GblId, Arity=2, Str=<MC(1,L)><1L>, Unf=OtherCon []] =
{} \r [f ds]
case ds of wild {
- GHC.Internal.Data.Either.Left e [Occ=Once1] -> wild<TagProper>;
+ GHC.Internal.Data.Either.Left e [Occ=Once1] -> wild<TagVal[TagEPT]>;
GHC.Internal.Data.Either.Right a1 [Occ=Once1] ->
let {
go_sat [Occ=Once1] :: b
=====================================
testsuite/tests/simplCore/should_compile/T4201.stdout
=====================================
@@ -1,4 +1,4 @@
lift :: Foo -> T
- [HasNoCafRefs, TagSig: <TagProper>, LambdaFormInfo: LFReEntrant 1,
- Arity: 1, Strictness: <1!A>, CPR: 1,
+ [HasNoCafRefs, TagSig: <TagFun[TagEPT]>,
+ LambdaFormInfo: LFReEntrant 1, Arity: 1, Strictness: <1!A>, CPR: 1,
Unfolding: Core: <vanilla> bof `cast` (Sym N:Foo ->_R <T>_R)]
=====================================
testsuite/tests/simplCore/should_run/T27005.hs
=====================================
@@ -0,0 +1,14 @@
+module Main (main) where
+import GHC.Exts.Heap (GenClosure(..), getClosureData)
+import T27005_aux (T(..), S(..), f)
+import System.Exit
+
+main :: IO ()
+main = do
+ let !t = MkT (MkS (pure ()) 0)
+ dup <- f t
+ c <- getClosureData dup
+ case c of
+ ThunkClosure{} -> putStrLn "FAIL" >> exitFailure
+ APClosure{} -> putStrLn "FAIL" >> exitFailure
+ _ -> putStrLn "OK"
=====================================
testsuite/tests/simplCore/should_run/T27005.stdout
=====================================
@@ -0,0 +1 @@
+OK
=====================================
testsuite/tests/simplCore/should_run/T27005_aux.hs
=====================================
@@ -0,0 +1,12 @@
+module T27005_aux (T(..), S(..), f) where
+import GHC.Stack
+
+class Monad m => C m
+instance C IO
+
+data S = MkS !(IO ()) Int
+data T = MkT !S
+
+{-# SPECIALISE f :: HasCallStack => T -> IO T #-}
+f :: (C m, HasCallStack) => T -> m T
+f (MkT a) = do () <- pure (); pure $! MkT a
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -122,3 +122,4 @@ test('AppIsHNF', normal, compile_and_run, ['-O'])
test('T24359b', normal, compile_and_run, ['-O'])
test('T23429', normal, compile_and_run, ['-O'])
test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv'])
+test('T27005', [], multimod_compile_and_run, ['T27005', '-O'])
=====================================
testsuite/tests/simplStg/should_compile/T24806.hs
=====================================
@@ -7,10 +7,10 @@ data Tup2 a b = Tup2 !a !b
-- All branches of go return either two properly tagged values *or* are bottom.
-- This means we should see something like:
--
--- (T24806.$wgo, <TagTuple[TagProper, TagProper]>) =
+-- (T24806.$wgo, <TagFun[TagTuple[TagEPT, TagEPT]]>) =
--
-- in the dump output.
--- See Note [Bottom functions are TagTagged] for details why.
+-- See Note [Bottom functions are TagBottoming] for details why.
go :: List a1 -> List a2 -> Tup2 (List a2) (List a2)
go Nil ys = Tup2 ys Nil
go (Cons _ xs) ys = case ys of
=====================================
testsuite/tests/simplStg/should_compile/T24806.stderr
=====================================
@@ -1,99 +1,77 @@
==================== CodeGenAnal STG: ====================
-lvl6 :: GHC.Prim.Addr#
+lvl6 :: GHC.Internal.Prim.Addr#
[GblId, Unf=OtherCon []] =
"T24806.hs"#;
-lvl4 :: GHC.Prim.Addr#
+lvl4 :: GHC.Internal.Prim.Addr#
[GblId, Unf=OtherCon []] =
"T24806"#;
-lvl2 :: GHC.Prim.Addr#
+lvl2 :: GHC.Internal.Prim.Addr#
[GblId, Unf=OtherCon []] =
"main"#;
-lvl :: GHC.Prim.Addr#
+lvl :: GHC.Internal.Prim.Addr#
[GblId, Unf=OtherCon []] =
"undefined"#;
-(T24806.$WTup2, <TagProper>) =
- {} \r [(conrep, <TagDunno>) (conrep1, <TagDunno>)]
- case conrep of (conrep2, <TagProper>) {
- __DEFAULT ->
- case conrep1 of (conrep3, <TagProper>) {
- __DEFAULT -> T24806.Tup2 [conrep2 conrep3];
- };
- };
-
-(T24806.$WCons, <TagProper>) =
- {} \r [(conrep, <TagDunno>) (conrep1, <TagDunno>)]
- case conrep1 of (conrep2, <TagProper>) {
- __DEFAULT -> T24806.Cons [conrep conrep2];
- };
+(T24806.Tup2, <TagFun[TagDunno]>) =
+ {} \r [(eta, <TagVal[TagDunno]>) (eta, <TagVal[TagDunno]>)] T24806.Tup2 [eta eta];
-(lvl1, <TagDunno>) = {} \u [] GHC.CString.unpackCString# lvl;
+(T24806.Nil, <TagVal[TagEPT]>) = T24806.Nil! [];
-(lvl3, <TagDunno>) = {} \u [] GHC.CString.unpackCString# lvl2;
+(T24806.Cons, <TagFun[TagDunno]>) =
+ {} \r [(eta, <TagVal[TagDunno]>) (eta, <TagVal[TagDunno]>)] T24806.Cons [eta eta];
-(lvl5, <TagDunno>) = {} \u [] GHC.CString.unpackCString# lvl4;
+(lvl1, <TagVal[TagDunno]>) =
+ {} \u [] GHC.Internal.CString.unpackCString# lvl;
-(lvl7, <TagDunno>) = {} \u [] GHC.CString.unpackCString# lvl6;
+(lvl3, <TagVal[TagDunno]>) =
+ {} \u [] GHC.Internal.CString.unpackCString# lvl2;
-(lvl8, <TagProper>) = GHC.Types.I#! [17#];
+(lvl5, <TagVal[TagDunno]>) =
+ {} \u [] GHC.Internal.CString.unpackCString# lvl4;
-(lvl9, <TagProper>) = GHC.Types.I#! [12#];
+(lvl7, <TagVal[TagDunno]>) =
+ {} \u [] GHC.Internal.CString.unpackCString# lvl6;
-(lvl10, <TagProper>) = GHC.Types.I#! [21#];
+(lvl8, <TagVal[TagEPT]>) =
+ GHC.Internal.Stack.Types.SrcLoc! [lvl3 lvl5 lvl7 17# 12# 17# 21#];
-(lvl11, <TagProper>) =
- GHC.Internal.Stack.Types.SrcLoc! [lvl3
- lvl5
- lvl7
- lvl8
- lvl9
- lvl8
- lvl10];
-
-(lvl12, <TagProper>) =
+(lvl9, <TagVal[TagEPT]>) =
GHC.Internal.Stack.Types.PushCallStack! [lvl1
- lvl11
+ lvl8
GHC.Internal.Stack.Types.EmptyCallStack];
-(lvl13, <TagDunno>) = {} \u [] GHC.Internal.Err.undefined lvl12;
-
-(T24806.Tup2, <TagDunno>) =
- {} \r [(eta, <TagDunno>) (eta, <TagDunno>)] T24806.Tup2 [eta eta];
-
-(T24806.Nil, <TagProper>) = T24806.Nil! [];
+(lvl10, <TagVal[TagDunno]>) = {} \u [] GHC.Internal.Err.undefined lvl9;
Rec {
-(T24806.$wgo, <TagTuple[TagProper, TagProper]>) =
- {} \r [(ds, <TagProper>) (ys, <TagProper>)]
- case ds of (wild, <TagProper>) {
+(T24806.$wgo, <TagFun[TagTuple[TagEPT, TagEPT]]>) =
+ {} \r [(ds, <TagVal[TagEPT]>) (ys, <TagVal[TagEPT]>)]
+ case ds of (wild, <TagVal[TagEPT]>) {
T24806.Nil ->
- case ys of (conrep, <TagProper>) {
- __DEFAULT -> (#,#) [conrep T24806.Nil];
+ case ys of (wild1, <TagVal[TagEPT]>) {
+ __DEFAULT -> (#,#) [wild1 T24806.Nil];
};
- T24806.Cons (ds1, <TagDunno>) (xs, <TagProper>) ->
- case ys of (wild1, <TagProper>) {
- T24806.Nil -> lvl13;
- T24806.Cons (y, <TagDunno>) (ys', <TagProper>) ->
- case T24806.$wgo xs ys' of (wild2, <TagProper>) {
- (#,#) (ww, <TagProper>) (ww1, <TagProper>) ->
- let { (sat, <TagProper>) = T24806.Cons! [y ww1];
- } in (#,#) [ww sat];
+ T24806.Cons (ds1, <TagVal[TagDunno]>) (xs, <TagVal[TagEPT]>) ->
+ case ys of (wild1, <TagVal[TagEPT]>) {
+ T24806.Nil -> lvl10;
+ T24806.Cons (y, <TagVal[TagDunno]>) (ys', <TagVal[TagEPT]>) ->
+ case T24806.$wgo xs ys' of (wild2, <TagVal[TagEPT]>) {
+ (#,#) (ww, <TagVal[TagEPT]>) (ww1, <TagVal[TagEPT]>) ->
+ let { ($wgo_sat, <TagVal[TagEPT]>) = T24806.Cons! [y ww1];
+ } in (#,#) [ww $wgo_sat];
};
};
};
end Rec }
-(T24806.go, <TagProper>) =
- {} \r [(ds, <TagDunno>) (ys, <TagDunno>)]
- case T24806.$wgo ds ys of (wild, <TagProper>) {
- (#,#) (ww, <TagProper>) (ww1, <TagProper>) -> T24806.Tup2 [ww ww1];
+(T24806.go, <TagFun[TagEPT]>) =
+ {} \r [(ds, <TagVal[TagDunno]>) (ys, <TagVal[TagDunno]>)]
+ case T24806.$wgo ds ys of (wild, <TagVal[TagEPT]>) {
+ (#,#) (ww, <TagVal[TagEPT]>) (ww1, <TagVal[TagEPT]>) ->
+ T24806.Tup2 [ww ww1];
};
-(T24806.Cons, <TagDunno>) =
- {} \r [(eta, <TagDunno>) (eta, <TagDunno>)] T24806.Cons [eta eta];
-
=====================================
testsuite/tests/simplStg/should_compile/T27005b.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE BangPatterns, UnboxedTuples #-}
+module T27005b where
+
+-- A function returning an unboxed tuple whose single component is itself a
+-- function. With the TagFun/TagVal split, `f`'s tag signature records that the
+-- returned component is properly tagged (TagEPT), so when `g` scrutinises the
+-- result of `f h` the binder `x` is already known to be evaluated. Hence the
+-- pair `(x, x)` is built without re-evaluating `x`.
+f :: (Bool -> Bool) -> (# Bool -> Bool #)
+f !x = (# x #)
+{-# NOINLINE f #-}
+
+g :: (Bool -> Bool) -> (Bool -> Bool, Bool -> Bool)
+g h =
+ case f h of
+ (# !x #) -> (x, x)
=====================================
testsuite/tests/simplStg/should_compile/T27005b.stderr
=====================================
@@ -0,0 +1,16 @@
+
+==================== CodeGenAnal STG: ====================
+(T27005b.f, <TagFun[TagTuple[TagEPT]]>) =
+ {} \r [(x, <TagVal[TagDunno]>)]
+ case x of (x1, <TagVal[TagEPT]>) {
+ __DEFAULT -> GHC.Internal.Types.MkSolo# [x1];
+ };
+
+(T27005b.g, <TagFun[TagEPT]>) =
+ {} \r [(h, <TagVal[TagDunno]>)]
+ case T27005b.f h of (ds, <TagVal[TagEPT]>) {
+ GHC.Internal.Types.MkSolo# (ipv, <TagVal[TagEPT]>) ->
+ case ipv of (x, <TagVal[TagEPT]>) { __DEFAULT -> (,) [x x]; };
+ };
+
+
=====================================
testsuite/tests/simplStg/should_compile/all.T
=====================================
@@ -24,5 +24,6 @@ test('inferTags003', [ only_ways(['optasm']),
grep_errmsg(r'(call stg\_ap\_0)', [1])
], compile, ['-ddump-cmm -dno-typeable-binds -O'])
test('inferTags004', normal, compile, ['-O -ddump-stg-tags -dno-typeable-binds -dsuppress-uniques'])
+test('T27005b', normal, compile, ['-O -ddump-stg-tags -dno-typeable-binds -dsuppress-uniques'])
test('T24806', grep_errmsg('^\\(T24806\\.\\$wgo'), compile, ['-O -ddump-stg-tags -dno-typeable-binds -dsuppress-uniques'])
=====================================
testsuite/tests/simplStg/should_compile/inferTags004.hs
=====================================
@@ -7,5 +7,5 @@ x = x
f :: a -> (# Int, a #)
-- Adapted from a TODO in EnforceEpt.
-- f's tag signature should indicate that the second component
--- of its result is properly tagged: TagTuple[TagDunno,TagProper]
+-- of its result is properly tagged: TagTuple[TagDunno,TagEPT]
f g = case g of !g' -> (# x, g' #)
=====================================
testsuite/tests/simplStg/should_compile/inferTags004.stderr
=====================================
@@ -1,12 +1,12 @@
==================== CodeGenAnal STG: ====================
Rec {
-(EnforceEpt004.x, <TagDunno>) = {} \u [] EnforceEpt004.x;
+(EnforceEpt004.x, <TagVal[TagDunno]>) = {} \u [] EnforceEpt004.x;
end Rec }
-(EnforceEpt004.f, <TagTuple[TagDunno, TagProper]>) =
- {} \r [(g, <TagDunno>)]
- case g of (g', <TagProper>) {
+(EnforceEpt004.f, <TagFun[TagTuple[TagDunno, TagEPT]]>) =
+ {} \r [(g, <TagVal[TagDunno]>)]
+ case g of (g', <TagVal[TagEPT]>) {
__DEFAULT -> (#,#) [EnforceEpt004.x g'];
};
=====================================
testsuite/tests/simplStg/should_run/T27005a.hs
=====================================
@@ -0,0 +1,30 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+-- Test for EnforceEpt mixing up tag signatures between functions and their return values
+module Main (main) where
+
+import GHC.Exts
+import GHC.Exts.Heap (GenClosure(..), getClosureData)
+import System.Exit
+
+-- an evaluated function that returns a tuple
+g :: State# RealWorld -> (# State# RealWorld, () #)
+g s = (# s, () #)
+{-# NOINLINE g #-}
+
+data S = MkS !(State# RealWorld -> (# State# RealWorld, () #)) Int
+data T = MkT !S
+
+s :: S
+s = MkS g 0
+{-# NOINLINE s #-}
+
+t :: T
+t = MkT s
+
+main :: IO ()
+main = do
+ c <- getClosureData t
+ case c of
+ ThunkClosure{} -> putStrLn "FAIL: ThunkClosure" >> exitFailure
+ APClosure{} -> putStrLn "FAIL: APClosure" >> exitFailure
+ _ -> putStrLn "OK"
=====================================
testsuite/tests/simplStg/should_run/T27005a.stdout
=====================================
@@ -0,0 +1 @@
+OK
=====================================
testsuite/tests/simplStg/should_run/all.T
=====================================
@@ -21,4 +21,5 @@ test('T13536a',
test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a'])
test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042'])
test('T23783', normal, multimod_compile_and_run, ['T23783', '-O -v0'])
-test('unpack_enum', normal, compile_and_run, [''])
\ No newline at end of file
+test('unpack_enum', normal, compile_and_run, [''])
+test('T27005a', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fe4f2ec3ce12ea138177c81a019dcf…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fe4f2ec3ce12ea138177c81a019dcf…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
17 Jun '26
Sebastian Graf pushed new branch wip/sg/first-class-strict at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sg/first-class-strict
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Make the order of usages deterministic
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d216412b by Ian-Woo Kim at 2026-06-16T20:25:57-04:00
Make the order of usages deterministic
It has been observed that the ordering of usages can be non-determinstic
in parallel builds. Therefore, this contribution introduces sorting of
usages based on a platform- and race-independent sorting criterion.
Resolves #26877.
Co-authored-by: Wolfgang Jeltsch <wolfgang(a)well-typed.com>
- - - - -
8e1cc105 by Wolfgang Jeltsch at 2026-06-16T20:25:57-04:00
Change the descriptions of two existing changelog entries
The descriptions now describe the changes in a user-friendly manner, as
opposed to describing the contributions that led to these changes in a
developer-friendly manner.
- - - - -
636c1c7a by Ian Duncan at 2026-06-16T20:26:50-04:00
AArch64: use SXTH, not SXTW, for W32 signExtendReg
signExtendReg was using SXTH (sign-extend halfword, 16-bit) for
W32-to-W64 sign extension. This should be SXTW (sign-extend word,
32-bit). SXTH only sign-extends the lower 16 bits, producing wrong
results for 32-bit values whose bit 15 differs from bit 31.
Other fixes:
- At sub-W64, code gen for MO_S_Mul2 should use W32 registers for
SMULL source operands as per the ARM spec (SMULL Xd, Wn, Wm),
and not W64.
- Ensure signExtendReg uses the source width for the source operand
in SXTW/SXTH/SXTB instructions. GNU as requires sxtw Xd,Wn (not
sxtw Xd,Xn), while LLVM's integrated assembler on macOS is lenient.
- Fix overflow flag computation for `MO_S_Mul2`. The overflow bit
was exactly inverted for sub-W64 operands.
Fixes #26978 and #27047
- - - - -
b734c75d by Igor Ranieri at 2026-06-16T20:27:32-04:00
haddock: Update CONTRIBUTING with missing step, add missing test
dependency
- - - - -
fa8c0c26 by Luite Stegeman at 2026-06-16T23:04:29-04:00
tag inference: don't confuse functions with their return values
inferTagRhs was mixing up taggedness for closures and return values
for function closures. We really shouldn't assign TagTuple to a
properly tagged function returning a tuple.
We fix this by keeping track of functions (TagFun) separately from
values (TagVal) and keeping track of their return value. TagFun is
also used for join points.
fixes #27005
- - - - -
5c1fd991 by Sebastian Graf at 2026-06-16T23:04:30-04:00
Seed the simplifier's in-scope set for open expressions
simplifyExpr simplifies expressions typed at the GHCi prompt and the
results of Template Haskell splices. Such an expression may be open: at a
GHCi debugger breakpoint its free variables include RuntimeUnk skolems
standing for as-yet-unknown types.
The simplifier began with an in-scope set holding only the wildcard
binder, so when it instantiated the unsafeCoerce# wrapper that GHCi
builds around a result, it formed a substitution whose range mentioned a
free skolem that was not in scope. That breaks the substitution invariant
and, in a compiler built with assertions, trips substTy's sanity check.
Seed the initial in-scope set with the free variables of the expression.
For a closed expression this adds nothing.
See Note [Seed the in-scope set for open expressions].
Fixes #17833 and its duplicate #21118.
- - - - -
46 changed files:
- + changelog.d/T17833
- + changelog.d/T26978
- + changelog.d/T27047
- + changelog.d/deterministic-usage-order
- changelog.d/module-graph-reuse-in-downsweep
- changelog.d/more-efficient-home-unit-imports-finding
- + changelog.d/tag-inference-27005
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/EnforceEpt/Rewrite.hs
- compiler/GHC/Stg/EnforceEpt/TagSig.hs
- compiler/GHC/Stg/EnforceEpt/Types.hs
- compiler/GHC/Unit/Module/Deps.hs
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.asm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.cmm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-cmm.cmm
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/core-to-stg/T14895.stderr
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/simplCore/should_compile/T4201.stdout
- + testsuite/tests/simplCore/should_run/T27005.hs
- + testsuite/tests/simplCore/should_run/T27005.stdout
- + testsuite/tests/simplCore/should_run/T27005_aux.hs
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/simplStg/should_compile/T24806.hs
- testsuite/tests/simplStg/should_compile/T24806.stderr
- + testsuite/tests/simplStg/should_compile/T27005b.hs
- + testsuite/tests/simplStg/should_compile/T27005b.stderr
- testsuite/tests/simplStg/should_compile/all.T
- testsuite/tests/simplStg/should_compile/inferTags004.hs
- testsuite/tests/simplStg/should_compile/inferTags004.stderr
- + testsuite/tests/simplStg/should_run/T27005a.hs
- + testsuite/tests/simplStg/should_run/T27005a.stdout
- testsuite/tests/simplStg/should_run/all.T
- utils/haddock/CONTRIBUTING.md
- utils/haddock/haddock-test/haddock-test.cabal
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/798b1ee0061d72004286a5a5f92898…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/798b1ee0061d72004286a5a5f92898…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] haddock: Update CONTRIBUTING with missing step, add missing test
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b734c75d by Igor Ranieri at 2026-06-16T20:27:32-04:00
haddock: Update CONTRIBUTING with missing step, add missing test
dependency
- - - - -
2 changed files:
- utils/haddock/CONTRIBUTING.md
- utils/haddock/haddock-test/haddock-test.cabal
Changes:
=====================================
utils/haddock/CONTRIBUTING.md
=====================================
@@ -33,6 +33,14 @@ $ ./hadrian/build -j --flavour=Quick --freeze1 _build/stage1/bin/haddock
Currently, this cannot be done with hadrian but has to be done with a
`cabal-install` built from `master`.
+First, generate the `.haddock` interface files for GHC's bundled libraries:
+
+```
+$ ./hadrian/build -j docs-haddock
+```
+
+Then run the tests:
+
```
cabal test -w <absolute-path-to-ghc-repo>/_build/stage1/bin/ghc
```
=====================================
utils/haddock/haddock-test/haddock-test.cabal
=====================================
@@ -16,7 +16,7 @@ library
default-language: Haskell2010
ghc-options: -Wall
hs-source-dirs: src
- build-depends: base >= 4.3 && < 4.24, bytestring, directory, process, filepath, Cabal
+ build-depends: base >= 4.3 && < 4.24, bytestring, directory, process, filepath, Cabal, containers
exposed-modules:
Test.Haddock
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b734c75d68e572192f0ca2efb875ad1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b734c75d68e572192f0ca2efb875ad1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] AArch64: use SXTH, not SXTW, for W32 signExtendReg
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
636c1c7a by Ian Duncan at 2026-06-16T20:26:50-04:00
AArch64: use SXTH, not SXTW, for W32 signExtendReg
signExtendReg was using SXTH (sign-extend halfword, 16-bit) for
W32-to-W64 sign extension. This should be SXTW (sign-extend word,
32-bit). SXTH only sign-extends the lower 16 bits, producing wrong
results for 32-bit values whose bit 15 differs from bit 31.
Other fixes:
- At sub-W64, code gen for MO_S_Mul2 should use W32 registers for
SMULL source operands as per the ARM spec (SMULL Xd, Wn, Wm),
and not W64.
- Ensure signExtendReg uses the source width for the source operand
in SXTW/SXTH/SXTB instructions. GNU as requires sxtw Xd,Wn (not
sxtw Xd,Xn), while LLVM's integrated assembler on macOS is lenient.
- Fix overflow flag computation for `MO_S_Mul2`. The overflow bit
was exactly inverted for sub-W64 operands.
Fixes #26978 and #27047
- - - - -
14 changed files:
- + changelog.d/T26978
- + changelog.d/T27047
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.asm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.cmm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm
- + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-cmm.cmm
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs
- + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
changelog.d/T26978
=====================================
@@ -0,0 +1,14 @@
+section: compiler
+issues: #26978
+mrs: !15619
+synopsis:
+ AArch64 code generation: use ``SXTH`` instead of ``SXTW`` for ``W32`` sign extension
+description:
+ Fix the AArch64 code generator incorrectly using using ``SXTH``
+ (sign-extend halfword, 16-bit) for ``W32``-to-``W64`` sign extension, and
+ always use the source width for the source operand in sign extension
+ instructions.
+
+ Also ensures that sub-W64 code generation for ``MO_S_Mul2`` uses ``W32``
+ registers as mandated by the ARM specification.
+
=====================================
changelog.d/T27047
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+issues: #27047
+mrs: !15619
+synopsis:
+ Fix incorrect overflow bit for ``MUL2`` on AArch64 for sub-``W64`` operands.
+description:
+ This fixes the computation of the overflow bit for ``MO_S_Mul2`` on
+ sub-``W64`` operands; the old condition was exactly inverted.
+
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1894,15 +1894,15 @@ signExtendReg w w' r =
W64 -> noop
W32
| w' == W32 -> noop
- | otherwise -> extend SXTH
+ | otherwise -> extend SXTW
W16 -> extend SXTH
W8 -> extend SXTB
_ -> panic "intOp"
where
noop = return (r, nilOL)
extend instr = do
- r' <- getNewRegNat II64
- return (r', unitOL $ instr (OpReg w' r') (OpReg w' r))
+ r' <- getNewRegNat (intFormat w')
+ return (r', unitOL $ instr (OpReg w' r') (OpReg w r))
-- | Instructions to truncate the value in the given register from width @w@
-- down to width @w'@.
@@ -2333,41 +2333,35 @@ genCCall target dest_regs arg_regs = do
let lo = getRegisterReg platform (CmmLocal dst_lo)
hi = getRegisterReg platform (CmmLocal dst_hi)
nd = getRegisterReg platform (CmmLocal dst_needed)
- -- Do everything in a full 64 bit registers
w' = platformWordWidth platform
- (reg_a, code_a') <- signExtendReg w w' reg_a'
- (reg_b, code_b') <- signExtendReg w w' reg_b'
+ -- Sign-extend inputs to W32 for SMULL (Xd = Wn * Wm).
+ -- signExtendReg always allocates a fresh temp for w < W32,
+ -- and is a noop for W32 (safe: SMULL reads both sources
+ -- atomically before writing the destination).
+ (reg_a, code_a') <- signExtendReg w W32 reg_a'
+ (reg_b, code_b') <- signExtendReg w W32 reg_b'
return $
code_a `appOL`
code_b `appOL`
code_a' `appOL`
code_b' `snocOL`
- -- the low 2w' of lo contains the full multiplication;
- -- eg: int8 * int8 -> int16 result
- -- so lo is in the last w of the register, and hi is in the second w.
- SMULL (OpReg w' lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
- -- Make sure we hold onto the sign bits for dst_needed
- ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL`
- -- lo can now be truncated so we can get at it's top bit easily.
+ -- SMULL Xd, Wn, Wm: multiply two W32 values producing a
+ -- 64-bit result. The low w bits of lo contain the truncated
+ -- product, and hi gets the overflow (sign extension bits).
+ SMULL (OpReg w' lo) (OpReg W32 reg_a) (OpReg W32 reg_b) `snocOL`
+ ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL`
truncateReg w' w lo `snocOL`
- -- Note the use of CMN (compare negative), not CMP: we want to
- -- test if the top half is negative one and the top
- -- bit of the bottom half is positive one. eg:
- -- hi = 0b1111_1111 (actually 64 bits)
- -- lo = 0b1010_1111 (-81, so the result didn't need the top half)
- -- lo' = ASR(lo,7) (second reg of SMN)
- -- = 0b0000_0001 (theeshift gives us 1 for negative,
- -- and 0 for positive)
- -- hi == -lo'?
- -- 0b1111_1111 == 0b1111_1111 (yes, top half is just overflow)
- -- Another way to think of this is if hi + lo' == 0, which is what
- -- CMN really is under the hood.
+ -- CMN (compare negative) tests hi + lo' == 0, i.e. hi == -lo'.
+ -- lo' = LSR(lo, w-1) gives 1 if lo is negative, 0 if positive.
+ -- No overflow iff hi is the sign extension of lo:
+ -- lo positive (bit w-1 = 0) => lo' = 0, need hi == 0
+ -- lo negative (bit w-1 = 1) => lo' = 1, need hi == -1
+ -- CMN sets Z when hi + lo' == 0 (no overflow), so we use
+ -- NE to set nd = 1 when overflow occurred.
CMN (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL`
- -- Set dst_needed to 1 if hi and lo' were (negatively) equal
- CSET (OpReg w' nd) EQ `appOL`
- -- Finally truncate hi to drop any extraneous sign bits.
+ CSET (OpReg w' nd) NE `appOL`
truncateReg w' w hi
-- Can't handle > 64 bit operands
| otherwise -> unsupported (MO_S_Mul2 w)
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -105,6 +105,7 @@ regUsageOfInstr platform instr = case instr of
SXTB dst src -> usage (regOp src, regOp dst)
UXTB dst src -> usage (regOp src, regOp dst)
SXTH dst src -> usage (regOp src, regOp dst)
+ SXTW dst src -> usage (regOp src, regOp dst)
UXTH dst src -> usage (regOp src, regOp dst)
CLZ dst src -> usage (regOp src, regOp dst)
RBIT dst src -> usage (regOp src, regOp dst)
@@ -296,6 +297,7 @@ patchRegsOfInstr instr env = case instr of
SXTB o1 o2 -> SXTB (patchOp o1) (patchOp o2)
UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2)
SXTH o1 o2 -> SXTH (patchOp o1) (patchOp o2)
+ SXTW o1 o2 -> SXTW (patchOp o1) (patchOp o2)
UXTH o1 o2 -> UXTH (patchOp o1) (patchOp o2)
CLZ o1 o2 -> CLZ (patchOp o1) (patchOp o2)
RBIT o1 o2 -> RBIT (patchOp o1) (patchOp o2)
@@ -699,8 +701,7 @@ data Instr
| UXTB Operand Operand
| SXTH Operand Operand
| UXTH Operand Operand
- -- | SXTW Operand Operand
- -- | SXTX Operand Operand
+ | SXTW Operand Operand
| PUSH_STACK_FRAME
| POP_STACK_FRAME
-- 1. Arithmetic Instructions ----------------------------------------------
@@ -857,6 +858,7 @@ instrCon i =
SXTB{} -> "SXTB"
UXTB{} -> "UXTB"
SXTH{} -> "SXTH"
+ SXTW{} -> "SXTW"
UXTH{} -> "UXTH"
PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME"
POP_STACK_FRAME{} -> "POP_STACK_FRAME"
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -516,6 +516,7 @@ pprInstr platform instr = case instr of
SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2
UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2
SXTH o1 o2 -> op2 (text "\tsxth") o1 o2
+ SXTW o1 o2 -> op2 (text "\tsxtw") o1 o2
UXTH o1 o2 -> op2 (text "\tuxth") o1 o2
-- 3. Logical and Move Instructions ------------------------------------------
=====================================
testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.asm
=====================================
@@ -0,0 +1 @@
+sxth
=====================================
testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.cmm
=====================================
@@ -0,0 +1,12 @@
+#include "Cmm.h"
+
+// Exercises MO_S_Mul2 W16: signExtendReg W16 W32 must emit SXTH to
+// sign-extend the 16-bit inputs to 32-bit before SMULL.
+testMul2W16 (W_ buffer) {
+ I16 a, b, needed, hi, lo;
+ a = I16[buffer];
+ b = I16[buffer + 2];
+ (needed, hi, lo) = prim %mul2_16(a, b);
+ I16[buffer + 4] = lo;
+ return();
+}
=====================================
testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm
=====================================
@@ -0,0 +1 @@
+smull
=====================================
testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.cmm
=====================================
@@ -0,0 +1,13 @@
+#include "Cmm.h"
+
+// Exercises MO_S_Mul2 W32, which uses SMULL (Xd = Wn * Wm).
+// After the fix, signExtendReg W32 W32 is a noop (no SXTW needed),
+// but the SMULL instruction itself must still appear.
+testMul2W32 (W_ buffer) {
+ I32 a, b, needed, hi, lo;
+ a = I32[buffer];
+ b = I32[buffer + 4];
+ (needed, hi, lo) = prim %mul2_32(a, b);
+ I32[buffer + 8] = lo;
+ return();
+}
=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -31,3 +31,5 @@ is_aarch64_codegen = [
# AArch64-specific tests
test('aarch64-ushr-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
test('aarch64-shl-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
+test('aarch64-sxtw', is_aarch64_codegen, compile_grep_asm, ['cmm', True, ''])
+test('aarch64-sxth-mul2', is_aarch64_codegen, compile_grep_asm, ['cmm', True, ''])
=====================================
testsuite/tests/codeGen/should_run/aarch64-sxtw-cmm.cmm
=====================================
@@ -0,0 +1,41 @@
+#include "Cmm.h"
+
+// MO_S_Mul2 W32: signExtendReg W32 W32 is a noop (inputs already W32).
+// Tests the SMULL path with values whose bit 15 != bit 31 (the old SXTH
+// bug would corrupt these).
+runMul2W32zh (W_ x) {
+ I32 a, b, needed, hi, lo;
+ a = %lobits32(x);
+ b = 2::I32;
+ (needed, hi, lo) = prim %mul2_32(a, b);
+ return(TO_W_(lo));
+}
+
+// MO_S_Mul2 W16: signExtendReg W16 W32 emits SXTH before SMULL.
+runMul2W16zh (W_ x) {
+ I16 a, b, needed, hi, lo;
+ a = %lobits16(x);
+ b = 2::I16;
+ (needed, hi, lo) = prim %mul2_16(a, b);
+ return(TO_W_(lo));
+}
+
+// MO_S_Mul2 W8: signExtendReg W8 W32 emits SXTB before SMULL.
+runMul2W8zh (W_ x) {
+ I8 a, b, needed, hi, lo;
+ a = %lobits8(x);
+ b = 2::I8;
+ (needed, hi, lo) = prim %mul2_8(a, b);
+ return(TO_W_(lo));
+}
+
+// MO_S_Mul2 W16 returning (needed, hi, lo) as a packed triple.
+// Tests the CSET NE overflow detection: needed=1 when overflow occurs.
+// Returns (needed << 32) | (lo & 0xFFFF) so the Haskell side can inspect both.
+runMul2W16Overflowzh (W_ x, W_ y) {
+ I16 a, b, needed, hi, lo;
+ a = %lobits16(x);
+ b = %lobits16(y);
+ (needed, hi, lo) = prim %mul2_16(a, b);
+ return(TO_W_(needed) * 0x100000000 + (TO_W_(lo) `and` 0xFFFF));
+}
=====================================
testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs
=====================================
@@ -0,0 +1,60 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module Main where
+
+import GHC.Exts
+import Data.Bits (shiftR, (.&.))
+
+foreign import prim "runMul2W32zh" runMul2W32# :: Word# -> Word#
+foreign import prim "runMul2W16zh" runMul2W16# :: Word# -> Word#
+foreign import prim "runMul2W8zh" runMul2W8# :: Word# -> Word#
+foreign import prim "runMul2W16Overflowzh"
+ runMul2W16Overflow# :: Word# -> Word# -> Word#
+
+mul2W32 :: Word -> Word
+mul2W32 (W# x) = W# (runMul2W32# x)
+
+mul2W16 :: Word -> Word
+mul2W16 (W# x) = W# (runMul2W16# x)
+
+mul2W8 :: Word -> Word
+mul2W8 (W# x) = W# (runMul2W8# x)
+
+mul2W16Overflow :: Word -> Word -> (Word, Word)
+mul2W16Overflow (W# x) (W# y) =
+ let r = W# (runMul2W16Overflow# x y)
+ needed = r `shiftR` 32
+ lo = r .&. 0xFFFF
+ in (needed, lo)
+
+main :: IO ()
+main = do
+ -- W32: 50000 has bit 15 set, bit 31 clear. The old SXTH bug would
+ -- sign-extend from bit 15, corrupting the value before SMULL.
+ putStrLn $ "W32 50000*2 = " ++ show (mul2W32 50000)
+ putStrLn $ "W32 1*2 = " ++ show (mul2W32 1)
+ putStrLn $ "W32 70000*2 = " ++ show (mul2W32 70000)
+
+ -- W16: exercises signExtendReg W16 W32 (SXTH before SMULL).
+ putStrLn $ "W16 200*2 = " ++ show (mul2W16 200)
+ putStrLn $ "W16 100*2 = " ++ show (mul2W16 100)
+
+ -- W8: exercises signExtendReg W8 W32 (SXTB before SMULL).
+ putStrLn $ "W8 50*2 = " ++ show (mul2W8 50)
+ putStrLn $ "W8 3*2 = " ++ show (mul2W8 3)
+
+ -- Overflow detection (CSET NE fix):
+ -- 200 * 200 = 40000, overflows I16 [-32768, 32767]. needed=1.
+ let (n1, lo1) = mul2W16Overflow 200 200
+ putStrLn $ "W16 200*200: needed=" ++ show n1 ++ " lo=" ++ show lo1
+ -- 100 * 2 = 200, fits in I16. needed=0.
+ let (n2, lo2) = mul2W16Overflow 100 2
+ putStrLn $ "W16 100*2: needed=" ++ show n2 ++ " lo=" ++ show lo2
+ -- 181 * 181 = 32761, just under 32767. needed=0.
+ let (n3, lo3) = mul2W16Overflow 181 181
+ putStrLn $ "W16 181*181: needed=" ++ show n3 ++ " lo=" ++ show lo3
+ -- 182 * 182 = 33124, just over 32767. needed=1.
+ let (n4, lo4) = mul2W16Overflow 182 182
+ putStrLn $ "W16 182*182: needed=" ++ show n4 ++ " lo=" ++ show lo4
=====================================
testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout
=====================================
@@ -0,0 +1,11 @@
+W32 50000*2 = 100000
+W32 1*2 = 2
+W32 70000*2 = 140000
+W16 200*2 = 400
+W16 100*2 = 200
+W8 50*2 = 100
+W8 3*2 = 6
+W16 200*200: needed=1 lo=40000
+W16 100*2: needed=0 lo=200
+W16 181*181: needed=0 lo=32761
+W16 182*182: needed=1 lo=33124
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -289,3 +289,9 @@ test('T27072w', [req_c, js_skip, when(opsys('darwin'), skip)],
# AArch64-specific runtime tests
test('aarch64-ushr-subword-run', [unless(arch('aarch64'), skip)], compile_and_run, ['-O'])
test('aarch64-subword-ops', [unless(arch('aarch64'), skip)], compile_and_run, ['-O'])
+test('aarch64-sxtw-run',
+ [ extra_files(['aarch64-sxtw-cmm.cmm']),
+ unless(arch('aarch64'), skip),
+ when(unregisterised(), skip)],
+ multi_compile_and_run,
+ ['aarch64-sxtw-run', [('aarch64-sxtw-cmm.cmm', '')], '-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636c1c7ae47495f022affa501ea0a40…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636c1c7ae47495f022affa501ea0a40…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 2 commits: Make the order of usages deterministic
by Marge Bot (＠marge-bot) 17 Jun '26
by Marge Bot (＠marge-bot) 17 Jun '26
17 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d216412b by Ian-Woo Kim at 2026-06-16T20:25:57-04:00
Make the order of usages deterministic
It has been observed that the ordering of usages can be non-determinstic
in parallel builds. Therefore, this contribution introduces sorting of
usages based on a platform- and race-independent sorting criterion.
Resolves #26877.
Co-authored-by: Wolfgang Jeltsch <wolfgang(a)well-typed.com>
- - - - -
8e1cc105 by Wolfgang Jeltsch at 2026-06-16T20:25:57-04:00
Change the descriptions of two existing changelog entries
The descriptions now describe the changes in a user-friendly manner, as
opposed to describing the contributions that led to these changes in a
developer-friendly manner.
- - - - -
5 changed files:
- + changelog.d/deterministic-usage-order
- changelog.d/module-graph-reuse-in-downsweep
- changelog.d/more-efficient-home-unit-imports-finding
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Unit/Module/Deps.hs
Changes:
=====================================
changelog.d/deterministic-usage-order
=====================================
@@ -0,0 +1,8 @@
+section: compiler
+synopsis: Make the order of usages deterministic
+issues: #26877
+mrs: !15484
+description: {
+ The order in which usages appear in interface files is now
+ deterministic.
+}
=====================================
changelog.d/module-graph-reuse-in-downsweep
=====================================
@@ -3,7 +3,7 @@ synopsis: Allow `downsweep` to use nodes of an existing module graph
issues: #27054
mrs: !16028
description: {
- This contribution enables `downsweep` to use the nodes of a module
- graph obtained from a previous downsweeping round, which allows GHC
- API applications to build module graphs somewhat incrementally.
+ The `downsweep` operation can now use the nodes of a module graph
+ obtained from a previous downsweeping round, which allows GHC API
+ applications to build module graphs somewhat incrementally.
}
=====================================
changelog.d/more-efficient-home-unit-imports-finding
=====================================
@@ -3,13 +3,10 @@ synopsis: Introduce a cache of home module name providers
issues: #27055
mrs: !15888
description: {
- This contribution optimizes the algorithm for finding out which home
- unit provides the module that a certain import declaration refers
- to. The previous approach has been to simply search all home units
- in no particular order. This change introduces a cache that allows
- for efficiently determining those complete home units that provide a
- certain module name and changes the module-finding algorithm such
- that it searches these units before the other home units. This leads
- to significant performance improvements in situations where there
- are lots of home units.
+ For finding out which home unit provides the module that a certain
+ import declaration refers to, we now use a better algorithm. The
+ previous approach was to simply search all home units in no
+ particular order. The new algorithm first searches those complete
+ home units that provide a certain module name, before searching the
+ other home units.
}
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -70,6 +70,8 @@ data UsageConfig = UsageConfig
{ uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode?
}
+-- | Build the list of 'Usage's that drive recompilation checking.
+-- The resulting list is deterministically sorted.
mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv
-> Module -> ImportedMods -> [ImportUserSpec] -> NameSet
-> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [LinkableUsage] -> PkgsLoaded
@@ -100,10 +102,10 @@ mkUsageInfo uc plugins fc unit_env
}
| (mod, hash) <- merged ]
++ object_usages
- usages `seqList` return usages
- -- seq the list of Usages returned: occasionally these
- -- don't get evaluated for a while and we can end up hanging on to
- -- the entire collection of Ifaces.
+ usages `seqList` return (sortBy stableUsageCmp usages)
+ -- The use of 'seqList' is important because occasionally the returned list
+ -- is not evaluated for a while, so that with too much laziness here we
+ -- could end up hanging on to the entire collection of 'Iface's.
{- Note [Plugin dependencies]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DerivingVia #-}
+
+{-# OPTIONS_GHC -Wwarn=incomplete-record-selectors #-}
+
-- | Dependencies and Usage of a module
module GHC.Unit.Module.Deps
( Dependencies(dep_direct_mods
@@ -17,6 +20,7 @@ module GHC.Unit.Module.Deps
, noDependencies
, pprDeps
, Usage (..)
+ , stableUsageCmp
, HomeModImport (..)
, HomeModImportedAvails (..)
, ImportAvails (..)
@@ -52,6 +56,7 @@ import GHC.Utils.Outputable
import Control.DeepSeq
import Data.Bifunctor
import qualified Data.Foldable as Foldable
+import Data.Function (on)
import Data.List (sortBy, sort, partition)
import Data.Set (Set)
import qualified Data.Set as Set
@@ -497,6 +502,47 @@ instance Binary Usage where
i -> error ("Binary.get(Usage): " ++ show i)
+-- | Compares 'Usage's by constructor and, if the constructors are the same, by
+-- identifying strings, to achieve a predictable ordering.
+stableUsageCmp :: Usage -> Usage -> Ordering
+stableUsageCmp
+ usage1@UsagePackageModule {}
+ usage2@UsagePackageModule {}
+ = (compare `on` usg_mod) usage1 usage2
+stableUsageCmp
+ usage1@UsageHomeModule {}
+ usage2@UsageHomeModule {}
+ = (compare `on` Module <$> usg_unit_id <*> usg_mod_name) usage1 usage2
+stableUsageCmp
+ usage1@UsageFile {}
+ usage2@UsageFile {}
+ = (lexicalCompareFS `on` usg_file_path) usage1 usage2
+stableUsageCmp
+ usage1@UsageDirectory {}
+ usage2@UsageDirectory {}
+ = (lexicalCompareFS `on` usg_dir_path) usage1 usage2
+stableUsageCmp
+ usage1@UsageHomeModuleBytecode {}
+ usage2@UsageHomeModuleBytecode {}
+ = (compare `on` Module <$> usg_unit_id <*> usg_mod_name) usage1 usage2
+stableUsageCmp
+ usage1@UsageMergedRequirement {}
+ usage2@UsageMergedRequirement {}
+ = (compare `on` usg_mod) usage1 usage2
+stableUsageCmp
+ usage1
+ usage2
+ = (compare `on` constructorIndex) usage1 usage2
+ where
+
+ constructorIndex :: Usage -> Int
+ constructorIndex UsagePackageModule {} = 0
+ constructorIndex UsageHomeModule {} = 1
+ constructorIndex UsageFile {} = 2
+ constructorIndex UsageDirectory {} = 3
+ constructorIndex UsageHomeModuleBytecode {} = 4
+ constructorIndex UsageMergedRequirement {} = 5
+
-- | Records the imports that we depend on from a home module,
-- for recompilation checking.
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3fa10e0c93a58f46815c4fab7522f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3fa10e0c93a58f46815c4fab7522f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T27383] Desugar a `case` scrutinee only once (#27383, #20251)
by Sebastian Graf (＠sgraf812) 17 Jun '26
by Sebastian Graf (＠sgraf812) 17 Jun '26
17 Jun '26
Sebastian Graf pushed to branch wip/T27383 at Glasgow Haskell Compiler / GHC
Commits:
0e7c8aca by Sebastian Graf at 2026-06-16T23:47:03+02:00
Desugar a `case` scrutinee only once (#27383, #20251)
In `dsExpr` for `HsCase` we desugared the scrutinee /twice/: once to
build the Core `case` itself, and again inside `matchWrapper`, which
re-desugared the source scrutinee (via `addHsScrutTmCs`) purely to
record long-distance information for the pattern-match checker.
For a single `case` that is merely wasteful. But for nested cases it
is catastrophic. Consider
case (case (case e of ... ) of ... ) of ...
Desugaring the outer scrutinee desugars the middle `case` twice, each
of which desugars the inner `case` twice, and so on. The work doubles
at every level, so desugaring takes O(2^n) time in the nesting depth.
That is the blowup reported in #27383; it is also what makes the
machine-generated program in #20251 take an age to compile.
The fix is simple. `matchWrapper` is handed the scrutinee anyway, so
we give it the Core expression we have /already/ desugared, and record
the long-distance term constraint with `addCoreScrutTmCs` instead of
re-desugaring from source. This is just what `matchSinglePatVar`
already does for single-pattern matches.
So:
* `matchWrapper` now takes `Maybe [CoreExpr]` rather than
`Maybe [LHsExpr GhcTc]`.
* The `HsCase` equation of `dsExpr` passes the already-desugared
`core_discrim`; the arrow desugarer passes its match variables.
* `addHsScrutTmCs` had no other use, so it is gone.
Desugaring is now linear in the nesting depth. (The coverage checker
still runs `simpleOptExpr` over each scrutinee, which leaves the total
at O(n^2); that is ample.) The long-distance information itself is
unchanged: the checker sees precisely the Core that backs the
generated code.
Test: deSugar/should_compile/T27383
- - - - -
8 changed files:
- + changelog.d/fix-exponential-case-desugar-27383
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match.hs-boot
- compiler/GHC/HsToCore/Pmc.hs
- + testsuite/tests/deSugar/should_compile/T27383.hs
- testsuite/tests/deSugar/should_compile/all.T
Changes:
=====================================
changelog.d/fix-exponential-case-desugar-27383
=====================================
@@ -0,0 +1,6 @@
+section: compiler
+synopsis: Fix exponential-time desugaring of nested ``case`` expressions.
+ The scrutinee is no longer desugared a second time when recording
+ long-distance information for the pattern-match checker.
+issues: #27383 #20251
+mrs: !16203
=====================================
compiler/GHC/HsToCore/Arrows.hs
=====================================
@@ -553,7 +553,7 @@ dsCmd ids local_vars stack_ty res_ty
in_ty = envStackType env_ids stack_ty'
discrims = map nlHsVar arg_ids
(discrim_vars, matching_code)
- <- matchWrapper (ArrowMatchCtxt match_ctxt) (Just discrims) match'
+ <- matchWrapper (ArrowMatchCtxt match_ctxt) (Just (map Var arg_ids)) match'
core_body <- flip (bind_vars discrim_vars) matching_code <$>
traverse dsLExpr discrims
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -421,7 +421,7 @@ dsExpr (HsPragE _ (HsPragSCC _ cc) expr)
dsExpr (HsCase ctxt discrim matches)
= do { core_discrim <- dsLExpr discrim
- ; ([discrim_var], matching_code) <- matchWrapper ctxt (Just [discrim]) matches
+ ; ([discrim_var], matching_code) <- matchWrapper ctxt (Just [core_discrim]) matches
; return (bindNonRec discrim_var core_discrim matching_code) }
-- Pepe: The binds are in scope in the body but NOT in the binding group
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -761,7 +761,7 @@ Call @match@ with all of this information!
matchWrapper
:: HsMatchContextRn -- ^ For shadowing warning messages
- -> Maybe [LHsExpr GhcTc] -- ^ Scrutinee(s)
+ -> Maybe [CoreExpr] -- ^ Already-desugared scrutinee(s)
-- see Note [matchWrapper scrutinees]
-> MatchGroup GhcTc (LHsExpr GhcTc) -- ^ Matches being desugared
-> DsM ([Id], CoreExpr) -- ^ Results (usually passed to 'match')
@@ -818,7 +818,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches
-- pmc for pattern synonyms
-- See Note [Long-distance information] in GHC.HsToCore.Pmc
- then addHsScrutTmCs (concat scrs) new_vars $
+ then addCoreScrutTmCs (concat scrs) new_vars $
pmcMatches origin (DsMatchContext ctxt locn) new_vars matches
-- When we're not doing PM checks on the match group,
=====================================
compiler/GHC/HsToCore/Match.hs-boot
=====================================
@@ -16,7 +16,7 @@ match :: [Id]
matchWrapper
:: HsMatchContextRn
- -> Maybe [LHsExpr GhcTc]
+ -> Maybe [CoreExpr]
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> DsM ([Id], CoreExpr)
=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -34,7 +34,7 @@ module GHC.HsToCore.Pmc (
isMatchContextPmChecked, isMatchContextPmChecked_SinglePat,
-- See Note [Long-distance information]
- addTyCs, addCoreScrutTmCs, addHsScrutTmCs, getLdiNablas,
+ addTyCs, addCoreScrutTmCs, getLdiNablas,
getNFirstUncovered
) where
@@ -59,7 +59,6 @@ import GHC.Utils.Panic
import GHC.Types.Var (EvVar, Var (..))
import GHC.Types.Id.Info
import GHC.Tc.Utils.TcType (evVarPred)
-import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr)
import GHC.HsToCore.Monad
import GHC.Data.Bag
import GHC.Data.OrdList
@@ -684,12 +683,6 @@ addCoreScrutTmCs (scr:scrs) (x:xs) k
addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr))
addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ"
--- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first.
-addHsScrutTmCs :: [LHsExpr GhcTc] -> [Id] -> DsM a -> DsM a
-addHsScrutTmCs scrs vars k = do
- scr_es <- traverse dsLExpr scrs
- addCoreScrutTmCs scr_es vars k
-
{- Note [Long-distance information]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
@@ -716,8 +709,8 @@ To achieve similar reasoning in the coverage checker:
which the call sites put into place with 'GHC.HsToCore.Monad.updPmNablas'.
* Call sites also extend this set with facts from type-constraint dictionaries,
- case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs'
- and 'addHsScrutTmCs'.
+ case scrutinees, etc. with the exported functions 'addTyCs' and
+ 'addCoreScrutTmCs'.
Note [Recovering from unsatisfiable pattern-matching constraints]
=====================================
testsuite/tests/deSugar/should_compile/T27383.hs
=====================================
@@ -0,0 +1,9 @@
+-- Regression test for #27383 (and #20251): deeply nested cases whose
+-- scrutinees are themselves cases must desugar in polynomial (not
+-- exponential) time. With the bug the scrutinee is desugared twice at
+-- every level, so compiler allocation (tracked by this performance test)
+-- grows as O(2^n) in the nesting depth.
+module T27383 where
+
+zero :: Int
+zero = (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case (case 0 of x500 -> x500) of x499 -> x499) of x498 -> x498) of x497 -> x497) of x496 -> x496) of x495 -> x495) of x494 -> x494) of x493 -> x493) of x492 -> x492) of x491 -> x491) of x490 -> x490) of x489 -> x489) of x488 -> x488) of x487 -> x487) of x486 -> x486) of x485 -> x485) of x484 -> x484) of x483 -> x483) of x482 -> x482) of x481 -> x481) of x480 -> x480) of x479 -> x479) of x478 -> x478) of x477 -> x477) of x476 -> x476) of x475 -> x475) of x474 -> x474) of x473 -> x473) of x472 -> x472) of x471 -> x471) of x470 -> x470) of x469 -> x469) of x468 -> x468) of x467 -> x467) of x466 -> x466) of x465 -> x465) of x464 -> x464) of x463 -> x463) of x462 -> x462) of x461 -> x461) of x460 -> x460) of x459 -> x459) of x458 -> x458) of x457 -> x457) of x456 -> x456) of x455 -> x455) of x454 -> x454) of x453 -> x453) of x452 -> x452) of x451 -> x451) of x450 -> x450) of x449 -> x449) of x448 -> x448) of x447 -> x447) of x446 -> x446) of x445 -> x445) of x444 -> x444) of x443 -> x443) of x442 -> x442) of x441 -> x441) of x440 -> x440) of x439 -> x439) of x438 -> x438) of x437 -> x437) of x436 -> x436) of x435 -> x435) of x434 -> x434) of x433 -> x433) of x432 -> x432) of x431 -> x431) of x430 -> x430) of x429 -> x429) of x428 -> x428) of x427 -> x427) of x426 -> x426) of x425 -> x425) of x424 -> x424) of x423 -> x423) of x422 -> x422) of x421 -> x421) of x420 -> x420) of x419 -> x419) of x418 -> x418) of x417 -> x417) of x416 -> x416) of x415 -> x415) of x414 -> x414) of x413 -> x413) of x412 -> x412) of x411 -> x411) of x410 -> x410) of x409 -> x409) of x408 -> x408) of x407 -> x407) of x406 -> x406) of x405 -> x405) of x404 -> x404) of x403 -> x403) of x402 -> x402) of x401 -> x401) of x400 -> x400) of x399 -> x399) of x398 -> x398) of x397 -> x397) of x396 -> x396) of x395 -> x395) of x394 -> x394) of x393 -> x393) of x392 -> x392) of x391 -> x391) of x390 -> x390) of x389 -> x389) of x388 -> x388) of x387 -> x387) of x386 -> x386) of x385 -> x385) of x384 -> x384) of x383 -> x383) of x382 -> x382) of x381 -> x381) of x380 -> x380) of x379 -> x379) of x378 -> x378) of x377 -> x377) of x376 -> x376) of x375 -> x375) of x374 -> x374) of x373 -> x373) of x372 -> x372) of x371 -> x371) of x370 -> x370) of x369 -> x369) of x368 -> x368) of x367 -> x367) of x366 -> x366) of x365 -> x365) of x364 -> x364) of x363 -> x363) of x362 -> x362) of x361 -> x361) of x360 -> x360) of x359 -> x359) of x358 -> x358) of x357 -> x357) of x356 -> x356) of x355 -> x355) of x354 -> x354) of x353 -> x353) of x352 -> x352) of x351 -> x351) of x350 -> x350) of x349 -> x349) of x348 -> x348) of x347 -> x347) of x346 -> x346) of x345 -> x345) of x344 -> x344) of x343 -> x343) of x342 -> x342) of x341 -> x341) of x340 -> x340) of x339 -> x339) of x338 -> x338) of x337 -> x337) of x336 -> x336) of x335 -> x335) of x334 -> x334) of x333 -> x333) of x332 -> x332) of x331 -> x331) of x330 -> x330) of x329 -> x329) of x328 -> x328) of x327 -> x327) of x326 -> x326) of x325 -> x325) of x324 -> x324) of x323 -> x323) of x322 -> x322) of x321 -> x321) of x320 -> x320) of x319 -> x319) of x318 -> x318) of x317 -> x317) of x316 -> x316) of x315 -> x315) of x314 -> x314) of x313 -> x313) of x312 -> x312) of x311 -> x311) of x310 -> x310) of x309 -> x309) of x308 -> x308) of x307 -> x307) of x306 -> x306) of x305 -> x305) of x304 -> x304) of x303 -> x303) of x302 -> x302) of x301 -> x301) of x300 -> x300) of x299 -> x299) of x298 -> x298) of x297 -> x297) of x296 -> x296) of x295 -> x295) of x294 -> x294) of x293 -> x293) of x292 -> x292) of x291 -> x291) of x290 -> x290) of x289 -> x289) of x288 -> x288) of x287 -> x287) of x286 -> x286) of x285 -> x285) of x284 -> x284) of x283 -> x283) of x282 -> x282) of x281 -> x281) of x280 -> x280) of x279 -> x279) of x278 -> x278) of x277 -> x277) of x276 -> x276) of x275 -> x275) of x274 -> x274) of x273 -> x273) of x272 -> x272) of x271 -> x271) of x270 -> x270) of x269 -> x269) of x268 -> x268) of x267 -> x267) of x266 -> x266) of x265 -> x265) of x264 -> x264) of x263 -> x263) of x262 -> x262) of x261 -> x261) of x260 -> x260) of x259 -> x259) of x258 -> x258) of x257 -> x257) of x256 -> x256) of x255 -> x255) of x254 -> x254) of x253 -> x253) of x252 -> x252) of x251 -> x251) of x250 -> x250) of x249 -> x249) of x248 -> x248) of x247 -> x247) of x246 -> x246) of x245 -> x245) of x244 -> x244) of x243 -> x243) of x242 -> x242) of x241 -> x241) of x240 -> x240) of x239 -> x239) of x238 -> x238) of x237 -> x237) of x236 -> x236) of x235 -> x235) of x234 -> x234) of x233 -> x233) of x232 -> x232) of x231 -> x231) of x230 -> x230) of x229 -> x229) of x228 -> x228) of x227 -> x227) of x226 -> x226) of x225 -> x225) of x224 -> x224) of x223 -> x223) of x222 -> x222) of x221 -> x221) of x220 -> x220) of x219 -> x219) of x218 -> x218) of x217 -> x217) of x216 -> x216) of x215 -> x215) of x214 -> x214) of x213 -> x213) of x212 -> x212) of x211 -> x211) of x210 -> x210) of x209 -> x209) of x208 -> x208) of x207 -> x207) of x206 -> x206) of x205 -> x205) of x204 -> x204) of x203 -> x203) of x202 -> x202) of x201 -> x201) of x200 -> x200) of x199 -> x199) of x198 -> x198) of x197 -> x197) of x196 -> x196) of x195 -> x195) of x194 -> x194) of x193 -> x193) of x192 -> x192) of x191 -> x191) of x190 -> x190) of x189 -> x189) of x188 -> x188) of x187 -> x187) of x186 -> x186) of x185 -> x185) of x184 -> x184) of x183 -> x183) of x182 -> x182) of x181 -> x181) of x180 -> x180) of x179 -> x179) of x178 -> x178) of x177 -> x177) of x176 -> x176) of x175 -> x175) of x174 -> x174) of x173 -> x173) of x172 -> x172) of x171 -> x171) of x170 -> x170) of x169 -> x169) of x168 -> x168) of x167 -> x167) of x166 -> x166) of x165 -> x165) of x164 -> x164) of x163 -> x163) of x162 -> x162) of x161 -> x161) of x160 -> x160) of x159 -> x159) of x158 -> x158) of x157 -> x157) of x156 -> x156) of x155 -> x155) of x154 -> x154) of x153 -> x153) of x152 -> x152) of x151 -> x151) of x150 -> x150) of x149 -> x149) of x148 -> x148) of x147 -> x147) of x146 -> x146) of x145 -> x145) of x144 -> x144) of x143 -> x143) of x142 -> x142) of x141 -> x141) of x140 -> x140) of x139 -> x139) of x138 -> x138) of x137 -> x137) of x136 -> x136) of x135 -> x135) of x134 -> x134) of x133 -> x133) of x132 -> x132) of x131 -> x131) of x130 -> x130) of x129 -> x129) of x128 -> x128) of x127 -> x127) of x126 -> x126) of x125 -> x125) of x124 -> x124) of x123 -> x123) of x122 -> x122) of x121 -> x121) of x120 -> x120) of x119 -> x119) of x118 -> x118) of x117 -> x117) of x116 -> x116) of x115 -> x115) of x114 -> x114) of x113 -> x113) of x112 -> x112) of x111 -> x111) of x110 -> x110) of x109 -> x109) of x108 -> x108) of x107 -> x107) of x106 -> x106) of x105 -> x105) of x104 -> x104) of x103 -> x103) of x102 -> x102) of x101 -> x101) of x100 -> x100) of x99 -> x99) of x98 -> x98) of x97 -> x97) of x96 -> x96) of x95 -> x95) of x94 -> x94) of x93 -> x93) of x92 -> x92) of x91 -> x91) of x90 -> x90) of x89 -> x89) of x88 -> x88) of x87 -> x87) of x86 -> x86) of x85 -> x85) of x84 -> x84) of x83 -> x83) of x82 -> x82) of x81 -> x81) of x80 -> x80) of x79 -> x79) of x78 -> x78) of x77 -> x77) of x76 -> x76) of x75 -> x75) of x74 -> x74) of x73 -> x73) of x72 -> x72) of x71 -> x71) of x70 -> x70) of x69 -> x69) of x68 -> x68) of x67 -> x67) of x66 -> x66) of x65 -> x65) of x64 -> x64) of x63 -> x63) of x62 -> x62) of x61 -> x61) of x60 -> x60) of x59 -> x59) of x58 -> x58) of x57 -> x57) of x56 -> x56) of x55 -> x55) of x54 -> x54) of x53 -> x53) of x52 -> x52) of x51 -> x51) of x50 -> x50) of x49 -> x49) of x48 -> x48) of x47 -> x47) of x46 -> x46) of x45 -> x45) of x44 -> x44) of x43 -> x43) of x42 -> x42) of x41 -> x41) of x40 -> x40) of x39 -> x39) of x38 -> x38) of x37 -> x37) of x36 -> x36) of x35 -> x35) of x34 -> x34) of x33 -> x33) of x32 -> x32) of x31 -> x31) of x30 -> x30) of x29 -> x29) of x28 -> x28) of x27 -> x27) of x26 -> x26) of x25 -> x25) of x24 -> x24) of x23 -> x23) of x22 -> x22) of x21 -> x21) of x20 -> x20) of x19 -> x19) of x18 -> x18) of x17 -> x17) of x16 -> x16) of x15 -> x15) of x14 -> x14) of x13 -> x13) of x12 -> x12) of x11 -> x11) of x10 -> x10) of x9 -> x9) of x8 -> x8) of x7 -> x7) of x6 -> x6) of x5 -> x5) of x4 -> x4) of x3 -> x3) of x2 -> x2) of x1 -> x1)
=====================================
testsuite/tests/deSugar/should_compile/all.T
=====================================
@@ -116,3 +116,7 @@ test('T22719', normal, compile, ['-ddump-simpl -dsuppress-uniques -dno-typeable-
test('T23550', normal, compile, [''])
test('T24489', normal, compile, ['-O'])
test('T25996', normal, compile, [''])
+test('T27383',
+ [collect_compiler_stats('bytes allocated', 10)],
+ compile,
+ ['-Wincomplete-patterns'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e7c8acaba5f930f5dffc9660636744…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e7c8acaba5f930f5dffc9660636744…
You're receiving this email because of your account on gitlab.haskell.org.
1
0