parser and renamer checkpointwip/17594-another-approach

Metric Decrease:
    T16875

58 files changed, 690 insertions, 265 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 405b772199..d27cf835d5 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1319,7 +1319,7 @@ matchGroupArity (MG { mg_alts = alts })
   | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
   | otherwise        = panic "matchGroupArity"
 
-hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]
+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
@@ -1364,7 +1364,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)
@@ -1384,9 +1384,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)
@@ -1394,10 +1394,10 @@ pprMatch (Match { m_pats = pats, m_ctxt = ctxt, m_grhss = grhss })
             -- We don't simply return (empty, pats) to avoid introducing an
             -- additional `nest 2` via the empty herald
             LamCaseAlt LamCases ->
-              maybe (empty, []) (first $ pprParendLPat appPrec) (uncons pats)
+              maybe (empty, []) (first $ pprParendLMatchPat appPrec) (uncons pats)
 
             ArrowMatchCtxt (ArrowLamCaseAlt LamCases) ->
-              maybe (empty, []) (first $ pprParendLPat appPrec) (uncons pats)
+              maybe (empty, []) (first $ pprParendLMatchPat appPrec) (uncons pats)
 
             ArrowMatchCtxt KappaExpr -> (char '\\', pats)
 
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index a0c588413b..91119a2c0c 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -316,6 +316,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 3d251103ce..c2fadec91c 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -21,7 +21,7 @@
 -}
 
 module GHC.Hs.Pat (
-        Pat(..), LPat,
+        Pat(..), LPat, MatchPat(..), LMatchPat,
         EpAnnSumPat(..),
         ConPatTc (..),
         ConLikeP,
@@ -37,17 +37,17 @@ module GHC.Hs.Pat (
         hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
         hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
 
-        mkPrefixConPat, mkCharLitPat, mkNilPat,
+        mkPrefixConPat, mkCharLitPat, mkNilPat, mkVisPat, expectVisPats,
 
         isSimplePat,
         looksLazyPatBind,
         isBangedLPat,
-        gParPat, patNeedsParens, parenthesizePat,
+        gParPat, patNeedsParens, parenthesizePat, parenthesizeLMatchPat,
         isIrrefutableHsPat,
 
         collectEvVarsPat, collectEvVarsPats,
 
-        pprParendLPat, pprConArgs,
+        pprParendLPat, pprParendLMatchPat, pprConArgs,
         pprLPat
     ) where
 
@@ -172,6 +172,30 @@ type instance ConLikeP GhcTc = ConLike
 
 type instance XHsFieldBind _ = EpAnn [AddEpAnn]
 
+type instance XVisPat (GhcPass _) = NoExtField
+
+type instance XInvisTyVarPat GhcPs = NoExtField
+type instance XInvisTyVarPat GhcRn = NoExtField
+type instance XInvisTyVarPat GhcTc = DataConCantHappen
+
+type instance XInvisWildTyPat GhcPs = NoExtField
+type instance XInvisWildTyPat GhcRn = NoExtField
+type instance XInvisWildTyPat GhcTc = DataConCantHappen
+
+type instance XXMatchPat (GhcPass _) = DataConCantHappen
+
+-- | A helper function that constructs a match pattern from an LPat
+mkVisPat :: LPat (GhcPass pass) -> LMatchPat (GhcPass pass)
+mkVisPat lpat = L (getLoc lpat) (VisPat noExtField lpat)
+
+expectVisPats :: [LMatchPat GhcTc] -> [LPat GhcTc]
+expectVisPats xs = map toLPat xs
+  where
+    toLPat :: LMatchPat GhcTc -> LPat GhcTc
+    toLPat (L _ (VisPat _ pat))      = pat
+    toLPat (L _ (InvisTyVarPat x _)) = dataConCantHappen x
+    toLPat (L _ (InvisWildTyPat x))  = dataConCantHappen x
+
 -- ---------------------------------------------------------------------
 
 -- API Annotations types
@@ -287,6 +311,11 @@ 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 _ tvb) = char '@' <> ppr tvb
+    ppr (InvisWildTyPat _)    = text "@_"
+
 pprLPat :: (OutputableBndrId p) => LPat (GhcPass p) -> SDoc
 pprLPat (L _ e) = pprPat e
 
@@ -302,6 +331,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 _ tv_name)) = char '@' <> (ppr (unLoc tv_name))
+pprParendLMatchPat _ (L _ (InvisWildTyPat _))        = text "@_"
+
 pprParendPat :: forall p. OutputableBndrId p
              => PprPrec
              -> Pat (GhcPass p)
@@ -469,7 +504,6 @@ patterns are treated specially, of course.
 
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 -}
-
 isBangedLPat :: LPat (GhcPass p) -> Bool
 isBangedLPat = isBangedPat . unLoc
 
@@ -705,6 +739,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
 -}
@@ -751,6 +793,7 @@ collectEvVarsPat pat =
 -}
 
 type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
+type instance Anno (MatchPat (GhcPass p)) = SrcSpanAnnA
 type instance Anno (HsOverLit (GhcPass p)) = SrcAnn NoEpAnns
 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..c3cfbdf993 100644
--- a/compiler/GHC/Hs/Pat.hs-boot
+++ b/compiler/GHC/Hs/Pat.hs-boot
@@ -13,5 +13,6 @@ 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
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index 2e40cec8d0..073b45cfeb 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
 
   ) where
 
@@ -41,6 +42,10 @@ import GHC.Utils.Panic
 hsLPatType :: LPat GhcTc -> Type
 hsLPatType (L _ p) = hsPatType p
 
+hsLMatchPatType :: LMatchPat GhcTc -> Type
+hsLMatchPatType (L _ (VisPat _ p)) = hsPatType (unLoc p)
+hsLMatchPatType _                  = panic "@-binders in functions are not allowed yet"
+
 hsPatType :: Pat GhcTc -> Type
 hsPatType (ParPat _ _ pat _)            = hsLPatType pat
 hsPatType (WildPat ty)                  = ty
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 3e74eea3db..015b24da15 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -72,7 +72,7 @@ module GHC.Hs.Utils(
   -- * Patterns
   mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,
   nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat,
-  nlWildPatName, nlTuplePat, mkParPat, nlParPat,
+  nlWildPatName, nlTuplePat, nlParPat,
   mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup,
 
   -- * Types
@@ -96,8 +96,8 @@ module GHC.Hs.Utils(
   collectHsIdBinders,
   collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
 
-  collectPatBinders, collectPatsBinders,
-  collectLStmtsBinders, collectStmtsBinders,
+  collectPatBinders, collectPatsBinders, collectLMatchPatsBinders,
+  collectLMatchPatBinders, collectLStmtsBinders, collectStmtsBinders,
   collectLStmtBinders, collectStmtBinders,
   CollectPass(..), CollectFlag(..),
 
@@ -171,7 +171,7 @@ mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                   Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                         ~ SrcAnn NoEpAnns)
               => 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 $
@@ -180,7 +180,7 @@ mkSimpleMatch ctxt pats rhs
   where
     loc = case pats of
                 []      -> getLoc rhs
-                (pat:_) -> combineSrcSpansA (getLoc pat) (getLoc rhs)
+                (pat:_) -> combineSrcSpansA (noAnnSrcSpan (getLocA pat)) (getLoc rhs)
 
 unguardedGRHSs :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                      ~ SrcAnn NoEpAnns
@@ -253,14 +253,14 @@ mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl' mkHsAppType
 
 mkHsLam :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin)
-        => [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
@@ -275,7 +275,7 @@ mkHsCaseAlt :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
             => LPat (GhcPass p) -> (LocatedA (body (GhcPass p)))
             -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
 mkHsCaseAlt pat expr
-  = mkSimpleMatch CaseAlt [pat] expr
+  = mkSimpleMatch CaseAlt [mkVisPat pat] expr
 
 nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc
 nlHsTyApp fun_id tys
@@ -290,8 +290,8 @@ nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
 mkLHsPar :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 mkLHsPar = parenthesizeHsExpr appPrec
 
-mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
-mkParPat = parenthesizePat appPrec
+mkParMatchPat :: IsPass p => LMatchPat (GhcPass p) -> LMatchPat (GhcPass p)
+mkParMatchPat = parenthesizeLMatchPat appPrec
 
 nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
 nlParPat p = noLocA (gParPat p)
@@ -889,7 +889,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)
@@ -905,14 +905,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 mkParMatchPat pats
                   , m_grhss = GRHSs emptyComments (unguardedRHS noAnn noSrcSpan expr) binds })
 
 {-
@@ -1155,6 +1155,24 @@ collectPatsBinders
     -> [IdP p]
 collectPatsBinders flag pats = foldr (collect_lpat flag) [] pats
 
+collectLMatchPatBinders
+    :: CollectPass p
+    => CollectFlag p
+    -> LMatchPat p
+    -> [IdP p]
+-- ^ Return all the variables bound by the `LMatchPat p`,
+--   including both type variables and term variables
+collectLMatchPatBinders flag pat = collect_lmatchpat flag pat []
+
+
+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
 
 -------------
 
@@ -1178,6 +1196,15 @@ 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
+  _            -> bndrs
+
 collect_pat :: forall p. CollectPass p
             => CollectFlag p
             -> Pat p
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index e7dbebb5f9..9b326043fe 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -414,7 +414,7 @@ dsCmd ids local_vars stack_ty res_ty
           = (L _ [L _ (Match { m_pats  = pats
                              , m_grhss = GRHSs _ [L _ (GRHS _ [] body)] _ })]) }))
         env_ids
-  = dsCmdLam ids local_vars stack_ty res_ty pats body env_ids
+  = dsCmdLam ids local_vars stack_ty res_ty (expectVisPats pats) body env_ids
 
 dsCmd ids local_vars stack_ty res_ty (HsCmdPar _ _ cmd _) env_ids
   = dsLCmd ids local_vars stack_ty res_ty cmd env_ids
@@ -1205,7 +1205,7 @@ leavesMatch :: LMatch GhcTc (LocatedA (body GhcTc))
 leavesMatch (L _ (Match { m_pats = pats
                         , m_grhss = GRHSs _ grhss binds }))
   = let
