parser and renamer checkpointswip/17594-implementation

19 files changed, 242 insertions, 47 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index eb51021b83..a7de65843c 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1276,7 +1276,11 @@ matchGroupArity (MG { mg_alts = alts })
   | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
   | otherwise        = panic "matchGroupArity"
 
-hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]
+matchGroupLMatchPats :: MatchGroup (GhcPass id) body -> [LMatchPat (GhcPass id)]
+matchGroupLMatchPats (MG { mg_alts = (L _ (alt : _)) }) = hsLMatchPats alt
+matchGroupLMatchPats _ = panic []
+
+hsLMatchPats :: LMatch (GhcPass id) body -> [LMatchPat (GhcPass id)]
 hsLMatchPats (L _ (Match { m_pats = pats })) = pats
 
 -- We keep the type checker happy by providing EpAnnComments.  They
@@ -1321,7 +1325,7 @@ pprPatBind pat grhss
 pprMatch :: (OutputableBndrId idR, Outputable body)
          => Match (GhcPass idR) body -> SDoc
 pprMatch (Match { m_pats = pats, m_ctxt = ctxt, m_grhss = grhss })
-  = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)
+  = sep [ sep (herald : map (nest 2 . pprParendLMatchPat appPrec) other_pats)
         , nest 2 (pprGRHSs ctxt grhss) ]
   where
     (herald, other_pats)
@@ -1341,9 +1345,9 @@ pprMatch (Match { m_pats = pats, m_ctxt = ctxt, m_grhss = grhss })
                         | null rest -> (pp_infix, [])           -- x &&& y = e
                         | otherwise -> (parens pp_infix, rest)  -- (x &&& y) z = e
                         where
-                          pp_infix = pprParendLPat opPrec p1
+                          pp_infix = pprParendLMatchPat opPrec p1
                                      <+> pprInfixOcc fun
-                                     <+> pprParendLPat opPrec p2
+                                     <+> pprParendLMatchPat opPrec p2
                      _ -> pprPanic "pprMatch" (ppr ctxt $$ ppr pats)
 
             LambdaExpr -> (char '\\', pats)
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 21cd9b5d76..8e345cdd95 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -307,6 +307,11 @@ deriving instance Data (HsCmdTop GhcPs)
 deriving instance Data (HsCmdTop GhcRn)
 deriving instance Data (HsCmdTop GhcTc)
 
+-- deriving instance (DataIdLR p p) => Data (MatchPat p)
+deriving instance Data (MatchPat GhcPs)
+deriving instance Data (MatchPat GhcRn)
+deriving instance Data (MatchPat GhcTc)
+
 -- deriving instance (DataIdLR p p,Data body) => Data (MatchGroup p body)
 deriving instance Data (MatchGroup GhcPs (LocatedA (HsExpr GhcPs)))
 deriving instance Data (MatchGroup GhcRn (LocatedA (HsExpr GhcRn)))
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index a4b3bed851..88bc223b7b 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -20,7 +20,7 @@
 -}
 
 module GHC.Hs.Pat (
-        Pat(..), LPat,
+        Pat(..), LPat, MatchPat(..), LMatchPat,
         EpAnnSumPat(..),
         ConPatTc (..),
         ConLikeP,
@@ -34,18 +34,18 @@ module GHC.Hs.Pat (
         hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
         hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
 
-        mkPrefixConPat, mkCharLitPat, mkNilPat,
+        mkPrefixConPat, mkCharLitPat, mkNilPat, mkVisPat,
 
         isSimplePat,
         looksLazyPatBind,
-        isBangedLPat,
-        gParPat, patNeedsParens, parenthesizePat,
+        isBangedLPat, isBangedLMatchPat,
+        gParPat, patNeedsParens, parenthesizePat, parenthesizeLMatchPat,
         isIrrefutableHsPat,
 
         collectEvVarsPat, collectEvVarsPats,
 
-        pprParendLPat, pprConArgs,
-        pprLPat
+        pprParendLPat, pprParendLMatchPat, pprConArgs,
+        pprLPat, pprLMatchPat
     ) where
 
 import GHC.Prelude
@@ -170,6 +170,27 @@ type instance ConLikeP GhcTc = ConLike
 
 type instance XHsFieldBind _ = EpAnn [AddEpAnn]
 
+type instance XVisPat (GhcPass _) = NoExtField
+
+type instance XInvisTyVarPat GhcPs = EpAnn [AddEpAnn]
+type instance XInvisTyVarPat GhcRn = NoExtField
+type instance XInvisTyVarPat GhcTc = NoExtField
+
+type instance XInvisWildTyPat GhcPs = NoExtField
+type instance XInvisWildTyPat GhcRn = NoExtField
+type instance XInvisWildTyPat GhcTc = Type -- ?? perhaps, NoExtField, I'm not sure
+
+type instance XXMatchPat (GhcPass _) = NoExtCon
+
+mkVisPat :: forall pass. IsPass pass => LPat (GhcPass pass) -> LMatchPat (GhcPass pass)
+mkVisPat lpat =
+  case ghcPass @pass of
+    GhcPs -> L l (VisPat noExtField lpat)
+    GhcRn -> L l (VisPat noExtField lpat)
+    GhcTc -> L l (VisPat noExtField lpat)
+  where
+    l = getLoc lpat
+
 -- ---------------------------------------------------------------------
 
 -- API Annotations types
@@ -205,7 +226,6 @@ data XXPatGhcTc
   -- See Note [Rebindable syntax and HsExpansion].
   | ExpansionPat (Pat GhcRn) (Pat GhcTc)
 
-
 -- See Note [Rebindable syntax and HsExpansion].
 data HsPatExpansion a b
   = HsPatExpanded a b
@@ -267,9 +287,17 @@ instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
 instance (Outputable a, Outputable b) => Outputable (HsPatExpansion a b) where
   ppr (HsPatExpanded a b) = ifPprDebug (vcat [ppr a, ppr b]) (ppr a)
 
+instance OutputableBndrId p => Outputable (MatchPat (GhcPass p)) where
+    ppr (VisPat _ lpat)     = ppr (unLoc lpat)
+    ppr (InvisTyVarPat _ idp) = ppr idp
+    ppr (InvisWildTyPat _)    = text "_@"
+
 pprLPat :: (OutputableBndrId p) => LPat (GhcPass p) -> SDoc
 pprLPat (L _ e) = pprPat e
 
+pprLMatchPat :: (OutputableBndrId p) => LMatchPat (GhcPass p) -> SDoc
+pprLMatchPat (L _ e) = ppr e
+
 -- | Print with type info if -dppr-debug is on
 pprPatBndr :: OutputableBndr name => name -> SDoc
 pprPatBndr var
@@ -282,6 +310,12 @@ pprParendLPat :: (OutputableBndrId p)
               => PprPrec -> LPat (GhcPass p) -> SDoc
 pprParendLPat p = pprParendPat p . unLoc
 
+pprParendLMatchPat :: (OutputableBndrId p)
+                => PprPrec -> LMatchPat (GhcPass p) -> SDoc
+pprParendLMatchPat p (L _ (VisPat _ pat))      = pprParendLPat p pat
+pprParendLMatchPat _ (L _ (InvisTyVarPat _ pat)) = char '@' <> (ppr (unLoc pat))
+pprParendLMatchPat _ (L _ (InvisWildTyPat _))    = text "@_"
+
 pprParendPat :: forall p. OutputableBndrId p
              => PprPrec
              -> Pat (GhcPass p)
@@ -444,6 +478,9 @@ patterns are treated specially, of course.
 
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 -}
+isBangedLMatchPat :: LMatchPat (GhcPass p) -> Bool
+isBangedLMatchPat (L _ (VisPat _ pat)) = isBangedLPat pat
+isBangedLMatchPat _                    = False
 
 isBangedLPat :: LPat (GhcPass p) -> Bool
 isBangedLPat = isBangedPat . unLoc
@@ -680,6 +717,14 @@ parenthesizePat p lpat@(L loc pat)
   | patNeedsParens p pat = L loc (gParPat lpat)
   | otherwise            = lpat
 
+parenthesizeLMatchPat :: IsPass p
+                   => PprPrec
+                   -> LMatchPat (GhcPass p)
+                   -> LMatchPat (GhcPass p)
+parenthesizeLMatchPat p (L l (VisPat x lpat)) =
+  L l (VisPat x (parenthesizePat p lpat))
+parenthesizeLMatchPat _ invis         = invis
+
 {-
 % Collect all EvVars from all constructor patterns
 -}
