diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 99661a07896361aa3fd5ca63d97681ecb7b53b08..1c7d030518d675675897ad1d8d3e579d63f1e124 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -361,7 +361,11 @@ type instance XBndrNoKind (GhcPass p) = NoExtField
 type instance XXBndrKind  (GhcPass p) = DataConCantHappen
 
 type instance XBndrVar (GhcPass p) = NoExtField
-type instance XBndrWildCard (GhcPass p) = NoExtField
+
+type instance XBndrWildCard GhcPs = EpToken "_"
+type instance XBndrWildCard GhcRn = NoExtField
+type instance XBndrWildCard GhcTc = NoExtField
+
 type instance XXBndrVar (GhcPass p) = DataConCantHappen
 
 data AnnTyVarBndr
@@ -487,7 +491,9 @@ type instance XExplicitTupleTy GhcTc = [Kind]
 
 type instance XTyLit           (GhcPass _) = NoExtField
 
-type instance XWildCardTy      (GhcPass _) = NoExtField
+type instance XWildCardTy      GhcPs = EpToken "_"
+type instance XWildCardTy      GhcRn = NoExtField
+type instance XWildCardTy      GhcTc = NoExtField
 
 type instance XXType         (GhcPass _) = HsCoreTy
 
@@ -670,8 +676,8 @@ ignoreParens ty                   = ty
 ************************************************************************
 -}
 
-mkAnonWildCardTy :: HsType GhcPs
-mkAnonWildCardTy = HsWildCardTy noExtField
+mkAnonWildCardTy :: EpToken "_" -> HsType GhcPs
+mkAnonWildCardTy tok = HsWildCardTy tok
 
 mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
          => PromotionFlag
@@ -1408,13 +1414,13 @@ ppr_mono_ty (HsSpliceTy ext s)    =
 ppr_mono_ty (HsExplicitListTy _ prom tys)
   | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)
   | otherwise       = brackets (interpp'SP tys)
-ppr_mono_ty (HsExplicitTupleTy _ tys)
+ppr_mono_ty (HsExplicitTupleTy _ prom tys)
     -- Special-case unary boxed tuples so that they are pretty-printed as
     -- `'MkSolo x`, not `'(x)`
   | [ty] <- tys
-  = quoteIfPunsEnabled $ sep [text (mkTupleStr Boxed dataName 1), ppr_mono_lty ty]
+  = quote_tuple prom $ sep [text (mkTupleStr Boxed dataName 1), ppr_mono_lty ty]
   | otherwise
-  = quoteIfPunsEnabled $ parens (maybeAddSpace tys $ interpp'SP tys)
+  = quote_tuple prom $ parens (maybeAddSpace tys $ interpp'SP tys)
 ppr_mono_ty (HsTyLit _ t)       = ppr t
 ppr_mono_ty (HsWildCardTy {})   = char '_'
 
@@ -1448,6 +1454,10 @@ ppr_fun_ty mult ty1 ty2
     in
     sep [p1, arr <+> p2]
 
+quote_tuple :: PromotionFlag -> SDoc -> SDoc
+quote_tuple IsPromoted  doc = quote doc
+quote_tuple NotPromoted doc = doc
+
 --------------------------
 -- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses
 -- under precedence @p@.
@@ -1477,7 +1487,7 @@ hsTypeNeedsParens p = go_hs_ty
     -- Special-case unary boxed tuple applications so that they are
     -- parenthesized as `Proxy ('MkSolo x)`, not `Proxy 'MkSolo x` (#18612)
     -- See Note [One-tuples] in GHC.Builtin.Types
-    go_hs_ty (HsExplicitTupleTy _ [_])
+    go_hs_ty (HsExplicitTupleTy _ _ [_])
                                       = p >= appPrec
     go_hs_ty (HsExplicitTupleTy{})    = False
     go_hs_ty (HsTyLit{})              = False
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 85c56b3a3104aba6286d88a5ad4b6326df545cd9..2c384c5df0ef3dbe2e6cbb0d2c196ebd55c7cfc1 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1464,7 +1464,7 @@ repTy t@(HsSpliceTy (HsUntypedSpliceTop _ _) _) = pprPanic "repTy: top level spl
 repTy (HsExplicitListTy _ _ tys) = do
                                     tys1 <- repLTys tys
                                     repTPromotedList tys1
-repTy (HsExplicitTupleTy _ tys) = do
+repTy (HsExplicitTupleTy _ _ tys) = do
                                     tys1 <- repLTys tys
                                     tcon <- repPromotedTupleTyCon (length tys)
                                     repTapps tcon tys1
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index f9ebdfa01b58b60caef9e5d26e119fb9c11b6a5f..9ce95988ed18da4794c932a380887476f7ab16eb 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1952,7 +1952,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
       HsExplicitListTy _ _ tys ->
         [ toHie tys
         ]
-      HsExplicitTupleTy _ tys ->
+      HsExplicitTupleTy _ _ tys ->
         [ toHie tys
         ]
       HsTyLit _ _ -> []
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index e103d02eb2dd57aab66e5b5ae10e20faa1dd33c9..b6df4e7a96f1be6d6d1b8df518c3d8eb2c868ea3 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2316,7 +2316,7 @@ atype :: { LHsType GhcPs }
         : ntgtycon                       {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) }      -- Not including unit tuples
         -- See Note [%shift: atype -> tyvar]
         | tyvar %shift                   {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) }      -- (See Note [Unit tuples])
-        | '_'   %shift                   { sL1a $1 $ mkAnonWildCardTy }
+        | '_'   %shift                   { sL1a $1 $ mkAnonWildCardTy (epTok $1) }
         | '*'                            {% do { warnStarIsType (getLoc $1)
                                                ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } }
 
@@ -2342,14 +2342,14 @@ atype :: { LHsType GhcPs }
         | '(' ktype ')'               {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }
                                       -- see Note [Promotion] for the followings
         | SIMPLEQUOTE '(' ')'         {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
-                                            ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) []) }}
+                                            ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) IsPromoted []) }}
         | SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }
         | SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)
                                            ; amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}
         | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'
                              {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
                                    ; h <- addTrailingCommaA $3 (epTok $4)
-                                   ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) (h : $5)) }}
+                                   ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) IsPromoted (h : $5)) }}
         | '[' ']'               {% withCombinedComments $1 $> (mkListSyntaxTy0 (epTok $1) (epTok $2)) }
         | SIMPLEQUOTE  '[' comma_types0 ']'     {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
                                                       ; amsA' (sLL $1 $> $ HsExplicitListTy (epTok $1, epTok $2, epTok $4) IsPromoted $3) }}
@@ -2435,7 +2435,7 @@ tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs }
 
 tyvar_wc :: { Located (HsBndrVar GhcPs) }
         : tyvar                         { sL1 $1 (HsBndrVar noExtField $1) }
