diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-08-17 08:27:35 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-08-18 05:18:01 -0400 |
| commit | d071627932f61a20223ff0875ed96452f9e81b34 (patch) | |
| tree | 991a466f9e132bc9c12ffd224bf3f4cee28b2e3f | |
| parent | 1230d6f92440818241f3ae776fc51742c7395bb4 (diff) | |
| download | haskell-d071627932f61a20223ff0875ed96452f9e81b34.tar.gz | |
Fix #17067 by making data family type constructors actually injective
`TcTyClsDecls.tcFamDecl1` was using `NotInjective` when creating data
family type constructors, which is just plain wrong. This tweaks it
to use `Injective` instead.
Fixes #17067.
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T17067.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 |
3 files changed, 15 insertions, 2 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index b9e51fa1f5..91536e5d23 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1938,11 +1938,12 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info ; let (_, final_res_kind) = splitPiTys res_kind ; checkDataKindSig DataFamilySort final_res_kind ; tc_rep_name <- newTyConRepName tc_name - ; let tycon = mkFamilyTyCon tc_name binders + ; let inj = Injective $ replicate (length binders) True + tycon = mkFamilyTyCon tc_name binders res_kind (resultVariableName sig) (DataFamilyTyCon tc_rep_name) - parent NotInjective + parent inj ; return tycon } | OpenTypeFamily <- fam_info diff --git a/testsuite/tests/typecheck/should_compile/T17067.hs b/testsuite/tests/typecheck/should_compile/T17067.hs new file mode 100644 index 0000000000..2666c4cf2b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17067.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} +module T17067 where + +import Data.Kind + +data family D1 a +data family D2 :: Type -> Type + +type family F a +type instance F (D1 a) = a +type instance F (D2 a) = a diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e393fe41c7..9a91f4ea9c 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -686,3 +686,4 @@ test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) test('T16832', normal, ghci_script, ['T16832.script']) test('T16946', normal, compile, ['']) test('T17007', normal, compile, ['']) +test('T17067', normal, compile, ['']) |