Keep track of promotion ticks in HsOpTywip/no-c-stubswip/matt-merge-batch

This patch adds a PromotionFlag field to HsOpTy, which is used
in pretty-printing and when determining whether to emit warnings
with -fwarn-unticked-promoted-constructors.

This allows us to correctly report tick-related warnings for things
like:

  type A = Int : '[]
  type B = [Int, Bool]

Updates haddock submodule

Fixes #19984

32 files changed, 295 insertions, 132 deletions

diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 43579082a9..b319abec08 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -23,13 +23,15 @@ module GHC.Core.Ppr (
         pprCoreBinding, pprCoreBindings, pprCoreAlt,
         pprCoreBindingWithSize, pprCoreBindingsWithSize,
         pprCoreBinder, pprCoreBinders,
-        pprRule, pprRules, pprOptCo
+        pprRule, pprRules, pprOptCo,
+        pprOcc, pprOccWithTick
     ) where
 
 import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Stats (exprStats)
+import GHC.Types.Fixity (LexicalFixity(..))
 import GHC.Types.Literal( pprLiteral )
 import GHC.Types.Name( pprInfixName, pprPrefixName )
 import GHC.Types.Var
@@ -382,6 +384,17 @@ instance Outputable b => OutputableBndr (TaggedBndr b) where
   pprPrefixOcc b = ppr b
   bndrIsJoin_maybe (TB b _) = isJoinId_maybe b
 
+pprOcc :: OutputableBndr a => LexicalFixity -> a -> SDoc
+pprOcc Infix  = pprInfixOcc
+pprOcc Prefix = pprPrefixOcc
+
+pprOccWithTick :: OutputableBndr a => LexicalFixity -> PromotionFlag -> a -> SDoc
+pprOccWithTick fixity prom op
+  | isPromoted prom
+  = quote (pprOcc fixity op)
+  | otherwise
+  = pprOcc fixity op
+
 pprCoreBinder :: BindingSite -> Var -> SDoc
 pprCoreBinder LetBind binder
   | isTyVar binder = pprKindedTyVarBndr binder
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 40dc281a74..208d7777f7 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -97,6 +97,7 @@ import Language.Haskell.Syntax.Extension
 import GHC.Hs.Extension
 import GHC.Parser.Annotation
 
+import GHC.Types.Fixity ( LexicalFixity(..) )
 import GHC.Types.Id ( Id )
 import GHC.Types.SourceText
 import GHC.Types.Name( Name, NamedThing(getName) )
@@ -104,6 +105,7 @@ import GHC.Types.Name.Reader ( RdrName )
 import GHC.Types.Var ( VarBndr )
 import GHC.Core.TyCo.Rep ( Type(..) )
 import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr )
+import GHC.Core.Ppr ( pprOccWithTick)
 import GHC.Core.Type
 import GHC.Hs.Doc
 import GHC.Types.Basic
@@ -291,7 +293,7 @@ type instance XFunTy           (GhcPass _) = EpAnnCO
 type instance XListTy          (GhcPass _) = EpAnn AnnParen
 type instance XTupleTy         (GhcPass _) = EpAnn AnnParen
 type instance XSumTy           (GhcPass _) = EpAnn AnnParen
-type instance XOpTy            (GhcPass _) = NoExtField
+type instance XOpTy            (GhcPass _) = EpAnn [AddEpAnn]
 type instance XParTy           (GhcPass _) = EpAnn AnnParen
 type instance XIParamTy        (GhcPass _) = EpAnn [AddEpAnn]
 type instance XStarTy          (GhcPass _) = NoExtField
@@ -448,9 +450,10 @@ mkAnonWildCardTy :: HsType GhcPs
 mkAnonWildCardTy = HsWildCardTy noExtField
 
 mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
-         => LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
+         => PromotionFlag
+         -> LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
          -> LHsType (GhcPass p) -> HsType (GhcPass p)
-mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2
+mkHsOpTy prom ty1 op ty2 = HsOpTy noAnn prom ty1 op ty2
 
 mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 mkHsAppTy t1 t2
@@ -513,7 +516,7 @@ hsTyGetAppHead_maybe = go
     go (L _ (HsTyVar _ _ ln))          = Just ln
     go (L _ (HsAppTy _ l _))           = go l
     go (L _ (HsAppKindTy _ t _))       = go t
-    go (L _ (HsOpTy _ _ ln _))         = Just ln
+    go (L _ (HsOpTy _ _ _ ln _))       = Just ln
     go (L _ (HsParTy _ t))             = go t
     go (L _ (HsKindSig _ t _))         = go t
     go _                               = Nothing
@@ -1040,12 +1043,10 @@ ppr_mono_ty (HsForAllTy { hst_tele = tele, hst_body = ty })
 ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty })
   = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty]
 
-ppr_mono_ty (HsBangTy _ b ty)   = ppr b <> ppr_mono_lty ty
-ppr_mono_ty (HsRecTy _ flds)      = pprConDeclFields flds
-ppr_mono_ty (HsTyVar _ prom (L _ name))
-  | isPromoted prom = quote (pprPrefixOcc name)
-  | otherwise       = pprPrefixOcc name
-ppr_mono_ty (HsFunTy _ mult ty1 ty2)   = ppr_fun_ty mult ty1 ty2
+ppr_mono_ty (HsBangTy _ b ty)           = ppr b <> ppr_mono_lty ty
+ppr_mono_ty (HsRecTy _ flds)            = pprConDeclFields flds
+ppr_mono_ty (HsTyVar _ prom (L _ name)) = pprOccWithTick Prefix prom name
+ppr_mono_ty (HsFunTy _ mult ty1 ty2)    = ppr_fun_ty mult ty1 ty2
 ppr_mono_ty (HsTupleTy _ con tys)
     -- Special-case unary boxed tuples so that they are pretty-printed as
     -- `Solo x`, not `(x)`
@@ -1083,10 +1084,9 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
   = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
 ppr_mono_ty (HsAppKindTy _ ty k)
   = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
-ppr_mono_ty (HsOpTy _ ty1 (L _ op) ty2)
+ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2)
   = sep [ ppr_mono_lty ty1
-        , sep [pprInfixOcc op, ppr_mono_lty ty2 ] ]
-
+        , sep [pprOccWithTick Infix prom op, ppr_mono_lty ty2 ] ]
 ppr_mono_ty (HsParTy _ ty)
   = parens (ppr_mono_lty ty)
   -- Put the parens in where the user did
@@ -1187,7 +1187,7 @@ lhsTypeHasLeadingPromotionQuote ty
     go (HsListTy{})          = False
     go (HsTupleTy{})         = False
     go (HsSumTy{})           = False
-    go (HsOpTy _ t1 _ _)     = goL t1
+    go (HsOpTy _ _ t1 _ _)   = goL t1
     go (HsKindSig _ t _)     = goL t
     go (HsIParamTy{})        = False
     go (HsSpliceTy{})        = False
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 51306d627c..ef5ad6e494 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -603,24 +603,25 @@ nlList exprs          = noLocA (ExplicitList noAnn exprs)
 
 nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsTyVar :: IsSrcSpanAnn p a
-          => IdP (GhcPass p)                            -> LHsType (GhcPass p)
+          => PromotionFlag -> IdP (GhcPass p)           -> LHsType (GhcPass p)
 nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLocA (HsAppTy noExtField f (parenthesizeHsType appPrec t))
-nlHsTyVar x   = noLocA (HsTyVar noAnn NotPromoted (noLocA x))
+nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA x))
 nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) (parenthesizeHsType funPrec a) b)
 nlHsParTy t   = noLocA (HsParTy noAnn t)
 
 nlHsTyConApp :: IsSrcSpanAnn p a
-             => LexicalFixity -> IdP (GhcPass p)
+             => PromotionFlag
+             -> LexicalFixity -> IdP (GhcPass p)
              -> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p)
-nlHsTyConApp fixity tycon tys
+nlHsTyConApp prom fixity tycon tys
   | Infix <- fixity
   , HsValArg ty1 : HsValArg ty2 : rest <- tys
-  = foldl' mk_app (noLocA $ HsOpTy noExtField ty1 (noLocA tycon) ty2) rest
+  = foldl' mk_app (noLocA $ HsOpTy noAnn prom ty1 (noLocA tycon) ty2) rest
   | otherwise
-  = foldl' mk_app (nlHsTyVar tycon) tys
+  = foldl' mk_app (nlHsTyVar prom tycon) tys
   where
     mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
     mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 22fc242e87..dfa634b399 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1394,7 +1394,7 @@ repTy (HsTupleTy _ _ tys)   = do tys1 <- repLTys tys
 repTy (HsSumTy _ tys)       = do tys1 <- repLTys tys
                                  tcon <- repUnboxedSumTyCon (length tys)
                                  repTapps tcon tys1
-repTy (HsOpTy _ ty1 n ty2)  = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
+repTy (HsOpTy _ prom ty1 n ty2) = repLTy ((nlHsTyVar prom (unLoc n) `nlHsAppTy` ty1)
                                    `nlHsAppTy` ty2)
 repTy (HsParTy _ t)         = repLTy t
 repTy (HsStarTy _ _) =  repTStar
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index db93777a7d..19f198e2c3 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1768,7 +1768,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
       HsSumTy _ tys ->
         [ toHie tys
         ]
-      HsOpTy _ a op b ->
+      HsOpTy _ _prom a op b ->
         [ toHie a
         , toHie $ C Use op
         , toHie b
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index af6bb3d51a..55052f0df6 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2168,14 +2168,15 @@ infixtype :: { forall b. DisambTD b => PV (LocatedA b) }
         : ftype %shift                  { $1 }
         | ftype tyop infixtype          { $1 >>= \ $1 ->
                                           $3 >>= \ $3 ->
-                                          do { when (looksLikeMult $1 $2 $3) $ hintLinear (getLocA $2)
-                                             ; mkHsOpTyPV $1 $2 $3 } }
+                                          do { let (op, prom) = $2
+                                             ; when (looksLikeMult $1 op $3) $ hintLinear (getLocA op)
+                                             ; mkHsOpTyPV prom $1 op $3 } }
         | unpackedness infixtype        { $2 >>= \ $2 ->
                                           mkUnpackednessPV $1 $2 }
 
 ftype :: { forall b. DisambTD b => PV (LocatedA b) }
         : atype                         { mkHsAppTyHeadPV $1 }
-        | tyop                          { failOpFewArgs $1 }
+        | tyop                          { failOpFewArgs (fst $1) }
         | ftype tyarg                   { $1 >>= \ $1 ->
                                           mkHsAppTyPV $1 $2 }
         | ftype PREFIX_AT atype         { $1 >>= \ $1 ->
@@ -2185,13 +2186,15 @@ tyarg :: { LHsType GhcPs }
         : atype                         { $1 }
         | unpackedness atype            {% addUnpackednessP $1 $2 }
 
-tyop :: { LocatedN RdrName }
-        : qtyconop                      { $1 }
-        | tyvarop                       { $1 }
-        | SIMPLEQUOTE qconop            {% amsrn (sLL $1 (reLoc $>) (unLoc $2))
-                                                 (NameAnnQuote (glAA $1) (gl $2) []) }
-        | SIMPLEQUOTE varop             {% amsrn (sLL $1 (reLoc $>) (unLoc $2))
-                                                 (NameAnnQuote (glAA $1) (gl $2) []) }
+tyop :: { (LocatedN RdrName, PromotionFlag) }
+        : qtyconop                      { ($1, NotPromoted) }
+        | tyvarop                       { ($1, NotPromoted) }
+        | SIMPLEQUOTE qconop            {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2))
+                                                            (NameAnnQuote (glAA $1) (gl $2) [])
+                                              ; return (op, IsPromoted) } }
+        | SIMPLEQUOTE varop             {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2))
+                                                            (NameAnnQuote (glAA $1) (gl $2) [])
+                                              ; return (op, IsPromoted) } }
 
 atype :: { LHsType GhcPs }
         : ntgtycon                       {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) }      -- Not including unit tuples
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 0457618e86..568f5df5e6 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -984,7 +984,7 @@ checkTyClHdr is_cls ty
 
     go _ (HsTyVar _ _ ltc@(L _ tc)) acc ops cps fix
       | isRdrTc tc               = return (ltc, acc, fix, (reverse ops) ++ cps)
-    go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ops cps _fix
+    go _ (HsOpTy _ _ t1 ltc@(L _ tc) t2) acc ops cps _fix
       | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, (reverse ops) ++ cps)
     go l (HsParTy _ ty)    acc ops cps fix = goL ty acc (o:ops) (c:cps) fix
       where
@@ -1928,7 +1928,7 @@ class DisambTD b where
   -- | Disambiguate @f \@t@ (visible kind application)
   mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate @f \# x@ (infix operator)
-  mkHsOpTyPV :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
+  mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma)
   mkUnpackednessPV :: Located UnpackednessPragma -> LocatedA b -> PV (LocatedA b)
 
@@ -1936,7 +1936,7 @@ instance DisambTD (HsType GhcPs) where
   mkHsAppTyHeadPV = return
   mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2)
   mkHsAppKindTyPV t l_at ki = return (mkHsAppKindTy l_at t ki)
-  mkHsOpTyPV t1 op t2 = return (mkLHsOpTy t1 op t2)
+  mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2)
   mkUnpackednessPV = addUnpackednessP
 
 dataConBuilderCon :: DataConBuilder -> LocatedN RdrName
@@ -1975,7 +1975,7 @@ instance DisambTD DataConBuilder where
     addFatalError $ mkPlainErrorMsgEnvelope l_at $
                       (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
 
-  mkHsOpTyPV lhs tc rhs = do
+  mkHsOpTyPV _ lhs tc rhs = do
       check_no_ops (unLoc rhs)  -- check the RHS because parsing type operators is right-associative
       data_con <- eitherToP $ tyConToDataCon tc
       return $ L l (InfixDataConBuilder lhs data_con rhs)
@@ -3048,10 +3048,10 @@ mkSumOrTuplePat l Boxed a@Sum{} _ =
     addFatalError $
       mkPlainErrorMsgEnvelope (locA l) $ PsErrUnsupportedBoxedSumPat a
 
-mkLHsOpTy :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> LHsType GhcPs
-mkLHsOpTy x op y =
+mkLHsOpTy :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> LHsType GhcPs
+mkLHsOpTy prom x op y =
   let loc = getLoc x `combineSrcSpansA` (noAnnSrcSpan $ getLocA op) `combineSrcSpansA` getLoc y
-  in L loc (mkHsOpTy x op y)
+  in L loc (mkHsOpTy prom x op y)
 
 mkMultTy :: LHsToken "%" GhcPs -> LHsType GhcPs -> LHsUniToken "->" "→" GhcPs -> HsArrow GhcPs
 mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) arr
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 2440976b31..e5c1c17f3c 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1078,9 +1078,7 @@ lookup_demoted rdr_name
             then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr
                     ; case mb_demoted_name of
                         Nothing -> unboundNameX looking_for rdr_name star_is_type_hints
-                        Just demoted_name ->
-                          do { addDiagnostic $ TcRnUntickedPromotedConstructor demoted_name
-                             ; return demoted_name } }
+                        Just demoted_name -> return demoted_name }
             else do { -- We need to check if a data constructor of this name is
                       -- in scope to give good error messages. However, we do
                       -- not want to give an additional error if the data
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index ae22cfa0cb..bbcd5244af 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -61,6 +61,7 @@ import GHC.Tc.Errors.Ppr ( pprScopeError
 import GHC.Tc.Utils.Monad
 import GHC.Types.Name.Reader
 import GHC.Builtin.Names
+import GHC.Types.Hint ( UntickedPromotedThing(..) )
 import GHC.Types.Name
 import GHC.Types.SrcLoc
 import GHC.Types.Name.Set
@@ -70,7 +71,7 @@ import GHC.Types.Error
 import GHC.Utils.Misc
 import GHC.Types.Fixity ( compareFixity, negateFixity
                         , Fixity(..), FixityDirection(..), LexicalFixity(..) )
-import GHC.Types.Basic  ( TypeOrKind(..) )
+import GHC.Types.Basic  ( PromotionFlag(..), isPromoted, TypeOrKind(..) )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
@@ -626,15 +627,21 @@ rnHsTyKi env (HsTyVar _ ip (L loc rdr_name))
            -- Any type variable at the kind level is illegal without the use
            -- of PolyKinds (see #14710)
        ; name <- rnTyVar env rdr_name
+       ; when (isDataConName name && not (isPromoted ip)) $
+         -- NB: a prefix symbolic operator such as (:) is represented as HsTyVar.
+            addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Prefix name)
        ; return (HsTyVar noAnn ip (L loc name), unitFV name) }
 
-rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)
+rnHsTyKi env ty@(HsOpTy _ prom ty1 l_op ty2)
   = setSrcSpan (getLocA l_op) $
     do  { (l_op', fvs1) <- rnHsTyOp env (ppr ty) l_op
+        ; let op_name = unLoc l_op'
         ; fix   <- lookupTyFixityRn l_op'
         ; (ty1', fvs2) <- rnLHsTyKi env ty1
         ; (ty2', fvs3) <- rnLHsTyKi env ty2
-        ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2'
+        ; res_ty <- mkHsOpTyRn prom l_op' fix ty1' ty2'
+        ; when (isDataConName op_name && not (isPromoted prom)) $
+            addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name)
         ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
 
 rnHsTyKi env (HsParTy _ ty)
@@ -758,6 +765,8 @@ rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
   = do { data_kinds <- xoptM LangExt.DataKinds
        ; unless data_kinds (addErr (dataKindsErr env ty))
        ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
+       ; unless (isPromoted ip) $
+           addDiagnostic (TcRnUntickedPromotedThing $ UntickedExplicitList)
        ; return (HsExplicitListTy noExtField ip tys', fvs) }
 
 rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
@@ -1314,33 +1323,34 @@ precedence and does not require rearrangement.
 -}
 
 ---------------
--- Building (ty1 `op1` (ty21 `op2` ty22))
-mkHsOpTyRn :: LocatedN Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
+-- Building (ty1 `op1` (ty2a `op2` ty2b))
+mkHsOpTyRn :: PromotionFlag
+           -> LocatedN Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
            -> RnM (HsType GhcRn)
 
-mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22))
+mkHsOpTyRn prom1 op1 fix1 ty1 (L loc2 (HsOpTy _ prom2 ty2a op2 ty2b))
   = do  { fix2 <- lookupTyFixityRn op2
-        ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 }
+        ; mk_hs_op_ty prom1 op1 fix1 ty1 prom2 op2 fix2 ty2a ty2b loc2 }
 
-mkHsOpTyRn op1 _ ty1 ty2              -- Default case, no rearrangment
-  = return (HsOpTy noExtField ty1 op1 ty2)
+mkHsOpTyRn prom1 op1 _ ty1 ty2              -- Default case, no rearrangment
+  = return (HsOpTy noAnn prom1 ty1 op1 ty2)
 
 ---------------
-mk_hs_op_ty :: LocatedN Name -> Fixity -> LHsType GhcRn
-            -> LocatedN Name -> Fixity -> LHsType GhcRn
+mk_hs_op_ty :: PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn
+            -> PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn
             -> LHsType GhcRn -> SrcSpanAnnA
             -> RnM (HsType GhcRn)
-mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2
+mk_hs_op_ty prom1 op1 fix1 ty1 prom2 op2 fix2 ty2a ty2b loc2
   | nofix_error     = do { precParseErr (NormalOp (unLoc op1),fix1)
                                         (NormalOp (unLoc op2),fix2)
-                         ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) }
-  | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22)))
-  | otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
-                           new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21
-                         ; return (noLocA new_ty `op2ty` ty22) }
+                         ; return (ty1 `op1ty` (L loc2 (ty2a `op2ty` ty2b))) }
+  | associate_right = return (ty1 `op1ty` (L loc2 (ty2a `op2ty` ty2b)))
+  | otherwise       = do { -- Rearrange to ((ty1 `op1` ty2a) `op2` ty2b)
+                           new_ty <- mkHsOpTyRn prom1 op1 fix1 ty1 ty2a
+                         ; return (noLocA new_ty `op2ty` ty2b) }
   where
-    lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs
-    lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs
+    lhs `op1ty` rhs = HsOpTy noAnn prom1 lhs op1 rhs
+    lhs `op2ty` rhs = HsOpTy noAnn prom2 lhs op2 rhs
     (nofix_error, associate_right) = compareFixity fix1 fix2
 
 
@@ -1352,17 +1362,17 @@ mkOpAppRn :: NegationHandling
                                        -- be a NegApp)
           -> RnM (HsExpr GhcRn)
 
--- (e11 `op1` e12) `op2` e2
-mkOpAppRn negation_handling e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2
+-- (e1a `op1` e1b) `op2` e2
+mkOpAppRn negation_handling e1@(L _ (OpApp fix1 e1a op1 e1b)) op2 fix2 e2
   | nofix_error
   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
        return (OpApp fix2 e1 op2 e2)
 
   | associate_right = do
-    new_e <- mkOpAppRn negation_handling e12 op2 fix2 e2
-    return (OpApp fix1 e11 op1 (L loc' new_e))
+    new_e <- mkOpAppRn negation_handling e1b op2 fix2 e2
+    return (OpApp fix1 e1a op1 (L loc' new_e))
   where
-    loc'= combineLocsA e12 e2
+    loc'= combineLocsA e1b e2
     (nofix_error, associate_right) = compareFixity fix1 fix2
 
 ---------------------------
@@ -1447,20 +1457,20 @@ mkOpFormRn :: LHsCmdTop GhcRn            -- Left operand; already rearranged
           -> LHsCmdTop GhcRn             -- Right operand (not an infix)
           -> RnM (HsCmd GhcRn)
 
--- (e11 `op1` e12) `op2` e2
-mkOpFormRn a1@(L loc
+-- (e1a `op1` e1b) `op2` e2
+mkOpFormRn e1@(L loc
                     (HsCmdTop _
                      (L _ (HsCmdArrForm x op1 f (Just fix1)
-                        [a11,a12]))))
-        op2 fix2 a2
+                        [e1a,e1b]))))
+        op2 fix2 e2
   | nofix_error
   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
-       return (HsCmdArrForm x op2 f (Just fix2) [a1, a2])
+       return (HsCmdArrForm x op2 f (Just fix2) [e1, e2])
 
   | associate_right
-  = do new_c <- mkOpFormRn a12 op2 fix2 a2
+  = do new_c <- mkOpFormRn e1a op2 fix2 e2
        return (HsCmdArrForm noExtField op1 f (Just fix1)
-               [a11, L loc (HsCmdTop [] (L (l2l loc) new_c))])
+               [e1b, L loc (HsCmdTop [] (L (l2l loc) new_c))])
         -- TODO: locs are wrong
   where
     (nofix_error, associate_right) = compareFixity fix1 fix2
@@ -1474,7 +1484,7 @@ mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
 mkConOpPatRn :: LocatedN Name -> Fixity -> LPat GhcRn -> LPat GhcRn
              -> RnM (Pat GhcRn)
 
-mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p11 p12))) p2
+mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p1a p1b))) p2
   = do  { fix1 <- lookupFixityRn (unLoc op1)
         ; let (nofix_error, associate_right) = compareFixity fix1 fix2
 
@@ -1489,11 +1499,11 @@ mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p11 p12))) p2
                 }
 
           else if associate_right then do
-                { new_p <- mkConOpPatRn op2 fix2 p12 p2
+                { new_p <- mkConOpPatRn op2 fix2 p1b p2
                 ; return $ ConPat
                     { pat_con_ext = noExtField
                     , pat_con = op1
-                    , pat_args = InfixCon p11 (L loc new_p)
+                    , pat_args = InfixCon p1a (L loc new_p)
                     }
                 }
                 -- XXX loc right?
@@ -1946,7 +1956,7 @@ extract_lty (L _ ty) acc
                                      extract_lty ty2 $
                                      extract_hs_arrow w acc
       HsIParamTy _ _ ty           -> extract_lty ty acc
-      HsOpTy _ ty1 tv ty2         -> extract_tv tv $
+      HsOpTy _ _ ty1 tv ty2       -> extract_tv tv $
                                      extract_lty ty1 $
                                      extract_lty ty2 acc
       HsParTy _ ty                -> extract_lty ty acc
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 5bacc4fb30..dc4fa5d46b 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -590,7 +590,7 @@ unliftedCompare lt_op eq_op a_expr b_expr lt eq gt
   where
     ascribeBool e = noLocA $ ExprWithTySig noAnn e
                            $ mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType
-                           $ nlHsTyVar boolTyCon_RDR
+                           $ nlHsTyVar NotPromoted boolTyCon_RDR
 
 nlConWildPat :: DataCon -> LPat GhcPs
 -- The pattern (K {})
@@ -2233,9 +2233,9 @@ genAuxBindSpecSig loc spec = case spec of
   DerivMaxTag _ _
     -> mk_sig (L (noAnnSrcSpan loc) (XHsType intTy))
   DerivDataDataType _ _ _
-    -> mk_sig (nlHsTyVar dataType_RDR)
+    -> mk_sig (nlHsTyVar NotPromoted dataType_RDR)
   DerivDataConstr _ _ _
-    -> mk_sig (nlHsTyVar constr_RDR)
+    -> mk_sig (nlHsTyVar NotPromoted constr_RDR)
   where
     mk_sig = mkHsWildCardBndrs . L (noAnnSrcSpan loc) . mkHsImplicitSigType
 
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index de8d893f80..cab71a1deb 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -50,6 +50,7 @@ import GHC.Tc.Types.Rank (Rank(..))
 import GHC.Tc.Utils.TcType
 import GHC.Types.Error
 import GHC.Types.FieldLabel (flIsOverloaded)
+import GHC.Types.Hint (UntickedPromotedThing(..), pprUntickedConstructor, isBareSymbol)
 import GHC.Types.Hint.Ppr () -- Outputable GhcHint
 import GHC.Types.Basic
 import GHC.Types.Id
@@ -691,9 +692,17 @@ instance Diagnostic TcRnMessage where
     TcRnNotInScope err name imp_errs _
       -> mkSimpleDecorated $
            pprScopeError name err $$ vcat (map ppr imp_errs)
-    TcRnUntickedPromotedConstructor name
-      -> mkSimpleDecorated $
-         text "Unticked promoted constructor" <> colon <+> quotes (ppr name) <> dot
+    TcRnUntickedPromotedThing thing
+      -> mkSimpleDecorated $
+         text "Unticked promoted" <+> what
+           where
+             what :: SDoc
+             what = case thing of
+               UntickedExplicitList -> text "list" <> dot
+               UntickedConstructor fixity nm ->
+                 let con      = pprUntickedConstructor fixity nm
+                     bare_sym = isBareSymbol fixity nm
+                 in text "constructor:" <+> con <> if bare_sym then empty else dot
     TcRnIllegalBuiltinSyntax what rdr_name
       -> mkSimpleDecorated $
            hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr_name]
@@ -1032,7 +1041,7 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnNotInScope {}
       -> ErrorWithoutFlag
-    TcRnUntickedPromotedConstructor {}
+    TcRnUntickedPromotedThing {}
       -> WarningWithFlag Opt_WarnUntickedPromotedConstructors
     TcRnIllegalBuiltinSyntax {}
       -> ErrorWithoutFlag
@@ -1291,8 +1300,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnNotInScope err _ _ hints
       -> scopeErrorHints err ++ hints
-    TcRnUntickedPromotedConstructor name
-      -> [SuggestAddTick name]
+    TcRnUntickedPromotedThing thing
+      -> [SuggestAddTick thing]
     TcRnIllegalBuiltinSyntax {}
       -> noHints
     TcRnWarnDefaulting {}
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 78be225cf9..9a9a64130f 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -73,6 +73,7 @@ import GHC.Tc.Types.Origin (CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol),
 import GHC.Tc.Types.Rank (Rank)
 import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType)
 import GHC.Types.Error
+import GHC.Types.Hint (UntickedPromotedThing(..))
 import GHC.Types.FieldLabel (FieldLabelString)
 import GHC.Types.ForeignCall (CLabelString)
 import GHC.Types.Name (Name, OccName, getSrcLoc)
@@ -1631,18 +1632,20 @@ data TcRnMessage where
                  -> [GhcHint]        -- ^ hints, e.g. enable DataKinds to refer to a promoted data constructor
                  -> TcRnMessage
 
-  {-| TcRnUntickedPromotedConstructor is a warning (controlled with -Wunticked-promoted-constructors)
+  {-| TcRnUntickedPromotedThing is a warning (controlled with -Wunticked-promoted-constructors)
       that is triggered by an unticked occurrence of a promoted data constructor.
 
-      Example:
+      Examples:
 
         data A = MkA
         type family F (a :: A) where { F MkA = Bool }
 
-      Test case: T9778.
+        type B = [ Int, Bool ]
+
+      Test cases: T9778, T19984.
   -}
-  TcRnUntickedPromotedConstructor :: Name
-                                  -> TcRnMessage
+  TcRnUntickedPromotedThing :: UntickedPromotedThing
+                            -> TcRnMessage
 
   {-| TcRnIllegalBuiltinSyntax is an error that occurs when built-in syntax appears
       in an unexpected location, e.g. as a data constructor or in a fixity declaration.
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index de16c657fd..b3d6a69977 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1165,7 +1165,7 @@ tc_hs_type _ ty@(HsSpliceTy {}) _exp_kind
 tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind
   = tc_fun_type mode mult ty1 ty2 exp_kind
 
-tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
+tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind
   | op `hasKey` funTyConKey
   = tc_fun_type mode (HsUnrestrictedArrow noHsUniTok) ty1 ty2 exp_kind
 
@@ -1508,7 +1508,7 @@ splitHsAppTys hs_ty
     is_app :: HsType GhcRn -> Bool
     is_app (HsAppKindTy {})        = True
     is_app (HsAppTy {})            = True
-    is_app (HsOpTy _ _ (L _ op) _) = not (op `hasKey` funTyConKey)
+    is_app (HsOpTy _ _ _ (L _ op) _) = not (op `hasKey` funTyConKey)
       -- I'm not sure why this funTyConKey test is necessary
       -- Can it even happen?  Perhaps for   t1 `(->)` t2
       -- but then maybe it's ok to treat that like a normal
@@ -1524,8 +1524,8 @@ splitHsAppTys hs_ty
     go (L _  (HsAppTy _ f a))      as = go f (HsValArg a : as)
     go (L _  (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
     go (L sp (HsParTy _ f))        as = go f (HsArgPar (locA sp) : as)
-    go (L _  (HsOpTy _ l op@(L sp _) r)) as
-      = ( L (na2la sp) (HsTyVar noAnn NotPromoted op)
+    go (L _  (HsOpTy _ prom l op@(L sp _) r)) as
+      = ( L (na2la sp) (HsTyVar noAnn prom op)
         , HsValArg l : HsValArg r : as )
     go f as = (f, as)
 
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index ed1833c1e7..971a47bb99 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -301,7 +301,7 @@ no_anon_wc_ty lty = go lty
       HsListTy _ ty                  -> go ty
       HsTupleTy _ _ tys              -> gos tys
       HsSumTy _ tys                  -> gos tys
-      HsOpTy _ ty1 _ ty2             -> go ty1 && go ty2
+      HsOpTy _ _ ty1 _ ty2           -> go ty1 && go ty2
       HsParTy _ ty                   -> go ty
       HsIParamTy _ _ ty              -> go ty
       HsKindSig _ ty kind            -> go ty && go kind
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index d9bb0dba17..9a19461b13 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2516,8 +2516,8 @@ getGhciStepIO :: TcM (LHsExpr GhcRn)
 getGhciStepIO = do
     ghciTy <- getGHCiMonad
     a_tv <- newName (mkTyVarOccFS (fsLit "a"))
-    let ghciM   = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv)
-        ioM     = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv)
+    let ghciM   = nlHsAppTy (nlHsTyVar NotPromoted ghciTy) (nlHsTyVar NotPromoted a_tv)
+        ioM     = nlHsAppTy (nlHsTyVar NotPromoted ioTyConName) (nlHsTyVar NotPromoted a_tv)
 
         step_ty :: LHsSigType GhcRn
         step_ty = noLocA $ HsSig
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 36a58d760a..24802a65ea 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -924,7 +924,7 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
                   -- Check that the result kind of the TyCon applied to its args
                   -- is compatible with the explicit signature (or Type, if there
                   -- is none)
-                  ; let hs_lhs = nlHsTyConApp fixity (getName fam_tc) hs_pats
+                  ; let hs_lhs = nlHsTyConApp NotPromoted fixity (getName fam_tc) hs_pats
                   ; _ <- unifyKind (Just . HsTypeRnThing $ unLoc hs_lhs) lhs_applied_kind res_kind
 
                   ; traceTc "tcDataFamInstHeader" $
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index d1ab002532..7644109ae0 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1661,7 +1661,7 @@ cvtTypeKind ty_str ty
            UInfixT t1 s t2
              -> do { s' <- tconNameN s
                    ; t2' <- cvtType t2
-                   ; t <- cvtOpAppT t1 s' t2'
+                   ; t <- cvtOpAppT NotPromoted t1 s' t2'
                    ; mk_apps (unLoc t) tys'
                    } -- Note [Converting UInfix]
 
@@ -1677,7 +1677,7 @@ cvtTypeKind ty_str ty
            PromotedUInfixT t1 s t2
              -> do { s' <- cNameN s
                    ; t2' <- cvtType t2
-                   ; t <- cvtOpAppT t1 s' t2'
+                   ; t <- cvtOpAppT IsPromoted t1 s' t2'
                    ; mk_apps (unLoc t) tys'
                    } -- Note [Converting UInfix]
 
@@ -1725,7 +1725,7 @@ cvtTypeKind ty_str ty
                    let px = parenthesizeHsType opPrec x'
                        py = parenthesizeHsType opPrec y'
                    in do { eq_tc <- returnLA eqTyCon_RDR
-                         ; returnLA (HsOpTy noExtField px eq_tc py) }
+                         ; returnLA (HsOpTy noAnn NotPromoted px eq_tc py) }
                -- The long-term goal is to remove the above case entirely and
                -- subsume it under the case for InfixT. See #15815, comment:6,
                -- for more details.
@@ -1835,18 +1835,18 @@ provided @y@ is.
 
 See the @cvtOpApp@ documentation for how this function works.
 -}
-cvtOpAppT :: TH.Type -> LocatedN RdrName -> LHsType GhcPs -> CvtM (LHsType GhcPs)
-cvtOpAppT (UInfixT x op2 y) op1 z
+cvtOpAppT :: PromotionFlag -> TH.Type -> LocatedN RdrName -> LHsType GhcPs -> CvtM (LHsType GhcPs)
+cvtOpAppT prom (UInfixT x op2 y) op1 z
   = do { op2' <- tconNameN op2
-       ; l <- cvtOpAppT y op1 z
-       ; cvtOpAppT x op2' l }
-cvtOpAppT (PromotedUInfixT x op2 y) op1 z
+       ; l <- cvtOpAppT prom y op1 z
+       ; cvtOpAppT NotPromoted x op2' l }
+cvtOpAppT prom (PromotedUInfixT x op2 y) op1 z
   = do { op2' <- cNameN op2
-       ; l <- cvtOpAppT y op1 z
-       ; cvtOpAppT x op2' l }
-cvtOpAppT x op y
+       ; l <- cvtOpAppT prom y op1 z
+       ; cvtOpAppT IsPromoted x op2' l }
+cvtOpAppT prom x op y
   = do { x' <- cvtType x
-       ; returnLA (mkHsOpTy x' op y) }
+       ; returnLA (mkHsOpTy prom x' op y) }
 
 cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
 cvtKind = cvtTypeKind "kind"
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 6304b1d7fd..a3b40dbf2f 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -9,6 +9,8 @@ module GHC.Types.Hint (
   , HowInScope(..)
   , SimilarName(..)
   , StarIsType(..)
+  , UntickedPromotedThing(..)
+  , pprUntickedConstructor, isBareSymbol
   , suggestExtension
   , suggestExtensionWithInfo
   , suggestExtensions
@@ -29,7 +31,8 @@ import Data.Typeable
 import GHC.Unit.Module (ModuleName, Module)
 import GHC.Hs.Extension (GhcTc)
 import GHC.Core.Coercion
-import GHC.Types.Name (Name, NameSpace, OccName (occNameFS))
+import GHC.Types.Fixity (LexicalFixity(..))
+import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName)
 import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec)
 import GHC.Types.SrcLoc (SrcSpan)
 import GHC.Types.Basic (Activation, RuleName)
@@ -342,12 +345,12 @@ data GhcHint
    -}
   | SuggestDumpSlices
 
-  {-| Suggests adding a tick to refer to a data constructor
-      at the type level.
+  {-| Suggests adding a tick to refer to something which has been
+      promoted to the type level, e.g. a data constructor.
 
-      Test case: T9778.
+      Test cases: T9778, T19984.
   -}
-  | SuggestAddTick Name
+  | SuggestAddTick UntickedPromotedThing
 
   {-| Something is split off from its corresponding declaration.
       For example, a datatype is given a role declaration
@@ -422,6 +425,33 @@ data SimilarName
   = SimilarName Name
   | SimilarRdrName RdrName HowInScope
 
+-- | Something is promoted to the type-level without a promotion tick.
+data UntickedPromotedThing
+  = UntickedConstructor LexicalFixity Name
+  | UntickedExplicitList
+
+pprUntickedConstructor :: LexicalFixity -> Name -> SDoc
+pprUntickedConstructor fixity nm =
+  case fixity of
+    Prefix -> pprPrefixVar is_op ppr_nm -- e.g. (:) and '(:)
+    Infix  -> pprInfixVar  is_op ppr_nm -- e.g. `Con` and '`Con`
+  where
+    ppr_nm = ppr nm
+    is_op = isSymOcc (nameOccName nm)
+
+-- | Whether a constructor name is printed out as a bare symbol, e.g. @:@.
+--
+-- True for symbolic names in infix position.
+--
+-- Used for pretty-printing.
+isBareSymbol :: LexicalFixity -> Name -> Bool
+isBareSymbol fixity nm
+  | isSymOcc (nameOccName nm)
+  , Infix <- fixity
+  = True
+  | otherwise
+  = False
+
 --------------------------------------------------------------------------------
 
 -- | Whether '*' is a synonym for 'Data.Kind.Type'.
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 5ed31571b0..ee1060f0ff 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -152,11 +152,24 @@ instance Outputable GhcHint where
       -> vcat [ text "If you bound a unique Template Haskell name (NameU)"
               , text "perhaps via newName,"
               , text "then -ddump-splices might be useful." ]
-    SuggestAddTick name
+    SuggestAddTick (UntickedConstructor fixity name)
       -> hsep [ text "Use"
-              , quotes (char '\'' <> ppr name)
+              , char '\'' <> con
               , text "instead of"
-              , quotes (ppr name) <> dot ]
+              , con <> mb_dot ]
+        where
+          con = pprUntickedConstructor fixity name
+          mb_dot
+            | isBareSymbol fixity name
+            -- A final dot can be confusing for a symbol without parens, e.g.
+            --
+            --  * Use ': instead of :.
+            = empty
+            | otherwise
+            = dot
+
+    SuggestAddTick UntickedExplicitList
+      -> text "Add a promotion tick, e.g." <+> text "'[x,y,z]" <> dot
     SuggestMoveToDeclarationSite what rdr_name
       -> text "Move the" <+> what <+> text "to the declaration site of"
          <+> quotes (ppr rdr_name) <> dot
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index e7c35f93c1..0c84e9faa6 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -791,6 +791,8 @@ data HsType pass
     -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
 
   | HsOpTy              (XOpTy pass)
+                        PromotionFlag    -- Whether explicitly promoted,
+                                         -- for the pretty printer
                         (LHsType pass) (LIdP pass) (LHsType pass)
       -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
 
diff --git a/docs/users_guide/9.4.1-notes.rst b/docs/users_guide/9.4.1-notes.rst
index a77b6b451b..2576a21cea 100644
--- a/docs/users_guide/9.4.1-notes.rst
+++ b/docs/users_guide/9.4.1-notes.rst
@@ -383,3 +383,7 @@ Compiler
 - GHC no longer carries ``Derived`` constraints. Accordingly, several functions
   in the plugin architecture that previously passed or received three sets of
   constraints (givens, deriveds, and wanteds) now work with two such sets.
+
+- A new argument has been added to the ``HsOpTy`` constructor of the ``HsType``
+  datatype, to track the presence of a promotion tick. Plugins which manipulate
+  the Haskell AST will need to take this change into account.
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 9eaf63ed80..13c04f7d98 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -1652,6 +1652,13 @@ of ``-W(no-)*``.
     Will raise two warnings because ``Zero`` and ``Succ`` are not
     written as ``'Zero`` and ``'Succ``.
 
+    This also applies to list literals since 9.4. For example: ::
+
+      type L = [Int, Char, Bool]
+
+    will raise a warning, because ``[Int, Char, Bool]`` is a promoted list
+    which lacks a tick.
+
 .. ghc-flag:: -Wunused-binds
     :shortdesc: warn about bindings that are unused. Alias for
         :ghc-flag:`-Wunused-top-binds`, :ghc-flag:`-Wunused-local-binds` and
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 68519f5ce7..fa04121821 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1783,9 +1783,9 @@ defineMacro overwrite s = do
       expr <- GHC.parseExpr definition
       -- > ghciStepIO . definition :: String -> IO String
       let stringTy :: LHsType GhcPs
-          stringTy = nlHsTyVar stringTyCon_RDR
+          stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
           ioM :: LHsType GhcPs -- AZ
-          ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+          ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
           body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
                                      `mkHsApp` (nlHsPar expr)
           tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
@@ -1853,9 +1853,9 @@ cmdCmd str = handleSourceError printErrAndMaybeExit $ do
 getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
 getGhciStepIO = do
   ghciTyConName <- GHC.getGHCiMonad
-  let stringTy = nlHsTyVar stringTyCon_RDR
-      ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy
-      ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+  let stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+      ghciM = nlHsTyVar NotPromoted (getRdrName ghciTyConName) `nlHsAppTy` stringTy
+      ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
       body = nlHsVar (getRdrName ghciStepIoMName)
       tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
               nlHsFunTy ghciM ioM
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 60230b3b63..38e55e1021 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -227,7 +227,8 @@
                 (L
                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:11:11-16 })
                  (HsOpTy
-                  (NoExtField)
+                  (EpAnnNotUsed)
+                  (NotPromoted)
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:11:11 })
                    (HsTyVar
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 77061c1f84..cfaa1b102e 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -206,7 +206,8 @@
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:13:11-16 })
                    (HsOpTy
-                    (NoExtField)
+                    (EpAnnNotUsed)
+                    (NotPromoted)
                     (L
                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:13:11 })
                      (HsTyVar
diff --git a/testsuite/tests/rename/should_compile/T19984.hs b/testsuite/tests/rename/should_compile/T19984.hs
new file mode 100644
index 0000000000..355fcdda64
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T19984.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T19984 where
+
+data D a = (:-) a a
+
+-- promoted datacons missing promotion tick
+-- (should give warnings with -fwarn-unticked-promoted-constructors)
+type A1 = Int : '[]
+type B1 = [Int, Bool]
+type C1 = (:) Int '[]
+type E1 = Int :- Bool
+type F1 = (:-) Int Bool
+
+-- promoted datacons with promotion ticks
+-- (no warnings)
+type A2 = Int ': '[]
+type B2 = '[Int, Bool]
+type C2 = '(:) Int '[]
+type E2 = Int ':- Bool
+type F2 = '(:-) Int Bool
+
+-- non-promoted datacons
+-- (no warnings)
+data G = GA | GB
+a3, b3, c3 :: [G]
+a3 = GA : []
+b3 = [GA, GB]
+c3 = (:) GA []
+
+e3, f3 :: D G
+e3 = GA :- GB
+f3 = (:-) GA GB
diff --git a/testsuite/tests/rename/should_compile/T19984.stderr b/testsuite/tests/rename/should_compile/T19984.stderr
new file mode 100644
index 0000000000..1f814797be
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T19984.stderr
@@ -0,0 +1,20 @@
+
+T19984.hs:10:15: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: :
+    Suggested fix: Use ': instead of :
+
+T19984.hs:11:11: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted list.
+    Suggested fix: Add a promotion tick, e.g. '[x,y,z].
+
+T19984.hs:12:11: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: (:).
+    Suggested fix: Use '(:) instead of (:).
+
+T19984.hs:13:15: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: :-
+    Suggested fix: Use ':- instead of :-
+
+T19984.hs:14:11: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: (:-).
+    Suggested fix: Use '(:-) instead of (:-).
diff --git a/testsuite/tests/rename/should_compile/T9778.hs b/testsuite/tests/rename/should_compile/T9778.hs
index 5b32f6763f..1ced4fbab5 100644
--- a/testsuite/tests/rename/should_compile/T9778.hs
+++ b/testsuite/tests/rename/should_compile/T9778.hs
@@ -1,8 +1,16 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+
 module T9778 where
 
+import Data.Kind
+
 data T = A | B
 
 data G a where
   C :: G A
+
+data D = MkD Type Type
+
+type S = Int `MkD` Bool
diff --git a/testsuite/tests/rename/should_compile/T9778.stderr b/testsuite/tests/rename/should_compile/T9778.stderr
index 99b93c104c..24a9c3c958 100644
--- a/testsuite/tests/rename/should_compile/T9778.stderr
+++ b/testsuite/tests/rename/should_compile/T9778.stderr
@@ -1,4 +1,8 @@
 
-T9778.hs:8:10: warning: [-Wunticked-promoted-constructors]
-    Unticked promoted constructor: ‘A’.
-    Suggested fix: Use ‘'A’ instead of ‘A’.
+T9778.hs:12:10: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: A.
+    Suggested fix: Use 'A instead of A.
+
+T9778.hs:16:14: warning: [-Wunticked-promoted-constructors]
+    Unticked promoted constructor: `MkD`.
+    Suggested fix: Use '`MkD` instead of `MkD`.
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 563eb3604f..e81bc0e4c8 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -187,3 +187,4 @@ test('T20609c', normal, compile, [''])
 test('T20609d', normal, compile, [''])
 test('T18862', normal, compile, [''])
 test('unused_haddock', normal, compile, ['-haddock -Wall'])
+test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors'])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 67aa1f280d..3d493cfd22 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -2876,7 +2876,7 @@ instance ExactPrint (HsType GhcPs) where
   getAnnotationEntry (HsListTy an _)           = fromAnn an
   getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an
   getAnnotationEntry (HsSumTy an _)            = fromAnn an
-  getAnnotationEntry (HsOpTy _ _ _ _)          = NoEntryVal
+  getAnnotationEntry (HsOpTy an _ _ _ _)       = fromAnn an
   getAnnotationEntry (HsParTy an _)            = fromAnn an
   getAnnotationEntry (HsIParamTy an _ _)       = fromAnn an
   getAnnotationEntry (HsStarTy _ _)            = NoEntryVal
@@ -2926,7 +2926,8 @@ instance ExactPrint (HsType GhcPs) where
     markOpeningParen an
     markAnnotated tys
     markClosingParen an
-  exact (HsOpTy _an t1 lo t2) = do
+  exact (HsOpTy an promoted t1 lo t2) = do
+    when (isPromoted promoted) $ markEpAnn an AnnSimpleQuote
     markAnnotated t1
     markAnnotated lo
     markAnnotated t2
diff --git a/utils/haddock b/utils/haddock
-Subproject 559e41505e81d93939e9afa6aa9793b0a428924
+Subproject 58237d76c96325f25627bfd7cdad5b93364d29a