Get the in-scope set right in simplArg

This was a simple (but long standing) error in simplArg,
revealed by #20639

2 files changed, 28 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T20639.hs b/testsuite/tests/simplCore/should_compile/T20639.hs
new file mode 100644
index 0000000000..4ccb998c9d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T20639.hs
@@ -0,0 +1,27 @@
+module CtxRed(ctxRedCQType', CtxRed(..)) where
+
+import Control.Monad.State
+import Control.Monad.Except
+
+type TI = StateT Bool (ExceptT [Integer] (State Bool))
+
+data CDefn = Cclass (Maybe Bool) [CPred]
+data CQType = CQType [CPred]
+data CTypeclass = CTypeclass
+data CPred = CPred CTypeclass
+
+class CtxRed a where
+    ctxRed :: a -> TI a
+
+instance CtxRed CDefn where
+    ctxRed d@(Cclass incoh cpreds) = do
+       (CQType _) <- ctxRedCQType' (CQType [])
+       return (Cclass incoh cpreds)
+
+ctxRedCQType' :: CQType -> TI (CQType)
+ctxRedCQType' cqt = do
+    let CQType cqs = cqt
+    case [p | p@(CPred CTypeclass) <- cqs] of
+      p : _ -> return ()
+      [] -> return ()
+    return (cqt)
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 3b75f2b7a5..d500b5364a 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -376,3 +376,4 @@ test('T20200', normal, compile, [''])
 test('T20200a', normal, compile, ['-O2'])
 test('T20200b', normal, compile, ['-O2'])
 test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_compile, ['T20200KG', '-v0 -O2 -fspecialise-aggressively'])
+test('T20639', normal, compile, ['-O2'])