Commit 13829758 authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu

Fix #8773.

To make a role annotation on a class asserting a role other than
nominal, you now need -XIncoherentInstances. See the ticket for
more information as to why this is a good idea.
parent 473f12a3
......@@ -1694,6 +1694,15 @@ checkValidRoleAnnots role_annots thing
; checkTc (type_vars `equalLength` the_role_annots)
(wrongNumberOfRoles type_vars decl)
; _ <- zipWith3M checkRoleAnnot type_vars the_role_annots type_roles
-- Representational or phantom roles for class parameters
-- quickly lead to incoherence. So, we require
-- IncoherentInstances to have them. See #8773.
; incoherent_roles_ok <- xoptM Opt_IncoherentInstances
; checkTc ( incoherent_roles_ok
|| (not $ isClassTyCon tc)
|| (all (== Nominal) type_roles))
incoherentRoles
; lint <- goptM Opt_DoCoreLinting
; when lint $ checkValidRoles tc }
......@@ -2180,6 +2189,11 @@ needXRoleAnnotations tc
= ptext (sLit "Illegal role annotation for") <+> ppr tc <> char ';' $$
ptext (sLit "did you intend to use RoleAnnotations?")
incoherentRoles :: SDoc
incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+>
text "for class parameters can lead to incoherence.") $$
(text "Use IncoherentInstances to allow this; bad role found")
addTyThingCtxt :: TyThing -> TcM a -> TcM a
addTyThingCtxt thing
= addErrCtxt ctxt
......
{-# LANGUAGE RoleAnnotations, IncoherentInstances #-}
module Roles12 where
type role C2 representational
class C2 a where
meth2 :: a -> a
TYPE SIGNATURES
TYPE CONSTRUCTORS
C2 :: * -> Constraint
class C2 a
Roles: [representational]
RecFlag NonRecursive
meth2 :: a -> a
COERCION AXIOMS
axiom Roles12.NTCo:C2 :: C2 a = a -> a
Dependent modules: []
Dependent packages: [base, ghc-prim, integer-gmp]
==================== Typechecker ====================
......@@ -6,10 +6,6 @@ type role C1 nominal
class C1 a where
meth1 :: a -> a
type role C2 representational
class C2 a where
meth2 :: a -> a
type Syn1 a = [a]
class C3 a where
......
......@@ -5,11 +5,6 @@ TYPE CONSTRUCTORS
Roles: [nominal]
RecFlag NonRecursive
meth1 :: a -> a
C2 :: * -> Constraint
class C2 a
Roles: [representational]
RecFlag NonRecursive
meth2 :: a -> a
C3 :: * -> Constraint
class C3 a
Roles: [nominal]
......@@ -19,7 +14,6 @@ TYPE CONSTRUCTORS
type Syn1 a = [a]
COERCION AXIOMS
axiom Roles4.NTCo:C1 :: C1 a = a -> a
axiom Roles4.NTCo:C2 :: C2 a = a -> a
axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a
Dependent modules: []
Dependent packages: [base, ghc-prim, integer-gmp]
......
......@@ -3,4 +3,5 @@ test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
test('Roles14', only_ways('normal'), compile, ['-ddump-tc'])
test('RolesIArray', only_ways('normal'), compile, [''])
\ No newline at end of file
{-# LANGUAGE RoleAnnotations #-}
module T8773 where
type role C2 representational
class C2 a where
meth2 :: a -> a
T8773.hs:5:1:
Roles other than ‛nominal’ for class parameters can lead to incoherence.
Use IncoherentInstances to allow this; bad role found
while checking a role annotation for ‛C2’
......@@ -7,3 +7,4 @@ test('Roles11', normal, compile_fail, [''])
test('Roles12',
extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']),
run_command, ['$MAKE --no-print-directory -s Roles12'])
test('T8773', normal, compile_fail, [''])
\ No newline at end of file
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