diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index 5581852ef3343b36a91b734a75e0ae5681958bb7..9111c0634b61fe87082e5439791c2d6ee128bb5b 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -946,8 +946,7 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con mk_boxer boxers = DCB (\ ty_args src_vars -> do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars subst1 = zipTvSubst univ_tvs ty_args - subst2 = extendTCvSubstList subst1 ex_tvs - (mkTyCoVarTys ex_vars) + subst2 = foldl2 extendTvSubstWithClone subst1 ex_tvs ex_vars ; (rep_ids, binds) <- go subst2 boxers term_vars ; return (ex_vars ++ rep_ids, binds) } ) diff --git a/testsuite/tests/deSugar/should_compile/T24489.hs b/testsuite/tests/deSugar/should_compile/T24489.hs new file mode 100644 index 0000000000000000000000000000000000000000..af3af3a5e8afc9cce4b30122a2583a60f528859f --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T24489.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +module A where + +data Term where + BinaryTerm :: {-# UNPACK #-} !Bool -> tag -> Term + +f :: Term -> String +f (BinaryTerm _ _) = "hello" diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index c8591cd7bdf9ccd093663c7b90d5fc889a17e122..385a55216322bb84939c4cedb42339a3fb6d5eb7 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -114,3 +114,4 @@ test('T19969', [grep_errmsg('LoopBreaker')], compile, ['-ddump-simpl -dsuppress- test('T19883', normal, compile, ['']) test('T22719', normal, compile, ['-ddump-simpl -dsuppress-uniques -dno-typeable-binds']) test('T23550', normal, compile, ['']) +test('T24489', normal, compile, ['-O'])