From a36b34c4821653e3db3ff24b903265a7750a3397 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 29 Aug 2017 14:53:12 -0400 Subject: 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 --- compiler/simplStg/SimplStg.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'compiler/simplStg') 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 -- cgit v1.2.1