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.

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, [''])