-        defined_vars = mkVarSet (collectPatsBinders CollWithDictBinders pats)
+        defined_vars = mkVarSet (collectLMatchPatsBinders CollWithDictBinders pats)
                         `unionVarSet`
                        mkVarSet (collectLocalBinders CollWithDictBinders binds)
     in
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 1acc52fad0..90c786e98a 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -758,7 +758,7 @@ dsDo ctx stmts
         mfix_arg     = noLocA $ HsLam noExtField
                            (MG { mg_alts = noLocA [mkSimpleMatch
                                                     LambdaExpr
-                                                    [mfix_pat] body]
+                                                    [mkVisPat mfix_pat] body]
                                , mg_ext = MatchGroupTc [unrestricted tup_ty] body_ty Generated
                                })
         mfix_pat     = noLocA $ LazyPat noExtField $ mkBigLHsPatTupId rec_tup_pats
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 4e3df9b3ae..57490dea2b 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -775,7 +775,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches
                             selectMatchVars (zipWithEqual "matchWrapper"
                                               (\a b -> (scaledMult a, unLoc b))
                                                 arg_tys
-                                                (hsLMatchPats m))
+                                                (expectVisPats (hsLMatchPats m)))
 
         -- Pattern match check warnings for /this match-group/.
         -- @rhss_nablas@ is a flat list of covered Nablas for each RHS.
@@ -796,7 +796,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches
     mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo
     mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas)
       = do { dflags <- getDynFlags
-           ; let upats = map (unLoc . decideBangHood dflags) pats
+           ; let upats = map (unLoc . decideBangHood dflags) (expectVisPats pats)
            -- pat_nablas is the covered set *after* matching the pattern, but
            -- before any of the GRHSs. We extend the environment with pat_nablas
            -- (via updPmNablas) so that the where-clause of 'grhss' can profit
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index c0d0d9f0e9..272021b6c9 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -254,6 +254,12 @@ desugarPatV pat = do
 desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
 desugarLPat x = desugarPat x . unLoc
 
+-- | Desugar a match pattern
+desugarLMatchPat :: Id -> LMatchPat GhcTc -> DsM [PmGrd]
+desugarLMatchPat x (L _ (VisPat _ pat))      = desugarLPat x pat
+desugarLMatchPat _ (L _ (InvisTyVarPat x _)) = dataConCantHappen x
+desugarLMatchPat _ (L _ (InvisWildTyPat x))  = dataConCantHappen x
+
 -- | 'desugarLPat', but also select and return a new match var.
 desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
 desugarLPatV = desugarPatV . unLoc
@@ -332,7 +338,7 @@ desugarMatches vars matches =
 -- Desugar a single match
 desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre)
 desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do
-  pats'  <- concat <$> zipWithM desugarLPat vars pats
+  pats'  <- concat <$> zipWithM desugarLMatchPat vars pats
   grhss' <- desugarGRHSs (locA match_loc) (sep (map ppr pats)) grhss
   -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss'])
   return PmMatch { pm_pats = GrdVec pats', pm_grhss = grhss' }
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index a77ca82c7d..fb5c07eb2c 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1678,9 +1678,9 @@ the choice in HsExpanded, but it seems simpler to consult the flag (again).
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
 repMatchTup (L _ (Match { m_pats = [p]
                         , m_grhss = GRHSs _ guards wheres })) =