@@ -726,6 +771,7 @@ collectEvVarsPat pat =
 -}
 
 type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
+type instance Anno (MatchPat (GhcPass p)) = SrcSpanAnnA
 type instance Anno (HsOverLit (GhcPass p)) = SrcSpan
 type instance Anno ConLike = SrcSpanAnnN
 type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
diff --git a/compiler/GHC/Hs/Pat.hs-boot b/compiler/GHC/Hs/Pat.hs-boot
index f128e6d4ea..4056823581 100644
--- a/compiler/GHC/Hs/Pat.hs-boot
+++ b/compiler/GHC/Hs/Pat.hs-boot
@@ -13,5 +13,7 @@ import GHC.Hs.Extension ( OutputableBndrId, GhcPass )
 import Language.Haskell.Syntax.Pat
 
 instance (OutputableBndrId p) => Outputable (Pat (GhcPass p))
+instance (OutputableBndrId p) => Outputable (MatchPat (GhcPass p))
 
 pprLPat :: (OutputableBndrId p) => LPat (GhcPass p) -> SDoc
+pprLMatchPat :: (OutputableBndrId p) => LMatchPat (GhcPass p) -> SDoc
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index 1501abbb9e..80c4ad5b6c 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -7,7 +7,8 @@ module GHC.Hs.Syn.Type (
     -- * Extracting types from HsExpr
     lhsExprType, hsExprType, hsWrapperType,
     -- * Extracting types from HsSyn
-    hsLitType, hsPatType, hsLPatType
+    hsLitType, hsPatType, hsLPatType,
+    hsLMatchPatType, hsMatchPatType
 
   ) where
 
@@ -38,6 +39,14 @@ import GHC.Utils.Panic
 
 -}
 
+hsLMatchPatType :: LMatchPat GhcTc -> Type
+hsLMatchPatType (L _ pat) = hsMatchPatType pat
+
+hsMatchPatType :: MatchPat GhcTc -> Type
+hsMatchPatType (VisPat _ pat) = hsLPatType pat
+hsMatchPatType (InvisTyVarPat _ var) = idType (unLoc var)
+hsMatchPatType (InvisWildTyPat ty) = ty
+
 hsLPatType :: LPat GhcTc -> Type
 hsLPatType (L _ p) = hsPatType p
 
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index eb410a3c6a..9c7fe17f88 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -98,7 +98,7 @@ module GHC.Hs.Utils(
   collectHsIdBinders,
   collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
 
-  collectPatBinders, collectPatsBinders,
+  collectPatBinders, collectPatsBinders, collectLMatchPatsBinders,
   collectLStmtsBinders, collectStmtsBinders,
   collectLStmtBinders, collectStmtBinders,
   CollectPass(..), CollectFlag(..),
@@ -174,7 +174,7 @@ mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                   Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                         ~ SrcSpan)
               => HsMatchContext (GhcPass p)
-              -> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p))
+              -> [LMatchPat (GhcPass p)] -> LocatedA (body (GhcPass p))
               -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
 mkSimpleMatch ctxt pats rhs
   = L loc $
@@ -183,7 +183,8 @@ mkSimpleMatch ctxt pats rhs
   where
     loc = case pats of
                 []      -> getLoc rhs
-                (pat:_) -> combineSrcSpansA (getLoc pat) (getLoc rhs)
+                ((L _ (VisPat _ pat)):_)   -> combineSrcSpansA (getLoc pat) (getLoc rhs)
+                _                  -> getLoc rhs
 
 unguardedGRHSs :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                      ~ SrcSpan
@@ -248,14 +249,14 @@ mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl' mkHsAppType
 
 mkHsLam :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField)
