From b4cae4ecc8ab207c8180242b8fc062464fc70157 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simon.peytonjones@gmail.com>
Date: Wed, 28 Feb 2024 17:34:18 +0000
Subject: [PATCH] In mkDataConRep, ensure the in-scope set is right
A small change that fixes #24489
---
compiler/GHC/Types/Id/Make.hs | 3 +--
testsuite/tests/deSugar/should_compile/T24489.hs | 8 ++++++++
testsuite/tests/deSugar/should_compile/all.T | 1 +
3 files changed, 10 insertions(+), 2 deletions(-)
create mode 100644 testsuite/tests/deSugar/should_compile/T24489.hs
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 5581852ef334..9111c0634b61 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 000000000000..af3af3a5e8af
--- /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 c8591cd7bdf9..385a55216322 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'])
--
GitLab