diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-08-29 14:53:12 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-08-29 19:08:07 -0400 |
| commit | a36b34c4821653e3db3ff24b903265a7750a3397 (patch) | |
| tree | 7521d179d2730cbd17ea9bf577517af6c1238924 /compiler/simplStg | |
| parent | 651b4dc790d931789eb41dd0e8f281de4061824b (diff) | |
| download | haskell-a36b34c4821653e3db3ff24b903265a7750a3397.tar.gz | |
StgLint: Enforce MultiValAlt liveness invariant only after unariser
The unariser ensures that we never use case binders that are void,
unboxed sums, or unboxed tuples. However, previously StgLint was
enforcing this invariant even before the unariser was running, giving
rise to spurious lint failures. Fix this. Following CoreLint, we
introduce a LintFlags environment to the linter monad, allowing for
additional flags to be easily accomodated in the future.
See #14118.
Test Plan: Build GHC with -dstg-lint
Reviewers: simonpj, austin
Subscribers: rwbarton, thomie
GHC Trac Issues: #14118
Differential Revision: https://phabricator.haskell.org/D3889
Diffstat (limited to 'compiler/simplStg')
| -rw-r--r-- | compiler/simplStg/SimplStg.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index 4943f525af..6c8b005d80 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -51,7 +51,8 @@ stg2stg dflags module_name binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "Pre unarise:" (pprStgTopBindings processed_binds) - ; let un_binds = unarise us1 processed_binds + ; let un_binds = stg_linter True "Unarise" + $ unarise us1 processed_binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgTopBindings un_binds) @@ -60,9 +61,9 @@ stg2stg dflags module_name binds } where - stg_linter = if gopt Opt_DoStgLinting dflags - then lintStgTopBindings - else ( \ _whodunnit binds -> binds ) + stg_linter unarised + | gopt Opt_DoStgLinting dflags = lintStgTopBindings unarised + | otherwise = \ _whodunnit binds -> binds ------------------------------------------- do_stg_pass (binds, us, ccs) to_do @@ -91,7 +92,7 @@ stg2stg dflags module_name binds = do -- report verbosely, if required dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what (vcat (map ppr binds2)) - let linted_binds = stg_linter what binds2 + let linted_binds = stg_linter False what binds2 return (linted_binds, us2, ccs) -- return: processed binds -- UniqueSupply for the next guy to use |