diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2022-08-25 15:43:56 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-08-29 04:18:57 -0400 |
commit | cbe51ac5e0bbe2667b6c7204ae62a534a9bc7c95 (patch) | |
tree | 3d21c9302ca6a0c0603dea875498045bdd66bebc | |
parent | 68e6786f3d1bde5d044a649462cdf2b6034a2df8 (diff) | |
download | haskell-cbe51ac5e0bbe2667b6c7204ae62a534a9bc7c95.tar.gz |
Fix a bug in anyInRnEnvR
This bug was a subtle error in anyInRnEnvR, introduced by
commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06
Author: Andreas Klebinger <klebinger.andreas@gmx.at>
Date: Sat Jul 9 01:19:52 2022 +0200
Rule matching: Don't compute the FVs if we don't look at them.
The net result was #22028, where a rewrite rule would wrongly
match on a lambda.
The fix to that function is easy.
-rw-r--r-- | compiler/GHC/Types/Var/Env.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22028.hs | 19 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22028.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
4 files changed, 26 insertions, 4 deletions
diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs index 88337b9e9d..88f27af415 100644 --- a/compiler/GHC/Types/Var/Env.hs +++ b/compiler/GHC/Types/Var/Env.hs @@ -9,7 +9,7 @@ module GHC.Types.Var.Env ( -- ** Manipulating these environments emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly, - elemVarEnv, disjointVarEnv, + elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, @@ -62,7 +62,8 @@ module GHC.Types.Var.Env ( -- ** Operations on RnEnv2s mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var, - rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, + rnOccL, rnOccR, inRnEnvL, inRnEnvR, anyInRnEnvR, + rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR, extendRnInScopeSetList, @@ -72,7 +73,7 @@ module GHC.Types.Var.Env ( -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, anyInRnEnvR + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList ) where import GHC.Prelude @@ -409,7 +410,7 @@ anyInRnEnvR :: RnEnv2 -> VarSet -> Bool anyInRnEnvR (RV2 { envR = env }) vs -- Avoid allocating the predicate if we deal with an empty env. | isEmptyVarEnv env = False - | otherwise = anyVarEnv (`elemVarSet` vs) env + | otherwise = anyVarSet (`elemVarEnv` env) vs lookupRnInScope :: RnEnv2 -> Var -> Var lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v diff --git a/testsuite/tests/simplCore/should_compile/T22028.hs b/testsuite/tests/simplCore/should_compile/T22028.hs new file mode 100644 index 0000000000..c79b685226 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22028.hs @@ -0,0 +1,19 @@ + +-- This one triggers the bug reported in #22028, which +-- was in a test for #1092 +-- The problem is that the rule +-- forall w. f (\v->w) = w +-- erroneously matches the call +-- f id +-- And that caused an assertion error. + +module Foo where + +f :: (Int -> Int) -> Int +{-# NOINLINE f #-} +f g = g 4 +{-# RULES "f" forall w. f (\v->w) = w #-} + +h1 = f (\v -> v) -- Rule should not fire +h2 = f id -- Rule should not fire +h3 = f (\v -> 3) -- Rule should fire diff --git a/testsuite/tests/simplCore/should_compile/T22028.stderr b/testsuite/tests/simplCore/should_compile/T22028.stderr new file mode 100644 index 0000000000..a9ef070c51 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22028.stderr @@ -0,0 +1 @@ +Rule fired: f (Foo) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index b66692e8eb..c1a32a7248 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -427,3 +427,4 @@ test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T22028', normal, compile, ['-O -ddump-rule-firings']) |