Draft: An experiment towards #20514wip/joachim/phantom-kind-params

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 @@
                 <ReaderT r (ST s) a>_R
                 %<'Many>_N ->_R <ReaderT r (ST s) b>_R
                 %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <b>_R)
-                                ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <b>_N)
+                                ; Sym (N:ReaderT[0] <*>_P <r>_R <ST s>_R <b>_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 <ReaderT r (ST s) a>_R
                 %<'Many>_N ->_R <ReaderT r (ST s) b>_R
                 %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <c>_R)
-                                ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <c>_N)
+                                ; Sym (N:ReaderT[0] <*>_P <r>_R <ST s>_R <c>_N)
                 :: Coercible
                      (forall {a} {b} {c}.
                       (a -> b -> c)
@@ -62,7 +62,7 @@
       = (useAbstractMonad1 @s)
         `cast` (<Int>_R
                 %<'Many>_N ->_R <Int>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <Int>_R)
-                                ; Sym (N:ReaderT[0] <*>_N <Int>_R <ST s>_R <Int>_N)
+                                ; Sym (N:ReaderT[0] <*>_P <Int>_R <ST s>_R <Int>_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]