-  do { ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
+  do { ss1 <- mkGenSyms (collectLMatchPatBinders CollNoDictBinders p)
      ; addBinds ss1 $ do {
-     ; p1 <- repLP p
+     ; p1 <- repLMP p
      ; (ss2,ds) <- repBinds wheres
      ; addBinds ss2 $ do {
      ; gs    <- repGuards guards
@@ -1691,9 +1691,9 @@ repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
 repClauseTup (L _ (Match { m_pats = ps
                          , m_grhss = GRHSs _ guards  wheres })) =
-  do { ss1 <- mkGenSyms (collectPatsBinders CollNoDictBinders ps)
+  do { ss1 <- mkGenSyms (collectLMatchPatsBinders CollNoDictBinders ps)
      ; addBinds ss1 $ do {
-       ps1 <- repLPs ps
+       ps1 <- repLMPs ps
      ; (ss2,ds) <- repBinds wheres
      ; addBinds ss2 $ do {
        gs <- repGuards guards
@@ -2027,10 +2027,10 @@ repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp))
 repLambda (L _ (Match { m_pats = ps
                       , m_grhss = GRHSs _ [L _ (GRHS _ [] e)]
                                               (EmptyLocalBinds _) } ))
- = do { let bndrs = collectPatsBinders CollNoDictBinders ps ;
+ = do { let bndrs = collectLMatchPatsBinders CollNoDictBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
-                do { xs <- repLPs ps; body <- repLE e; repLam xs body })
+                do { xs <- repLMPs ps; body <- repLE e; repLam xs body })
       ; wrapGenSyms ss lam }
 
 repLambda (L _ m) = notHandled (ThGuardedLambdas m)
@@ -2050,6 +2050,15 @@ repLPs ps = repListM patTyConName repLP ps
 repLP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
 repLP p = repP (unLoc p)
 
+repLMP :: LMatchPat GhcRn -> MetaM (Core (M TH.Pat))
+repLMP (L _ (VisPat _ p)) = repLP p
+repLMP _                  = panic "@-binders in functions are not allowed yet"
+
+-- Process a list of match patterns
+repLMPs :: [LMatchPat GhcRn] -> MetaM (Core ([M TH.Pat]))
+repLMPs ps = repListM patTyConName repLMP ps
+
+
 repP :: Pat GhcRn -> MetaM (Core (M TH.Pat))
 repP (WildPat _)        = repPwild
 repP (LitPat _ l)       = do { l2 <- repLiteral l; repPlit l2 }
diff --git a/compiler/GHC/HsToCore/Ticks.hs b/compiler/GHC/HsToCore/Ticks.hs
index f47ee5689e..6af487cbfb 100644
--- a/compiler/GHC/HsToCore/Ticks.hs
+++ b/compiler/GHC/HsToCore/Ticks.hs
@@ -622,7 +622,7 @@ addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
 addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
                                                , m_grhss = gRHSs }) =
-  bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+  bindLocals (collectLMatchPatsBinders CollNoDictBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
     return $ match { m_grhss = gRHSs' }
 
@@ -876,7 +876,7 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
 addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
-  bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+  bindLocals (collectLMatchPatsBinders CollNoDictBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
     return $ match { m_grhss = gRHSs' }
 
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 64eac53af0..0abd7cf6e4 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -496,6 +496,15 @@ 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 'HsConPatTyArg'
 taScopes
   :: Scope
@@ -924,6 +933,12 @@ instance HiePass p => ToHie (HsPatSynDir (GhcPass p)) where
     ExplicitBidirectional mg -> toHie mg
     _ -> pure []
 
+instance HiePass p => ToHie (PScoped (GenLocated SrcSpanAnnA (MatchPat (GhcPass p)))) where
+  toHie (PS mb sc1 sc2 (L _ (VisPat _ pat))) =
+    toHie (PS mb sc1 sc2 pat)
+  toHie _ = panic "@-binders in functions are not allowed yet"
+
+
 instance ( HiePass p
          , Data (body (GhcPass p))
          , AnnoBody p body
@@ -933,7 +948,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 280bbbfe43..81d0d9933a 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2803,7 +2803,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
@@ -3263,7 +3263,7 @@ alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
                          acsA (\cs -> sLLAsl $1 $>
                                          (Match { m_ext = EpAnn (listAsAnchor $1) [] cs
                                                 , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing
-                                                , m_pats = $1
+                                                , m_pats = map mkVisPat $1
                                                 , m_grhss = unLoc $2 }))}
 
 alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) }
@@ -3314,6 +3314,15 @@ bindpat :  exp            {% -- See Note [Parser-Validator Details] in GHC.Parse
                              checkPattern_details incompleteDoBlock
                                               (unECP $1) }
 
+matchpat   :: { LMatchPat GhcPs }
+matchpat    : aexp                  {%  (fmap mkVisPat . checkPattern <=< runPV) (unECP $1) }
+            | PREFIX_AT tyvar       { L (getLocAnn (reLocN $2)) (InvisTyVarPat noExtField (L noSrcSpanA (UserTyVar EpAnnNotUsed () $2))) }
+            | PREFIX_AT '_'         { L (getLocAnn $2) (InvisWildTyPat noExtField) }
+
+matchpats :: { [LMatchPat GhcPs] }
+           : matchpat matchpats            { $1 : $2 }
+           | {- empty -}                   { [] }
+
 apat   :: { LPat GhcPs }
 apat    : aexp                  {% (checkPattern <=< runPV) (unECP $1) }
 
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 6f7581c2a2..2707fd870d 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -444,12 +444,6 @@ instance Diagnostic PsMessage where
       -> let msg  = parse_error_in_pat
              body = case details of
                  PEIP_NegApp -> text "-" <> ppr s
-                 PEIP_TypeArgs peipd_tyargs
-                   | not (null peipd_tyargs) -> ppr s <+> vcat [
-                               hsep (map ppr peipd_tyargs)
-                             , text "Type applications in patterns are only allowed on data constructors."
-                             ]
-                   | otherwise -> ppr s
                  PEIP_OtherPatDetails (ParseContext (Just fun) _)
                   -> ppr s <+> text "In a function binding for the"
                                      <+> quotes (ppr fun)
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index 1d3fcbc08e..1dae162d84 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -504,8 +504,6 @@ data ParseContext
 data PsErrInPatDetails
   = PEIP_NegApp
     -- ^ Negative application pattern?
-  | 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?
                     !ParseContext
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 3f99b1bfa4..be71b56ae6 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -691,17 +691,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 _ _) p2@(L _ _) -> return $ Match { m_ext = noAnn
+                                                                , m_ctxt = ctxt
+                                                                , m_pats = [mkVisPat p1, mkVisPat p2]
+                                                                , m_grhss = rhs }
                    where
                      ctxt = FunRhs { mc_fun = ln
                                    , mc_fixity = Infix
@@ -1157,6 +1158,11 @@ checkPattern_details extraDetails pp = runPV_details extraDetails (pp >>= checkL
 checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
 checkLPat e@(L l _) = checkPat l e [] []
 
+checkLMatchPat :: LocatedA (MatchPatBuilder GhcPs) -> PV (LMatchPat GhcPs)
+checkLMatchPat (L l (MatchPatBuilderVisPat p))
+  = L l <$> (VisPat noExtField <$> checkPat l (L l p) [] [])
+checkLMatchPat (L l (MatchPatBuilderMatchPat p)) = return (L l p)
+
 checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
          -> PV (LPat GhcPs)
 checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
@@ -1165,8 +1171,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
@@ -1278,12 +1282,12 @@ checkFunBind :: SrcStrictness
              -> [AddEpAnn]
              -> LocatedN RdrName
              -> LexicalFixity
-             -> [LocatedA (PatBuilder GhcPs)]
+             -> [LocatedA (MatchPatBuilder GhcPs)]
              -> 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)
-        let match_span = noAnnSrcSpan $ locF
+  = do  ps <- runPV_details extraDetails (mapM checkLMatchPat pats)
+        let match_span = noAnnSrcSpan locF
         cs <- getCommentsFor locF
         return (makeFunBind fun (L (noAnnSrcSpan $ locA match_span)
                  [L match_span (Match { m_ext = EpAnn (spanAsAnchor locF) ann cs
@@ -1356,33 +1360,58 @@ checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr
 
 isFunLhs :: LocatedA (PatBuilder GhcPs)
       -> P (Maybe (LocatedN RdrName, LexicalFixity,
-                   [LocatedA (PatBuilder GhcPs)],[AddEpAnn]))
+                   [LocatedA (MatchPatBuilder GhcPs)],[AddEpAnn]))
 -- A variable binding is parsed as a FunBind.
 -- Just (fun, is_infix, arg_pats) if e is a function LHS
 isFunLhs e = go e [] [] []
  where
+   mk :: LocatedA (PatBuilder GhcPs) -> LocatedA (MatchPatBuilder GhcPs)
+   mk = fmap MatchPatBuilderVisPat
+
+   go :: LocatedA (PatBuilder GhcPs)          -- the lhs to examine
+      -> [LocatedA (MatchPatBuilder GhcPs)]   -- acc for argument patterns, in correct order
+      -> [AddEpAnn]                           -- acc for open-paren annotations, in reverse order
+      -> [AddEpAnn]                           -- acc for close-paren annotations, in correct order
+      -> P (Maybe (LocatedN RdrName, LexicalFixity, [LocatedA (MatchPatBuilder GhcPs)], [AddEpAnn]))
    go (L _ (PatBuilderVar (L loc f))) es ops cps
        | not (isRdrDataCon f)        = return (Just (L loc f, Prefix, es, (reverse ops) ++ cps))
-   go (L _ (PatBuilderApp f e)) es       ops cps = go f (e:es) ops cps
-   go (L l (PatBuilderPar _ e _)) es@(_:_) ops cps
-                                      = let
-                                          (o,c) = mkParensEpAnn (realSrcSpan $ locA l)
-                                        in
-                                          go e es (o:ops) (c:cps)
+   go (L _ (PatBuilderApp f e))   es       ops cps = go f (mk e:es) ops cps
+   go (L l (PatBuilderPar _ e _)) es@(_:_) ops cps = go e es (o:ops) (c:cps)
+      -- NB: es@(_:_) means that there must be an arg after the parens for the
+      -- LHS to be a function LHS. This corresponds to the Haskell Report's definition
+      -- of funlhs.
+     where
+       (o,c) = mkParensEpAnn (realSrcSpan $ locA l)
    go (L loc (PatBuilderOpApp l (L loc' op) r (EpAnn loca anns cs))) es ops cps
-        | not (isRdrDataCon op)         -- We have found the function!
-        = return (Just (L loc' op, Infix, (l:r:es), (anns ++ reverse ops ++ cps)))
-        | otherwise                     -- Infix data con; keep going
-        = do { mb_l <- go l es ops cps
-             ; case mb_l of
-                 Just (op', Infix, j : k : es', anns')
-                   -> return (Just (op', Infix, j : op_app : es', anns'))
-                   where
-                     op_app = L loc (PatBuilderOpApp k
-                               (L loc' op) r (EpAnn loca (reverse ops++cps) cs))
-                 _ -> return Nothing }
+      | not (isRdrDataCon op)         -- We have found the function!
+      = return (Just (L loc' op, Infix, (mk l:mk r:es), (anns ++ reverse ops ++ cps)))
+      | otherwise                     -- Infix data con; keep going
+      = do { mb_l <- go l es ops cps
+           ; return (join $ fmap reassociate mb_l) }
+        where
+          reassociate (op', Infix, j : L k_loc (MatchPatBuilderVisPat k) : es', anns')
+            = Just (op', Infix, j : op_app : es', anns')
+            where
+              op_app = mk $ L loc (PatBuilderOpApp (L k_loc k) (L loc' op) r
+                                    (EpAnn loca (reverse ops ++ cps) cs))
+          reassociate _other = Nothing
+   go (L _ (PatBuilderAppType pat _ (HsPS _ (L loc hs_ty)))) es ops cps
+             | Just arg <- go_type_arg hs_ty
+             = go pat (L loc (MatchPatBuilderMatchPat arg) : es) ops cps
    go _ _ _ _ = return Nothing
 
+   go_type_arg :: HsType GhcPs -> Maybe (MatchPat GhcPs)
+   go_type_arg (HsTyVar en_ann _ lname@(L name_loc _))
+     = Just (InvisTyVarPat noExtField (L (l2l name_loc) (UserTyVar en_ann () lname)))
+     -- TODO: Richard is deeply suspicious of en_ann getting repeated above
+     -- TODO: Richard is also suspicious of the use of l2l there.
+   go_type_arg (HsWildCardTy x)
+     = Just (InvisWildTyPat x)
+      -- TODO: deal with (a :: ki) and (_ :: ki) constructs
+   go_type_arg _other = Nothing
+
+
+
 mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
 mkBangTy anns strictness =
   HsBangTy anns (HsSrcBang NoSourceText NoSrcUnpack strictness)
@@ -1470,7 +1499,7 @@ instance DisambInfixOp (HsExpr GhcPs) where
 instance DisambInfixOp RdrName where
   mkHsConOpPV (L l v) = return $ L l v
   mkHsVarOpPV (L l v) = return $ L l v
-  mkHsInfixHolePV l _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrInvalidInfixHole
+  mkHsInfixHolePV l _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrInvalidInfixHole
 
 type AnnoBody b
   = ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ SrcAnn NoEpAnns
@@ -1640,7 +1669,7 @@ instance DisambECP (HsCmd GhcPs) where
   type Body (HsCmd GhcPs) = HsCmd
   ecpFromCmd' = return
   ecpFromExp' (L l e) = cmdFail (locA l) (ppr e)
-  mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $
+  mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l
                                                  PsErrOverloadedRecordDotInvalid
   mkHsLamPV l mg = do
     cs <- getCommentsFor l
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index 6ea37dda6d..a89472cc5f 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -7,6 +7,7 @@ module GHC.Parser.Types
    ( SumOrTuple(..)
    , pprSumOrTuple
    , PatBuilder(..)
+   , MatchPatBuilder(..)
    , DataConBuilder(..)
    )
 where
@@ -61,6 +62,10 @@ data PatBuilder p
   | PatBuilderVar (LocatedN RdrName)
   | PatBuilderOverLit (HsOverLit GhcPs)
 
+data MatchPatBuilder p
+  = MatchPatBuilderVisPat (PatBuilder p)
+  | MatchPatBuilderMatchPat (MatchPat p)
+
 instance Outputable (PatBuilder GhcPs) where
   ppr (PatBuilderPat p) = ppr p
   ppr (PatBuilderPar _ (L _ p) _) = parens (ppr p)
@@ -70,6 +75,10 @@ instance Outputable (PatBuilder GhcPs) where
   ppr (PatBuilderVar v) = ppr v
   ppr (PatBuilderOverLit l) = ppr l
 
+instance Outputable (MatchPatBuilder GhcPs) where
+  ppr (MatchPatBuilderVisPat p) = ppr p
+  ppr (MatchPatBuilderMatchPat p) = ppr p
+
 -- | An accumulator to build a prefix data constructor,
 --   e.g. when parsing @MkT A B C@, the accumulator will evolve as follows:
 --
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 5ade2db117..df869dee1a 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -1238,7 +1238,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 6316ecea63..0dee0764e2 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -2684,7 +2684,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 ca83adcd01..250aefe6aa 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1543,8 +1543,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 2d6cb57bd1..489addeac6 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -22,7 +22,8 @@ general, all of these functions return a renamed thing, and a set of
 free variables.
 -}
 module GHC.Rename.Pat (-- main entry points
-              rnPat, rnPats, rnBindPat,
+              rnPat, rnBindPat, rnPatAndThen,
+              rnLMatchPats, rnLMatchPat,
 
               NameMaker, applyNameMaker,     -- a utility for making names:
               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
@@ -404,41 +405,71 @@ There are various entry points to renaming patterns, depending on
 --   * local namemaker
 --   * unused and duplicate checking
 --   * no fixities
-rnPats :: HsMatchContext GhcRn -- for error messages
-       -> [LPat GhcPs]
-       -> ([LPat GhcRn] -> RnM (a, FreeVars))
-       -> RnM (a, FreeVars)
-rnPats ctxt pats thing_inside
-  = do  { envs_before <- getRdrEnvs
-
-          -- (1) rename the patterns, bringing into scope all of the term variables
-          -- (2) then do the thing inside.
-        ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
-        { -- Check for duplicated and shadowed names
-          -- Must do this *after* renaming the patterns
-          -- See Note [Collect binders only after renaming] in GHC.Hs.Utils
-          -- Because we don't bind the vars all at once, we can't
-          --    check incrementally for duplicates;
-          -- Nor can we check incrementally for shadowing, else we'll
-          --    complain *twice* about duplicates e.g. f (x,x) = ...
-          --
-          -- See Note [Don't report shadowing for pattern synonyms]
-        ; let bndrs = collectPatsBinders CollNoDictBinders pats'
-        ; addErrCtxt doc_pat $
-          if isPatSynCtxt ctxt
-             then checkDupNames bndrs
-             else checkDupAndShadowedNames envs_before bndrs
-        ; thing_inside pats' } }
+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
+
+         -- (1) rename the patterns, bringing into scope all of the term variables
+         -- (2) then do the thing inside.
+       ; unCpsRn (rnLMatchPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
+       { -- Check for duplicated and shadowed names
+         -- Must do this *after* renaming the patterns
+         -- See Note [Collect binders only after renaming] in GHC.Hs.Utils
+         -- Because we don't bind the vars all at once, we can't
+         --    check incrementally for duplicates;
+         -- Nor can we check incrementally for shadowing, else we'll
+         --    complain *twice* about duplicates e.g. f (x,x) = ...
+         --
+         -- See note [Don't report shadowing for pattern synonyms]
+       ; 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
 
+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 (UserTyVar epp_ann () rdr)))
+  = do { name <- newPatName nm rdr
+       ; return (InvisTyVarPat NoExtField (L l (UserTyVar epp_ann () (L (getLoc rdr) name))))
+       }
+rnMatchPatAndThen nm (InvisTyVarPat _ (L l (KindedTyVar epp_ann () rdr kind)))
+  = do { name <- newPatName nm rdr
+       ; (kind', _) <- liftCps $ rnLHsKind HsTypePatCtx kind
+       ; return (InvisTyVarPat NoExtField (L l (KindedTyVar epp_ann () (L (getLoc rdr) name) kind')))
+       }
+rnMatchPatAndThen _ (InvisWildTyPat _) = return (InvisWildTyPat NoExtField)
+
+rnLMatchPat :: HsMatchContext GhcRn -- for error messages
+            -> LMatchPat GhcPs
+            -> (LMatchPat GhcRn -> RnM (a, FreeVars))
+            -> RnM (a, FreeVars)
+rnLMatchPat ctxt pat thing_inside =
+  rnLMatchPats ctxt [pat] (\[pat'] -> thing_inside pat')
+
 rnPat :: HsMatchContext GhcRn -- for error messages
       -> LPat GhcPs
       -> (LPat GhcRn -> RnM (a, FreeVars))
       -> RnM (a, FreeVars)     -- Variables bound by pattern do not
                                -- appear in the result FreeVars
 rnPat ctxt pat thing_inside
-  = rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
+  = rnLMatchPat ctxt (mkVisPat pat) (\(L _ (VisPat _ pat')) -> thing_inside pat')
 
 applyNameMaker :: NameMaker -> LocatedN RdrName -> RnM (LocatedN Name)
 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatLName mk rdr)
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 16f6d49767..3fa3b1d687 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -695,7 +695,7 @@ genVarPat n = wrapGenSpan $ VarPat noExtField (wrapGenSpan n)
 genWildPat :: LPat GhcRn
 genWildPat = wrapGenSpan $ WildPat noExtField
 
-genSimpleFunBind :: Name -> [LPat GhcRn]
+genSimpleFunBind :: Name -> [LMatchPat GhcRn]
                  -> LHsExpr GhcRn -> LHsBind GhcRn
 genSimpleFunBind fun pats expr
   = L gen $ genFunBind (L gen fun)
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index b3e9fb775c..641557fc8e 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -159,7 +159,7 @@ gen_Functor_binds loc (DerivInstTys{dit_rep_tc = tycon})
     fmap_name = L (noAnnSrcSpan loc) fmap_RDR
     fmap_bind = mkRdrFunBind fmap_name fmap_eqns
     fmap_eqns = [mkSimpleMatch fmap_match_ctxt
-                               [nlWildPat]
+                               [mkVisPat nlWildPat]
                                coerce_Expr]
     fmap_match_ctxt = mkPrefixFunRhs fmap_name
 
@@ -580,7 +580,7 @@ mkSimpleLam lam =
       n:names -> do
         put names
         body <- lam (nlHsVar n)
-        return (mkHsLam [nlVarPat n] body)
+        return (mkHsLam [mkVisPat (nlVarPat n)] body)
       _ -> panic "mkSimpleLam"
 
 mkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs
@@ -591,7 +591,7 @@ mkSimpleLam2 lam =
       n1:n2:names -> do
         put names
         body <- lam (nlHsVar n1) (nlHsVar n2)
-        return (mkHsLam [nlVarPat n1,nlVarPat n2] body)
+        return (mkHsLam (map mkVisPat [nlVarPat n1, nlVarPat n2]) body)
       _ -> panic "mkSimpleLam2"
 
 -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]"
@@ -616,7 +616,7 @@ mkSimpleConMatch ctxt fold extra_pats con insides = do
           else nlParPat bare_pat
     rhs <- fold con_name
                 (zipWith (\i v -> i $ nlHsVar v) insides vars_needed)
-    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs emptyLocalBinds
+    return $ mkMatch ctxt (map mkVisPat (extra_pats ++ [pat])) rhs emptyLocalBinds
 
 -- "Con a1 a2 a3 -> fmap (\b2 -> Con a1 b2 a3) (traverse f a2)"
 --
@@ -663,10 +663,10 @@ mkSimpleConMatch2 ctxt fold extra_pats con insides = do
           | otherwise =
               let bs   = filterByList  argTysTyVarInfo bs_RDRs
                   vars = filterByLists argTysTyVarInfo bs_Vars as_Vars
-              in mkHsLam (map nlVarPat bs) (nlHsApps con_name vars)
+              in mkHsLam (map (mkVisPat . nlVarPat) bs) (nlHsApps con_name vars)
 
     rhs <- fold con_expr exps
-    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs emptyLocalBinds
+    return $ mkMatch ctxt (map mkVisPat (extra_pats ++ [pat])) rhs emptyLocalBinds
 
 -- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
 mkSimpleTupleCase :: Monad m => ([LPat GhcPs] -> DataCon -> [a]
@@ -794,7 +794,7 @@ gen_Foldable_binds loc (DerivInstTys{dit_rep_tc = tycon})
     foldMap_name = L (noAnnSrcSpan loc) foldMap_RDR
     foldMap_bind = mkRdrFunBind foldMap_name foldMap_eqns
     foldMap_eqns = [mkSimpleMatch foldMap_match_ctxt
-                                  [nlWildPat, nlWildPat]
+                                  [mkVisPat nlWildPat, mkVisPat nlWildPat]
                                   mempty_Expr]
     foldMap_match_ctxt = mkPrefixFunRhs foldMap_name
 
@@ -852,7 +852,7 @@ gen_Foldable_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
           parts <- sequence $ foldDataConArgs ft_null con dit
           case convert parts of
             Nothing -> return $
-              mkMatch null_match_ctxt [nlParPat (nlWildConPat con)]
+              mkMatch null_match_ctxt [mkVisPat (nlParPat (nlWildConPat con))]
                 false_Expr emptyLocalBinds
             Just cp -> match_null [] con cp
 
@@ -1029,7 +1029,7 @@ gen_Traversable_binds loc (DerivInstTys{dit_rep_tc = tycon})
     traverse_bind = mkRdrFunBind traverse_name traverse_eqns
     traverse_eqns =
         [mkSimpleMatch traverse_match_ctxt
-                       [nlWildPat, z_Pat]
+                       [mkVisPat nlWildPat, mkVisPat z_Pat]
                        (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])]
     traverse_match_ctxt = mkPrefixFunRhs traverse_name
 
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index a8536971bd..7d8bd6f9d1 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -246,13 +246,13 @@ gen_Eq_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
           , con1_pat <- nlParPat $ nlConVarPat data_con_RDR as_needed
           , con2_pat <- nlParPat $ nlConVarPat data_con_RDR bs_needed
           , eq_expr <- nested_eq_expr tys_needed as_needed bs_needed
-          = [([con1_pat, con2_pat], eq_expr)]
+          = [(map mkVisPat [con1_pat, con2_pat], eq_expr)]
           -- This is an enum (all constructors are nullary) - just do a simple tag check
           | all isNullarySrcDataCon all_cons
-          = [([a_Pat, b_Pat], untag_Expr [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
+          = [(map mkVisPat [a_Pat, b_Pat], untag_Expr [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
                     (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
           | otherwise
-          = [([a_Pat, b_Pat], eq_expr_with_tag_check)]
+          = [(map mkVisPat [a_Pat, b_Pat], eq_expr_with_tag_check)]
 
     ------------------------------------------------------------------
     nested_eq_expr []  [] [] = true_Expr
@@ -417,11 +417,11 @@ gen_Ord_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
       = emptyBag
 
     negate_expr = nlHsApp (nlHsVar not_RDR)
-    lE = mkSimpleGeneratedFunBind loc le_RDR [a_Pat, b_Pat] $
+    lE = mkSimpleGeneratedFunBind loc le_RDR [mkVisPat a_Pat, mkVisPat b_Pat] $
         negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr)
-    gT = mkSimpleGeneratedFunBind loc gt_RDR [a_Pat, b_Pat] $
+    gT = mkSimpleGeneratedFunBind loc gt_RDR [mkVisPat a_Pat, mkVisPat b_Pat] $
         nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr
-    gE = mkSimpleGeneratedFunBind loc ge_RDR [a_Pat, b_Pat] $
+    gE = mkSimpleGeneratedFunBind loc ge_RDR [mkVisPat a_Pat, mkVisPat b_Pat] $
         negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) a_Expr) b_Expr)
 
     get_tag con = dataConTag con - fIRST_TAG
@@ -441,7 +441,7 @@ gen_Ord_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
     mkOrdOp :: OrdOp -> LHsBind GhcPs
     -- Returns a binding   op a b = ... compares a and b according to op ....
     mkOrdOp op
-      = mkSimpleGeneratedFunBind loc (ordMethRdr op) [a_Pat, b_Pat]
+      = mkSimpleGeneratedFunBind loc (ordMethRdr op) [mkVisPat a_Pat, mkVisPat b_Pat]
                         (mkOrdOpRhs op)
 
     mkOrdOpRhs :: OrdOp -> LHsExpr GhcPs
@@ -670,7 +670,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     occ_nm = getOccString tycon
 
     succ_enum tag2con_RDR maxtag_RDR
-      = mkSimpleGeneratedFunBind loc succ_RDR [a_Pat] $
+      = mkSimpleGeneratedFunBind loc succ_RDR [mkVisPat a_Pat] $
         untag_Expr [(a_RDR, ah_RDR)] $
         nlHsIf (nlHsApps eq_RDR [nlHsVar maxtag_RDR,
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
@@ -680,7 +680,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
                                         nlHsIntLit 1]))
 
     pred_enum tag2con_RDR
-      = mkSimpleGeneratedFunBind loc pred_RDR [a_Pat] $
+      = mkSimpleGeneratedFunBind loc pred_RDR [mkVisPat a_Pat] $
         untag_Expr [(a_RDR, ah_RDR)] $
         nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
@@ -692,7 +692,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
                                                 (mkIntegralLit (-1 :: Int)))]))
 
     to_enum tag2con_RDR maxtag_RDR
-      = mkSimpleGeneratedFunBind loc toEnum_RDR [a_Pat] $
+      = mkSimpleGeneratedFunBind loc toEnum_RDR [mkVisPat a_Pat] $
         nlHsIf (nlHsApps and_RDR
                 [nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],
                  nlHsApps le_RDR [ nlHsVar a_RDR
@@ -701,7 +701,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
              (illegal_toEnum_tag occ_nm maxtag_RDR)
 
     enum_from tag2con_RDR maxtag_RDR
-      = mkSimpleGeneratedFunBind loc enumFrom_RDR [a_Pat] $
+      = mkSimpleGeneratedFunBind loc enumFrom_RDR [mkVisPat a_Pat] $
           untag_Expr [(a_RDR, ah_RDR)] $
           nlHsApps map_RDR
                 [nlHsVar tag2con_RDR,
@@ -710,7 +710,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
                             (nlHsVar maxtag_RDR))]
 
     enum_from_then tag2con_RDR maxtag_RDR
-      = mkSimpleGeneratedFunBind loc enumFromThen_RDR [a_Pat, b_Pat] $
+      = mkSimpleGeneratedFunBind loc enumFromThen_RDR [mkVisPat a_Pat, mkVisPat b_Pat] $
           untag_Expr [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
           nlHsApp (nlHsVarApps map_RDR [tag2con_RDR]) $
             nlHsPar (enum_from_then_to_Expr
@@ -723,7 +723,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
                            ))
 
     from_enum
-      = mkSimpleGeneratedFunBind loc fromEnum_RDR [a_Pat] $
+      = mkSimpleGeneratedFunBind loc fromEnum_RDR [mkVisPat a_Pat] $
           untag_Expr [(a_RDR, ah_RDR)] $
           (nlHsVarApps intDataCon_RDR [ah_RDR])
 
@@ -842,7 +842,7 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
       ]
 
     enum_range tag2con_RDR
-      = mkSimpleGeneratedFunBind loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $
+      = mkSimpleGeneratedFunBind loc range_RDR [mkVisPat $ nlTuplePat [a_Pat, b_Pat] Boxed] $
           untag_Expr [(a_RDR, ah_RDR)] $
           untag_Expr [(b_RDR, bh_RDR)] $
           nlHsApp (nlHsVarApps map_RDR [tag2con_RDR]) $
@@ -852,9 +852,9 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
 
     enum_index
       = mkSimpleGeneratedFunBind loc unsafeIndex_RDR
-                [noLocA (AsPat noAnn (noLocA c_RDR) noHsTok
+                (map mkVisPat [noLocA (AsPat noAnn (noLocA c_RDR) noHsTok
                            (nlTuplePat [a_Pat, nlWildPat] Boxed)),
-                                d_Pat] (
+                                d_Pat]) (
            untag_Expr [(a_RDR, ah_RDR)] (
            untag_Expr [(d_RDR, dh_RDR)] (
            let
@@ -868,7 +868,7 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
 
     -- This produces something like `(ch >= ah) && (ch <= bh)`
     enum_inRange
-      = mkSimpleGeneratedFunBind loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $
+      = mkSimpleGeneratedFunBind loc inRange_RDR (map mkVisPat [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat]) $
           untag_Expr [(a_RDR, ah_RDR)] (
           untag_Expr [(b_RDR, bh_RDR)] (
           untag_Expr [(c_RDR, ch_RDR)] (
@@ -902,7 +902,7 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     --------------------------------------------------------------
     single_con_range
       = mkSimpleGeneratedFunBind loc range_RDR
-          [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $
+          [mkVisPat $ nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $
         noLocA (mkHsComp ListComp stmts con_expr)
       where
         stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
@@ -914,8 +914,8 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     ----------------
     single_con_index
       = mkSimpleGeneratedFunBind loc unsafeIndex_RDR
-                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
-                 con_pat cs_needed]
+                (map mkVisPat [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
+                 con_pat cs_needed])
         -- We need to reverse the order we consider the components in
         -- so that
         --     range (l,u) !! index (l,u) i == i   -- when i is in range
@@ -940,8 +940,8 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     ------------------
     single_con_inRange
       = mkSimpleGeneratedFunBind loc inRange_RDR
-                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
-                 con_pat cs_needed] $
+                (map mkVisPat [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
+                 con_pat cs_needed]) $
           if con_arity == 0
              -- If the product type has no fields, inRange is trivially true
              -- (see #12853).
@@ -1222,9 +1222,9 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon
     pats_etc data_con
       | nullary_con =  -- skip the showParen junk...
          assert (null bs_needed)
-         ([nlWildPat, con_pat], mk_showString_app op_con_str)
+         (map mkVisPat [nlWildPat, con_pat], mk_showString_app op_con_str)
       | otherwise   =
-         ([a_Pat, con_pat],
+         ([mkVisPat a_Pat, mkVisPat con_pat],
           showParen_Expr (genOpApp a_Expr ge_RDR (nlHsLit
                          (HsInt noExtField (mkIntegralLit con_prec_plus_one))))
                          (nlHsPar (nested_compose_Expr show_thingies)))
@@ -1407,7 +1407,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
     gfoldl_bind = mkFunBindEC 3 loc gfoldl_RDR id (map gfoldl_eqn data_cons)
 
     gfoldl_eqn con
-      = ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],
+      = (map mkVisPat [nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],
                    foldl' mk_k_app (z_Expr `nlHsApp` (eta_expand_data_con con)) as_needed)
                    where
                      con_name ::  RdrName
@@ -1418,7 +1418,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
         ------------ gunfold
     gunfold_bind = mkSimpleGeneratedFunBind loc
                      gunfold_RDR
-                     [k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat]
+                     (map mkVisPat [k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat])
                      gunfold_rhs
 
     gunfold_rhs
@@ -1435,31 +1435,29 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
         mkHsLam eta_expand_pats
           (foldl nlHsApp (nlHsVar (getRdrName dc)) eta_expand_hsvars)
       where
-        eta_expand_pats = map nlVarPat eta_expand_vars
+        eta_expand_pats = map (mkVisPat . nlVarPat) eta_expand_vars
         eta_expand_hsvars = map nlHsVar eta_expand_vars
         eta_expand_vars = take (dataConSourceArity dc) as_RDRs
 
 
     mk_unfold_pat dc    -- Last one is a wild-pat, to avoid
                         -- redundant test, and annoying warning
-      | tag-fIRST_TAG == n_cons-1 = nlWildPat   -- Last constructor
-      | otherwise = nlConPat intDataCon_RDR
-                             [nlLitPat (HsIntPrim NoSourceText (toInteger tag))]
+      | tag-fIRST_TAG == n_cons-1 = nlWildPat -- Last constructor
+      | otherwise = nlConPat intDataCon_RDR [nlLitPat (HsIntPrim NoSourceText (toInteger tag))]
       where
         tag = dataConTag dc
 
         ------------ toConstr
     toCon_bind dataC_RDRs
-      = mkFunBindEC 1 loc toConstr_RDR id
-            (zipWith to_con_eqn data_cons dataC_RDRs)
-    to_con_eqn dc con_name = ([nlWildConPat dc], nlHsVar con_name)
+      = mkFunBindEC 1 loc toConstr_RDR id (zipWith to_con_eqn data_cons dataC_RDRs)
+    to_con_eqn dc con_name = ([mkVisPat (nlWildConPat dc)], nlHsVar con_name)
 
         ------------ dataTypeOf
     dataTypeOf_bind dataT_RDR
       = mkSimpleGeneratedFunBind
           loc
           dataTypeOf_RDR
-          [nlWildPat]
+          [mkVisPat nlWildPat]
           (nlHsVar dataT_RDR)
 
         ------------ gcast1/2
@@ -1483,7 +1481,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
                 | tycon_kind `tcEqKind` kind2 = mk_gcast dataCast2_RDR gcast2_RDR
                 | otherwise                 = emptyBag
     mk_gcast dataCast_RDR gcast_RDR
-      = unitBag (mkSimpleGeneratedFunBind loc dataCast_RDR [nlVarPat f_RDR]
+      = unitBag (mkSimpleGeneratedFunBind loc dataCast_RDR [mkVisPat (nlVarPat f_RDR)]
                                  (nlHsVar gcast_RDR `nlHsApp` nlHsVar f_RDR))
 
 
@@ -1666,7 +1664,7 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
     data_cons = getPossibleDataCons tycon tycon_args
 
     pats_etc mk_bracket mk_splice lift_name data_con
-      = ([con_pat], lift_Expr)
+      = ([mkVisPat con_pat], lift_Expr)
        where
             con_pat      = nlConVarPat data_con_RDR as_needed
             data_con_RDR = getRdrName data_con
@@ -2167,7 +2165,7 @@ genAuxBindSpecOriginal dflags loc spec
     gen_bind :: AuxBindSpec -> LHsBind GhcPs
     gen_bind (DerivTag2Con _ tag2con_RDR)
       = mkFunBindSE 0 loc tag2con_RDR
-           [([nlConVarPat intDataCon_RDR [a_RDR]],
+           [(map mkVisPat [nlConVarPat intDataCon_RDR [a_RDR]],
               nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)]
 
     gen_bind (DerivMaxTag tycon maxtag_RDR)
@@ -2285,13 +2283,13 @@ mkParentType tc
 -- | Make a function binding. If no equations are given, produce a function
 -- with the given arity that produces a stock error.
 mkFunBindSE :: Arity -> SrcSpan -> RdrName
-             -> [([LPat GhcPs], LHsExpr GhcPs)]
+             -> [([LMatchPat GhcPs], LHsExpr GhcPs)]
              -> LHsBind GhcPs
 mkFunBindSE arity loc fun pats_and_exprs
   = mkRdrFunBindSE arity (L (noAnnSrcSpan loc) fun) matches
   where
     matches = [mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) fun))
-                               (map (parenthesizePat appPrec) p) e
+                               (map (parenthesizeLMatchPat appPrec) p) e
                                emptyLocalBinds
               | (p,e) <-pats_and_exprs]
 
@@ -2306,13 +2304,13 @@ mkRdrFunBind fun@(L loc _fun_rdr) matches
 -- side.
 mkFunBindEC :: Arity -> SrcSpan -> RdrName
             -> (LHsExpr GhcPs -> LHsExpr GhcPs)
-            -> [([LPat GhcPs], LHsExpr GhcPs)]
+            -> [([LMatchPat GhcPs], LHsExpr GhcPs)]
             -> LHsBind GhcPs
 mkFunBindEC arity loc fun catch_all pats_and_exprs
   = mkRdrFunBindEC arity catch_all (L (noAnnSrcSpan loc) fun) matches
   where
     matches = [ mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) fun))
-                                (map (parenthesizePat appPrec) p) e
+                                (map (parenthesizeLMatchPat appPrec) p) e
                                 emptyLocalBinds
               | (p,e) <- pats_and_exprs ]
 
@@ -2339,7 +2337,7 @@ mkRdrFunBindEC arity catch_all fun@(L loc _fun_rdr) matches
    -- See #4302
    matches' = if null matches
               then [mkMatch (mkPrefixFunRhs fun)
-                            (replicate (arity - 1) nlWildPat ++ [z_Pat])
+                            (replicate (arity - 1) (mkVisPat nlWildPat) ++ [mkVisPat z_Pat])
                             (catch_all $ nlHsCase z_Expr [])
                             emptyLocalBinds]
               else matches
@@ -2359,7 +2357,7 @@ mkRdrFunBindSE arity fun@(L loc fun_rdr) matches
    -- See #4302
    matches' = if null matches
               then [mkMatch (mkPrefixFunRhs fun)
-                            (replicate arity nlWildPat)
+                            (replicate arity (mkVisPat nlWildPat))
                             (error_Expr str) emptyLocalBinds]
               else matches
    str = "Void " ++ occNameString (rdrNameOcc fun_rdr)
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 6e4166d36d..90759851f9 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -359,7 +359,7 @@ tcCmdMatchLambda env
     -- Check the patterns, and the GRHSs inside
     tc_match arg_tys cmd_stk' (L mtch_loc (Match { m_pats = pats, m_grhss = grhss }))
       = do { (pats', grhss') <- setSrcSpanA mtch_loc           $
-                                tcPats match_ctxt pats arg_tys $
+                                tcLMatchPats match_ctxt pats arg_tys $
                                 tc_grhss grhss cmd_stk' (mkCheckExpType res_ty)
 
            ; return $ L mtch_loc (Match { m_ext = noAnn
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index cb7f5cfb56..92d7709089 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -1331,7 +1331,7 @@ desugarRecordUpd record_expr rbnds res_ty
              -- we let-bind x' = e1, y' = e2 and generate the equation:
              --
              --   T1 _ _ z -> T1 x' y' z
-             make_pat conLike = mkSimpleMatch CaseAlt [pat] rhs
+             make_pat conLike = mkSimpleMatch CaseAlt [mkVisPat pat] rhs
                where
                  (lhs_con_pats, rhs_con_args)
                     = zipWithAndUnzip mk_con_arg [1..] con_fields
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index e1a0c2401b..778e6f0365 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -258,7 +258,7 @@ tcMatch ctxt pat_tys rhs_ty match
     tc_match ctxt pat_tys rhs_ty
              match@(Match { m_pats = pats, m_grhss = grhss })
       = add_match_ctxt match $
-        do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $
+        do { (pats', grhss') <- tcLMatchPats (mc_what ctxt) pats pat_tys $
                                 tcGRHSs ctxt grhss rhs_ty
            ; return (Match { m_ext = noAnn
                            , m_ctxt = mc_what ctxt, m_pats = pats'
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 83bb70e35f..c8589145cb 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -19,7 +19,7 @@ module GHC.Tc.Gen.Pat
    , newLetBndr
    , LetBndrSpec(..)
    , tcCheckPat, tcCheckPat_O, tcInferPat
-   , tcPats
+   , tcLMatchPats
    , addDataConStupidTheta
    , polyPatSig
    )
@@ -99,25 +99,25 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside
        ; tc_lpat pat_ty penv pat thing_inside }
 
 -----------------
-tcPats :: HsMatchContext GhcTc
-       -> [LPat GhcRn]             -- ^ atterns
-       -> [Scaled ExpSigmaTypeFRR] -- ^ types of the patterns
-       -> TcM a                    -- ^ checker for the body
-       -> TcM ([LPat GhcTc], a)
-
--- This is the externally-callable wrapper function
--- Typecheck the patterns, extend the environment to bind the variables,
--- do the thing inside, use any existentially-bound dictionaries to
--- discharge parts of the returning LIE, and deal with pattern type
--- signatures
-
---   1. Initialise the PatState
---   2. Check the patterns
---   3. Check the body
---   4. Check that no existentials escape
-
-tcPats ctxt pats pat_tys thing_inside
-  = tc_lpats pat_tys penv pats thing_inside
+tcLMatchPats :: HsMatchContext GhcTc
+             -> [LMatchPat GhcRn]            -- Patterns,
+             -> [Scaled ExpSigmaTypeFRR]         --   and their types
+             -> TcM a                  --   and the checker for the body
+             -> TcM ([LMatchPat GhcTc], a)
+
+    -- This is the externally-callable wrapper function
+    -- Typecheck the patterns, extend the environment to bind the variables,
+    -- do the thing inside, use any existentially-bound dictionaries to
+    -- discharge parts of the returning LIE, and deal with pattern type
+    -- signatures
+
+    --   1. Initialise the PatState
+    --   2. Check the patterns
+    --   3. Check the body
+    --   4. Check that no existentials escape
+
+tcLMatchPats ctxt pats pat_tys thing_inside
+  = tc_lmatchpats pat_tys penv pats thing_inside
   where
     penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = PatOrigin }
 
@@ -350,6 +350,24 @@ tc_lpats tys penv pats
                penv
                (zipEqual "tc_lpats" pats tys)
 
+tc_lmatchpat :: Scaled ExpSigmaTypeFRR
+             -> Checker (LMatchPat GhcRn) (LMatchPat GhcTc)
+tc_lmatchpat pat_ty penv (L l (VisPat x pat)) thing_inside
+  = do  { (pat', res) <- tc_lpat pat_ty penv pat thing_inside
+        ; return (L l (VisPat x pat'), res) }
+tc_lmatchpat _ _ _ _
+  = failWithTc (TcRnUnknownMessage $ mkPlainError noHints $ msg)
+  where
+    msg = text "@-binders in functions are not allowed yet"
+
+tc_lmatchpats :: [Scaled ExpSigmaTypeFRR]
+              -> Checker [LMatchPat GhcRn] [LMatchPat GhcTc]
+tc_lmatchpats tys penv pats
+  = assertPpr (equalLength pats tys) (ppr pats $$ ppr tys) $
+    tcMultiple (\ penv' (p,t) -> tc_lmatchpat t penv' p)
+               penv
+               (zipEqual "tc_lmatchpat" pats tys)
+
 --------------------
 -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
 checkManyPattern :: Scaled a -> TcM HsWrapper
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 7fd1f3677f..7cd2c859e2 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -820,7 +820,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn
 
              fail' = nlHsApps fail [nlHsVar voidPrimId]
 
-             args = map nlVarPat [scrutinee, cont, fail]
+             args = map (mkVisPat . nlVarPat) [scrutinee, cont, fail]
              lwpat = noLocA $ WildPat pat_ty
              cases = if isIrrefutableHsPat dflags lpat
                      then [mkHsCaseAlt lpat  cont']
@@ -986,7 +986,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name)
             builder_args  = [L (na2la loc) (VarPat noExtField (L loc n))
                             | L loc n <- args]
             builder_match = mkMatch (mkPrefixFunRhs ps_lname)
-                                    builder_args body
+                                    (map mkVisPat builder_args) body
                                     (EmptyLocalBinds noExtField)
 
     args = case details of
@@ -998,7 +998,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name)
                   -> MatchGroup GhcRn (LHsExpr GhcRn)
     add_dummy_arg mg@(MG { mg_alts =
                            (L l [L loc match@(Match { m_pats = pats })]) })
-      = mg { mg_alts = L l [L loc (match { m_pats = nlWildPatName : pats })] }
+      = mg { mg_alts = L l [L loc (match { m_pats = mkVisPat nlWildPatName : pats })] }
     add_dummy_arg other_mg = pprPanic "add_dummy_arg" $
                              pprMatches other_mg
 
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index a77d6be317..5a3d5623e2 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -927,7 +927,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel
                                            [] unit_rhs]
              | otherwise =  map mk_match cons_w_field ++ deflt
     mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname)
-                                 [L loc' (mk_sel_pat con)]
+                                 [mkVisPat (L loc' (mk_sel_pat con))]
                                  (L loc' (HsVar noExtField (L locn field_var)))
     mk_sel_pat con = ConPat NoExtField (L locn (getName con)) (RecCon rec_fields)
     rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
@@ -947,7 +947,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel
     -- mentions this particular record selector
     deflt | all dealt_with all_cons = []
           | otherwise = [mkSimpleMatch CaseAlt
-                            [L loc' (WildPat noExtField)]
+                            [mkVisPat (L loc' (WildPat noExtField))]
                             (mkHsApp (L loc' (HsVar noExtField
                                          (L locn (getName rEC_SEL_ERROR_ID))))
                                      (L loc' (HsLit noComments msg_lit)))]
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index f11bc29000..b798593c1d 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -690,7 +690,7 @@ zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
           -> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
 zonkMatch env zBody (L loc match@(Match { m_pats = pats
                                         , m_grhss = grhss }))
-  = do  { (env1, new_pats) <- zonkPats env pats
+  = do  { (env1, new_pats) <- zonkMatchPats env pats
         ; new_grhss <- zonkGRHSs env1 zBody grhss
         ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) }
 
@@ -1442,6 +1442,17 @@ zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
                              ; (env', pats') <- zonkPats env1 pats
                              ; return (env', pat':pats') }
 
+zonkMatchPats :: ZonkEnv -> [LMatchPat GhcTc] -> TcM (ZonkEnv, [LMatchPat GhcTc])
+zonkMatchPats env [] = return (env, [])
+zonkMatchPats env (pat:pats) =
+  case pat of
+    L l (VisPat x lpat) -> do { (env1, pat') <- zonkPat env lpat
+                              ; (env', pats') <- zonkMatchPats env1 pats
+                              ; return (env', L l (VisPat x pat') : pats')
+                              }
+    L _ (InvisTyVarPat x _) -> dataConCantHappen x
+    L _ (InvisWildTyPat x)  -> dataConCantHappen x
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 8d795d7fe2..eb11ec9125 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -959,7 +959,7 @@ cvtClause ctxt (Clause ps body wheres)
         ; let pps = map (parenthesizePat appPrec) ps'
         ; g'  <- cvtGuard body
         ; ds' <- cvtLocalDecs (text "a where clause") wheres
-        ; returnLA $ Hs.Match noAnn ctxt pps (GRHSs emptyComments g' ds') }
+        ; returnLA $ Hs.Match noAnn ctxt (map mkVisPat pps) (GRHSs emptyComments g' ds') }
 
 cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
 cvtImplicitParamBind n e = do
@@ -1006,7 +1006,7 @@ cvtl e = wrapLA (cvt e)
                                -- oddities that can result from zero-argument
                                -- lambda expressions. See #13856.
     cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e
-                            ; let pats = map (parenthesizePat appPrec) ps'
+                            ; let pats = map (mkVisPat . (parenthesizePat appPrec)) ps'
                             ; th_origin <- getOrigin
                             ; wrapParLA (HsLam noExtField . mkMatchGroup th_origin)
                                         [mkSimpleMatch LambdaExpr pats e']}
@@ -1280,7 +1280,7 @@ cvtMatch ctxt (TH.Match p body decs)
                      _                -> p'
         ; g' <- cvtGuard body
         ; decs' <- cvtLocalDecs (text "a where clause") decs
-        ; returnLA $ Hs.Match noAnn ctxt [lp] (GRHSs emptyComments g' decs') }
+        ; returnLA $ Hs.Match noAnn ctxt [mkVisPat lp] (GRHSs emptyComments g' decs') }
 
 cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
 cvtGuard (GuardedB pairs) = mapM cvtpair pairs
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 326c9903dc..5f774de2e4 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -976,8 +976,8 @@ data Match p body
   = Match {
         m_ext :: XCMatch p body,
         m_ctxt :: HsMatchContext p,
-          -- See Note [m_ctxt in Match]
-        m_pats :: [LPat p], -- The patterns
+          -- See note [m_ctxt in Match]
+        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 4bdb3ce3cb..bea00f86f8 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -604,6 +604,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 95abde9ce0..5f5f73362c 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, ConLikeP,
 
         HsConPatDetails, hsConPatArgs,
         HsConPatTyArg(..),
@@ -224,6 +223,17 @@ data Pat p
 
 type family ConLikeP x
 
+-- | A pattern to be used in a sequence of patterns, like what appears
+-- to the right of @f@ in @f a b True = ...@. A 'MatchPat' allows for the
+-- possibility of binding a /type variable/ with \@.
+data MatchPat pass
+  = VisPat (XVisPat pass) (LPat pass)
+  -- () means that we don't accept f @{x} syntax
+  | InvisTyVarPat (XInvisTyVarPat pass) (LHsTyVarBndr () pass)
+  | InvisWildTyPat (XInvisWildTyPat pass)
+  | XMatchPat !(XXMatchPat pass)
+
+type LMatchPat pass = XRec pass (MatchPat pass)
 
 -- ---------------------------------------------------------------------
 
diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs
index 2b55c1267d..d771bd7cbb 100644
--- a/testsuite/tests/ghc-api/T6145.hs
+++ b/testsuite/tests/ghc-api/T6145.hs
@@ -41,7 +41,7 @@ main = do
         = not (isEmptyBag (filterBag isDataCon bs))
       isDataCon (L l (f@FunBind {}))
         | (MG _ (L _ (m:_))) <- fun_matches f,
-          ((L _ (c@ConPat{})):_)<-hsLMatchPats m,
+          (L _ (VisPat _ (L _ (c@ConPat{}))):_)<-hsLMatchPats m,
           (L l _)<-pat_con c
         = isGoodSrcSpan (locA l) -- Check that the source location is a good one
       isDataCon _
diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr
index 9147e29ec4..c488bc0113 100644
--- a/testsuite/tests/parser/should_compile/DumpSemis.stderr
+++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr
@@ -1402,12 +1402,16 @@
             (NoSrcStrict))
            [(L
              (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:32:3 })
-             (VarPat
+             (VisPat
               (NoExtField)
               (L
                (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:32:3 })
-               (Unqual
-                {OccName: x}))))]
+               (VarPat
+                (NoExtField)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:32:3 })
+                 (Unqual
+                  {OccName: x}))))))]
            (GRHSs
             (EpaComments
              [])
@@ -1761,12 +1765,16 @@
             (NoSrcStrict))
            [(L
              (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:36:5 })
-             (VarPat
+             (VisPat
               (NoExtField)
               (L
                (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:36:5 })
-               (Unqual
-                {OccName: x}))))]
+               (VarPat
+                (NoExtField)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:36:5 })
+                 (Unqual
+                  {OccName: x}))))))]
            (GRHSs
             (EpaComments
              [])
@@ -1849,21 +1857,25 @@
                       (CaseAlt)
                       [(L
                         (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:39:6 })
-                        (NPat
-                         (EpAnnNotUsed)
+                        (VisPat
+                         (NoExtField)
                          (L
-                          (SrcSpanAnn
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:39:6 })
+                          (NPat
                            (EpAnnNotUsed)
-                           { DumpSemis.hs:39:6 })
-                          (OverLit
-                           (NoExtField)
-                           (HsIntegral
-                            (IL
-                             (SourceText 0)
-                             (False)
-                             (0)))))
-                         (Nothing)
-                         (NoExtField)))]
+                           (L
+                            (SrcSpanAnn
+                             (EpAnnNotUsed)
+                             { DumpSemis.hs:39:6 })
+                            (OverLit
+                             (NoExtField)
+                             (HsIntegral
+                              (IL
+                               (SourceText 0)
+                               (False)
+                               (0)))))
+                           (Nothing)
+                           (NoExtField)))))]
                       (GRHSs
                        (EpaComments
                         [])
@@ -1918,21 +1930,25 @@
                       (CaseAlt)
                       [(L
                         (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:40:6 })
-                        (NPat
-                         (EpAnnNotUsed)
+                        (VisPat
+                         (NoExtField)
                          (L
-                          (SrcSpanAnn
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:40:6 })
+                          (NPat
                            (EpAnnNotUsed)
-                           { DumpSemis.hs:40:6 })
-                          (OverLit
-                           (NoExtField)
-                           (HsIntegral
-                            (IL
-                             (SourceText 1)
-                             (False)
-                             (1)))))
-                         (Nothing)
-                         (NoExtField)))]
+                           (L
+                            (SrcSpanAnn
+                             (EpAnnNotUsed)
+                             { DumpSemis.hs:40:6 })
+                            (OverLit
+                             (NoExtField)
+                             (HsIntegral
+                              (IL
+                               (SourceText 1)
+                               (False)
+                               (1)))))
+                           (Nothing)
+                           (NoExtField)))))]
                       (GRHSs
                        (EpaComments
                         [])
@@ -1989,21 +2005,25 @@
                       (CaseAlt)
                       [(L
                         (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:41:6 })
-                        (NPat
-                         (EpAnnNotUsed)
+                        (VisPat
+                         (NoExtField)
                          (L
-                          (SrcSpanAnn
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:41:6 })
+                          (NPat
                            (EpAnnNotUsed)
-                           { DumpSemis.hs:41:6 })
-                          (OverLit
-                           (NoExtField)
-                           (HsIntegral
-                            (IL
-                             (SourceText 2)
-                             (False)
-                             (2)))))
-                         (Nothing)
-                         (NoExtField)))]
+                           (L
+                            (SrcSpanAnn
+                             (EpAnnNotUsed)
+                             { DumpSemis.hs:41:6 })
+                            (OverLit
+                             (NoExtField)
+                             (HsIntegral
+                              (IL
+                               (SourceText 2)
+                               (False)
+                               (2)))))
+                           (Nothing)
+                           (NoExtField)))))]
                       (GRHSs
                        (EpaComments
                         [])
@@ -2062,21 +2082,25 @@
                       (CaseAlt)
                       [(L
                         (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:42:6 })
-                        (NPat
-                         (EpAnnNotUsed)
+                        (VisPat
+                         (NoExtField)
                          (L
-                          (SrcSpanAnn
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:42:6 })
+                          (NPat
                            (EpAnnNotUsed)
-                           { DumpSemis.hs:42:6 })
-                          (OverLit
-                           (NoExtField)
-                           (HsIntegral
-                            (IL
-                             (SourceText 3)
-                             (False)
-                             (3)))))
-                         (Nothing)
-                         (NoExtField)))]
+                           (L
+                            (SrcSpanAnn
+                             (EpAnnNotUsed)
+                             { DumpSemis.hs:42:6 })
+                            (OverLit
+                             (NoExtField)
+                             (HsIntegral
+                              (IL
+                               (SourceText 3)
+                               (False)
+                               (3)))))
+                           (Nothing)
+                           (NoExtField)))))]
                       (GRHSs
                        (EpaComments
                         [])
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index f9b9a986e4..4d504287be 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -876,12 +876,20 @@
             (NoSrcStrict))
            [(L
              (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:23:5 })
-             (WildPat
-              (NoExtField)))
+             (VisPat
+              (NoExtField)
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:23:5 })
+               (WildPat
+                (NoExtField)))))
            ,(L
              (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:23:7 })
-             (WildPat
-              (NoExtField)))]
+             (VisPat
+              (NoExtField)
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:23:7 })
+               (WildPat
+                (NoExtField)))))]
            (GRHSs
             (EpaComments
              [])
diff --git a/testsuite/tests/parser/should_fail/T17594b.hs b/testsuite/tests/parser/should_fail/T17594b.hs
new file mode 100644
index 0000000000..c0f92f9b26
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594b.hs
@@ -0,0 +1,6 @@
+module T17594b where
+
+foo :: forall a. a -> a
+foo @a =
+  case a of
+    @a -> id
diff --git a/testsuite/tests/parser/should_fail/T17594b.stderr b/testsuite/tests/parser/should_fail/T17594b.stderr
new file mode 100644
index 0000000000..a41e27242e
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594b.stderr
@@ -0,0 +1,9 @@
+
+T17594b.hs:5:3: error:
+    Unexpected case expression in function application:
+        case a of {}
+    Suggested fixes:
+      • Use parentheses.
+      • Perhaps you intended to use BlockArguments
+
+T17594b.hs:6:8: error: parse error on input ‘->’
diff --git a/testsuite/tests/parser/should_fail/T17594c.hs b/testsuite/tests/parser/should_fail/T17594c.hs
new file mode 100644
index 0000000000..1cb84bccb7
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594c.hs
@@ -0,0 +1,6 @@
+module T17594c where
+
+foo :: forall a m. Monad m => a -> m a
+foo x = do
+  @a <- undefined
+  return (x :: a)
diff --git a/testsuite/tests/parser/should_fail/T17594c.stderr b/testsuite/tests/parser/should_fail/T17594c.stderr
new file mode 100644
index 0000000000..d93da5d6a5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594c.stderr
@@ -0,0 +1,11 @@
+
+T17594c.hs:4:9: error:
+    Unexpected do block in function application:
+        do
+    Suggested fixes:
+      • Use parentheses.
+      • Perhaps you intended to use BlockArguments
+
+T17594c.hs:5:6: error:
+    parse error on input ‘<-’
+    Suggested fix: Possibly caused by a missing 'do'?
diff --git a/testsuite/tests/parser/should_fail/T17594e.hs b/testsuite/tests/parser/should_fail/T17594e.hs
new file mode 100644
index 0000000000..92608eddec
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594e.hs
@@ -0,0 +1,5 @@
+module T17594e where
+
+thing :: forall a b. (a -> b) -> a -> b
+thing @a @b f x = f x
+thing @a = \ @b f x -> f x
diff --git a/testsuite/tests/parser/should_fail/T17594e.stderr b/testsuite/tests/parser/should_fail/T17594e.stderr
new file mode 100644
index 0000000000..543113b4a5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17594e.stderr
@@ -0,0 +1,5 @@
+
+T17594e.hs:4:1: error:
+    Equations for ‘thing’ have different numbers of arguments
+      T17594e.hs:4:1-21
+      T17594e.hs:5:1-26
diff --git a/testsuite/tests/parser/should_fail/T18251d.stderr b/testsuite/tests/parser/should_fail/T18251d.stderr
index 15825502e0..bf82c53290 100644
--- a/testsuite/tests/parser/should_fail/T18251d.stderr
+++ b/testsuite/tests/parser/should_fail/T18251d.stderr
@@ -1,4 +1,6 @@
 
 T18251d.hs:6:1: error:
-    Parse error in pattern: f @a
-    Type applications in patterns are only allowed on data constructors.
+    • @-binders in functions are not allowed yet
+    • In an equation for ‘f’: f @a _ = ()
+      The equation for ‘f’ has two value arguments,
+        but its type ‘a -> ()’ has only one
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 4d70833bed..786b9829fe 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -208,3 +208,6 @@ test('OpaqueParseFail4', normal, compile_fail, [''])
 test('T20385A', normal, compile_fail, [''])
 test('T20385B', normal, compile_fail, [''])
 test('T16999', normal, compile_fail, [''])
+test('T17594b', normal, compile_fail, [''])
+test('T17594c', normal, compile_fail, [''])
+test('T17594e', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T17594a.hs b/testsuite/tests/typecheck/should_fail/T17594a.hs
new file mode 100644
index 0000000000..c43d362a3c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594a.hs
@@ -0,0 +1,13 @@
+module T17594a where
+
+id1 :: forall a. a -> a
+id1 @a x = x
+
+id2 :: forall a. a -> a
+id2 @_ x = x
+
+id3 :: forall a. a -> a
+id3 @a (x :: a) = x
+
+const' :: forall a. a -> forall b. b -> a
+const' @a x @b y = x
diff --git a/testsuite/tests/typecheck/should_fail/T17594a.stderr b/testsuite/tests/typecheck/should_fail/T17594a.stderr
new file mode 100644
index 0000000000..9302796ce4
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594a.stderr
@@ -0,0 +1,24 @@
+
+T17594a.hs:4:1: error:
+    • @-binders in functions are not allowed yet
+    • In an equation for ‘id1’: id1 @a x = x
+      The equation for ‘id1’ has two value arguments,
+        but its type ‘a -> a’ has only one
+
+T17594a.hs:7:1: error:
+    • @-binders in functions are not allowed yet
+    • In an equation for ‘id2’: id2 @_ x = x
+      The equation for ‘id2’ has two value arguments,
+        but its type ‘a -> a’ has only one
+
+T17594a.hs:10:1: error:
+    • @-binders in functions are not allowed yet
+    • In an equation for ‘id3’: id3 @a (x :: a) = x
+      The equation for ‘id3’ has two value arguments,
+        but its type ‘a -> a’ has only one
+
+T17594a.hs:13:1: error:
+    • @-binders in functions are not allowed yet
+    • In an equation for ‘const'’: const' @a x @b y = x
+      The equation for ‘const'’ has four value arguments,
+        but its type ‘a -> b -> a’ has only two
diff --git a/testsuite/tests/typecheck/should_fail/T17594b.hs b/testsuite/tests/typecheck/should_fail/T17594b.hs
new file mode 100644
index 0000000000..cb7013efd0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594b.hs
@@ -0,0 +1,6 @@
+module T17594b where
+
+f :: forall a. a -> a
+f @x =
+  case x of
+    @a -> id
diff --git a/testsuite/tests/typecheck/should_fail/T17594d.hs b/testsuite/tests/typecheck/should_fail/T17594d.hs
new file mode 100644
index 0000000000..f5abd04710
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594d.hs
@@ -0,0 +1,13 @@
+module T17594d where
+
+thing :: forall k (a :: k) b. (a -> b) -> a -> b
+thing @k @(a :: k) f x = f x
+
+thing' :: forall k (a :: k) b. (a -> b) -> a -> b
+thing' @_ @a f x = f x
+
+thing'' :: forall k (a :: k) b. (a -> b) -> a -> b
+thing'' @k @_ f x = f x
+
+thing''' :: forall k (a :: k) b. (a -> b) -> a -> b
+thing''' @_ @_ f x = f x
diff --git a/testsuite/tests/typecheck/should_fail/T17594d.stderr b/testsuite/tests/typecheck/should_fail/T17594d.stderr
new file mode 100644
index 0000000000..9db8658992
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594d.stderr
@@ -0,0 +1,2 @@
+
+T17594d.hs:4:1: error: Parse error in pattern: thing
diff --git a/testsuite/tests/typecheck/should_fail/T17594f.hs b/testsuite/tests/typecheck/should_fail/T17594f.hs
new file mode 100644
index 0000000000..32578e6193
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594f.hs
@@ -0,0 +1,13 @@
+module T17594f where
+
+id1 :: forall a. a -> a
+id1 = \ @a x -> x
+
+id2 :: forall a. a -> a
+id2 = \ @_ x -> x
+
+id3 :: forall a. a -> a
+id3 = \ @a (x :: a) -> x
+
+const' :: forall a. a -> forall b. b -> a
+const' = \ @a x @b y -> x
diff --git a/testsuite/tests/typecheck/should_fail/T17594f.stderr b/testsuite/tests/typecheck/should_fail/T17594f.stderr
new file mode 100644
index 0000000000..4691dd86b0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594f.stderr
@@ -0,0 +1,30 @@
+
+T17594f.hs:4:7: error:
+    • @-binders in functions are not allowed yet
+    • The lambda expression ‘\ @a x -> x’ has two value arguments,
+        but its type ‘a -> a’ has only one
+      In the expression: \ @a x -> x
+      In an equation for ‘id1’: id1 = \ @a x -> x
+
+T17594f.hs:7:7: error:
+    • @-binders in functions are not allowed yet
+    • The lambda expression ‘\ @_ x -> x’ has two value arguments,
+        but its type ‘a -> a’ has only one
+      In the expression: \ @_ x -> x
+      In an equation for ‘id2’: id2 = \ @_ x -> x
+
+T17594f.hs:10:7: error:
+    • @-binders in functions are not allowed yet
+    • The lambda expression ‘\ @a (x :: a) -> x’
+      has two value arguments,
+        but its type ‘a -> a’ has only one
+      In the expression: \ @a (x :: a) -> x
+      In an equation for ‘id3’: id3 = \ @a (x :: a) -> x
+
+T17594f.hs:13:10: error:
+    • @-binders in functions are not allowed yet
+    • The lambda expression ‘\ @a x @b y -> x’
+      has four value arguments,
+        but its type ‘a -> b -> a’ has only two
+      In the expression: \ @a x @b y -> x
+      In an equation for ‘const'’: const' = \ @a x @b y -> x
diff --git a/testsuite/tests/typecheck/should_fail/T17594g.hs b/testsuite/tests/typecheck/should_fail/T17594g.hs
new file mode 100644
index 0000000000..63bf8346fa
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594g.hs
@@ -0,0 +1,4 @@
+module T17594g where
+
+comp :: forall a b c. (a -> b) -> (b -> c) -> a -> c
+comp @(a :: Type) @(b :: Type) @(c :: Type) = \ f g x -> g (f x)
diff --git a/testsuite/tests/typecheck/should_fail/T17594g.stderr b/testsuite/tests/typecheck/should_fail/T17594g.stderr
new file mode 100644
index 0000000000..c4f35d2f3a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17594g.stderr
@@ -0,0 +1,2 @@
+
+T17594g.hs:4:1: error: Parse error in pattern: comp
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 457e0c5bc1..de1ba1bb45 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -657,3 +657,7 @@ test('T20768_fail', normal, compile_fail, [''])
 test('T21327', normal, compile_fail, [''])
 test('T21338', normal, compile_fail, [''])
 test('T21158', normal, compile_fail, [''])
+test('T17594a', normal, compile_fail, [''])
+test('T17594d', normal, compile_fail, [''])
+test('T17594f', normal, compile_fail, [''])
+test('T17594g', normal, compile_fail, [''])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index eecb1e28eb..8f4dc70cd0 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -3625,6 +3625,19 @@ instance ExactPrint (Pat GhcPs) where
 
 -- ---------------------------------------------------------------------
 
+instance ExactPrint (MatchPat GhcPs) where
+  exact (VisPat _ pat) = exact pat
+  exact (InvisTyVarPat _ lidp) = do
+    let pun_RDR = "pun-left-hand-side"
+    when (showPprUnsafe lidp /= pun_RDR) $ markAnnotated lidp
+  exact (InvisWildTyPat _) = do
+    anchor <- getAnchorU
+    debugM $ "WildPat:anchor=" ++ show anchor
+    printStringAtRs anchor "@_"
+
+  getAnnotationEntry (VisPat _ pat) = getAnnotationEntry pat
+  getAnnotationEntry _              = NoEntryVal
+
 instance ExactPrint (HsPatSigType GhcPs) where
   getAnnotationEntry = const NoEntryVal
   exact (HsPS _ ty) = markAnnotated ty