HsToken for @-patterns and TypeApplications (#19623)

One more step towards the new design of EPA.

40 files changed, 159 insertions, 123 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index d664456654..12e9e2d81c 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -247,7 +247,7 @@ type instance XLamCase       (GhcPass _) = EpAnn [AddEpAnn]
 
 type instance XApp           (GhcPass _) = EpAnnCO
 
-type instance XAppTypeE      GhcPs = SrcSpan -- Where the `@` lives
+type instance XAppTypeE      GhcPs = NoExtField
 type instance XAppTypeE      GhcRn = NoExtField
 type instance XAppTypeE      GhcTc = Type
 
@@ -730,7 +730,7 @@ ppr_apps :: (OutputableBndrId p)
          -> SDoc
 ppr_apps (HsApp _ (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
-ppr_apps (HsAppType _ (L _ fun) arg)    args
+ppr_apps (HsAppType _ (L _ fun) _ arg)  args
   = ppr_apps fun (Right arg : args)
 ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))
   where
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 3f4c0b16bd..0a723cee11 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -431,6 +431,10 @@ deriving instance Data (Pat GhcTc)
 
 deriving instance Data ConPatTc
 
+deriving instance Data (HsConPatTyArg GhcPs)
+deriving instance Data (HsConPatTyArg GhcRn)
+deriving instance Data (HsConPatTyArg GhcTc)
+
 deriving instance (Data a, Data b) => Data (HsFieldBind a b)
 
 deriving instance (Data body) => Data (HsRecFields GhcPs body)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index f3e4fbe9c4..102587026e 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -28,6 +28,7 @@ module GHC.Hs.Pat (
         XXPatGhcTc(..),
 
         HsConPatDetails, hsConPatArgs,
+        HsConPatTyArg(..),
         HsRecFields(..), HsFieldBind(..), LHsFieldBind,
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
@@ -94,7 +95,7 @@ type instance XLazyPat GhcPs = EpAnn [AddEpAnn] -- For '~'
 type instance XLazyPat GhcRn = NoExtField
 type instance XLazyPat GhcTc = NoExtField
 
-type instance XAsPat   GhcPs = EpAnn [AddEpAnn] -- For '@'
+type instance XAsPat   GhcPs = EpAnnCO
 type instance XAsPat   GhcRn = NoExtField
 type instance XAsPat   GhcTc = NoExtField
 
@@ -307,7 +308,7 @@ pprPat (VarPat _ lvar)          = pprPatBndr (unLoc lvar)
 pprPat (WildPat _)              = char '_'
 pprPat (LazyPat _ pat)          = char '~' <> pprParendLPat appPrec pat
 pprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat
-pprPat (AsPat _ name pat)       = hcat [pprPrefixOcc (unLoc name), char '@',
+pprPat (AsPat _ name _ pat)     = hcat [pprPrefixOcc (unLoc name), char '@',
                                         pprParendLPat appPrec pat]
 pprPat (ViewPat _ expr pat)     = hcat [pprLExpr expr, text " -> ", ppr pat]
 pprPat (ParPat _ _ pat _)      = parens (ppr pat)
@@ -382,7 +383,7 @@ pprConArgs :: (OutputableBndrId p,
                      Outputable (Anno (IdGhcP p)))
            => HsConPatDetails (GhcPass p) -> SDoc
 pprConArgs (PrefixCon ts pats) = fsep (pprTyArgs ts : map (pprParendLPat appPrec) pats)
-  where pprTyArgs tyargs = fsep (map (\ty -> char '@' <> ppr ty) tyargs)
+  where pprTyArgs tyargs = fsep (map ppr tyargs)
 pprConArgs (InfixCon p1 p2)    = sep [ pprParendLPat appPrec p1
                                      , pprParendLPat appPrec p2 ]
 pprConArgs (RecCon rpats)      = ppr rpats
@@ -475,7 +476,7 @@ looksLazyLPat = looksLazyPat . unLoc
 
 looksLazyPat :: Pat (GhcPass p) -> Bool
 looksLazyPat (ParPat _ _ p _)  = looksLazyLPat p
-looksLazyPat (AsPat _ _ p)     = looksLazyLPat p
+looksLazyPat (AsPat _ _ _ p)   = looksLazyLPat p
 looksLazyPat (BangPat {})  = False
 looksLazyPat (VarPat {})   = False
 looksLazyPat (WildPat {})  = False
@@ -542,7 +543,7 @@ isIrrefutableHsPat' is_strict = goL
       | otherwise          = True
     go (BangPat _ pat)     = goL pat
     go (ParPat _ _ pat _)  = goL pat
-    go (AsPat _ _ pat)     = goL pat
+    go (AsPat _ _ _ pat)   = goL pat
     go (ViewPat _ _ pat)   = goL pat
     go (SigPat _ pat _)    = goL pat
     go (TuplePat _ pats _) = all goL pats
@@ -699,7 +700,7 @@ collectEvVarsPat :: Pat GhcTc -> Bag EvVar
 collectEvVarsPat pat =
   case pat of
     LazyPat _ p      -> collectEvVarsLPat p
-    AsPat _ _ p      -> collectEvVarsLPat p
+    AsPat _ _ _ p    -> collectEvVarsLPat p
     ParPat  _ _ p _  -> collectEvVarsLPat p
     BangPat _ p      -> collectEvVarsLPat p
     ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index 63b568df4a..2e40cec8d0 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -48,7 +48,7 @@ hsPatType (VarPat _ lvar)               = idType (unLoc lvar)
 hsPatType (BangPat _ pat)               = hsLPatType pat
 hsPatType (LazyPat _ pat)               = hsLPatType pat
 hsPatType (LitPat _ lit)                = hsLitType lit
-hsPatType (AsPat _ var _)               = idType (unLoc var)
+hsPatType (AsPat _ var _ _)             = idType (unLoc var)
 hsPatType (ViewPat ty _ _)              = ty
 hsPatType (ListPat ty _)                = mkListTy ty
 hsPatType (TuplePat tys _ bx)           = mkTupleTy1 bx tys
@@ -101,7 +101,7 @@ hsExprType (HsLit _ lit) = hsLitType lit
 hsExprType (HsLam     _ (MG { mg_ext = match_group })) = matchGroupTcType match_group
 hsExprType (HsLamCase _ _ (MG { mg_ext = match_group })) = matchGroupTcType match_group
 hsExprType (HsApp _ f _) = funResultTy $ lhsExprType f
-hsExprType (HsAppType x f _) = piResultTy (lhsExprType f) x
+hsExprType (HsAppType x f _ _) = piResultTy (lhsExprType f) x
 hsExprType (OpApp v _ _ _) = dataConCantHappen v
 hsExprType (NegApp _ _ se) = syntaxExprType se
 hsExprType (HsPar _ _ e _) = lhsExprType e
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index fe9aad3475..1635019dbe 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -203,7 +203,7 @@ type instance XHsWC              GhcTc b = [Name]
 
 type instance XXHsWildCardBndrs (GhcPass _) _ = DataConCantHappen
 
-type instance XHsPS GhcPs = EpAnn EpaLocation
+type instance XHsPS GhcPs = EpAnnCO
 type instance XHsPS GhcRn = HsPSRn
 type instance XHsPS GhcTc = HsPSRn
 
@@ -252,7 +252,7 @@ mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
 mkHsWildCardBndrs x = HsWC { hswc_body = x
                            , hswc_ext  = noExtField }
 
-mkHsPatSigType :: EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
+mkHsPatSigType :: EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
 mkHsPatSigType ann x = HsPS { hsps_ext  = ann
                             , hsps_body = x }
 
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 4dd0aab928..21e32825f5 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -244,7 +244,7 @@ mkHsAppsWith
 mkHsAppsWith mkLocated = foldl' (mkHsAppWith mkLocated)
 
 mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
-mkHsAppType e t = addCLocAA t_body e (HsAppType noExtField e paren_wct)
+mkHsAppType e t = addCLocAA t_body e (HsAppType noExtField e noHsTok paren_wct)
   where
     t_body    = hswc_body t
     paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
@@ -1188,7 +1188,7 @@ collect_pat flag pat bndrs = case pat of
   WildPat _             -> bndrs
   LazyPat _ pat         -> collect_lpat flag pat bndrs
   BangPat _ pat         -> collect_lpat flag pat bndrs
-  AsPat _ a pat         -> unXRec @p a : collect_lpat flag pat bndrs
+  AsPat _ a _ pat       -> unXRec @p a : collect_lpat flag pat bndrs
   ViewPat _ _ pat       -> collect_lpat flag pat bndrs
   ParPat _ _ pat _      -> collect_lpat flag pat bndrs
   ListPat _ pats        -> foldr (collect_lpat flag) bndrs pats
@@ -1584,7 +1584,7 @@ lPatImplicits = hs_lpat
 
     hs_pat (LazyPat _ pat)      = hs_lpat pat
     hs_pat (BangPat _ pat)      = hs_lpat pat
-    hs_pat (AsPat _ _ pat)      = hs_lpat pat
+    hs_pat (AsPat _ _ _ pat)    = hs_lpat pat
     hs_pat (ViewPat _ _ pat)    = hs_lpat pat
     hs_pat (ParPat _ _ pat _)   = hs_lpat pat
     hs_pat (ListPat _ pats)     = hs_lpats pats
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 834be5907d..655a9cc37a 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -841,7 +841,7 @@ dsHsWrapped orig_hs_expr
        = go wrap hs_e
     go wrap1 (XExpr (WrapExpr (HsWrap wrap2 hs_e)))
        = go (wrap1 <.> wrap2) hs_e
-    go wrap (HsAppType ty (L _ hs_e) _)
+    go wrap (HsAppType ty (L _ hs_e) _ _)
        = go (wrap <.> WpTyApp ty) hs_e
 
     go wrap (HsVar _ (L _ var))
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 1780c30755..0cc5907c2b 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -430,7 +430,7 @@ tidy1 v _ (VarPat _ (L _ var))
 
         -- case v of { x@p -> mr[] }
         -- = case v of { p -> let x=v in mr[] }
-tidy1 v o (AsPat _ (L _ var) pat)
+tidy1 v o (AsPat _ (L _ var) _ pat)
   = do  { (wrap, pat') <- tidy1 v o (unLoc pat)
         ; return (wrapBind var v . wrap, pat') }
 
@@ -517,8 +517,8 @@ tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p
 
 -- Push the bang-pattern inwards, in the hope that
 -- it may disappear next time
-tidy_bang_pat v o l (AsPat x v' p)
-  = tidy1 v o (AsPat x v' (L l (BangPat noExtField p)))
+tidy_bang_pat v o l (AsPat x v' at p)
+  = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p)))
 tidy_bang_pat v o l (XPat (CoPat w p t))
   = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t)
 
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 38d3fd54d7..c0d0d9f0e9 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -119,7 +119,7 @@ desugarPat x pat = case pat of
 
   -- (x@pat)   ==>   Desugar pat with x as match var and handle impedance
   --                 mismatch with incoming match var
-  AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p
+  AsPat _ (L _ y) _ p -> (mkPmLetVar y x ++) <$> desugarLPat y p
 
   SigPat _ p _ty -> desugarLPat x p
 
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 5f08571bf2..015ecb56f6 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1511,7 +1511,8 @@ repE (HsLamCase _ LamCases (MG { mg_alts = (L _ ms) }))
                         ; core_ms <- coreListM matchTyConName ms'
                         ; repLamCases core_ms }
 repE (HsApp _ x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
-repE (HsAppType _ e t) = do { a <- repLE e
+repE (HsAppType _ e _ t)
+                       = do { a <- repLE e
                             ; s <- repLTy (hswc_body t)
                             ; repAppType a s }
 
@@ -2055,7 +2056,7 @@ repP (LitPat _ l)       = do { l2 <- repLiteral l; repPlit l2 }
 repP (VarPat _ x)       = do { x' <- lookupBinder (unLoc x); repPvar x' }
 repP (LazyPat _ p)      = do { p1 <- repLP p; repPtilde p1 }
 repP (BangPat _ p)      = do { p1 <- repLP p; repPbang p1 }
-repP (AsPat _ x p)      = do { x' <- lookupNBinder x; p1 <- repLP p
+repP (AsPat _ x _ p)    = do { x' <- lookupNBinder x; p1 <- repLP p
                              ; repPaspat x' p1 }
 repP (ParPat _ _ p _)   = repLP p
 repP (ListPat _ ps)     = do { qs <- repLPs ps; repPlist qs }
@@ -2068,7 +2069,8 @@ repP (ConPat NoExtField dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of
          PrefixCon tyargs ps -> do { qs <- repLPs ps
-                                   ; ts <- repListM typeTyConName (repTy . unLoc . hsps_body) tyargs
+                                   ; let unwrapTyArg (HsConPatTyArg _ t) = unLoc (hsps_body t)
+                                   ; ts <- repListM typeTyConName (repTy . unwrapTyArg) tyargs
                                    ; repPcon con_str ts qs }
          RecCon rec   -> do { fps <- repListM fieldPatTyConName rep_fld (rec_flds rec)
                             ; repPrec con_str fps }
diff --git a/compiler/GHC/HsToCore/Ticks.hs b/compiler/GHC/HsToCore/Ticks.hs
index 860bf597bb..e2925de058 100644
--- a/compiler/GHC/HsToCore/Ticks.hs
+++ b/compiler/GHC/HsToCore/Ticks.hs
@@ -475,9 +475,9 @@ addTickHsExpr (HsLamCase x lc_variant mgs) = liftM (HsLamCase x lc_variant)
                                                    (addTickMatchGroup True mgs)
 addTickHsExpr (HsApp x e1 e2)          = liftM2 (HsApp x) (addTickLHsExprNever e1)
                                                           (addTickLHsExpr      e2)
-addTickHsExpr (HsAppType x e ty)       = liftM3 HsAppType (return x)
-                                                          (addTickLHsExprNever e)
-                                                          (return ty)
+addTickHsExpr (HsAppType x e at ty) = do
+        e' <- addTickLHsExprNever e
+        return (HsAppType x e' at ty)
 addTickHsExpr (OpApp fix e1 e2 e3) =
         liftM4 OpApp
                 (return fix)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index b6725331a1..e3c6ef1333 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -142,7 +142,7 @@ selectMatchVar _w (VarPat _ var)    = return (localiseId (unLoc var))
                                   -- multiplicity stored within the variable
                                   -- itself. It's easier to pull it from the
                                   -- variable, so we ignore the multiplicity.
-selectMatchVar _w (AsPat _ var _) = assert (isManyDataConTy _w ) (return (unLoc var))
+selectMatchVar _w (AsPat _ var _ _) = assert (isManyDataConTy _w ) (return (unLoc var))
 selectMatchVar w other_pat        = newSysLocalDs w (hsPatType other_pat)
 
 {- Note [Localise pattern binders]
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index e92327f6d7..9547296fe0 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -496,15 +496,15 @@ patScopes rsp useScope patScope xs =
   map (\(RS sc a) -> PS rsp useScope sc a) $
     listScopes patScope xs
 
--- | 'listScopes' specialised to 'HsPatSigType'
-tScopes
+-- | 'listScopes' specialised to 'HsConPatTyArg'
+taScopes
   :: Scope
   -> Scope
-  -> [HsPatSigType (GhcPass a)]
+  -> [HsConPatTyArg (GhcPass a)]
   -> [TScoped (HsPatSigType (GhcPass a))]
-tScopes scope rhsScope xs =
+taScopes scope rhsScope xs =
   map (\(RS sc a) -> TS (ResolvedScopes [scope, sc]) (unLoc a)) $
-    listScopes rhsScope (map (\hsps -> L (getLoc $ hsps_body hsps) hsps) xs)
+    listScopes rhsScope (map (\(HsConPatTyArg _ hsps) -> L (getLoc $ hsps_body hsps) hsps) xs)
   -- We make the HsPatSigType into a Located one by using the location of the underlying LHsType.
   -- We then strip off the redundant location information afterward, and take the union of the given scope and those to the right when forming the TS.
 
@@ -964,7 +964,7 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
       LazyPat _ p ->
         [ toHie $ PS rsp scope pscope p
         ]
-      AsPat _ lname pat ->
+      AsPat _ lname _ pat ->
         [ toHie $ C (PatternBind scope
                                  (combineScopes (mkLScopeA pat) pscope)
                                  rsp)
@@ -1039,9 +1039,11 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
               ]
             ExpansionPat _ p -> [ toHie $ PS rsp scope pscope (L ospan p) ]
     where
-      contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsPatSigType GhcRn) a (HsRecFields (GhcPass p) a)
+      contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a)
                  -> HsConDetails (TScoped (HsPatSigType GhcRn)) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
-      contextify (PrefixCon tyargs args) = PrefixCon (tScopes scope argscope tyargs) (patScopes rsp scope pscope args)
+      contextify (PrefixCon tyargs args) =
+        PrefixCon (taScopes scope argscope tyargs)
+                  (patScopes rsp scope pscope args)
         where argscope = foldr combineScopes NoScope $ map mkLScopeA args
       contextify (InfixCon a b) = InfixCon a' b'
         where [a', b'] = patScopes rsp scope pscope [a,b]
@@ -1105,7 +1107,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
         [ toHie a
         , toHie b
         ]
-      HsAppType _ expr sig ->
+      HsAppType _ expr _ sig ->
         [ toHie expr
         , toHie $ TS (ResolvedScopes []) sig
         ]
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index a238dac301..9d45b0c7c8 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2769,7 +2769,7 @@ fexp    :: { ECP }
         -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
         | fexp PREFIX_AT atype       { ECP $
                                         unECP $1 >>= \ $1 ->
-                                        mkHsAppTypePV (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 (getLoc $2) $3 }
+                                        mkHsAppTypePV (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 (hsTok $2) $3 }
 
         | 'static' aexp              {% runPV (unECP $2) >>= \ $2 ->
                                         fmap ecpFromExp $
@@ -2782,7 +2782,7 @@ aexp    :: { ECP }
         : qvar TIGHT_INFIX_AT aexp
                                 { ECP $
                                    unECP $3 >>= \ $3 ->
-                                     mkHsAsPatPV (comb2 (reLocN $1) (reLoc $>)) $1 $3 [mj AnnAt $2] }
+                                     mkHsAsPatPV (comb2 (reLocN $1) (reLoc $>)) $1 (hsTok $2) $3 }
 
 
         -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index d3119fb920..2f00422f8b 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -202,7 +202,6 @@ https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
 data AnnKeywordId
     = AnnAnyclass
     | AnnAs
-    | AnnAt
     | AnnBang  -- ^ '!'
     | AnnBackquote -- ^ '`'
     | AnnBy
@@ -414,6 +413,9 @@ data EpaLocation = EpaSpan !RealSrcSpan
 data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
                deriving (Data,Eq)
 
+instance Outputable a => Outputable (GenLocated TokenLocation a) where
+  ppr (L _ x) = ppr x
+
 -- | Spacing between output items when exact printing.  It captures
 -- the spacing from the current print position on the page to the
 -- position required for the thing about to be printed.  This is
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index d108673e9c..efe708bfee 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -445,7 +445,7 @@ instance Diagnostic PsMessage where
                  PEIP_NegApp -> text "-" <> ppr s
                  PEIP_TypeArgs peipd_tyargs
                    | not (null peipd_tyargs) -> ppr s <+> vcat [
-                               hsep [text "@" <> ppr t | t <- peipd_tyargs]
+                               hsep (map ppr peipd_tyargs)
                              , text "Type applications in patterns are only allowed on data constructors."
                              ]
                    | otherwise -> ppr s
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index 7f40c73635..18b6d60807 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -504,7 +504,7 @@ data ParseContext
 data PsErrInPatDetails
   = PEIP_NegApp
     -- ^ Negative application pattern?
-  | PEIP_TypeArgs [HsPatSigType GhcPs]
+  | PEIP_TypeArgs [HsConPatTyArg GhcPs]
     -- ^ The list of type arguments for the pattern
   | PEIP_RecPattern [LPat GhcPs]    -- ^ The pattern arguments
                     !PatIsRecursive -- ^ Is the parsed pattern recursive?
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 902e23e08c..94b689fe71 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1158,7 +1158,7 @@ checkPattern_details extraDetails pp = runPV_details extraDetails (pp >>= checkL
 checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
 checkLPat e@(L l _) = checkPat l e [] []
 
-checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsPatSigType GhcPs] -> [LPat GhcPs]
+checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
          -> PV (LPat GhcPs)
 checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
   | isRdrDataCon c = return . L loc $ ConPat
@@ -1171,8 +1171,8 @@ checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
   | (not (null args) && patIsRec c) = do
       ctx <- askParseContext
       patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx
-checkPat loc (L _ (PatBuilderAppType f t)) tyargs args =
-  checkPat loc f (t : tyargs) args
+checkPat loc (L _ (PatBuilderAppType f at t)) tyargs args =
+  checkPat loc f (HsConPatTyArg at t : tyargs) args
 checkPat loc (L _ (PatBuilderApp f e)) [] args = do
   p <- checkLPat e
   checkPat loc f [] (p : args)
@@ -1530,7 +1530,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
   -- | Disambiguate "f x" (function application)
   mkHsAppPV :: SrcSpanAnnA -> LocatedA b -> LocatedA (FunArg b) -> PV (LocatedA b)
   -- | Disambiguate "f @t" (visible type application)
-  mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
+  mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate "if ... then ... else ..."
   mkHsIfPV :: SrcSpan
          -> LHsExpr GhcPs
@@ -1583,7 +1583,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
     :: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
   -- | Disambiguate "a@b" (as-pattern)
   mkHsAsPatPV
-    :: SrcSpan -> LocatedN RdrName -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
+    :: SrcSpan -> LocatedN RdrName -> LHsToken "@" GhcPs -> LocatedA b -> PV (LocatedA b)
   -- | Disambiguate "~a" (lazy pattern)
   mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
   -- | Disambiguate "!a" (bang pattern)
@@ -1703,7 +1703,7 @@ instance DisambECP (HsCmd GhcPs) where
     in pp_op <> ppr c
   mkHsViewPatPV l a b _ = cmdFail l $
     ppr a <+> text "->" <+> ppr b
-  mkHsAsPatPV l v c _ = cmdFail l $
+  mkHsAsPatPV l v _ c = cmdFail l $
     pprPrefixOcc (unLoc v) <> text "@" <> ppr c
   mkHsLazyPatPV l c _ = cmdFail l $
     text "~" <> ppr c
@@ -1757,9 +1757,9 @@ instance DisambECP (HsExpr GhcPs) where
     checkExpBlockArguments e1
     checkExpBlockArguments e2
     return $ L l (HsApp (comment (realSrcSpan $ locA l) cs) e1 e2)
-  mkHsAppTypePV l e la t = do
+  mkHsAppTypePV l e at t = do
     checkExpBlockArguments e
-    return $ L l (HsAppType la e (mkHsWildCardBndrs t))
+    return $ L l (HsAppType noExtField e at (mkHsWildCardBndrs t))
   mkHsIfPV l c semi1 a semi2 b anns = do
     checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b
     cs <- getCommentsFor l
@@ -1799,7 +1799,7 @@ instance DisambECP (HsExpr GhcPs) where
     return $ L l (SectionR (comment (realSrcSpan l) cs) op e)
   mkHsViewPatPV l a b _ = addError (mkPlainErrorMsgEnvelope l $ PsErrViewPatInExpr a b)
                           >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn))
-  mkHsAsPatPV l v e   _ = addError (mkPlainErrorMsgEnvelope l $ PsErrTypeAppWithoutSpace (unLoc v) e)
+  mkHsAsPatPV l v _ e   = addError (mkPlainErrorMsgEnvelope l $ PsErrTypeAppWithoutSpace (unLoc v) e)
                           >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn))
   mkHsLazyPatPV l e   _ = addError (mkPlainErrorMsgEnvelope l $ PsErrLazyPatWithoutSpace e)
                           >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn))
@@ -1839,10 +1839,10 @@ instance DisambECP (PatBuilder GhcPs) where
   type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
   superFunArg m = m
   mkHsAppPV l p1 p2      = return $ L l (PatBuilderApp p1 p2)
-  mkHsAppTypePV l p la t = do
+  mkHsAppTypePV l p at t = do
     cs <- getCommentsFor (locA l)
-    let anns = EpAnn (spanAsAnchor (combineSrcSpans la (getLocA t))) (EpaSpan (realSrcSpan la)) cs
-    return $ L l (PatBuilderAppType p (mkHsPatSigType anns t))
+    let anns = EpAnn (spanAsAnchor (getLocA t)) NoEpAnns cs
+    return $ L l (PatBuilderAppType p at (mkHsPatSigType anns t))
   mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat
   mkHsDoPV l _ _ _       = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
   mkHsParPV l lpar p rpar   = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)
@@ -1881,10 +1881,10 @@ instance DisambECP (PatBuilder GhcPs) where
     p <- checkLPat b
     cs <- getCommentsFor l
     return $ L (noAnnSrcSpan l) (PatBuilderPat (ViewPat (EpAnn (spanAsAnchor l) anns cs) a p))
-  mkHsAsPatPV l v e a = do
+  mkHsAsPatPV l v at e = do
     p <- checkLPat e
     cs <- getCommentsFor l
-    return $ L (noAnnSrcSpan l) (PatBuilderPat (AsPat (EpAnn (spanAsAnchor l) a cs) v p))
+    return $ L (noAnnSrcSpan l) (PatBuilderPat (AsPat (EpAnn (spanAsAnchor l) NoEpAnns cs) v at p))
   mkHsLazyPatPV l e a = do
     p <- checkLPat e
     cs <- getCommentsFor l
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index 36abbe5125..6ea37dda6d 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -55,7 +55,7 @@ data PatBuilder p
   = PatBuilderPat (Pat p)
   | PatBuilderPar (LHsToken "(" p) (LocatedA (PatBuilder p)) (LHsToken ")" p)
   | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
-  | PatBuilderAppType (LocatedA (PatBuilder p)) (HsPatSigType GhcPs)
+  | PatBuilderAppType (LocatedA (PatBuilder p)) (LHsToken "@" p) (HsPatSigType GhcPs)
   | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
                     (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
   | PatBuilderVar (LocatedN RdrName)
@@ -65,7 +65,7 @@ instance Outputable (PatBuilder GhcPs) where
   ppr (PatBuilderPat p) = ppr p
   ppr (PatBuilderPar _ (L _ p) _) = parens (ppr p)
   ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
-  ppr (PatBuilderAppType (L _ p) t) = ppr p <+> text "@" <> ppr t
+  ppr (PatBuilderAppType (L _ p) _ t) = ppr p <+> text "@" <> ppr t
   ppr (PatBuilderOpApp (L _ p1) op (L _ p2) _) = ppr p1 <+> ppr op <+> ppr p2
   ppr (PatBuilderVar v) = ppr v
   ppr (PatBuilderOverLit l) = ppr l
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 70233c0854..8503dc400c 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -283,7 +283,7 @@ rnExpr (HsUnboundVar _ v)
 rnExpr (HsOverLabel _ v)
   = do { (from_label, fvs) <- lookupSyntaxName fromLabelClassOpName
        ; return ( mkExpandedExpr (HsOverLabel noAnn v) $
-                  HsAppType noExtField (genLHsVar from_label) hs_ty_arg
+                  HsAppType noExtField (genLHsVar from_label) noHsTok hs_ty_arg
                 , fvs ) }
   where
     hs_ty_arg = mkEmptyWildCardBndrs $ wrapGenSpan $
@@ -314,12 +314,12 @@ rnExpr (HsApp x fun arg)
        ; (arg',fvArg) <- rnLExpr arg
        ; return (HsApp x fun' arg', fvFun `plusFV` fvArg) }
 
-rnExpr (HsAppType _ fun arg)
+rnExpr (HsAppType _ fun at arg)
   = do { type_app <- xoptM LangExt.TypeApplications
        ; unless type_app $ addErr $ typeAppErr "type" $ hswc_body arg
        ; (fun',fvFun) <- rnLExpr fun
        ; (arg',fvArg) <- rnHsWcType HsTypeCtx arg
-       ; return (HsAppType NoExtField fun' arg', fvFun `plusFV` fvArg) }
+       ; return (HsAppType NoExtField fun' at arg', fvFun `plusFV` fvArg) }
 
 rnExpr (OpApp _ e1 op e2)
   = do  { (e1', fv_e1) <- rnLExpr e1
@@ -2250,7 +2250,7 @@ isStrictPattern (L loc pat) =
     WildPat{}       -> False
     VarPat{}        -> False
     LazyPat{}       -> False
-    AsPat _ _ p     -> isStrictPattern p
+    AsPat _ _ _ p   -> isStrictPattern p
     ParPat _ _ p _  -> isStrictPattern p
     ViewPat _ _ p   -> isStrictPattern p
     SigPat _ p _    -> isStrictPattern p
@@ -2423,7 +2423,7 @@ isReturnApp monad_names (L loc e) mb_pure = case e of
   _otherwise -> Nothing
  where
   is_var f (L _ (HsPar _ _ e _)) = is_var f e
-  is_var f (L _ (HsAppType _ e _)) = is_var f e
+  is_var f (L _ (HsAppType _ e _ _)) = is_var f e
   is_var f (L _ (HsVar _ (L _ r))) = f r
        -- TODO: I don't know how to get this right for rebindable syntax
   is_var _ _ = False
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 1755b6a1ef..be6dd17006 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1325,7 +1325,7 @@ validRuleLhs foralls lhs
     check (OpApp _ e1 op e2)              = checkl op `mplus` checkl_e e1
                                                       `mplus` checkl_e e2
     check (HsApp _ e1 e2)                 = checkl e1 `mplus` checkl_e e2
-    check (HsAppType _ e _)               = checkl e
+    check (HsAppType _ e _ _)             = checkl e
     check (HsVar _ lv)
       | (unLoc lv) `notElem` foralls      = Nothing
     check other                           = Just other  -- Failure
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index b64d1141e7..7886cebdf3 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -77,7 +77,7 @@ import GHC.Core.DataCon
 import GHC.Driver.Session ( getDynFlags, xopt_DuplicateRecordFields )
 import qualified GHC.LanguageExtensions as LangExt
 
-import Control.Monad       ( when, ap, guard, forM, unless )
+import Control.Monad       ( when, ap, guard, unless )
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Ratio
@@ -551,10 +551,10 @@ rnPatAndThen mk (NPlusKPat _ rdr (L l lit) _ _ _ )
                                       (L l lit') lit' ge minus) }
                 -- The Report says that n+k patterns must be in Integral
 
-rnPatAndThen mk (AsPat _ rdr pat)
+rnPatAndThen mk (AsPat _ rdr at pat)
   = do { new_name <- newPatLName mk rdr
        ; pat' <- rnLPatAndThen mk pat
-       ; return (AsPat noExtField new_name pat') }
+       ; return (AsPat noExtField new_name at pat') }
 
 rnPatAndThen mk p@(ViewPat _ expr pat)
   = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
@@ -626,8 +626,7 @@ rnConPatAndThen :: NameMaker
 rnConPatAndThen mk con (PrefixCon tyargs pats)
   = do  { con' <- lookupConCps con
         ; liftCps check_lang_exts
-        ; tyargs' <- forM tyargs $ \t ->
-            liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t
+        ; tyargs' <- mapM rnConPatTyArg tyargs
         ; pats' <- rnLPatsAndThen mk pats
         ; return $ ConPat
             { pat_con_ext = noExtField
@@ -642,12 +641,15 @@ rnConPatAndThen mk con (PrefixCon tyargs pats)
       type_app      <- xoptM LangExt.TypeApplications
       unless (scoped_tyvars && type_app) $
         case listToMaybe tyargs of
-          Nothing    -> pure ()
+          Nothing -> pure ()
           Just tyarg -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $
             hang (text "Illegal visible type application in a pattern:"
-                    <+> quotes (char '@' <> ppr tyarg))
+                    <+> quotes (ppr tyarg))
                2 (text "Both ScopedTypeVariables and TypeApplications are"
                     <+> text "required to use this feature")
+    rnConPatTyArg (HsConPatTyArg at t) = do
+      t' <- liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t
+      return (HsConPatTyArg at t')
 
 rnConPatAndThen mk con (InfixCon pat1 pat2)
   = do  { con' <- lookupConCps con
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index bb6cedf395..539b36ddc2 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -674,7 +674,7 @@ genHsVar :: Name -> HsExpr GhcRn
 genHsVar nm = HsVar noExtField $ wrapGenSpan nm
 
 genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
-genAppType expr = HsAppType noExtField (wrapGenSpan expr) . mkEmptyWildCardBndrs . wrapGenSpan
+genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty))
 
 genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn)
 genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit)
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index ad30052579..a8536971bd 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -852,7 +852,7 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
 
     enum_index
       = mkSimpleGeneratedFunBind loc unsafeIndex_RDR
-                [noLocA (AsPat noAnn (noLocA c_RDR)
+                [noLocA (AsPat noAnn (noLocA c_RDR) noHsTok
                            (nlTuplePat [a_Pat, nlWildPat] Boxed)),
                                 d_Pat] (
            untag_Expr [(a_RDR, ah_RDR)] (
@@ -2105,7 +2105,7 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty
         rep_cvs'    = scopedSort rep_cvs
 
 nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlHsAppType e s = noLocA (HsAppType noSrcSpan e hs_ty)
+nlHsAppType e s = noLocA (HsAppType noExtField e noHsTok hs_ty)
   where
     hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec $ nlHsCoreTy s
 
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index ecb79b8248..02cce2e38a 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -427,9 +427,9 @@ tcValArgs do_ql args
   = mapM tc_arg args
   where
     tc_arg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
-    tc_arg (EPrag l p)           = return (EPrag l (tcExprPrag p))
-    tc_arg (EWrap w)             = return (EWrap w)
-    tc_arg (ETypeArg l hs_ty ty) = return (ETypeArg l hs_ty ty)
+    tc_arg (EPrag l p) = return (EPrag l (tcExprPrag p))
+    tc_arg (EWrap w)   = return (EWrap w)
+    tc_arg (ETypeArg l at hs_ty ty) = return (ETypeArg l at hs_ty ty)
 
     tc_arg eva@(EValArg { eva_arg = arg, eva_arg_ty = Scaled mult arg_ty
                         , eva_ctxt = ctxt })
@@ -594,14 +594,14 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
       = go1 delta (EPrag sp prag : acc) so_far fun_ty args
 
     -- Rule ITYARG from Fig 4 of the QL paper
-    go1 delta acc so_far fun_ty ( ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty }
+    go1 delta acc so_far fun_ty ( ETypeArg { eva_ctxt = ctxt, eva_at = at, eva_hs_ty = hs_ty }
                                 : rest_args )
       | fun_is_out_of_scope   -- See Note [VTA for out-of-scope functions]
       = go delta acc so_far fun_ty rest_args
 
       | otherwise
       = do { (ty_arg, inst_ty) <- tcVTA fun_ty hs_ty
-           ; let arg' = ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty, eva_ty = ty_arg }
+           ; let arg' = ETypeArg { eva_ctxt = ctxt, eva_at = at, eva_hs_ty = hs_ty, eva_ty = ty_arg }
            ; go delta (arg' : acc) so_far inst_ty rest_args }
 
     -- Rule IVAR from Fig 4 of the QL paper:
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index af4575c490..a56b9c833e 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -172,6 +172,7 @@ data HsExprArg (p :: TcPass)
              , eva_arg_ty :: !(XEVAType p) }
 
   | ETypeArg { eva_ctxt  :: AppCtxt
+             , eva_at    :: !(LHsToken "@" GhcRn)
              , eva_hs_ty :: LHsWcType GhcRn  -- The type arg
              , eva_ty    :: !(XETAType p) }  -- Kind-checked type arg
 
@@ -263,9 +264,11 @@ mkEValArg :: AppCtxt -> LHsExpr GhcRn -> HsExprArg 'TcpRn
 mkEValArg ctxt e = EValArg { eva_arg = ValArg e, eva_ctxt = ctxt
                            , eva_arg_ty = noExtField }
 
-mkETypeArg :: AppCtxt -> LHsWcType GhcRn -> HsExprArg 'TcpRn
-mkETypeArg ctxt hs_ty = ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty
-                                 , eva_ty = noExtField }
+mkETypeArg :: AppCtxt -> LHsToken "@" GhcRn -> LHsWcType GhcRn -> HsExprArg 'TcpRn
+mkETypeArg ctxt at hs_ty =
+  ETypeArg { eva_ctxt = ctxt
+           , eva_at = at, eva_hs_ty = hs_ty
+           , eva_ty = noExtField }
 
 addArgWrap :: HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
 addArgWrap wrap args
@@ -284,7 +287,7 @@ splitHsApps e = go e (top_ctxt 0 e) []
     -- See Note [AppCtxt]
     top_ctxt n (HsPar _ _ fun _)           = top_lctxt n fun
     top_ctxt n (HsPragE _ _ fun)           = top_lctxt n fun
-    top_ctxt n (HsAppType _ fun _)         = top_lctxt (n+1) fun
+    top_ctxt n (HsAppType _ fun _ _)         = top_lctxt (n+1) fun
     top_ctxt n (HsApp _ fun _)             = top_lctxt (n+1) fun
     top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig      n noSrcSpan
     top_ctxt n other_fun                   = VACall other_fun n noSrcSpan
@@ -294,10 +297,10 @@ splitHsApps e = go e (top_ctxt 0 e) []
     go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn]
        -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
     -- Modify the AppCtxt as we walk inwards, so it describes the next argument
-    go (HsPar _ _ (L l fun) _)    ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt)   : args)
-    go (HsPragE _ p (L l fun))    ctxt args = go fun (set l ctxt) (EPrag      ctxt p   : args)
-    go (HsAppType _ (L l fun) ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt ty  : args)
-    go (HsApp _ (L l fun) arg)    ctxt args = go fun (dec l ctxt) (mkEValArg  ctxt arg : args)
+    go (HsPar _ _ (L l fun) _)       ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt)     : args)
+    go (HsPragE _ p (L l fun))       ctxt args = go fun (set l ctxt) (EPrag      ctxt p     : args)
+    go (HsAppType _ (L l fun) at ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt at ty : args)
+    go (HsApp _ (L l fun) arg)       ctxt args = go fun (dec l ctxt) (mkEValArg  ctxt arg   : args)
 
     -- See Note [Looking through HsExpanded]
     go (XExpr (HsExpanded orig fun)) ctxt args
@@ -356,8 +359,8 @@ rebuild_hs_apps fun ctxt (arg : args)
   = case arg of
       EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt' }
         -> rebuild_hs_apps (HsApp noAnn lfun arg) ctxt' args
-      ETypeArg { eva_hs_ty = hs_ty, eva_ty = ty, eva_ctxt = ctxt' }
-        -> rebuild_hs_apps (HsAppType ty lfun hs_ty) ctxt' args
+      ETypeArg { eva_hs_ty = hs_ty, eva_at = at, eva_ty = ty, eva_ctxt = ctxt' }
+        -> rebuild_hs_apps (HsAppType ty lfun at hs_ty) ctxt' args
       EPrag ctxt' p
         -> rebuild_hs_apps (HsPragE noExtField p lfun) ctxt' args
       EWrap (EPar ctxt')
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 9a0caedd11..83bb70e35f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -403,7 +403,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
         ; pat_ty <- expTypeToType (scaledThing pat_ty)
         ; return (mkHsWrapPat mult_wrap (WildPat pat_ty) pat_ty, res) }
 
-  AsPat x (L nm_loc name) pat -> do
+  AsPat x (L nm_loc name) at pat -> do
         { mult_wrap <- checkManyPattern pat_ty
             -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; (wrap, bndr_id) <- setSrcSpanA nm_loc (tcPatBndr penv name pat_ty)
@@ -418,7 +418,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
             --
             -- If you fix it, don't forget the bindInstsOfPatIds!
         ; pat_ty <- readExpType (scaledThing pat_ty)
-        ; return (mkHsWrapPat (wrap <.> mult_wrap) (AsPat x (L nm_loc bndr_id) pat') pat_ty, res) }
+        ; return (mkHsWrapPat (wrap <.> mult_wrap) (AsPat x (L nm_loc bndr_id) at pat') pat_ty, res) }
 
   ViewPat _ expr pat -> do
         { mult_wrap <- checkManyPattern pat_ty
@@ -1320,8 +1320,8 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
           -- dataConFieldLabels will be empty (and each field in the pattern
           -- will generate an error below).
 
-tcConTyArg :: Checker (HsPatSigType GhcRn) TcType
-tcConTyArg penv rn_ty thing_inside
+tcConTyArg :: Checker (HsConPatTyArg GhcRn) TcType
+tcConTyArg penv (HsConPatTyArg _ rn_ty) thing_inside
   = do { (sig_wcs, sig_ibs, arg_ty) <- tcHsPatSigType TypeAppCtxt HM_TyAppPat rn_ty AnyKind
                -- AnyKind is a bit suspect: it really should be the kind gotten
                -- from instantiating the constructor type. But this would be
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 90951272a2..160d8ceae9 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -2141,8 +2141,8 @@ mkDefMethBind dfun_id clas sel_id dm_name
     (_, _, _, inst_tys) = tcSplitDFunTy (idType dfun_id)
 
     mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn
-    mk_vta fun ty = noLocA (HsAppType noExtField fun (mkEmptyWildCardBndrs $ nlHsParTy
-                                                $ noLocA $ XHsType ty))
+    mk_vta fun ty = noLocA (HsAppType noExtField fun noHsTok
+        (mkEmptyWildCardBndrs $ nlHsParTy $ noLocA $ XHsType ty))
        -- NB: use visible type application
        -- See Note [Default methods in instances]
 
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index eb31cec392..8da94d2ec0 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -1271,7 +1271,7 @@ tcCollectEx pat = go pat
 
     go1 :: Pat GhcTc -> ([TyVar], [EvVar])
     go1 (LazyPat _ p)      = go p
-    go1 (AsPat _ _ p)      = go p
+    go1 (AsPat _ _ _ p)    = go p
     go1 (ParPat _ _ p _)   = go p
     go1 (BangPat _ p)      = go p
     go1 (ListPat _ ps)     = mergeMany . map go $ ps
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 137ee8f02e..1b7d4de3fd 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -684,7 +684,7 @@ exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"
 exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches
 exprCtOrigin (HsLamCase _ _ ms)   = matchesCtOrigin ms
 exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1
-exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1
+exprCtOrigin (HsAppType _ e1 _ _) = lexprCtOrigin e1
 exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
 exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
 exprCtOrigin (HsPar _ _ e _)      = lexprCtOrigin e
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 2180a113da..e8b5f8252e 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -771,10 +771,10 @@ zonkExpr env (HsApp x e1 e2)
        new_e2 <- zonkLExpr env e2
        return (HsApp x new_e1 new_e2)
 
-zonkExpr env (HsAppType ty e t)
+zonkExpr env (HsAppType ty e at t)
   = do new_e <- zonkLExpr env e
        new_ty <- zonkTcTypeToTypeX env ty
-       return (HsAppType new_ty new_e t)
+       return (HsAppType new_ty new_e at t)
        -- NB: the type is an HsType; can't zonk that!
 
 zonkExpr env (HsTypedBracket hsb_tc body)
@@ -1317,10 +1317,10 @@ zonk_pat env (BangPat x pat)
   = do  { (env', pat') <- zonkPat env pat
         ; return (env',  BangPat x pat') }
 
-zonk_pat env (AsPat x (L loc v) pat)
+zonk_pat env (AsPat x (L loc v) at pat)
   = do  { v' <- zonkIdBndr env v
         ; (env', pat') <- zonkPat (extendIdZonkEnv env v') pat
-        ; return (env', AsPat x (L loc v') pat') }
+        ; return (env', AsPat x (L loc v') at pat') }
 
 zonk_pat env (ViewPat ty expr pat)
   = do  { expr' <- zonkLExpr env expr
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 401f8c8a1d..441c84bad7 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1002,7 +1002,7 @@ cvtl e = wrapLA (cvt e)
     cvt (AppTypeE e t) = do { e' <- cvtl e
                             ; t' <- cvtType t
                             ; let tp = parenthesizeHsType appPrec t'
-                            ; return $ HsAppType noSrcSpan e'
+                            ; return $ HsAppType noExtField e' noHsTok
                                      $ mkHsWildCardBndrs tp }
     cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
                                -- own expression to avoid pretty-printing
@@ -1387,10 +1387,11 @@ cvtp (ConP s ts ps)    = do { s' <- cNameN s
                             ; ps' <- cvtPats ps
                             ; ts' <- mapM cvtType ts
                             ; let pps = map (parenthesizePat appPrec) ps'
+                                  pts = map (\t -> HsConPatTyArg noHsTok (mkHsPatSigType noAnn t)) ts'
                             ; return $ ConPat
                                 { pat_con_ext = noAnn
                                 , pat_con = s'
-                                , pat_args = PrefixCon (map (mkHsPatSigType noAnn) ts') pps
+                                , pat_args = PrefixCon pts pps
                                 }
                             }
 cvtp (InfixP p1 s p2)  = do { s' <- cNameN s; p1' <- cvtPat p1; p2' <- cvtPat p2
@@ -1412,7 +1413,7 @@ cvtp (ParensP p)       = do { p' <- cvtPat p;
 cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat noAnn p' }
 cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat noAnn p' }
 cvtp (TH.AsP s p)      = do { s' <- vNameN s; p' <- cvtPat p
-                            ; return $ AsPat noAnn s' p' }
+                            ; return $ AsPat noAnn s' noHsTok p' }
 cvtp TH.WildP          = return $ WildPat noExtField
 cvtp (RecP c fs)       = do { c' <- cNameN c; fs' <- mapM cvtPatFld fs
                             ; return $ ConPat
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 051edda97f..8d2a365a8c 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -371,6 +371,7 @@ data HsExpr p
 
   | HsAppType (XAppTypeE p) -- After typechecking: the type argument
               (LHsExpr p)
+             !(LHsToken "@" p)
               (LHsWcType (NoGhcTc p))  -- ^ Visible type application
        --
        -- Explicit type argument; e.g  f @Int x y
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 5cffd96690..47b693a9bd 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -23,7 +23,7 @@ module Language.Haskell.Syntax.Extension where
 
 import GHC.Prelude
 
-import GHC.TypeLits (Symbol, KnownSymbol)
+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
 import Data.Data hiding ( Fixity )
 import Data.Kind (Type)
 import GHC.Utils.Outputable
@@ -730,3 +730,10 @@ type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
 data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
 
 deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
+
+instance KnownSymbol tok => Outputable (HsToken tok) where
+   ppr _ = text (symbolVal (Proxy :: Proxy tok))
+
+instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where
+   ppr HsNormalTok  = text (symbolVal (Proxy :: Proxy tok))
+   ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok))
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 0e9f11dc1b..12ef7ae98a 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -23,6 +23,7 @@ module Language.Haskell.Syntax.Pat (
         ConLikeP,
 
         HsConPatDetails, hsConPatArgs,
+        HsConPatTyArg(..),
         HsRecFields(..), HsFieldBind(..), LHsFieldBind,
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
@@ -69,7 +70,9 @@ data Pat p
     -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
 
   | AsPat       (XAsPat p)
-                (LIdP p) (LPat p)    -- ^ As pattern
+                (LIdP p)
+               !(LHsToken "@" p)
+                (LPat p)    -- ^ As pattern
     -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'
 
     -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
@@ -217,9 +220,15 @@ type family ConLikeP x
 
 -- ---------------------------------------------------------------------
 
+-- | Type argument in a data constructor pattern,
+--   e.g. the @\@a@ in @f (Just \@a x) = ...@.
+data HsConPatTyArg p =
+  HsConPatTyArg
+    !(LHsToken "@" p)
+     (HsPatSigType p)
 
 -- | Haskell Constructor Pattern Details
-type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))
+type HsConPatDetails p = HsConDetails (HsConPatTyArg (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))
 
 hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p]
 hsConPatArgs (PrefixCon _ ps) = ps
@@ -353,6 +362,9 @@ hsRecFieldSel = foExt . unXRec @p . hfbLHS
 ************************************************************************
 -}
 
+instance Outputable (HsPatSigType p) => Outputable (HsConPatTyArg p) where
+  ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty
+
 instance (Outputable arg, Outputable (XRec p (HsRecField p arg)))
       => Outputable (HsRecFields p arg) where
   ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.hs b/testsuite/tests/perf/compiler/hard_hole_fits.hs
index d449a935b2..59d08c7f24 100644
--- a/testsuite/tests/perf/compiler/hard_hole_fits.hs
+++ b/testsuite/tests/perf/compiler/hard_hole_fits.hs
@@ -20,7 +20,7 @@ testMe (HsLit xle hl) = _
 testMe (HsLam xl mg) = _
 testMe (HsLamCase xlc lc_variant mg) = _
 testMe (HsApp xa gl gl') = _
-testMe (HsAppType xate gl hwcb) = _
+testMe (HsAppType xate gl at hwcb) = _
 testMe (OpApp xoa gl gl' gl2) = _
 testMe (NegApp xna gl se) = _
 testMe (HsPar xp gl ab ac) = _
diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.stderr b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
index 4caef50d4c..01df15c56c 100644
--- a/testsuite/tests/perf/compiler/hard_hole_fits.stderr
+++ b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
@@ -172,12 +172,15 @@ hard_hole_fits.hs:22:28: warning: [-Wtyped-holes (in -Wdefault)]
           (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
            (and originally defined in ‘GHC.Enum’))
 
-hard_hole_fits.hs:23:35: warning: [-Wtyped-holes (in -Wdefault)]
+hard_hole_fits.hs:23:38: warning: [-Wtyped-holes (in -Wdefault)]
     • Found hole: _ :: Int
-    • In an equation for ‘testMe’: testMe (HsAppType xate gl hwcb) = _
+    • In an equation for ‘testMe’:
+          testMe (HsAppType xate gl at hwcb) = _
     • Relevant bindings include
         hwcb :: Language.Haskell.Syntax.Type.LHsWcType
                   (Language.Haskell.Syntax.Extension.NoGhcTc GhcPs)
+          (bound at hard_hole_fits.hs:23:30)
+        at :: Language.Haskell.Syntax.Extension.LHsToken "@" GhcPs
           (bound at hard_hole_fits.hs:23:27)
         gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:23:24)
         xate :: Language.Haskell.Syntax.Extension.XAppTypeE GhcPs
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 05c6a1e792..9d5f932f1e 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1837,7 +1837,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsLam _ _)                  = NoEntryVal
   getAnnotationEntry (HsLamCase an _ _)           = fromAnn an
   getAnnotationEntry (HsApp an _ _)               = fromAnn an
-  getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal
+  getAnnotationEntry (HsAppType _ _ _ _)          = NoEntryVal
   getAnnotationEntry (OpApp an _ _ _)             = fromAnn an
   getAnnotationEntry (NegApp an _ _)              = fromAnn an
   getAnnotationEntry (HsPar an _ _ _)             = fromAnn an
@@ -1912,9 +1912,9 @@ instance ExactPrint (HsExpr GhcPs) where
     debugM $ "HsApp entered. p=" ++ show p
     markAnnotated e1
     markAnnotated e2
-  exact (HsAppType ss fun arg) = do
+  exact (HsAppType _ fun at arg) = do
     markAnnotated fun
-    printStringAtSs ss "@"
+    markToken at
     markAnnotated arg
   exact (OpApp _an e1 e2 e3) = do
     markAnnotated e1
@@ -3547,7 +3547,7 @@ instance ExactPrint (Pat GhcPs) where
   getAnnotationEntry (WildPat _)              = NoEntryVal
   getAnnotationEntry (VarPat _ _)             = NoEntryVal
   getAnnotationEntry (LazyPat an _)           = fromAnn an
-  getAnnotationEntry (AsPat an _ _)           = fromAnn an
+  getAnnotationEntry (AsPat an _ _ _)         = fromAnn an
   getAnnotationEntry (ParPat an _ _ _)        = fromAnn an
   getAnnotationEntry (BangPat an _)           = fromAnn an
   getAnnotationEntry (ListPat an _)           = fromAnn an
@@ -3573,9 +3573,9 @@ instance ExactPrint (Pat GhcPs) where
   exact (LazyPat an pat) = do
     markEpAnn an AnnTilde
     markAnnotated pat
-  exact (AsPat an n pat) = do
+  exact (AsPat _an n at pat) = do
     markAnnotated n
-    markEpAnn an AnnAt
+    markToken at
     markAnnotated pat
   exact (ParPat _an lpar pat rpar) = do
     markToken lpar
@@ -3633,10 +3633,7 @@ instance ExactPrint (Pat GhcPs) where
 
 instance ExactPrint (HsPatSigType GhcPs) where
   getAnnotationEntry = const NoEntryVal
-
-  exact (HsPS an ty) = do
-    markAnnKw an id AnnAt
-    markAnnotated ty
+  exact (HsPS _ ty) = markAnnotated ty
 
 -- ---------------------------------------------------------------------
 
@@ -3693,6 +3690,9 @@ exactUserCon an c details          = do
   exactConArgs details
   markEpAnn an AnnCloseC
 
+instance ExactPrint (HsConPatTyArg GhcPs) where
+  getAnnotationEntry _ = NoEntryVal
+  exact (HsConPatTyArg at tyarg) = markToken at >> markAnnotated tyarg
 
 exactConArgs ::HsConPatDetails GhcPs -> EPP ()
 exactConArgs (PrefixCon tyargs pats) = markAnnotated tyargs >> markAnnotated pats
diff --git a/utils/check-exact/Lookup.hs b/utils/check-exact/Lookup.hs
index 3cd53be04c..467f76c686 100644
--- a/utils/check-exact/Lookup.hs
+++ b/utils/check-exact/Lookup.hs
@@ -33,7 +33,6 @@ keywordToString kw =
       (G AnnValStr ) -> mkErr kw
       (G AnnName   ) -> mkErr kw
       (G AnnAs     ) -> "as"
-      (G AnnAt     ) -> "@"
       (G AnnBang   ) -> "!"
       (G AnnBackquote ) -> "`"
       (G AnnBy     ) -> "by"
@@ -126,5 +125,4 @@ keywordToString kw =
       (G AnnRarrowtailU) -> "⤜"
       (G AnnlarrowtailU) -> "⤙"
       (G AnnrarrowtailU) -> "⤚"
-      AnnTypeApp             -> "@"
       (G AnnVia) -> "via"
diff --git a/utils/check-exact/Types.hs b/utils/check-exact/Types.hs
index ef08421583..b9c6981671 100644
--- a/utils/check-exact/Types.hs
+++ b/utils/check-exact/Types.hs
@@ -156,7 +156,6 @@ instance Outputable Comment where
 -- AST.
 data KeywordId = G AnnKeywordId  -- ^ A normal keyword
                | AnnSemiSep          -- ^ A separating comma
-               | AnnTypeApp          -- ^ Visible type application annotation
                | AnnComment Comment
                | AnnString String    -- ^ Used to pass information from
                                      -- Delta to Print when we have to work
@@ -167,7 +166,6 @@ data KeywordId = G AnnKeywordId  -- ^ A normal keyword
 instance Show KeywordId where
   show (G gc)          = "(G " ++ show gc ++ ")"
   show AnnSemiSep      = "AnnSemiSep"
-  show AnnTypeApp      = "AnnTypeApp"
   show (AnnComment dc) = "(AnnComment " ++ show dc ++ ")"
   show (AnnString s)   = "(AnnString " ++ s ++ ")"