-        => [LPat (GhcPass p)]
+        => [LMatchPat (GhcPass p)]
         -> LHsExpr (GhcPass p)
         -> LHsExpr (GhcPass p)
 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches))
   where
     matches = mkMatchGroup Generated
                            (noLocA [mkSimpleMatch LambdaExpr pats' body])
-    pats' = map (parenthesizePat appPrec) pats
+    pats' = map (parenthesizeLMatchPat appPrec) pats
 
 mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
 mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars
@@ -267,10 +268,10 @@ mkHsCaseAlt :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                      ~ SrcSpan,
                  Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                         ~ SrcSpanAnnA)
-            => LPat (GhcPass p) -> (LocatedA (body (GhcPass p)))
+            => LMatchPat (GhcPass p) -> (LocatedA (body (GhcPass p)))
             -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
-mkHsCaseAlt pat expr
-  = mkSimpleMatch CaseAlt [pat] expr
+mkHsCaseAlt match_pat expr
+  = mkSimpleMatch CaseAlt [match_pat] expr
 
 nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc
 nlHsTyApp fun_id tys
@@ -288,6 +289,9 @@ mkLHsPar = parenthesizeHsExpr appPrec
 mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
 mkParPat = parenthesizePat appPrec
 
+mkParLamPat :: IsPass p => LMatchPat (GhcPass p) -> LMatchPat (GhcPass p)
+mkParLamPat = parenthesizeLMatchPat appPrec
+
 nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
 nlParPat p = noLocA (gParPat p)
 
@@ -893,7 +897,7 @@ spanHsLocaLBinds (HsIPBinds _ (IPBinds _ bs))
 ------------
 -- | Convenience function using 'mkFunBind'.
 -- This is for generated bindings only, do not use for user-written code.
-mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
+mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LMatchPat GhcPs]
                 -> LHsExpr GhcPs -> LHsBind GhcPs
 mkSimpleGeneratedFunBind loc fun pats expr
   = L (noAnnSrcSpan loc) $ mkFunBind Generated (L (noAnnSrcSpan loc) fun)
