diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 84e3c110503ea74223da2aa53b1b80feb7b3b33d..9efc3484658396d17893a1706317bdfae6079f14 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -89,6 +89,24 @@ functions called precisely once, without repeatedly optimising the same expression. In fact, the simple optimiser is a good example of this little dance in action; the full Simplifier is a lot more complicated. +Note [The InScopeSet for simpleOptExpr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Care must be taken to remove unfoldings from `Var`s collected by exprFreeVars +before using them to construct an in-scope set hence `zapIdUnfolding` in `init_subst`. +Consider calling `simpleOptExpr` on an expression like + +``` + case x of (a,b) -> (x,a) +``` + +* One of those two occurrences of x has an unfolding (the one in (x,a), with +unfolding x = (a,b)) and the other does not. (Inside a case GHC adds +unfolding-info to the scrutinee's Id.) +* But exprFreeVars just builds a set, so it's a bit random which occurrence is collected. +* Then simpleOptExpr replaces each occurrence of x with the one in the in-scope set. +* Bad bad bad: then the x in case x of ... may be replaced with a version that has an unfolding. + +See ticket #25790 -} -- | Simple optimiser options @@ -135,14 +153,9 @@ simpleOptExpr opts expr = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr) simpleOptExprWith opts init_subst expr where - init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr)) - -- It's potentially important to make a proper in-scope set - -- Consider let x = ..y.. in \y. ...x... - -- Then we should remember to clone y before substituting - -- for x. It's very unlikely to occur, because we probably - -- won't *be* substituting for x if it occurs inside a - -- lambda. - -- + init_subst = mkEmptySubst (mkInScopeSet (mapVarSet zapIdUnfolding (exprFreeVars expr))) + -- zapIdUnfolding: see Note [The InScopeSet for simpleOptExpr] + -- It's a bit painful to call exprFreeVars, because it makes -- three passes instead of two (occ-anal, and go) diff --git a/testsuite/tests/ghci/should_run/T25790.hs b/testsuite/tests/ghci/should_run/T25790.hs new file mode 100644 index 0000000000000000000000000000000000000000..99bca114bbf14222cbde8b61674c076239cc020a --- /dev/null +++ b/testsuite/tests/ghci/should_run/T25790.hs @@ -0,0 +1,10 @@ +module T25790 + ( nest + ) where + +import Control.Monad.Reader + +data RunS = RunS { depth :: Int } + +nest :: ReaderT RunS IO a -> ReaderT RunS IO a +nest = local (\s -> s { depth = depth s }) diff --git a/testsuite/tests/ghci/should_run/T25790.script b/testsuite/tests/ghci/should_run/T25790.script new file mode 100644 index 0000000000000000000000000000000000000000..d04616e9e2375936d5312b75bdffae51db7aa1ae --- /dev/null +++ b/testsuite/tests/ghci/should_run/T25790.script @@ -0,0 +1 @@ +:l T25790.hs diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 80237bb8a33f12c9302b4acd2c9304fee405bfa2..14d2501ee53fa19d322fce147fc5b4a2fab077af 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -97,3 +97,4 @@ test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script, test('T10920', [only_ways(ghci_ways), extra_files(['LocalPrelude/Prelude.hs'])], ghci_script, ['T10920.script']) test('TopEnvIface', [only_ways(ghci_ways)], makefile_test, []) +test('T25790', [only_ways(ghci_ways), extra_ways(["ghci-opt"])], ghci_script, ['T25790.script'])