From dc9ae0d7127174c11fac2d433ccdf5e1710f6e63 Mon Sep 17 00:00:00 2001 From: Joachim Breitner Date: Fri, 15 Oct 2021 13:57:36 +0200 Subject: Draft: An experiment towards #20514 --- compiler/GHC/Tc/TyCl/Utils.hs | 8 ++---- .../tests/dependent/should_compile/T14729.stderr | 2 +- .../tests/dependent/should_compile/T15743.stderr | 2 +- .../tests/dependent/should_compile/T15743e.stderr | 32 +++++++++++----------- testsuite/tests/polykinds/T15592.stderr | 2 +- testsuite/tests/roles/should_compile/Roles1.stderr | 6 ++-- .../tests/simplCore/should_compile/T8331.stderr | 6 ++-- testsuite/tests/th/TH_Roles2.stderr | 2 +- 8 files changed, 29 insertions(+), 31 deletions(-) diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index b7d47d57d8..5714e138cd 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -431,7 +431,7 @@ roles(T) = r_1 .. r_n ---------------------------------------------------- RCDApp Z |- T t_1 .. t_n : R -Z, a:N |- t : r +Z, a:P |- t : r ---------------------- RCAll Z |- forall a:k.t : r @@ -514,7 +514,7 @@ initialRoleEnv1 hsc_src annots_env tc | isVisibleArgFlag argf = (m_annot `orElse` default_role) : build_default_roles argfs ras build_default_roles (_argf : argfs) ras - = Nominal : build_default_roles argfs ras + = default_role : build_default_roles argfs ras build_default_roles [] [] = [] build_default_roles _ _ = pprPanic "initialRoleEnv1 (2)" (vcat [ppr tc, ppr role_annots]) @@ -615,7 +615,6 @@ irType = go ; zipWithM_ (go_app lcls) roles tys } go lcls (ForAllTy tvb ty) = do { let tv = binderVar tvb lcls' = extendVarSet lcls tv - ; markNominal lcls (tyVarKind tv) ; go lcls' ty } go lcls (FunTy _ w arg res) = markNominal lcls w >> go lcls arg >> go lcls res go _ (LitTy {}) = return () @@ -632,8 +631,7 @@ irTcTyVars tc thing = setRoleInferenceTc (tyConName tc) $ go (tyConTyVars tc) where go [] = thing - go (tv:tvs) = do { markNominal emptyVarSet (tyVarKind tv) - ; addRoleInferenceVar tv $ go tvs } + go (tv:tvs) = do { addRoleInferenceVar tv $ go tvs } irExTyVars :: [TyVar] -> (TyVarSet -> RoleM a) -> RoleM a irExTyVars orig_tvs thing = go emptyVarSet orig_tvs diff --git a/testsuite/tests/dependent/should_compile/T14729.stderr b/testsuite/tests/dependent/should_compile/T14729.stderr index ac0108be7c..f7b7685b03 100644 --- a/testsuite/tests/dependent/should_compile/T14729.stderr +++ b/testsuite/tests/dependent/should_compile/T14729.stderr @@ -5,7 +5,7 @@ TYPE CONSTRUCTORS type family F{1} :: * -> * roles nominal data type P{2} :: forall k -> k -> * - roles nominal phantom + roles phantom phantom COERCION AXIOMS axiom T14729.D:R:FInt :: F Int = Bool FAMILY INSTANCES diff --git a/testsuite/tests/dependent/should_compile/T15743.stderr b/testsuite/tests/dependent/should_compile/T15743.stderr index c9c95159a3..dd5ef9bf92 100644 --- a/testsuite/tests/dependent/should_compile/T15743.stderr +++ b/testsuite/tests/dependent/should_compile/T15743.stderr @@ -1,6 +1,6 @@ TYPE CONSTRUCTORS data type T{6} :: forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> * - roles nominal nominal nominal phantom phantom phantom + roles phantom phantom phantom phantom phantom phantom Dependent modules: [] Dependent packages: [base-4.16.0.0] diff --git a/testsuite/tests/dependent/should_compile/T15743e.stderr b/testsuite/tests/dependent/should_compile/T15743e.stderr index 0fad2d93fc..6df010cf9f 100644 --- a/testsuite/tests/dependent/should_compile/T15743e.stderr +++ b/testsuite/tests/dependent/should_compile/T15743e.stderr @@ -7,19 +7,19 @@ TYPE CONSTRUCTORS -> (k3 -> *) -> k3 -> forall (k7 :: k1). Proxy k7 -> forall (k8 :: k5). Proxy k8 -> * - roles nominal - nominal - nominal - nominal - nominal - nominal + roles phantom + phantom + phantom + phantom + phantom + phantom phantom phantom representational nominal - nominal phantom - nominal + phantom + phantom phantom data type T2{14} :: forall {k1} {k2} (k3 :: k2) k7. @@ -30,19 +30,19 @@ TYPE CONSTRUCTORS -> k7 -> forall (k5 :: k1). Proxy k5 -> forall k6 (k8 :: k6). Proxy k8 -> * - roles nominal - nominal - nominal - nominal - nominal + roles phantom + phantom + phantom + phantom + phantom phantom phantom representational nominal - nominal phantom - nominal - nominal + phantom + phantom + phantom phantom DATA CONSTRUCTORS MkT2 :: forall {k7} {k1} {k2 :: k1} {k3} {k4 :: k3} {k5} {k6 :: k5} diff --git a/testsuite/tests/polykinds/T15592.stderr b/testsuite/tests/polykinds/T15592.stderr index f04d4f56f3..95786e9590 100644 --- a/testsuite/tests/polykinds/T15592.stderr +++ b/testsuite/tests/polykinds/T15592.stderr @@ -1,6 +1,6 @@ TYPE CONSTRUCTORS data type T{5} :: forall {k} k1. (k1 -> k -> *) -> k1 -> k -> * - roles nominal nominal representational nominal nominal + roles phantom phantom representational nominal nominal DATA CONSTRUCTORS MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k). f a b -> T f a b -> T f a b diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index 3941c2d01f..34fa30be25 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -3,14 +3,14 @@ TYPE CONSTRUCTORS roles nominal data type T2{1} :: * -> * data type T3{2} :: forall k. k -> * - roles nominal phantom + roles phantom phantom data type T4{2} :: (* -> *) -> * -> * roles nominal nominal data type T5{1} :: * -> * data type T6{2} :: forall {k}. k -> * - roles nominal phantom + roles phantom phantom data type T7{3} :: forall {k}. k -> * -> * - roles nominal phantom representational + roles phantom phantom representational DATA CONSTRUCTORS K7 :: forall {k} (a :: k) b. b -> T7 a b K6 :: forall {k} (a :: k). T6 a diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr index 7219016651..6667da8c1e 100644 --- a/testsuite/tests/simplCore/should_compile/T8331.stderr +++ b/testsuite/tests/simplCore/should_compile/T8331.stderr @@ -8,7 +8,7 @@ _R %<'Many>_N ->_R _R %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) + ; Sym (N:ReaderT[0] <*>_P _R _R _N) :: Coercible (forall {a} {b}. ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) @@ -27,7 +27,7 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R _R %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) + ; Sym (N:ReaderT[0] <*>_P _R _R _N) :: Coercible (forall {a} {b} {c}. (a -> b -> c) @@ -62,7 +62,7 @@ = (useAbstractMonad1 @s) `cast` (_R %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) + ; Sym (N:ReaderT[0] <*>_P _R _R _N) :: Coercible (Int -> Int -> STRep s Int) (Int -> ReaderT Int (ST s) Int)) diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 46857abf86..66826d7424 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -1,6 +1,6 @@ TYPE CONSTRUCTORS data type T{2} :: forall k. k -> * - roles nominal representational + roles phantom representational Dependent modules: [] Dependent packages: [base-4.16.0.0, template-haskell-2.18.0.0] -- cgit v1.2.1