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

Fix #8958.

We now do role inference on stupid datatype contexts, allowing a
lightweight role annotation syntax.
parent e81d110e
......@@ -780,7 +780,8 @@ tcDataDefn rec_info tc_name tvs kind
= do { extra_tvs <- tcDataKindSig kind
; let final_tvs = tvs ++ extra_tvs
roles = rti_roles rec_info tc_name
; stupid_theta <- tcHsContext ctxt
; stupid_tc_theta <- tcHsContext ctxt
; stupid_theta <- zonkTcTypeToTypes emptyZonkEnv stupid_tc_theta
; kind_signatures <- xoptM Opt_KindSignatures
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
......
......@@ -709,6 +709,8 @@ irTyCon tc
; unless (all (== Nominal) old_roles) $ -- also catches data families,
-- which don't want or need role inference
do { whenIsJust (tyConClass_maybe tc) (irClass tc_name)
; addRoleInferenceInfo tc_name (tyConTyVars tc) $
mapM_ (irType emptyVarSet) (tyConStupidTheta tc) -- See #8958
; mapM_ (irDataCon tc_name) (visibleDataCons $ algTyConRhs tc) }}
| Just (SynonymTyCon ty) <- synTyConRhs_maybe tc
......@@ -778,7 +780,7 @@ lookupRoles tc
Just roles -> return roles
Nothing -> return $ tyConRoles tc }
-- tries to update a role; won't even update a role "downwards"
-- tries to update a role; won't ever update a role "downwards"
updateRole :: Role -> TyVar -> RoleM ()
updateRole role tv
= do { var_ns <- getVarNs
......
data Eq a => D a = C a -- Defined at ghci031.hs:7:1
type role D nominal
data Eq a => D a = C a
-- Defined at ghci031.hs:7:1
......@@ -32,9 +32,10 @@ RnFail055.hs-boot:12:1:
RnFail055.hs-boot:14:1:
Type constructor ‘T2’ has conflicting definitions in the module
and its hs-boot file
Main module: type role T2 representational phantom
Main module: type role T2 representational nominal
data Eq b => T2 a b = T2 a
Boot file: data Eq a => T2 a b = T2 a
Boot file: type role T2 nominal representational
data Eq a => T2 a b = T2 a
RnFail055.hs-boot:16:11:
T3 is exported by the hs-boot file, but not exported by the module
......
{-# LANGUAGE RoleAnnotations, DatatypeContexts, IncoherentInstances,
FlexibleInstances #-}
module T8958 where
class Nominal a
instance Nominal a
class Representational a
instance Representational a
type role Representational representational
newtype (Nominal k, Representational v) => Map k v = MkMap [(k,v)]
T8958.hs:1:31: Warning:
-XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
TYPE SIGNATURES
TYPE CONSTRUCTORS
Map :: * -> * -> *
newtype (Nominal k, Representational v) => Map k v
No C type associated
Roles: [nominal, representational]
RecFlag NonRecursive, Promotable
= MkMap :: [(k, v)] -> Map k v Stricts: _
FamilyInstance: none
Nominal :: * -> Constraint
class Nominal a
Roles: [nominal]
RecFlag NonRecursive
Representational :: * -> Constraint
class Representational a
Roles: [representational]
RecFlag NonRecursive
COERCION AXIOMS
axiom T8958.NTCo:Map :: Map k v = [(k, v)]
INSTANCES
instance [incoherent] Representational a
-- Defined at T8958.hs:10:10
instance [incoherent] Nominal a -- Defined at T8958.hs:7:10
Dependent modules: []
Dependent packages: [base, ghc-prim, integer-gmp]
==================== Typechecker ====================
AbsBinds [a] []
{Exports: [T8958.$fRepresentationala <= $dRepresentational_aJ6
<>]
Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE]
:: forall a. Representational a
[LclIdX[DFunId],
Str=DmdType,
Unf=DFun: \ (@ a) -> T8958.D:Representational TYPE a]
Binds: $dRepresentational_aJ6 = T8958.D:Representational}
AbsBinds [a] []
{Exports: [T8958.$fNominala <= $dNominal_aJ7
<>]
Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE]
:: forall a. Nominal a
[LclIdX[DFunId],
Str=DmdType,
Unf=DFun: \ (@ a) -> T8958.D:Nominal TYPE a]
Binds: $dNominal_aJ7 = T8958.D:Nominal}
......@@ -5,3 +5,4 @@ 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, [''])
test('T8958', only_ways('normal'), compile, ['-ddump-tc'])
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