-        | '_'                           { sL1 $1 (HsBndrWildCard noExtField) }
+        | '_'                           { sL1 $1 (HsBndrWildCard (epTok $1)) }
 
 fds :: { Located (EpToken "|",[LHsFunDep GhcPs]) }
         : {- empty -}                   { noLoc (NoEpTok,[]) }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index a91311786c7c8ef91a6256300950a9c6dc5eea3d..afa5c5734a6f27d32ef61ab83a3f8d6e23a23b1a 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -980,8 +980,8 @@ checkTyVars pp_what equals_or_where tc tparms
     match_bndr_var :: HsType GhcPs -> Maybe (EpToken "'", HsBndrVar GhcPs)
     match_bndr_var (HsTyVar ann _ tv) | isRdrTyVar (unLoc tv)
       = Just (ann, HsBndrVar noExtField tv)
-    match_bndr_var (HsWildCardTy _)
-      = Just (noAnn, HsBndrWildCard noExtField)
+    match_bndr_var (HsWildCardTy tok)
+      = Just (noAnn, HsBndrWildCard tok)
     match_bndr_var _ = Nothing
 
     -- Return a EpaLocation for use in widenLocatedAnL.
@@ -1159,7 +1159,7 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
   -- With NoListTuplePuns, contexts are parsed as data constructors, which causes failure
   -- downstream.
   -- This converts them just like when they are parsed as types in the punned case.
-  check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) ts))
+  check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) _ ts))
     = punsAllowed >>= \case
       True -> unprocessed
       False -> do
@@ -3622,7 +3622,7 @@ mkTupleSyntaxTy parOpen args parClose =
     enabled =
       HsTupleTy annParen HsBoxedOrConstraintTuple args
     disabled =
