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.

(cherry picked from commit 149bce42fc324863c5da8c98b4991358b5ec4617)

4 files changed, 27 insertions, 13 deletions

diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 41cab2d201..56f2f0dad8 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -777,6 +777,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
@@ -926,12 +928,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
 
@@ -1081,14 +1090,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 5f1235501b..3cb283c4ba 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -39,8 +39,6 @@ module GHC.Core.Subst (
 
 import GHC.Prelude
 
-import GHC.Driver.Ppr
-
 import GHC.Core
 import GHC.Core.FVs
 import GHC.Core.Seq
@@ -256,9 +254,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 = WARN( 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 cdffaea2ea..ce559309d7 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -357,3 +357,4 @@ test('T19586', normal, compile, [''])
 test('T20639', normal, compile, ['-O2'])
 
 test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output'])
+test('T20200', normal, compile, [''])