@@ -909,14 +913,14 @@ mkPrefixFunRhs n = FunRhs { mc_fun = n
 ------------
 mkMatch :: forall p. IsPass p
         => HsMatchContext (GhcPass p)
-        -> [LPat (GhcPass p)]
+        -> [LMatchPat (GhcPass p)]
         -> LHsExpr (GhcPass p)
         -> HsLocalBinds (GhcPass p)
         -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
 mkMatch ctxt pats expr binds
   = noLocA (Match { m_ext   = noAnn
                   , m_ctxt  = ctxt
-                  , m_pats  = map mkParPat pats
+                  , m_pats  = map mkParLamPat pats
                   , m_grhss = GRHSs emptyComments (unguardedRHS noAnn noSrcSpan expr) binds })
 
 {-
@@ -1160,6 +1164,14 @@ collectPatsBinders
     -> [IdP p]
 collectPatsBinders flag pats = foldr (collect_lpat flag) [] pats
 
+collectLMatchPatsBinders
+    :: CollectPass p
+    => CollectFlag p
+    -> [LMatchPat p]
+    -> [IdP p]
+-- ^ Return all the variables bound by the `[LMatchPat p]`,
+--   including both type variables and term variables
+collectLMatchPatsBinders flag pats = foldr (collect_lmatchpat flag) [] pats
 
 -------------
 
@@ -1183,6 +1195,16 @@ collect_lpat :: forall p. (CollectPass p)
              -> [IdP p]
 collect_lpat flag pat bndrs = collect_pat flag (unXRec @p pat) bndrs
 
+collect_lmatchpat :: forall p. (CollectPass p)
+                  => CollectFlag p
+                  -> LMatchPat p
+                  -> [IdP p]
+                  -> [IdP p]
+collect_lmatchpat flag match_pat bndrs   = case (unXRec @p match_pat) of
+  VisPat _ pat        -> collect_lpat flag pat bndrs
+  InvisTyVarPat _ idp -> (unXRec @p idp) : bndrs
+  _                   -> bndrs -- TODO: implement these cases properly
+
 collect_pat :: forall p. CollectPass p
             => CollectFlag p
             -> Pat p
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index a783833317..3d2940603a 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -490,6 +490,16 @@ patScopes rsp useScope patScope xs =
   map (\(RS sc a) -> PS rsp useScope sc a) $
     listScopes patScope xs
 
+matchPatScopes
+  :: Maybe Span
+  -> Scope
+  -> Scope
+  -> [LMatchPat (GhcPass p)]
+  -> [PScoped (LMatchPat (GhcPass p))]
+matchPatScopes rsp useScope patScope xs =
+  map (\(RS sc a) -> PS rsp useScope sc a) $
+    listScopes patScope xs
+
 -- | 'listScopes' specialised to 'HsPatSigType'
 tScopes
   :: Scope
@@ -908,6 +918,9 @@ instance HiePass p => ToHie (HsPatSynDir (GhcPass p)) where
     ExplicitBidirectional mg -> toHie mg
     _ -> pure []
 
+instance ToHie (PScoped (GenLocated SrcSpanAnnA (MatchPat (GhcPass p)))) where
+  toHie = undefined
+
 instance ( HiePass p
          , Data (body (GhcPass p))
          , AnnoBody p body
@@ -917,7 +930,7 @@ instance ( HiePass p
     Match{m_ctxt=mctx, m_pats = pats, m_grhss =  grhss } ->
       [ toHie mctx
       , let rhsScope = mkScope $ grhss_span grhss
-          in toHie $ patScopes Nothing rhsScope NoScope pats
+          in toHie $ matchPatScopes Nothing rhsScope NoScope pats
       , toHie grhss
       ]
 
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index fc546c515d..2b259354e5 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2788,7 +2788,7 @@ aexp    :: { ECP }
                                    unECP $2 >>= \ $2 ->
                                    mkHsNegAppPV (comb2A $1 $>) $2 [mj AnnMinus $1] }
 
-        | '\\' apats '->' exp
+        | '\\' matchpats '->' exp
                    {  ECP $
                       unECP $4 >>= \ $4 ->
                       mkHsLamPV (comb2 $1 (reLoc $>)) (\cs -> mkMatchGroup FromSource
@@ -3243,7 +3243,7 @@ alt     :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
                             acsA (\cs -> sLL (reLoc $1) $>
                                            (Match { m_ext = (EpAnn (glAR $1) [] cs)
                                                   , m_ctxt = CaseAlt
-                                                  , m_pats = [$1]
+                                                  , m_pats = [L noSrcSpanA (VisPat noExtField $1)]
                                                   , m_grhss = unLoc $2 }))}
 
 alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) }
@@ -3289,12 +3289,14 @@ bindpat :  exp            {% -- See Note [Parser-Validator Details] in GHC.Parse
                              checkPattern_details incompleteDoBlock
                                               (unECP $1) }
 
-apat   :: { LPat GhcPs }
-apat    : aexp                  {% (checkPattern <=< runPV) (unECP $1) }
+matchpat   :: { LMatchPat GhcPs }
+matchpat    : aexp                  {%  (fmap mkVisPat . checkPattern <=< runPV) (unECP $1) }
+            | PREFIX_AT tyvar       {  (L noSrcSpanA (InvisTyVarPat noAnn $2)) }
+            | PREFIX_AT '_'         {  (L noSrcSpanA (InvisWildTyPat noExtField)) }
 
-apats  :: { [LPat GhcPs] }
-        : apat apats            { $1 : $2 }
-        | {- empty -}           { [] }
+matchpats :: { [LMatchPat GhcPs] }
+           : matchpat matchpats            { $1 : $2 }
+           | {- empty -}                   { [] }
 
 -----------------------------------------------------------------------------
 -- Statement sequences
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 138a24ccd5..59edbff669 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -177,6 +177,8 @@ instance Diagnostic PsMessage where
       -> mkSimpleDecorated $ text "Illegal lambda-case"
     PsErrEmptyLambda
        -> mkSimpleDecorated $ text "A lambda requires at least one parameter"
+    PsErrorIllegalTypeArguments
+      -> mkSimpleDecorated $ text "Type variable arguments after ordinary patterns are not allowed yet"
     PsErrLinearFunction
       -> mkSimpleDecorated $ text "Illegal use of linear functions"
     PsErrOverloadedRecordUpdateNotEnabled
@@ -598,6 +600,7 @@ instance Diagnostic PsMessage where
     PsErrParseRightOpSectionInPat{}               -> ErrorWithoutFlag
     PsErrIllegalGadtRecordMultiplicity{}          -> ErrorWithoutFlag
     PsErrInvalidCApiImport {}                     -> ErrorWithoutFlag
+    PsErrorIllegalTypeArguments                   -> ErrorWithoutFlag
 
   diagnosticHints  = \case
     PsUnknownMessage m                            -> diagnosticHints m
@@ -757,6 +760,7 @@ instance Diagnostic PsMessage where
     PsErrInvalidPackageName{}                     -> noHints
     PsErrIllegalGadtRecordMultiplicity{}          -> noHints
     PsErrInvalidCApiImport {}                     -> noHints
+    PsErrorIllegalTypeArguments                   -> noHints
 
 psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc
 psHeaderMessageDiagnostic = \case
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index d39048c441..01168441c9 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -144,6 +144,9 @@ data PsMessage
    -- | A lambda requires at least one parameter
    | PsErrEmptyLambda
 
+   -- | Type variable arguments after ordinary patterns are not allowed yet
+   | PsErrorIllegalTypeArguments
+
    -- | Underscores in literals without the extension enabled
    | PsErrNumUnderscores !NumUnderscoreReason
 
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index e553348ea7..79855ddb40 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -655,17 +655,18 @@ mkPatSynMatchGroup (L loc patsyn_name) (L ld decls) =
                wrongNameBindingErr (locA loc) decl
            ; match <- case details of
                PrefixCon _ pats -> return $ Match { m_ext = noAnn
-                                                  , m_ctxt = ctxt, m_pats = pats
+                                                  , m_ctxt = ctxt
+                                                  , m_pats = (\pat -> L loc (VisPat noExtField pat)) <$> pats
                                                   , m_grhss = rhs }
                    where
                      ctxt = FunRhs { mc_fun = ln
                                    , mc_fixity = Prefix
                                    , mc_strictness = NoSrcStrict }
 
-               InfixCon p1 p2 -> return $ Match { m_ext = noAnn
-                                                , m_ctxt = ctxt
-                                                , m_pats = [p1, p2]
-                                                , m_grhss = rhs }
+               InfixCon p1@(L l1 _) p2@(L l2 _) -> return $ Match { m_ext = noAnn
+                                                                  , m_ctxt = ctxt
+                                                                  , m_pats = [(L l1 (VisPat noExtField p1)), (L l2 (VisPat noExtField p2))]
+                                                                  , m_grhss = rhs }
                    where
                      ctxt = FunRhs { mc_fun = ln
                                    , mc_fixity = Infix
@@ -1121,6 +1122,11 @@ checkPattern_details extraDetails pp = runPV_details extraDetails (pp >>= checkL
 checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
 checkLPat e@(L l _) = checkPat l e [] []
 
+checkLamPat :: LocatedA (PatBuilder GhcPs) -> PV (LMatchPat GhcPs)
+checkLamPat (L l (PatBuilderAppType _ (HsPS {hsps_body = L _ (HsTyVar _ NotPromoted c)}))) =
+  return $ (L l (InvisTyVarPat EpAnnNotUsed c))
+checkLamPat e@(L l _) = (\pat -> L l (VisPat noExtField pat)) <$> checkPat l e [] []
+
 checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsPatSigType GhcPs] -> [LPat GhcPs]
          -> PV (LPat GhcPs)
 checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
@@ -1129,8 +1135,6 @@ checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
       , pat_con = L ln c
       , pat_args = PrefixCon tyargs args
       }
-  | not (null tyargs) =
-      patFail (locA l) . PsErrInPat e $ PEIP_TypeArgs tyargs
   | (not (null args) && patIsRec c) = do
       ctx <- askParseContext
       patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx
@@ -1246,7 +1250,7 @@ checkFunBind :: SrcStrictness
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> P (HsBind GhcPs)
 checkFunBind strictness locF ann fun is_infix pats (L _ grhss)
-  = do  ps <- runPV_details extraDetails (mapM checkLPat pats)
+  = do  ps <- runPV_details extraDetails (mapM checkLamPat pats)
         let match_span = noAnnSrcSpan $ locF
         cs <- getCommentsFor locF
         return (makeFunBind fun (L (noAnnSrcSpan $ locA match_span)
@@ -1289,7 +1293,7 @@ checkPatBind loc annsIn (L _ (BangPat (EpAnn _ ans cs) (L _ (VarPat _ v))))
                                     , mc_fixity = Prefix
                                     , mc_strictness = SrcStrict }
                   , m_pats = []
-                 , m_grhss = grhss }
+                  , m_grhss = grhss }
 
 checkPatBind loc annsIn lhs (L _ grhss) = do
   cs <- getCommentsFor loc
@@ -1346,6 +1350,7 @@ isFunLhs e = go e [] [] []
                      op_app = L loc (PatBuilderOpApp k
                                (L loc' op) r (EpAnn loca (reverse ops++cps) cs))
                  _ -> return Nothing }
+   go (L _ (PatBuilderAppType pat _)) es ann cps = go pat es ann cps
    go _ _ _ _ = return Nothing
 
 mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 1e4c43cf7d..068b2a597b 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -1209,7 +1209,7 @@ rnMatch' :: (AnnoBody body)
          -> Match GhcPs (LocatedA (body GhcPs))
          -> RnM (Match GhcRn (LocatedA (body GhcRn)), FreeVars)
 rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
-  = rnPats ctxt pats $ \ pats' -> do
+  = rnLMatchPats ctxt pats $ \ pats' -> do
         { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
         ; let mf' = case (ctxt, mf) of
                       (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 35129a55cd..cc013047e6 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -2591,7 +2591,7 @@ getMonadFailOp ctxt
               nlHsApp (noLocA failExpr)
                       (nlHsApp (noLocA $ fromStringExpr) arg_syn_expr)
         let failAfterFromStringExpr :: HsExpr GhcRn =
-              unLoc $ mkHsLam [noLocA $ VarPat noExtField $ noLocA arg_name] body
+              unLoc $ mkHsLam [(L noSrcSpanA (VisPat NoExtField (noLocA $ VarPat noExtField $ noLocA arg_name)))] body
         let failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
               mkSyntaxExpr failAfterFromStringExpr
         return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs)
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 674cfe6198..07d805334f 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1534,8 +1534,8 @@ checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
 checkPrecMatch op (MG { mg_alts = (L _ ms) })
   = mapM_ check ms
   where
-    check (L _ (Match { m_pats = (L l1 p1)
-                               : (L l2 p2)
+    check (L _ (Match { m_pats = (L _ (VisPat _ (L l1 p1)))
+                               : (L _ (VisPat _ (L l2 p2)))
                                : _ }))
       = setSrcSpan (locA $ combineSrcSpansA l1 l2) $
         do checkPrec op p1 False
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 534b03e602..17a1973065 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -23,6 +23,7 @@ free variables.
 -}
 module GHC.Rename.Pat (-- main entry points
               rnPat, rnPats, rnBindPat, rnPatAndThen,
+              rnLMatchPats, rnLMatchPat,
 
               NameMaker, applyNameMaker,     -- a utility for making names:
               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
@@ -430,6 +431,50 @@ rnPats ctxt pats thing_inside
   where
     doc_pat = text "In" <+> pprMatchContext ctxt
 
+rnLMatchPatAndThen :: NameMaker -> LMatchPat GhcPs -> CpsRn (LMatchPat GhcRn)
+rnLMatchPatAndThen nm pat = wrapSrcSpanCps (rnMatchPatAndThen nm) pat
+
+rnLMatchPatsAndThen :: NameMaker -> [LMatchPat GhcPs] -> CpsRn ([LMatchPat GhcRn])
+rnLMatchPatsAndThen nm = mapM (rnLMatchPatAndThen nm)
+
+rnMatchPatAndThen :: NameMaker -> MatchPat GhcPs -> CpsRn (MatchPat GhcRn)
+rnMatchPatAndThen nm (VisPat _ lpat)
+  = do { renamed_pat <- rnLPatAndThen nm lpat
+       ; return (VisPat NoExtField renamed_pat)
+       }
+rnMatchPatAndThen nm (InvisTyVarPat _ (L l rdr))
+  = do { loc <- liftCps getSrcSpanM
+       ; name <- newPatName nm (L (noAnnSrcSpan loc) rdr)
+       ; return (InvisTyVarPat NoExtField (L l name))
+       }
+rnMatchPatAndThen _ (InvisWildTyPat _) = return (InvisWildTyPat NoExtField)
+
+rnLMatchPats :: HsMatchContext GhcRn -- for error messages
+             -> [LMatchPat GhcPs]
+             -> ([LMatchPat GhcRn] -> RnM (a, FreeVars))
+             -> RnM (a, FreeVars)
+rnLMatchPats ctxt pats thing_inside
+  = do { envs_before <- getRdrEnvs
+       ; unCpsRn (rnLMatchPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
+       {
+       ; let bndrs = collectLMatchPatsBinders CollNoDictBinders pats'
+       ; addErrCtxt doc_pat $
+         if isPatSynCtxt ctxt
+            then checkDupNames bndrs
+            else checkDupAndShadowedNames envs_before bndrs
+       ; thing_inside pats'
+       } }
+  where
+    doc_pat = text "In" <+> pprMatchContext ctxt
+
+rnLMatchPat :: HsMatchContext GhcRn -- for error messages
+            -> LMatchPat GhcPs
+            -> (LMatchPat GhcRn -> RnM (a, FreeVars))
+            -> RnM (a, FreeVars)
+rnLMatchPat ctxt pat thing_inside =
+  rnLMatchPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
+
+
 rnPat :: HsMatchContext GhcRn -- for error messages
       -> LPat GhcPs
       -> (LPat GhcRn -> RnM (a, FreeVars))
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index b472ac9589..c7c22c2bc1 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -1065,7 +1065,7 @@ data Match p body
         m_ext :: XCMatch p body,
         m_ctxt :: HsMatchContext p,
           -- See note [m_ctxt in Match]
-        m_pats :: [LPat p], -- The patterns
+        m_pats :: [LMatchPat p], -- The patterns
         m_grhss :: (GRHSs p body)
   }
   | XMatch !(XXMatch p body)
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 8d8eadf135..fa7628f8ad 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -583,6 +583,10 @@ type family XSigPat      x
 type family XCoPat       x
 type family XXPat        x
 type family XHsFieldBind x
+type family XVisPat      x
+type family XInvisTyVarPat  x
+type family XInvisWildTyPat x
+type family XXMatchPat   x
 
 -- =====================================================================
 -- Type families for the HsTypes type families
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 4393ad998a..02948d9664 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -19,8 +19,7 @@
 
 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
 module Language.Haskell.Syntax.Pat (
-        Pat(..), LPat,
-        ConLikeP,
+        Pat(..), LPat, MatchPat(..), LMatchPat, toLPats, toPats, toInvisPats, ConLikeP,
 
         HsConPatDetails, hsConPatArgs,
         HsRecFields(..), HsFieldBind(..), LHsFieldBind,
@@ -214,6 +213,35 @@ data Pat p
 
 type family ConLikeP x
 
+data MatchPat pass
+  = VisPat (XVisPat pass) (LPat pass)
+  | InvisTyVarPat (XInvisTyVarPat pass) (LIdP pass)
+  | InvisWildTyPat (XInvisWildTyPat pass)
+  | XMatchPat !(XXMatchPat pass)
+
+type LMatchPat pass = XRec pass (MatchPat pass)
+
+toLPats :: forall pass. UnXRec pass => [LMatchPat pass] -> [LPat pass]
+toLPats [] = []
+toLPats (x : xs) =
+  case unXRec @pass x of
+    VisPat _ pat -> pat : toLPats xs
+    _            -> toLPats xs
+
+toPats :: forall pass. UnXRec pass => [MatchPat pass] -> [Pat pass]
+toPats [] = []
+toPats (x : xs) =
+  case x of
+    VisPat _ pat -> unXRec @pass pat : toPats xs
+    _            -> toPats xs
+
+toInvisPats :: forall pass. UnXRec pass => [LMatchPat pass] -> [LMatchPat pass]
+toInvisPats [] = []
+toInvisPats (x : xs) =
+  case unXRec @pass x of
+    InvisTyVarPat _ _ -> x : toInvisPats xs
+    InvisWildTyPat _  -> x : toInvisPats xs
+    _               -> toInvisPats xs
 
 -- ---------------------------------------------------------------------
 
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs-boot b/compiler/Language/Haskell/Syntax/Pat.hs-boot
index 4ff0371e39..29ec86565f 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs-boot
+++ b/compiler/Language/Haskell/Syntax/Pat.hs-boot
@@ -9,5 +9,8 @@ import Language.Haskell.Syntax.Extension ( XRec )
 import Data.Kind
 
 type role Pat nominal
+type role MatchPat nominal
 data Pat (i :: Type)
 type LPat i = XRec i (Pat i)
+data MatchPat i
+type LMatchPat i = XRec i (MatchPat i)