Work in progress on #18359wip/T18389

Joint work between Richard, Simon, Ryan

14 files changed, 157 insertions, 110 deletions

diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 1378eda16e..24d6331be8 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -39,7 +39,7 @@ import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX
                     , reportUnsolvedEqualities )
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Env
-import GHC.Tc.Utils.Unify( unifyType, emitResidualTvConstraint )
+import GHC.Tc.Utils.Unify( emitResidualTvConstraint, unifyKind, unifyType )
 import GHC.Tc.Types.Constraint( emptyWC )
 import GHC.Tc.Validity
 import GHC.Tc.Utils.Zonk
@@ -1566,16 +1566,74 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo   = fd_info })) fam_tc
 
 -------------------
 
+unifyH98NewtypeKind ::
+     NewOrData
+  -> HsConDeclH98Details GhcRn
+  -> [Scaled TcType]
+  -> TcKind
+  -> TcM [Scaled TcType]
+unifyH98NewtypeKind new_or_data hs_args arg_tys res_kind =
+  do dflags <- getDynFlags
+     unifyNewtypeKind dflags new_or_data hs_vis_args arg_tys res_kind
+  where
+    hs_vis_args = case hs_args of
+      PrefixCon args      -> args
+      InfixCon arg1 arg2  -> [arg1, arg2]
+      RecCon (L _ fields) -> map (hsLinear . cd_fld_type . unLoc) fields
+
+unifyGADTNewtypeKind ::
+     NewOrData
+  -> HsConDeclGADTDetails GhcRn
+  -> [Scaled TcType]
+  -> TcKind
+  -> TcM [Scaled TcType]
+unifyGADTNewtypeKind new_or_data hs_args arg_tys res_kind =
+  do dflags <- getDynFlags
+     unifyNewtypeKind dflags new_or_data hs_vis_args arg_tys res_kind
+  where
+    hs_vis_args = case hs_args of
+      PrefixConGADT args      -> args
+      RecConGADT (L _ fields) -> map (hsLinear . cd_fld_type . unLoc) fields
+
+-- | Unify the kind of the first type provided with the newtype's kind, if
+-- -XUnliftedNewtypes is enabled and the NewOrData indicates Newtype. If there
+-- is more than one type provided, do nothing: the newtype is in error, and this
+-- will be caught in validity checking (which will give a better error than we can
+-- here.)
+unifyNewtypeKind ::
+     DynFlags
+  -> NewOrData
+  -> [HsScaled GhcRn (LBangType GhcRn)]
+                         -- user-written argument types, should be just 1
+  -> [Scaled TcType]     -- type-checked argument types, should be just 1
+  -> TcKind              -- expected kind of newtype
+  -> TcM [Scaled TcType] -- casted argument types (should be just 1)
+                         --  result = orig_arg |> kind_co
+                         -- where kind_co :: orig_arg_ki ~N expected_ki
+unifyNewtypeKind dflags NewType [hs_ty] [Scaled mult tc_ty] ki
+  | xopt LangExt.UnliftedNewtypes dflags
+  = do { traceTc "unifyNewtypeKind" (ppr hs_ty $$ ppr tc_ty $$ ppr ki)
+       ; co <- unifyKind (Just (ppr hs_ty)) (typeKind tc_ty) ki
+       ; return [Scaled mult $ tc_ty `mkCastTy` co] }
+  -- See comments above: just do nothing here
+unifyNewtypeKind _ _ _ arg_tys _ = return arg_tys
+
 -- Kind-check the types of the arguments to a data constructor.
+-- Type check the types of the arguments to a data constructor.
 -- This includes doing kind unification if the type is a newtype.
 -- See Note [Implementation of UnliftedNewtypes] for why we need
 -- the first two arguments.
 kcConArgTys :: NewOrData -> Kind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM ()
 kcConArgTys new_or_data res_kind arg_tys = do
-  { let exp_kind = getArgExpKind new_or_data res_kind
-  ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind
-                                             tcMult mult)
+  { arg_tc_tys <- forM arg_tys $ \(HsScaled mult ty) ->
+      do arg_tc_ty <- tcHsOpenType (getBangType ty)
+         tc_mult <- tcMult mult
+         pure $ Scaled tc_mult arg_tc_ty
+
     -- See Note [Implementation of UnliftedNewtypes], STEP 2
+  ; dflags <- getDynFlags
+  ; discardResult $
+      unifyNewtypeKind dflags new_or_data arg_tys arg_tc_tys res_kind
   }
 
 -- Kind-check the types of arguments to a Haskell98 data constructor.
@@ -2116,7 +2174,8 @@ STEP 2: Kind-checking, as done by kcTyClDecl. This step is skipped for CUSKs.
 The key function here is kcConDecl, which looks at an individual constructor
 declaration. When we are processing a newtype (but whether or not -XUnliftedNewtypes
 is enabled; see <Error Messages>, below), we generate a correct ContextKind
-for the checking argument types: see getArgExpKind.
+for the checking argument types: see getArgExpKind
+(TODO RGS: getArgExpKind no longer exists; update the sentence above).
 
 Examples of newtypes affected by STEP 2, assuming -XUnliftedNewtypes is
 enabled (we use r0 to denote a unification variable):
@@ -2141,6 +2200,7 @@ in kcTyClDecl.
 STEP 3: Type-checking (desugaring), as done by tcTyClDecl. The key function
 here is tcConDecl. Once again, we must use getArgExpKind to ensure that the
 representation type's kind matches that of the newtype, for two reasons:
+(TODO RGS: getArgExpKind no longer exists; update the sentence above).
 
   A. It is possible that a GADT has a CUSK. (Note that this is *not*
      possible for H98 types.) Recall that CUSK types don't go through
@@ -3246,11 +3306,12 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map
            <- pushLevelAndSolveEqualitiesX "tcConDecl:H98"  $
               tcExplicitTKBndrs explicit_tkv_nms            $
               do { ctxt <- tcHsMbContext hs_ctxt
-                 ; let exp_kind = getArgExpKind new_or_data res_kind
-                 ; btys <- tcConH98Args exp_kind hs_args
+                 ; btys <- tcConH98Args hs_args
                  ; field_lbls <- lookupConstructorFields name
                  ; let (arg_tys, stricts) = unzip btys
-                 ; return (ctxt, arg_tys, field_lbls, stricts)
+                 ; final_arg_tys <- unifyH98NewtypeKind new_or_data
+                                      hs_args arg_tys res_kind
+                 ; return (ctxt, final_arg_tys, field_lbls, stricts)
                  }
 
 
@@ -3331,6 +3392,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
            <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $
               tcOuterTKBndrs skol_info outer_hs_bndrs       $
               do { ctxt <- tcHsMbContext cxt
+                 ; btys <- tcConGADTArgs hs_args
                  ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty
                          -- See Note [GADT return kinds]
 
@@ -3347,13 +3409,11 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
                              addErrCtxt (dataConResCtxt names) $
                              unifyType Nothing res_ty head_shape }
 
-                   -- See Note [Datatype return kinds]
-                 ; let exp_kind = getArgExpKind new_or_data res_kind
-                 ; btys <- tcConGADTArgs exp_kind hs_args
-
                  ; let (arg_tys, stricts) = unzip btys
+                 ; final_arg_tys <- unifyGADTNewtypeKind new_or_data
+                                      hs_args arg_tys res_kind
                  ; field_lbls <- lookupConstructorFields name
-                 ; return (ctxt, arg_tys, res_ty, field_lbls, stricts)
+                 ; return (ctxt, final_arg_tys, res_ty, field_lbls, stricts)
                  }
 
        ; outer_tv_bndrs <- scopedSortOuter outer_bndrs
@@ -3482,16 +3542,6 @@ nothing wrong with it).  We are implicitly requiring tha
 tcInferLHsTypeKind doesn't any gratuitous top-level casts.
 -}
 
--- | Produce an "expected kind" for the arguments of a data/newtype.
--- If the declaration is indeed for a newtype,
--- then this expected kind will be the kind provided. Otherwise,
--- it is OpenKind for datatypes and liftedTypeKind.
--- Why do we not check for -XUnliftedNewtypes? See point <Error Messages>
--- in Note [Implementation of UnliftedNewtypes]
-getArgExpKind :: NewOrData -> Kind -> ContextKind
-getArgExpKind NewType res_ki = TheKind res_ki
-getArgExpKind DataType _     = OpenKind
-
 tcConIsInfixH98 :: Name
              -> HsConDeclH98Details GhcRn
              -> TcM Bool
@@ -3514,52 +3564,50 @@ tcConIsInfixGADT con details
                         ; return (con `elemNameEnv` fix_env) }
                | otherwise -> return False
 
-tcConH98Args :: ContextKind  -- expected kind of arguments
-                             -- always OpenKind for datatypes, but unlifted newtypes
-                             -- might have a specific kind
-             -> HsConDeclH98Details GhcRn
+tcConH98Args :: HsConDeclH98Details GhcRn
              -> TcM [(Scaled TcType, HsSrcBang)]
-tcConH98Args exp_kind (PrefixCon btys)
-  = mapM (tcConArg exp_kind) btys
-tcConH98Args exp_kind (InfixCon bty1 bty2)
-  = do { bty1' <- tcConArg exp_kind bty1
-       ; bty2' <- tcConArg exp_kind bty2
+tcConH98Args (PrefixCon btys)
+  = mapM tcConArg btys
+tcConH98Args (InfixCon bty1 bty2)
+  = do { bty1' <- tcConArg bty1
+       ; bty2' <- tcConArg bty2
        ; return [bty1', bty2'] }
-tcConH98Args exp_kind (RecCon fields)
-  = tcRecConDeclFields exp_kind fields
+tcConH98Args (RecCon fields)
+  = tcRecConDeclFields fields
 
-tcConGADTArgs :: ContextKind  -- expected kind of arguments
-                              -- always OpenKind for datatypes, but unlifted newtypes
-                              -- might have a specific kind
-              -> HsConDeclGADTDetails GhcRn
+tcConGADTArgs :: HsConDeclGADTDetails GhcRn
               -> TcM [(Scaled TcType, HsSrcBang)]
-tcConGADTArgs exp_kind (PrefixConGADT btys)
-  = mapM (tcConArg exp_kind) btys
-tcConGADTArgs exp_kind (RecConGADT fields)
-  = tcRecConDeclFields exp_kind fields
-
-tcConArg :: ContextKind  -- expected kind for args; always OpenKind for datatypes,
-                         -- but might be an unlifted type with UnliftedNewtypes
-         -> HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang)
-tcConArg exp_kind (HsScaled w bty)
+tcConGADTArgs (PrefixConGADT btys)
+  = mapM tcConArg btys
+tcConGADTArgs (RecConGADT fields)
+  = tcRecConDeclFields fields
+
+tcConArg :: HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang)
+tcConArg (HsScaled w bty)
   = do  { traceTc "tcConArg 1" (ppr bty)
-        ; arg_ty <- tcCheckLHsType (getBangType bty) exp_kind
+        ; arg_ty <- tcHsOpenType (getBangType bty)
         ; w' <- tcDataConMult w
         ; traceTc "tcConArg 2" (ppr bty)
         ; return (Scaled w' arg_ty, getBangStrictness bty) }
 
-tcRecConDeclFields :: ContextKind
-                   -> Located [LConDeclField GhcRn]
+tcRecConDeclFields :: Located [LConDeclField GhcRn]
                    -> TcM [(Scaled TcType, HsSrcBang)]
-tcRecConDeclFields exp_kind fields
-  = mapM (tcConArg exp_kind) btys
+tcRecConDeclFields (L _ fields)
+  = concatMapM tc_field fields
   where
-    -- We need a one-to-one mapping from field_names to btys
-    combined = map (\(L _ f) -> (cd_fld_names f,hsLinear (cd_fld_type f)))
-                   (unLoc fields)
-    explode (ns,ty) = zip ns (repeat ty)
-    exploded = concatMap explode combined
-    (_,btys) = unzip exploded
+    -- We need to ensure that each distinct field name gets its own type.
+    -- For example, if we have:
+    --
+    --   data T = MkT { a,b,c :: Int }
+    --
+    -- Then we should return /three/ Int types, not just one! At the same
+    -- time, we don't want to kind-check Int three separate times, as that
+    -- would be redundant. Therefore, we kind-check Int once and 'replicate'
+    -- it so that we return three occurrences of it.
+    tc_field :: LConDeclField GhcRn -> TcM [(Scaled TcType, HsSrcBang)]
+    tc_field (L _ f) = do
+      bty' <- tcConArg $ hsLinear $ cd_fld_type f
+      pure $ replicate (length (cd_fld_names f)) bty'
 
 tcDataConMult :: HsArrow GhcRn -> TcM Mult
 tcDataConMult arr@(HsUnrestrictedArrow _) = do
@@ -4332,7 +4380,7 @@ checkNewDataCon con
         ; let allowedArgType =
                 unlifted_newtypes || isLiftedType_maybe (scaledThing arg_ty1) == Just True
         ; checkTc allowedArgType $ vcat
-          [ text "A newtype cannot have an unlifted argument type"
+          [ text "A newtype must have an argument of kind" <+> ppr liftedTypeKind
           , text "Perhaps you intended to use UnliftedNewtypes"
           ]
         ; show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags
diff --git a/testsuite/tests/patsyn/should_fail/T15685.stderr b/testsuite/tests/patsyn/should_fail/T15685.stderr
index 723d0fcff3..643457540e 100644
--- a/testsuite/tests/patsyn/should_fail/T15685.stderr
+++ b/testsuite/tests/patsyn/should_fail/T15685.stderr
@@ -3,8 +3,8 @@ T15685.hs:13:24: error:
     • Could not deduce: k ~ [k0]
       from the context: as ~ (a : as1)
         bound by a pattern with constructor:
-                   Here :: forall {k} (f :: k -> *) (a :: k) (as :: [k]).
-                           f a -> NS f (a : as),
+                   Here :: forall {a1} (f :: a1 -> *) (a2 :: a1) (as :: [a1]).
+                           f a2 -> NS f (a2 : as),
                  in a pattern synonym declaration
         at T15685.hs:13:19-26
       ‘k’ is a rigid type variable bound by
diff --git a/testsuite/tests/polykinds/T15787.stderr b/testsuite/tests/polykinds/T15787.stderr
index b22e6c7b5b..14ab11c532 100644
--- a/testsuite/tests/polykinds/T15787.stderr
+++ b/testsuite/tests/polykinds/T15787.stderr
@@ -1,9 +1,9 @@
 
-T15787.hs:15:14: error:
-    • Expected a type, but ‘k’ has kind ‘ob1’
+T15787.hs:15:43: error:
+    • Expected kind ‘ob1’, but ‘k’ has kind ‘*’
       ‘ob1’ is a rigid type variable bound by
         the data constructor ‘Kl’
         at T15787.hs:15:3-43
-    • In the type ‘k’
+    • In the second argument of ‘Kl_kind’, namely ‘k’
+      In the type ‘Kl_kind (m :: ob -> ob) k’
       In the definition of data constructor ‘Kl’
-      In the data declaration for ‘Kl_kind’
diff --git a/testsuite/tests/typecheck/should_fail/T12729.stderr b/testsuite/tests/typecheck/should_fail/T12729.stderr
index 6bf544fe47..4c071a2bb4 100644
--- a/testsuite/tests/typecheck/should_fail/T12729.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12729.stderr
@@ -1,5 +1,12 @@
 
-T12729.hs:7:1: error:
-    • Newtype has non-* return kind ‘TYPE 'IntRep’
+T12729.hs:8:4: error:
+    • A newtype must have an argument of kind *
       Perhaps you intended to use UnliftedNewtypes
-    • In the newtype declaration for ‘A’
+    • In the definition of data constructor ‘MkA’
+      In the newtype declaration for ‘A’
+
+T12729.hs:10:13: error:
+    • A newtype must have an argument of kind *
+      Perhaps you intended to use UnliftedNewtypes
+    • In the definition of data constructor ‘MkB’
+      In the newtype declaration for ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/T15807.stderr b/testsuite/tests/typecheck/should_fail/T15807.stderr
index 8589ec1268..178f1995d4 100644
--- a/testsuite/tests/typecheck/should_fail/T15807.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15807.stderr
@@ -1,8 +1,10 @@
 
 T15807.hs:12:3: error:
-    • Cannot generalise type; skolem ‘f’ would escape its scope
+    • Cannot generalise type; skolem
+      ‘(f :: k0 -> *)’
+      would escape its scope
       if I tried to quantify (f0 :: f -> *) in this type:
-        forall f (a :: f). f a %1 -> App @f @f0 a
+        forall (f :: k0 -> *) (a :: k0). f a %1 -> App @f @f0 a
       (Indeed, I sometimes struggle even printing this correctly,
        due to its ill-scoped nature.)
     • In the definition of data constructor ‘MkApp’
diff --git a/testsuite/tests/typecheck/should_fail/T15883.stderr b/testsuite/tests/typecheck/should_fail/T15883.stderr
index d65ffa5ebc..3751c33016 100644
--- a/testsuite/tests/typecheck/should_fail/T15883.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15883.stderr
@@ -1,5 +1,6 @@
 
-T15883.hs:9:1: error:
-    • Newtype has non-* return kind ‘TYPE rep’
+T15883.hs:9:19: error:
+    • A newtype must have an argument of kind *
       Perhaps you intended to use UnliftedNewtypes
-    • In the newtype declaration for ‘Foo’
+    • In the definition of data constructor ‘MkFoo’
+      In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/T18357a.stderr b/testsuite/tests/typecheck/should_fail/T18357a.stderr
index a9e87fed98..45a4bb831e 100644
--- a/testsuite/tests/typecheck/should_fail/T18357a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T18357a.stderr
@@ -1,7 +1,6 @@
 
-T18357a.hs:9:10: error:
+T18357a.hs:9:3: error:
     • Couldn't match kind ‘r’ with ‘'LiftedRep’
       Expected a type, but ‘Int’ has kind ‘*’
-    • In the type ‘Int’
-      In the definition of data constructor ‘MkT’
+    • In the definition of data constructor ‘MkT’
       In the newtype declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
index 9725a779e7..11889b01f9 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
@@ -1,10 +1,9 @@
 
-UnliftedNewtypesInfinite.hs:9:20: error:
+UnliftedNewtypesInfinite.hs:9:15: error:
     • Couldn't match kind ‘t0’
                      with ‘'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0]’
       Expected kind ‘TYPE t0’,
         but ‘(# Int#, Foo #)’ has kind ‘TYPE
                                           ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0])’
-    • In the type ‘(# Int#, Foo #)’
-      In the definition of data constructor ‘FooC’
+    • In the definition of data constructor ‘FooC’
       In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr
index b54423576c..3a32bc7113 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr
@@ -1,6 +1,5 @@
 
-UnliftedNewtypesMismatchedKind.hs:12:10: error:
+UnliftedNewtypesMismatchedKind.hs:12:3: error:
     • Expecting a lifted type, but ‘Int#’ is unlifted
-    • In the type ‘Int#’
-      In the definition of data constructor ‘MkT’
+    • In the definition of data constructor ‘MkT’
       In the newtype declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
index f30d8b8fe8..80d67e7f38 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
@@ -1,7 +1,6 @@
 
-UnliftedNewtypesMismatchedKindRecord.hs:11:23: error:
+UnliftedNewtypesMismatchedKindRecord.hs:11:3: error:
     • Couldn't match kind ‘'WordRep’ with ‘'IntRep’
       Expected kind ‘TYPE 'IntRep’, but ‘Word#’ has kind ‘TYPE 'WordRep’
-    • In the type ‘Word#’
-      In the definition of data constructor ‘FooC’
+    • In the definition of data constructor ‘FooC’
       In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr
index 3ecec3fdf0..1dc038707a 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr
@@ -1,12 +1,6 @@
 
-UnliftedNewtypesMultiFieldGadt.hs:19:11: error:
-    • Expecting an unlifted type, but ‘Bool’ is lifted
-    • In the type ‘Bool’
-      In the definition of data constructor ‘FooC’
-      In the newtype declaration for ‘Foo’
-
-UnliftedNewtypesMultiFieldGadt.hs:19:19: error:
-    • Expecting an unlifted type, but ‘Char’ is lifted
-    • In the type ‘Char’
-      In the definition of data constructor ‘FooC’
+UnliftedNewtypesMultiFieldGadt.hs:19:3: error:
+    • The constructor of a newtype must have exactly one field
+        but ‘FooC’ has two
+    • In the definition of data constructor ‘FooC’
       In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr
index d45f3ca016..e0a3e3cd08 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr
@@ -1,5 +1,6 @@
 
-UnliftedNewtypesNotEnabled.hs:9:1: error:
-    • Newtype has non-* return kind ‘TYPE 'GHC.Types.IntRep’
+UnliftedNewtypesNotEnabled.hs:9:15: error:
+    • A newtype must have an argument of kind *
       Perhaps you intended to use UnliftedNewtypes
-    • In the newtype declaration for ‘Baz’
+    • In the definition of data constructor ‘Baz’
+      In the newtype declaration for ‘Baz’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr
index 972f873e62..2f5d83b381 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr
@@ -1,18 +1,15 @@
 
-UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error:
+UnliftedNewtypesUnassociatedFamilyFail.hs:21:23: error:
     • Expecting a lifted type, but ‘Int#’ is unlifted
-    • In the type ‘Int#’
-      In the definition of data constructor ‘MkDF1a’
+    • In the definition of data constructor ‘MkDF1a’
       In the newtype instance declaration for ‘DF’
 
-UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error:
+UnliftedNewtypesUnassociatedFamilyFail.hs:22:23: error:
     • Expecting a lifted type, but ‘Word#’ is unlifted
-    • In the type ‘Word#’
-      In the definition of data constructor ‘MkDF2a’
+    • In the definition of data constructor ‘MkDF2a’
       In the newtype instance declaration for ‘DF’
 
-UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error:
+UnliftedNewtypesUnassociatedFamilyFail.hs:23:23: error:
     • Expecting a lifted type, but ‘(# Int#, Word# #)’ is unlifted
-    • In the type ‘(# Int#, Word# #)’
-      In the definition of data constructor ‘MkDF3a’
+    • In the definition of data constructor ‘MkDF3a’
       In the newtype instance declaration for ‘DF’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail079.stderr b/testsuite/tests/typecheck/should_fail/tcfail079.stderr
index dce069a456..c9510483e9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail079.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail079.stderr
@@ -1,5 +1,6 @@
 
-tcfail079.hs:9:1: error:
-    • Newtype has non-* return kind ‘TYPE 'GHC.Types.IntRep’
+tcfail079.hs:9:19: error:
+    • A newtype must have an argument of kind *
       Perhaps you intended to use UnliftedNewtypes
-    • In the newtype declaration for ‘Unboxed’
+    • In the definition of data constructor ‘Unboxed’
+      In the newtype declaration for ‘Unboxed’