diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-10-05 18:13:35 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-09 08:48:15 -0400 |
| commit | 32dc7698a0c38afe2889119a2df0f2a2b8debe0a (patch) | |
| tree | b23a8074e58453716df0591ea985ceabd55e5324 | |
| parent | 36787bba78ae5acbb857c84b85b8feb7c83e54a5 (diff) | |
| download | haskell-32dc7698a0c38afe2889119a2df0f2a2b8debe0a.tar.gz | |
Linear types: fix roles in GADTs (#18799)
| -rw-r--r-- | compiler/GHC/Tc/TyCl/Utils.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/linear/should_fail/LinearRole.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/linear/should_fail/LinearRole.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/linear/should_fail/all.T | 1 |
4 files changed, 21 insertions, 2 deletions
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index 0528976a6b..2e8b5124fc 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -580,8 +580,8 @@ irDataCon :: DataCon -> RoleM () irDataCon datacon = setRoleInferenceVars univ_tvs $ irExTyVars ex_tvs $ \ ex_var_set -> - mapM_ (irType ex_var_set) - (map tyVarKind ex_tvs ++ eqSpecPreds eq_spec ++ theta ++ (map scaledThing arg_tys)) + do mapM_ (irType ex_var_set) (eqSpecPreds eq_spec ++ theta ++ map scaledThing arg_tys) + mapM_ (markNominal ex_var_set) (map tyVarKind ex_tvs ++ map scaledMult arg_tys) -- Field multiplicities are nominal (#18799) -- See Note [Role-checking data constructor arguments] where (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) diff --git a/testsuite/tests/linear/should_fail/LinearRole.hs b/testsuite/tests/linear/should_fail/LinearRole.hs new file mode 100644 index 0000000000..403935f4ce --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearRole.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE LinearTypes, GADTs, DataKinds #-} + +module LinearRole where -- #18799 + +import GHC.Types (Multiplicity(..)) +import Data.Coerce + +data T m a where + MkT :: a %m -> T m a + +f :: T 'One a -> T 'Many a +f x = coerce x diff --git a/testsuite/tests/linear/should_fail/LinearRole.stderr b/testsuite/tests/linear/should_fail/LinearRole.stderr new file mode 100644 index 0000000000..6d499c4d70 --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearRole.stderr @@ -0,0 +1,6 @@ + +LinearRole.hs:12:7: error: + • Couldn't match type ‘'One’ with ‘'Many’ + arising from a use of ‘coerce’ + • In the expression: coerce x + In an equation for ‘f’: f x = coerce x diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T index 5fa6fdb18f..95cb337711 100644 --- a/testsuite/tests/linear/should_fail/all.T +++ b/testsuite/tests/linear/should_fail/all.T @@ -17,6 +17,7 @@ test('LinearSeq', normal, compile_fail, ['']) test('LinearViewPattern', normal, compile_fail, ['']) test('LinearConfusedDollar', normal, compile_fail, ['']) test('LinearPatSyn', normal, compile_fail, ['']) +test('LinearRole', normal, compile_fail, ['']) test('LinearGADTNewtype', normal, compile_fail, ['']) test('LinearPartialSig', normal, compile_fail, ['']) test('LinearKind', normal, compile_fail, ['']) |