-      HsExplicitTupleTy annsKeyword args
+      HsExplicitTupleTy annsKeyword NotPromoted args
 
     annParen = AnnParens parOpen parClose
     annsKeyword = (NoEpTok, parOpen, parClose)
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index d1b5fcb88eb2c18d4b58e314a3b9d91ae2f78cbb..0db8a9edd1800435d58144ac2d1765fe206fba5b 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -684,10 +684,10 @@ rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
            addDiagnostic (TcRnUntickedPromotedThing $ UntickedExplicitList)
        ; return (HsExplicitListTy noExtField ip tys', fvs) }
 
-rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
+rnHsTyKi env ty@(HsExplicitTupleTy _ ip tys)
   = do { checkDataKinds env ty
        ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
-       ; return (HsExplicitTupleTy noExtField tys', fvs) }
+       ; return (HsExplicitTupleTy noExtField ip tys', fvs) }
 
 rnHsTyKi env (HsWildCardTy _)
   = do { checkAnonWildCard env
@@ -955,9 +955,10 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside
     get_bndr_loc (L l tvb) =
       combineSrcSpans
         (case hsBndrVar tvb of
-          HsBndrWildCard _ ->
-            locA l -- this should rather be the location of the wildcard,
-                   -- but we don't have it
+          HsBndrWildCard tok ->
+            case tok of
+              NoEpTok   -> locA l
+              EpTok loc -> locA loc
           HsBndrVar _ ln   -> getLocA ln)
         (case hsBndrKind tvb of
           HsBndrNoKind _ -> noSrcSpan
@@ -2083,7 +2084,7 @@ extract_lty (L _ ty) acc
       HsSpliceTy {}               -> acc  -- Type splices mention no tvs
       HsDocTy _ ty _              -> extract_lty ty acc
       HsExplicitListTy _ _ tys    -> extract_ltys tys acc
-      HsExplicitTupleTy _ tys     -> extract_ltys tys acc
+      HsExplicitTupleTy _ _ tys   -> extract_ltys tys acc
       HsTyLit _ _                 -> acc
       HsStarTy _ _                -> acc
       HsKindSig _ ty ki           -> extract_kind_sig ty ki acc
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 162dc4e0d1697372b62f0220c5615bdd51379375..813c8a8d8fd0fd3081f3de345c1b2422a815ef28 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -1374,10 +1374,10 @@ rn_ty_pat ty@(HsExplicitListTy _ prom tys) = do
   tys' <- mapM rn_lty_pat tys
   pure (HsExplicitListTy noExtField prom tys')
 
-rn_ty_pat ty@(HsExplicitTupleTy _ tys) = do
+rn_ty_pat ty@(HsExplicitTupleTy _ prom tys) = do
   check_data_kinds ty
   tys' <- mapM rn_lty_pat tys
-  pure (HsExplicitTupleTy noExtField tys')
+  pure (HsExplicitTupleTy noExtField prom tys')
 
 rn_ty_pat tyLit@(HsTyLit src t) = do
   check_data_kinds tyLit
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index a88c9db5930f8dda419b8ec1113ac9aa0a256bbe..0dfea4f43a616bd12a7fed99d4a99080aec3d2e4 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -1027,7 +1027,7 @@ expr_to_type earg =
       | isBoxed boxity
       , Just es <- tupArgsPresent_maybe tup_args
       = do { ts <- traverse go es
-           ; return (L l (HsExplicitTupleTy noExtField ts)) }
+           ; return (L l (HsExplicitTupleTy noExtField NotPromoted ts)) }
     go (L l (ExplicitList _ es)) =
       do { ts <- traverse go es
          ; return (L l (HsExplicitListTy noExtField NotPromoted ts)) }
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 2cbaba0836d1a35056868a940799149289b871e5..602fa2f4f2080f8e8e3e58f9ea6a2102d8b82776 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1214,7 +1214,7 @@ tcHsType mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind
     mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]
     mk_nil  k     = mkTyConApp (promoteDataCon nilDataCon) [k]
 
-tcHsType mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
+tcHsType mode rn_ty@(HsExplicitTupleTy _ _ tys) exp_kind
   -- using newMetaKindVar means that we force instantiations of any polykinded
   -- types. At first, I just used tc_infer_lhs_type, but that led to #11255.
   = do { ks   <- replicateM arity newMetaKindVar
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index aaf478d9a94fd79af374d52ba6c9890a04f794cb..7674bedefa9634689e14d11539fe51312ce12d08 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -541,7 +541,7 @@ pat_to_type (SplicePat (HsUntypedSpliceTop mod_finalizers pat) splice) = do
 
 pat_to_type (TuplePat _ pats Boxed)
   = do { tys <- traverse (pat_to_type . unLoc) pats
-       ; let t = noLocA (HsExplicitTupleTy noExtField tys)
+       ; let t = noLocA (HsExplicitTupleTy noExtField NotPromoted tys)
        ; pure t }
 pat_to_type (ListPat _ pats)
   = do { tys <- traverse (pat_to_type . unLoc) pats
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 2ab34755802a9205c753165485623d205e44e50b..55eccda11e7f5485edbef13d0070266c64017f2d 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -285,7 +285,7 @@ no_anon_wc_ty lty = go lty
       HsBangTy _ _ ty                -> go ty
       HsRecTy _ flds                 -> gos $ map (cd_fld_type . unLoc) flds
       HsExplicitListTy _ _ tys       -> gos tys
-      HsExplicitTupleTy _ tys        -> gos tys
+      HsExplicitTupleTy _ _ tys      -> gos tys
       HsForAllTy { hst_tele = tele
                  , hst_body = ty } -> no_anon_wc_tele tele
                                         && go ty
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 499a90f2958e224455a82a5fc7ddbb89b7ef18b8..d05d7a076049b94272b4f8fbb0929559004613a2 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1756,7 +1756,7 @@ cvtTypeKind typeOrKind ty
              -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys'
 
            WildCardT
-             -> mk_apps mkAnonWildCardTy tys'
+             -> mk_apps (mkAnonWildCardTy noAnn) tys'
 
            InfixT t1 s t2
              -> do { s'  <- tconName s
@@ -1805,7 +1805,7 @@ cvtTypeKind typeOrKind ty
            PromotedTupleT n
               | Just normals <- m_normals
               , normals `lengthIs` n   -- Saturated
-              -> returnLA (HsExplicitTupleTy noAnn normals)
+              -> returnLA (HsExplicitTupleTy noAnn IsPromoted normals)
               | otherwise
               -> do { tuple_tc <- returnLA $ getRdrName $ tupleDataCon Boxed n
                     ; mk_apps (HsTyVar noAnn IsPromoted tuple_tc) tys' }
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index ad6c8f289442a21b8e4d7684ed7a1bfd348254a0..0e49ab25a3f57060402d2b4c3e7833bde006ac72 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -919,6 +919,7 @@ data HsType pass
 
   | HsExplicitTupleTy      -- A promoted explicit tuple
         (XExplicitTupleTy pass)
+        PromotionFlag      -- whether explicitly promoted, for pretty printer
         [LHsType pass]
 
   | HsTyLit (XTyLit pass) (HsTyLit pass)      -- A promoted numeric literal.
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index a83d45f64b7dcdf3f9bc3a852acb749132aa561b..c87f89ffc480d205e8cd84376c3506b79fa5a2e9 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -1418,6 +1418,7 @@
           (EpaSpan { KindSigs.hs:28:17 }))
          (EpTok
           (EpaSpan { KindSigs.hs:28:44 })))
+        (IsPromoted)
         [(L
           (EpAnn
            (EpaSpan { KindSigs.hs:28:19-39 })
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 01f009d7bbb5308d5eef7eece2dff7c6468a7af6..a37628c5deb7dd0370f8a9a043f87ee1e89677db 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -886,3 +886,8 @@ Test24159:
 Test25132:
 	$(CHECK_PPR)   $(LIBDIR) Test25132.hs
 	$(CHECK_EXACT) $(LIBDIR) Test25132.hs
+
+.PHONY: Test25454
+Test25454:
+	$(CHECK_PPR)   $(LIBDIR) Test25454.hs
+	$(CHECK_EXACT) $(LIBDIR) Test25454.hs
diff --git a/testsuite/tests/printer/Test25454.hs b/testsuite/tests/printer/Test25454.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a7989ef35627f565b943e4562b32b7264df5a71d
--- /dev/null
+++ b/testsuite/tests/printer/Test25454.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeAbstractions #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds, NoListTuplePuns #-}
+
+module T23501a where
+
+import Prelude.Experimental (List, Unit)
+import Data.Kind (Type, Constraint)
+
+----------------------------
+--   Class declarations   --
+----------------------------
+
+class C1 (_ :: k) _   -- no SAKS
+  where f1 :: k -> Unit
+
+f1' :: C1 @k a b => k -> Unit
+f1' @_ @a @b = f1 @_ @a @b
+
+type C2 :: k1 -> k2 -> Constraint
+class C2 (_ :: k) _ where
+  f2 :: k -> Unit
+
+f2' :: C2 @k1 @k2 a b => k1 -> Unit
+f2' @_ @_ @a @b = f2 @_ @_ @a @b
+
+type C3 :: k1 -> k2 -> Constraint
+class C3 @k @_ _ _ where
+  f3 :: k -> Unit
+
+f3' :: C3 @k1 @k2 a b => k1 -> Unit
+f3' @_ @_ @a @b = f3 @_ @_ @a @b
+
+---------------------------
+--   Data declarations   --
+---------------------------
+
+data D1 k (_ :: k) _  -- no SAKS
+  where MkD1 :: k -> D1 k a b
+
+mkD1 :: k -> D1 k a b
+mkD1 = MkD1
+
+type D2 :: forall (k1 :: Type) -> k1 -> k2 -> Type
+data D2 k (_ :: k) _ where
+  MkD2 :: k -> D2 k a b
+
+mkD2 :: k -> D2 k a b
+mkD2 = MkD2
+
+type D3 :: k1 -> k2 -> Type
+data D3 @k @_ _ _ = MkD3 k
+
+data MProxy (_ :: Type) = MPrx
+data CProxy (_ :: k -> Constraint) = CPrx
+
+type Rec :: (k -> Type) -> List k -> Type
+data Rec _ _ where
+  RNil :: Rec f []
+  (:&) :: f x -> Rec f xs -> Rec f (x:xs)
+
+------------------
+--   Newtypes   --
+------------------
+
+newtype N1 k (_ :: k) _   -- no SAKS
+  = MkN1 k
+
+mkN1 :: k -> N1 k a b
+mkN1 = MkN1
+
+type N2 :: forall (k1 :: Type) -> k1 -> k2 -> Type
+newtype N2 k (_ :: k) _ = MkN2 k
+
+mkN2 :: k -> N2 k a b
+mkN2 = MkN2
+
+----------------------------
+--   Open type families   --
+----------------------------
+
+type family OTF1 (_ :: Type -> Type) _    -- no SAKS
+
+type instance OTF1 f x = f x
+
+otf1 :: OTF1 Maybe Int -> Int
+otf1 Nothing = 0
+otf1 (Just x) = x
+
+type OTF2 :: (Type -> Type) -> Type -> Type
+type family OTF2 (_ :: Type -> Type) _
+
+type instance OTF2 f x = f x
+
+otf2 :: OTF2 Maybe Int -> Int
+otf2 Nothing = 0
+otf2 (Just x) = x
+
+------------------------------
+--   Closed type families   --
+------------------------------
+
+type family CTF1 (_ :: Type -> Type) _  -- no SAKS
+  where CTF1 f x = f x
+
+ctf1 :: CTF1 Maybe Int -> Int
+ctf1 Nothing = 0
+ctf1 (Just x) = x
+
+type CTF2 :: (Type -> Type) -> Type -> Type
+type family CTF2 (_ :: Type -> Type) _ where
+  CTF2 f x = f x
+
+ctf2 :: CTF2 Maybe Int -> Int
+ctf2 Nothing = 0
+ctf2 (Just x) = x
+
+type CTF3 :: k1 -> k2 -> Type
+type family CTF3 @_ @k _ _
+  where CTF3 @_ @k _ _ = k
+
+ctf3 :: CTF3 a True -> Bool
+ctf3 = id
+
+-----------------------
+--   Type synonyms   --
+-----------------------
+
+type T1 (_ :: Type -> Type) _ = ()   -- no SAKS
+
+type T2 :: (Type -> Type) -> k -> Type
+type T2 (_ :: Type -> Type) _ = Unit
+
+type T3 :: k1 -> k2 -> Type
+type T3 @_ @k _ _ = k
+
+type FConst _ = ()
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index fc5a258f5299bc3c1964c573bdbdb626f04ab625..6b5c25f0fa8a49d6c91c87b4c5f94905884423db 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -212,3 +212,5 @@ test('Test24159', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24159'])
 test('Test25132', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25132'])
 
 test('T24237', normal, compile_fail, [''])
+
+test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454'])
\ No newline at end of file
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 0311d9a5319444968e63912df869fdeb921a820a..f11b90eaafa23c03b6dcb8df1910402b65d9b092 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -3935,9 +3935,9 @@ instance ExactPrint (HsBndrVar GhcPs) where
   exact (HsBndrVar x n) = do
     n' <- markAnnotated n
     return (HsBndrVar x n')
-  exact (HsBndrWildCard x) = do
-    printStringAdvance "_"
-    return (HsBndrWildCard x)
+  exact (HsBndrWildCard t) = do
+    t' <- markEpToken t
+    return (HsBndrWildCard t')
 
 -- ---------------------------------------------------------------------
 
@@ -4046,12 +4046,14 @@ instance ExactPrint (HsType GhcPs) where
     tys' <- markAnnotated tys
     c' <- markEpToken c
     return (HsExplicitListTy (sq',o',c') prom tys')
-  exact (HsExplicitTupleTy (sq, o, c) tys) = do
-    sq' <- markEpToken sq
+  exact (HsExplicitTupleTy (sq, o, c) prom tys) = do
+    sq' <- if (isPromoted prom)
+              then markEpToken sq
+              else return sq
     o' <- markEpToken o
     tys' <- markAnnotated tys
     c' <- markEpToken c
-    return (HsExplicitTupleTy (sq', o', c') tys')
+    return (HsExplicitTupleTy (sq', o', c') prom tys')
   exact (HsTyLit a lit) = do
     case lit of
       (HsNumTy src v) -> printSourceText src (show v)
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index d708adc3bf2594b2531d51d1cd6c97c9f9d66572..8065b43339a93a4d5fa92e70677e8d29c9976927 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -89,7 +89,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil
  -- "../../testsuite/tests/parser/should_compile/T14189.hs" Nothing
 
  -- "../../testsuite/tests/printer/AnnotationLet.hs" Nothing
- "../../testsuite/tests/printer/AnnotationTuple.hs" Nothing
+ -- "../../testsuite/tests/printer/AnnotationTuple.hs" Nothing
  -- "../../testsuite/tests/printer/Ppr001.hs" Nothing
  -- "../../testsuite/tests/printer/Ppr002.hs" Nothing
  -- "../../testsuite/tests/printer/Ppr002a.hs" Nothing
@@ -216,6 +216,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil
 --  "../../testsuite/tests/printer/Test22765.hs" Nothing
  -- "../../testsuite/tests/printer/Test22771.hs" Nothing
  -- "../../testsuite/tests/printer/Test23465.hs" Nothing
+ "../../testsuite/tests/printer/Test25454.hs" Nothing
 
 -- cloneT does not need a test, function can be retired
 
diff --git a/utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs b/utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
index 431ba46aa61192e70e001e01de72685efd528318..5fb8ec90bb46ed4b68828ac5615b0fb33941a457 100644
--- a/utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1321,7 +1321,8 @@ ppr_mono_ty (HsRecTy{}) _ = text "{..}"
 ppr_mono_ty (XHsType{}) _ = error "ppr_mono_ty HsCoreTy"
 ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty (HsExplicitTupleTy _ IsPromoted tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty (HsExplicitTupleTy _ NotPromoted tys) u = parenList $ map (ppLType u) tys
 ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode =
   hsep [ppr_mono_lty fun_ty unicode, ppr_mono_lty arg_ty unicode]
 ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode =
diff --git a/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 802cbb49c0672f83647efd696ae400335159f09b..5b455447bd00552b87deeb2cf9e0cc888f7520b0 100644
--- a/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1833,7 +1833,8 @@ ppr_mono_ty (HsRecTy{}) _ _ _ = toHtml "{..}"
 ppr_mono_ty (XHsType{}) _ _ _ = error "ppr_mono_ty HsCoreTy"
 ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
-ppr_mono_ty (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty (HsExplicitTupleTy _ IsPromoted tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty (HsExplicitTupleTy _ NotPromoted tys) u q _ = parenList $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode qual _ =
   hsep
     [ ppr_mono_lty fun_ty unicode qual HideEmptyContexts
diff --git a/utils/haddock/haddock-api/src/Haddock/Convert.hs b/utils/haddock/haddock-api/src/Haddock/Convert.hs
index 4034d49af45c08129864f287f4b3326b5070be8c..cf6ae2919d0e3ca3fbbfffecfed96df737cda87e 100644
--- a/utils/haddock/haddock-api/src/Haddock/Convert.hs
+++ b/utils/haddock/haddock-api/src/Haddock/Convert.hs
@@ -741,7 +741,7 @@ synifyType _ vs (TyConApp tc tys) =
       | Just dc <- isPromotedDataCon_maybe tc
       , isTupleDataCon dc
       , dataConSourceArity dc == length vis_tys =
-          noLocA $ HsExplicitTupleTy noExtField (map (synifyType WithinType vs) vis_tys)
+          noLocA $ HsExplicitTupleTy noExtField IsPromoted (map (synifyType WithinType vs) vis_tys)
       -- ditto for lists
       | getName tc == listTyConName
       , [ty] <- vis_tys =
diff --git a/utils/haddock/haddock-api/src/Haddock/GhcUtils.hs b/utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
index 0d92c3a0f3c5689a5832fe6df8be895c51f7bebd..0e60358d971c7f6bb3a50ad691ac2e7c1a98d6db 100644
--- a/utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
+++ b/utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
@@ -418,7 +418,7 @@ reparenTypePrec = go
     go _ (HsRecTy x flds) = HsRecTy x (map (mapXRec @a reparenConDeclField) flds)
     go p (HsDocTy x ty d) = HsDocTy x (goL p ty) d
     go _ (HsExplicitListTy x p tys) = HsExplicitListTy x p (map reparenLType tys)
-    go _ (HsExplicitTupleTy x tys) = HsExplicitTupleTy x (map reparenLType tys)
+    go _ (HsExplicitTupleTy x p tys) = HsExplicitTupleTy x p (map reparenLType tys)
     go p (HsKindSig x ty kind) =
       paren p PREC_SIG $ HsKindSig x (goL PREC_SIG ty) (goL PREC_SIG kind)
     go p (HsIParamTy x n ty) =
diff --git a/utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs b/utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
index da50807b235725e3a4a2fe80c11c46e9f8472584..77c18c05125397b967dba3ee8051abbdae4c08fc 100644
--- a/utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
@@ -405,12 +405,12 @@ renameType t = case t of
   HsExplicitListTy _ a b -> HsExplicitListTy noAnn a <$> mapM renameLType b
   -- Special-case unary boxed tuples so that they are pretty-printed as
   -- `'MkSolo x`, not `'(x)`
-  HsExplicitTupleTy _ [ty] -> do
+  HsExplicitTupleTy _ ip [ty] -> do
     name <- renameName (tupleDataConName Boxed 1)
-    let lhs = noLocA $ HsTyVar noAnn IsPromoted (noLocA name)
+    let lhs = noLocA $ HsTyVar noAnn ip (noLocA name)
     rhs <- renameLType ty
     return (HsAppTy noAnn lhs rhs)
-  HsExplicitTupleTy _ b -> HsExplicitTupleTy noAnn <$> mapM renameLType b
+  HsExplicitTupleTy _ ip b -> HsExplicitTupleTy noAnn ip <$> mapM renameLType b
   HsSpliceTy (HsUntypedSpliceTop _ st) _ -> renameType (unLoc st)
   HsSpliceTy (HsUntypedSpliceNested _) _ -> error "renameType: not an top level type splice"
   HsWildCardTy _ -> pure (HsWildCardTy noAnn)
diff --git a/utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs b/utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
index 87731ae934ee7dca98c1873e19425ff977f7517b..d8dde34903ef7597d6e8102682fcf7773a46b871 100644
--- a/utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
+++ b/utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
@@ -116,8 +116,8 @@ renameType t@(HsRecTy _ _) = pure t
 renameType t@(XHsType _) = pure t
 renameType (HsExplicitListTy x ip ltys) =
   HsExplicitListTy x ip <$> renameLTypes ltys
-renameType (HsExplicitTupleTy x ltys) =
-  HsExplicitTupleTy x <$> renameLTypes ltys
+renameType (HsExplicitTupleTy x ip ltys) =
+  HsExplicitTupleTy x ip <$> renameLTypes ltys
 renameType t@(HsTyLit _ _) = pure t
 renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)