Add a missing update of sc_hole_ty (#16312)

In simplCast I totally failed to keep the sc_hole_ty field of
ApplyToTy (see Note [The hole type in ApplyToTy]) up to date.
When a cast goes by, of course the hole type changes.

Amazingly this has not bitten us before, but #16312 finally
triggered it.  Fortunately the fix is simple.

Fixes #16312.

3 files changed, 20 insertions, 1 deletions

diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 6e13ddf59b..753cce3104 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -1304,9 +1304,13 @@ simplCast env body co0 cont0
 
         addCoerce co cont@(ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })
           | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty
+          , Pair hole_ty _ <- coercionKind co
           = {-#SCC "addCoerce-pushCoTyArg" #-}
             do { tail' <- addCoerceM m_co' tail
-               ; return (cont { sc_arg_ty = arg_ty', sc_cont = tail' }) }
+               ; return (cont { sc_arg_ty  = arg_ty'
+                              , sc_hole_ty = hole_ty  -- NB!  As the cast goes past, the
+                                                      -- type of the hole changes (#16312)
+                              , sc_cont    = tail' }) }
 
         addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
                                       , sc_dup = dup, sc_cont = tail })
diff --git a/testsuite/tests/typecheck/should_compile/T16312.hs b/testsuite/tests/typecheck/should_compile/T16312.hs
new file mode 100644
index 0000000000..1823d98558
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T16312.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+module T16312 where
+
+newtype Curried g h a =
+  Curried { runCurried :: forall r. g (a -> r) -> h r }
+
+instance Functor g => Functor (Curried g h) where
+  fmap f (Curried g) = Curried (g . fmap (.f))
+
+instance (Functor g, g ~ h) => Applicative (Curried g h) where
+  pure a = Curried (fmap ($a))
+  Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))
+  {-# INLINE (<*>) #-}
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 9a91f4ea9c..bb01a02dd3 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -671,6 +671,7 @@ test('T16204a', normal, compile, [''])
 test('T16204b', normal, compile, [''])
 test('T16225', normal, compile, [''])
 test('T13951', normal, compile, [''])
+test('T16312', normal, compile, ['-O'])
 test('T16411', normal, compile, [''])
 test('T16609', normal, compile, [''])
 test('T16827', normal, compile, [''])