diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2021-08-03 19:13:56 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-15 16:13:35 -0400 |
commit | 149bce42fc324863c5da8c98b4991358b5ec4617 (patch) | |
tree | 43c0bb7879e91cfc4f01b8361ca4decde71a03b8 | |
parent | 0f6fb7d309cbe69dcd534c14155d68c981895ab2 (diff) | |
download | haskell-149bce42fc324863c5da8c98b4991358b5ec4617.tar.gz |
Fix lookupIdSubst call during RULE matching
As #20200 showed, there was a call to lookupIdSubst during RULE
matching, where the variable being looked up wasn't in the InScopeSet.
This patch fixes the problem at source, by dealing separately with
nested and non-nested binders.
As a result we can change the trace call in lookupIdSubst to a
proper panic -- if it happens, we really want to know.
-rw-r--r-- | compiler/GHC/Core/Rules.hs | 25 | ||||
-rw-r--r-- | compiler/GHC/Core/Subst.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T20200.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
4 files changed, 27 insertions, 12 deletions
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index 878b905929..9c7f083e46 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -782,6 +782,8 @@ match renv subst e1 (Let bind e2) (subst { rs_binds = rs_binds subst . Let bind' , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs }) e1 e2 + | otherwise + = Nothing where flt_subst = addInScopeSet (rv_fltR renv) (rs_bndrs subst) (flt_subst', bind') = substBind flt_subst bind @@ -930,12 +932,19 @@ match_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env }) | otherwise -- v1' is not a template variable; check for an exact match with e2 = case e2 of -- Remember, envR of rn_env is disjoint from rv_fltR - Var v2 | v1' == rnOccR rn_env v2 - -> Just subst - + Var v2 | Just v2' <- rnOccR_maybe rn_env v2 + -> -- v2 was bound by a nested lambda or case + if v1' == v2' then Just subst + else Nothing + + -- v2 is not bound nestedly; it is free + -- in the whole expression being matched + -- So it will be in the InScopeSet for flt_env (#20200) | Var v2' <- lookupIdSubst flt_env v2 , v1' == v2' -> Just subst + | otherwise + -> Nothing _ -> Nothing @@ -1085,14 +1094,14 @@ There are a couple of tricky points. Our cunning plan is this: * Along with the growing substitution for template variables we maintain a growing set of floated let-bindings (rs_binds) - plus the set of variables thus bound. + plus the set of variables thus bound (rs_bndrs). * The RnEnv2 in the MatchEnv binds only the local binders - in the term (lambdas, case) + in the term (lambdas, case), not the floated let-bndrs. - * When we encounter a let in the term to be matched, we - check that does not mention any locally bound (lambda, case) - variables. If so we fail + * When we encounter a let in the term to be matched, we use + okToFloat check that does not mention any locally bound (lambda, + case) variables. If so we fail. * We use GHC.Core.Subst.substBind to freshen the binding, using an in-scope set that is the original in-scope variables plus the diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index be05e1c44c..2d4eac114c 100644 --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -61,7 +61,6 @@ import GHC.Types.Unique.Supply import GHC.Builtin.Names import GHC.Data.Maybe -import GHC.Utils.Trace import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic @@ -256,9 +255,9 @@ lookupIdSubst (Subst in_scope ids _ _) v | Just e <- lookupVarEnv ids v = e | Just v' <- lookupInScope in_scope v = Var v' -- Vital! See Note [Extending the Subst] - | otherwise = warnPprTrace True (text "GHC.Core.Subst.lookupIdSubst" <+> ppr v - $$ ppr in_scope) $ - Var v + -- If v isn't in the InScopeSet, we panic, because + -- it's a bad bug and we reallly want to know + | otherwise = pprPanic "lookupIdSubst" (ppr v $$ ppr in_scope) -- | Find the substitution for a 'TyVar' in the 'Subst' lookupTCvSubst :: Subst -> TyVar -> Type diff --git a/testsuite/tests/simplCore/should_compile/T20200.hs b/testsuite/tests/simplCore/should_compile/T20200.hs new file mode 100644 index 0000000000..0695b86ff4 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T20200.hs @@ -0,0 +1,6 @@ +module T20200 where + +import qualified Data.Map as Map + +cleanTempDirs :: ([String] -> a) -> Map.Map String String -> a +cleanTempDirs logger ds = logger (Map.elems ds) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index c8fc59f78d..28e5cb4fc9 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -372,3 +372,4 @@ test('T20143', [ grep_errmsg(r'unsafeEqualityProof') ], compile, ['-O -ddump-si test('T20174', normal, compile, ['']) test('T16373', normal, compile, ['']) test('T20112', normal, multimod_compile, ['T20112', '-O -v0 -g1']) +test('T20200', normal, compile, ['']) |