Commit ef36b102 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ben Gamari
Browse files

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.
parent 9bc10993
......@@ -1269,9 +1269,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 })
......
{-# 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 (<*>) #-}
......@@ -670,6 +670,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('T505', normal, compile, [''])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment