Commit 7d9feb26 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix a serious, but rare, strictness analyser bug (Trac #9128)

In a special case for trivial RHSs (see DmdAnal.unpackTrivial),
I'd forgotten to include a demand for the RHS itself.
See Note [Remember to demand the function itself].

Thanks to David Terei for guiding me to the bug,
at PLDI in Edinburgh.
parent c8295c0b
......@@ -596,7 +596,16 @@ dmdAnalRhs :: TopLevelFlag
dmdAnalRhs top_lvl rec_flag env id rhs
| Just fn <- unpackTrivial rhs -- See Note [Demand analysis for trivial right-hand sides]
, let fn_str = getStrictness env fn
= (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs)
fn_fv | isLocalId fn = unitVarEnv fn topDmd
| otherwise = emptyDmdEnv
-- Note [Remember to demand the function itself]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- fn_fv: don't forget to produce a demand for fn itself
-- Lacking this caused Trac #9128
-- The demand is very conservative (topDmd), but that doesn't
-- matter; trivial bindings are usually inlined, so it only
-- kicks in for top-level bindings and NOINLINE bindings
= (fn_str, fn_fv, set_idStrictness env id fn_str, rhs)
| otherwise
= (sig_ty, lazy_fv, id', mkLams bndrs' body')
module Main where
newtype T a = MkT a
-- Trac #9128: we treated x as absent!!!!
f x = let {-# NOINLINE h #-}
h = case x of MkT g -> g
h (h (h (h (h (h True)))))
main = print (f (MkT id))
......@@ -65,3 +65,5 @@ test('T7924', exit_code(1), compile_and_run, [''])
# Run this test *without* optimisation too
test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, [''])
test('T9128', normal, compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment