all the other stuffwip/old-varpats

23 files changed, 314 insertions, 162 deletions

diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 3d93e0b7a5..5758ba8b74 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -286,8 +286,8 @@ dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
     let env_stk_expr = mkCorePairExpr (mkBigCoreVarTup env_ids) mkCoreUnitExpr
     fail_expr <- mkFailExpr (ArrowMatchCtxt ProcExpr) env_stk_ty
     var <- selectSimpleMatchVarL Many pat
-    match_code <- matchSimply (Var var) (ArrowMatchCtxt ProcExpr) pat env_stk_expr fail_expr
     let pat_ty = hsLPatType pat
+    match_code <- matchSimply (Var var) (ArrowMatchCtxt ProcExpr) (mkVisPat pat) env_stk_expr fail_expr
     let proc_code = do_premap meth_ids pat_ty env_stk_ty cmd_ty
                     (Lam var match_code)
                     core_cmd
@@ -559,7 +559,7 @@ dsCmd ids local_vars stack_ty res_ty
       (HsCmdLamCase _ mg@MG { mg_ext = MatchGroupTc [Scaled arg_mult arg_ty] _ }) env_ids = do
   arg_id <- newSysLocalDs arg_mult arg_ty
   let case_cmd  = noLocA $ HsCmdCase noExtField (nlHsVar arg_id) mg
-  dsCmdLam ids local_vars stack_ty res_ty [nlVarPat arg_id] case_cmd env_ids
+  dsCmdLam ids local_vars stack_ty res_ty [mkVisPat (nlVarPat arg_id)] case_cmd env_ids
 
 -- D; ys |-a cmd : stk --> t
 -- ----------------------------------
@@ -691,7 +691,7 @@ dsCmdLam :: DsCmdEnv            -- arrow combinators
          -> IdSet               -- set of local vars available to this command
          -> Type                -- type of the stack (right-nested tuple)
          -> Type                -- return type of the command
-         -> [LPat GhcTc]        -- argument patterns to desugar
+         -> [LMatchPat GhcTc]   -- argument patterns to desugar
          -> LHsCmd GhcTc        -- body to desugar
          -> [Id]                -- list of vars in the input to this command
                                 -- This is typically fed back,
@@ -699,7 +699,7 @@ dsCmdLam :: DsCmdEnv            -- arrow combinators
          -> DsM (CoreExpr,      -- desugared expression
                  DIdSet)        -- subset of local vars that occur free
 dsCmdLam ids local_vars stack_ty res_ty pats body env_ids = do
-    let pat_vars = mkVarSet (collectPatsBinders CollWithDictBinders pats)
+    let pat_vars = mkVarSet (collectLMatchPatsBinders CollWithDictBinders pats)
     let local_vars' = pat_vars `unionVarSet` local_vars
         (pat_tys, stack_ty') = splitTypeAt (length pats) stack_ty
     (core_body, free_vars, env_ids')
@@ -865,7 +865,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do
     fail_expr <- mkFailExpr (StmtCtxt (HsDoStmt (DoExpr Nothing))) out_ty
     pat_id    <- selectSimpleMatchVarL Many pat
     match_code
-      <- matchSimply (Var pat_id) (StmtCtxt (HsDoStmt (DoExpr Nothing))) pat body_expr fail_expr
+      <- matchSimply (Var pat_id) (StmtCtxt (HsDoStmt (DoExpr Nothing))) (mkVisPat pat) body_expr fail_expr
     pair_id   <- newSysLocalDs Many after_c_ty
     let
         proj_expr = Lam pair_id (coreCasePair pair_id pat_id env_id match_code)
@@ -1094,7 +1094,7 @@ dsCmdStmts _ _ _ [] _ = panic "dsCmdStmts []"
 
 matchSimplys :: [CoreExpr]              -- Scrutinees
              -> HsMatchContext GhcRn    -- Match kind
-             -> [LPat GhcTc]            -- Patterns they should match
+             -> [LMatchPat GhcTc]            -- Patterns they should match
              -> CoreExpr                -- Return this if they all match
              -> CoreExpr                -- Return this if they don't
              -> DsM CoreExpr
@@ -1111,7 +1111,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/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 2e45539fba..a6ebd06e38 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -667,7 +667,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' }
 
@@ -922,7 +922,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/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index f818be46a1..e8a656203c 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -207,11 +207,11 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss
         -- ==> case rhs of C x# y# -> body
     do { match_nablas <- pmcGRHSs PatBindGuards grhss
        ; rhs          <- dsGuarded grhss ty match_nablas
-       ; let upat = unLoc pat
+       ; let upat = VisPat noExtField pat
              eqn = EqnInfo { eqn_pats = [upat],
                              eqn_orig = FromSource,
                              eqn_rhs = cantFailMatchResult body }
-       ; var    <- selectMatchVar Many upat
+       ; var    <- selectMatchPatVar Many upat
                     -- `var` will end up in a let binder, so the multiplicity
                     -- doesn't matter.
        ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
@@ -722,7 +722,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields
                                          , cpt_wrap = req_wrap
                                          }
                                        }
-           ; return (mkSimpleMatch RecUpd [pat] wrapped_rhs) }
+           ; return (mkSimpleMatch RecUpd [mkVisPat pat] wrapped_rhs) }
 
 {- Note [Scrutinee in Record updates]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -927,7 +927,7 @@ dsDo ctx stmts
       = do  { body     <- goL stmts
             ; rhs'     <- dsLExpr rhs
             ; var   <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat
-            ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat
+            ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) (mkVisPat pat)
                          (xbstc_boundResultType xbs) (cantFailMatchResult body)
             ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs)
             ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] }
@@ -948,7 +948,7 @@ dsDo ctx stmts
 
            ; let match_args (pat, fail_op) (vs,body)
                    = do { var   <- selectSimpleMatchVarL Many pat
-                        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat
+                        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) (mkVisPat pat)
                                    body_ty (cantFailMatchResult body)
                         ; match_code <- dsHandleMonadicFailure ctx pat match fail_op
                         ; return (var:vs, match_code)
@@ -990,7 +990,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
                                , mg_origin = Generated })
         mfix_pat     = noLocA $ LazyPat noExtField $ mkBigLHsPatTupId rec_tup_pats
diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 8ecf6c84ed..8d440219b6 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -137,7 +137,7 @@ matchGuards (BindStmt _ pat bind_rhs : stmts) ctx nablas rhs rhs_ty = do
     match_result <- matchGuards stmts ctx nablas rhs rhs_ty
     core_rhs <- dsLExpr bind_rhs
     match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx)
-                                       pat rhs_ty match_result
+                                       (mkVisPat pat) rhs_ty match_result
     pure $ bindNonRec match_var core_rhs <$> match_result'
 
 matchGuards (LastStmt  {} : _) _ _ _ _ = panic "matchGuards LastStmt"
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 12a40e6c90..9c42d87c6c 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -285,7 +285,7 @@ deBindComp pat core_list1 quals core_list2 = do
         letrec_body = App (Var h) core_list1
 
     rest_expr <- deListComp quals core_fail
-    core_match <- matchSimply (Var u2) (StmtCtxt (HsDoStmt ListComp)) pat rest_expr core_fail
+    core_match <- matchSimply (Var u2) (StmtCtxt (HsDoStmt ListComp)) (mkVisPat pat) rest_expr core_fail
 
     let
         rhs = Lam u1 $
@@ -374,7 +374,7 @@ dfBindComp c_id n_id (pat, core_list1) quals = do
 
     -- build the pattern match
     core_expr <- matchSimply (Var x) (StmtCtxt (HsDoStmt ListComp))
-                pat core_rest (Var b)
+                (mkVisPat pat) core_rest (Var b)
 
     -- now build the outermost foldr, and return
     mkFoldrExpr x_ty b_ty (mkLams [x, b] core_expr) (Var n_id) core_list1
@@ -611,7 +611,7 @@ dsMcBindStmt :: LPat GhcTc
 dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
   = do  { body     <- dsMcStmts stmts
         ; var      <- selectSimpleMatchVarL Many pat
-        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt (DoExpr Nothing))) pat
+        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt (DoExpr Nothing))) (mkVisPat pat)
                                   res1_ty (cantFailMatchResult body)
         ; match_code <- dsHandleMonadicFailure MonadComp pat match fail_op
         ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index a4cdb78f6d..4a503051e4 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -275,7 +275,7 @@ matchBangs (var :| vars) ty eqns
 matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
 -- Apply the coercion to the match variable and then match that
 matchCoercion (var :| vars) ty (eqns@(eqn1 :| _))
-  = do  { let XPat (CoPat co pat _) = firstPat eqn1
+  = do  { let VisPat _ (L _ (XPat (CoPat co pat _))) = firstPat eqn1
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var (idMult var) pat_ty'
         ; match_result <- match (var':vars) ty $ NEL.toList $
@@ -290,7 +290,7 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _))
   = do  { -- we could pass in the expr from the PgView,
          -- but this needs to extract the pat anyway
          -- to figure out the type of the fresh variable
-         let TcViewPat viewExpr pat = firstPat eqn1
+         let VisPat _ (L _ (TcViewPat viewExpr pat)) = firstPat eqn1
          -- do the rest of the compilation
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var (idMult var) pat_ty'
@@ -303,17 +303,17 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _))
                     match_result) }
 
 -- decompose the first pattern and leave the rest alone
-decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo
+decomposeFirstPat :: (MatchPat GhcTc -> MatchPat GhcTc) -> EquationInfo -> EquationInfo
 decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
         = eqn { eqn_pats = extractpat pat : pats}
 decomposeFirstPat _ _ = panic "decomposeFirstPat"
 
-getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc
-getCoPat (XPat (CoPat _ pat _)) = pat
+getCoPat, getBangPat, getViewPat :: MatchPat GhcTc -> MatchPat GhcTc
+getCoPat (VisPat _ (L _ (XPat (CoPat _ pat _)))) = VisPat noExtField (L noSrcSpanA pat)
 getCoPat _                   = panic "getCoPat"
-getBangPat (BangPat _ pat  ) = unLoc pat
+getBangPat (VisPat _ (L _ (BangPat _ pat))) = VisPat noExtField pat
 getBangPat _                 = panic "getBangPat"
-getViewPat (TcViewPat _ pat) = pat
+getViewPat (VisPat _ (L _ (TcViewPat _ pat))) = VisPat noExtField (L noSrcSpanA pat)
 getViewPat _                 = panic "getViewPat"
 
 -- | Use this pattern synonym to match on a 'ViewPat'.
@@ -403,9 +403,20 @@ tidyEqnInfo _ (EqnInfo { eqn_pats = [] })
   = panic "tidyEqnInfo"
 
 tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig })
-  = do { (wrap, pat') <- tidy1 v orig pat
+  = do { (wrap, pat') <- tidy1' v orig pat
        ; return (wrap, eqn { eqn_pats = pat' : pats }) }
 
+tidy1' :: Id
+       -> Origin
+       -> MatchPat GhcTc
+       -> DsM (DsWrapper,
+          MatchPat GhcTc)
+tidy1' v o (VisPat ty (L src pat)) =
+  do { (wrapper, pat') <- tidy1 v o pat
+     ; return (wrapper, VisPat ty (L src pat')) }
+tidy1' _ _ var@(InvisTyVarPat _ _) = return (idDsWrapper, var)
+tidy1' _ _ wild@(InvisWildTyPat _) = return (idDsWrapper, wild)
+
 tidy1 :: Id                  -- The Id being scrutinised
       -> Origin              -- Was this a pattern the user wrote?
       -> Pat GhcTc           -- The pattern against which it is to be matched
@@ -752,10 +763,10 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
         ; new_vars    <- case matches of
                            []    -> newSysLocalsDs arg_tys
                            (m:_) ->
-                            selectMatchVars (zipWithEqual "matchWrapper"
-                                              (\a b -> (scaledMult a, unLoc b))
-                                                arg_tys
-                                                (hsLMatchPats m))
+                            selectMatchPatVars (zipWithEqual "matchWrapper"
+                                                 (\a b -> (scaledMult a, unLoc b))
+                                                   arg_tys
+                                                   (hsLMatchPats m))
 
         -- Pattern match check warnings for /this match-group/.
         -- @rhss_nablas@ is a flat list of covered Nablas for each RHS.
@@ -776,7 +787,7 @@ matchWrapper ctxt mb_scr (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 . decideBangHoodMatch dflags) 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
@@ -816,7 +827,7 @@ matchEquations ctxt vars eqns_info rhs_ty
 -- pattern. It returns an expression.
 matchSimply :: CoreExpr                 -- ^ Scrutinee
             -> HsMatchContext GhcRn     -- ^ Match kind
-            -> LPat GhcTc               -- ^ Pattern it should match
+            -> LMatchPat GhcTc          -- ^ Pattern it should match
             -> CoreExpr                 -- ^ Return this if it matches
             -> CoreExpr                 -- ^ Return this if it doesn't
             -> DsM CoreExpr
@@ -837,7 +848,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
     match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
     extractMatchResult match_result' fail_expr
 
-matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc
+matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LMatchPat GhcTc
                -> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr)
 -- matchSinglePat ensures that the scrutinee is a variable
 -- and then calls matchSinglePatVar
@@ -851,7 +862,7 @@ matchSinglePat (Var var) ctx pat ty match_result
   = matchSinglePatVar var Nothing ctx pat ty match_result
 
 matchSinglePat scrut hs_ctx pat ty match_result
-  = do { var           <- selectSimpleMatchVarL Many pat
+  = do { var           <- selectMatchPatVarL Many pat
                             -- matchSinglePat is only used in matchSimply, which
                             -- is used in list comprehension, arrow notation,
                             -- and to create field selectors. All of which only
@@ -863,7 +874,7 @@ matchSinglePat scrut hs_ctx pat ty match_result
 
 matchSinglePatVar :: Id   -- See Note [Match Ids]
                   -> Maybe CoreExpr -- ^ The scrutinee the match id is bound to
-                  -> HsMatchContext GhcRn -> LPat GhcTc
+                  -> HsMatchContext GhcRn -> LMatchPat GhcTc
                   -> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr)
 matchSinglePatVar var mb_scrut ctx pat ty match_result
   = assertPpr (isInternalName (idName var)) (ppr var) $
@@ -872,14 +883,13 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result
        -- Pattern match check warnings
        ; when (isMatchContextPmChecked dflags FromSource ctx) $
            addCoreScrutTmCs mb_scrut [var] $
-           pmcPatBind (DsMatchContext ctx locn) var (unLoc pat)
+           pmcMatchPatBind (DsMatchContext ctx locn) var (unLoc pat)
 
-       ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)]
+       ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHoodMatch dflags pat)]
                                 , eqn_orig = FromSource
                                 , eqn_rhs  = match_result }
        ; match [var] ty [eqn_info] }
 
-
 {-
 ************************************************************************
 *                                                                      *
@@ -931,7 +941,7 @@ groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf
 -- (b) none of the gi are empty
 -- The ordering of equations is unchanged
 groupEquations platform eqns
-  = NEL.groupBy same_gp $ [(patGroup platform (firstPat eqn), eqn) | eqn <- eqns]
+  = NEL.groupBy same_gp $ [(patGroup platform (firstPat' eqn), eqn) | eqn <- eqns]
   -- comprehension on NonEmpty
   where
     same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
diff --git a/compiler/GHC/HsToCore/Match.hs-boot b/compiler/GHC/HsToCore/Match.hs-boot
index e163a0bde2..7b16eb465f 100644
--- a/compiler/GHC/HsToCore/Match.hs-boot
+++ b/compiler/GHC/HsToCore/Match.hs-boot
@@ -5,7 +5,7 @@ import GHC.Types.Var ( Id )
 import GHC.Tc.Utils.TcType  ( Type )
 import GHC.HsToCore.Monad ( DsM, EquationInfo, MatchResult )
 import GHC.Core ( CoreExpr )
-import GHC.Hs   ( LPat, HsMatchContext, MatchGroup, LHsExpr )
+import GHC.Hs   ( LMatchPat, HsMatchContext, MatchGroup, LHsExpr )
 import GHC.Hs.Extension ( GhcTc, GhcRn )
 
 match   :: [Id]
@@ -22,7 +22,7 @@ matchWrapper
 matchSimply
         :: CoreExpr
         -> HsMatchContext GhcRn
-        -> LPat GhcTc
+        -> LMatchPat GhcTc
         -> CoreExpr
         -> CoreExpr
         -> DsM CoreExpr
@@ -31,7 +31,7 @@ matchSinglePatVar
         :: Id
         -> Maybe CoreExpr
         -> HsMatchContext GhcRn
-        -> LPat GhcTc
+        -> LMatchPat GhcTc
         -> Type
         -> MatchResult CoreExpr
         -> DsM (MatchResult CoreExpr)
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index 1e56808278..ee0f57b362 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -154,21 +154,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns)   -- All eqns for a single construct
                      }
 
               shift (_, eqn@(EqnInfo
-                             { eqn_pats = ConPat
+                             { eqn_pats = VisPat _ (L _ (ConPat
                                { pat_args = args
                                , pat_con_ext = ConPatTc
                                  { cpt_tvs = tvs
                                  , cpt_dicts = ds
                                  , cpt_binds = bind
                                  }
-                               } : pats
+                               })) : pats
                              }))
                 = do ds_bind <- dsTcEvBinds bind
                      return ( wrapBinds (tvs `zip` tvs1)
                             . wrapBinds (ds  `zip` dicts1)
                             . mkCoreLets ds_bind
                             , eqn { eqn_orig = Generated
-                                  , eqn_pats = conArgPats val_arg_tys args ++ pats }
+                                  , eqn_pats = ((\pat -> VisPat noExtField (L noSrcSpanA pat)) <$> (conArgPats val_arg_tys args)) ++ pats }
                             )
               shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps)
         ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys
@@ -185,7 +185,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns)   -- All eqns for a single construct
 
         -- Divide into sub-groups; see Note [Record patterns]
         ; let groups :: [[(ConArgPats, EquationInfo)]]
-              groups = groupBy compatible_pats [ (pat_args (firstPat eqn), eqn)
+              groups = groupBy compatible_pats [ (pat_args (firstPat' eqn), eqn)
                                                | eqn <- eqn1:eqns ]
 
         ; match_results <- mapM (match_group arg_vars) groups
@@ -195,15 +195,15 @@ matchOneConLike vars ty mult (eqn1 :| eqns)   -- All eqns for a single construct
                               alt_wrapper = wrapper1,
                               alt_result = foldr1 combineMatchResults match_results } }
   where
-    ConPat { pat_con = L _ con1
-           , pat_args = args1
-           , pat_con_ext = ConPatTc
-             { cpt_arg_tys = arg_tys
-             , cpt_wrap = wrapper1
-             , cpt_tvs = tvs1
-             , cpt_dicts = dicts1
-             }
-           } = firstPat eqn1
+    VisPat _ (L _ (ConPat { pat_con = L _ con1
+                     , pat_args = args1
+                     , pat_con_ext = ConPatTc
+                       { cpt_arg_tys = arg_tys
+                       , cpt_wrap = wrapper1
+                       , cpt_tvs = tvs1
+                       , cpt_dicts = dicts1
+                       }
+                      })) = firstPat eqn1
     fields1 = map flSelector (conLikeFieldLabels con1)
 
     ex_tvs = conLikeExTyCoVars con1
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index a581a961b5..b70a7f2c07 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -602,7 +602,7 @@ matchLiterals (var :| vars) ty sub_groups
     match_group eqns@(firstEqn :| _)
         = do { dflags <- getDynFlags
              ; let platform = targetPlatform dflags
-             ; let LitPat _ hs_lit = firstPat firstEqn
+             ; let (VisPat _ (L _ (LitPat _ hs_lit))) = firstPat firstEqn
              ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns)
              ; return (hsLitKey platform hs_lit, match_result) }
 
@@ -651,7 +651,7 @@ hsLitKey _        l                   = pprPanic "hsLitKey" (ppr l)
 
 matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
 matchNPats (var :| vars) ty (eqn1 :| eqns)    -- All for the same literal
-  = do  { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1
+  = do  { let VisPat _ (L _ (NPat _ (L _ lit) mb_neg eq_chk)) = firstPat eqn1
         ; lit_expr <- dsOverLit lit
         ; neg_lit <- case mb_neg of
                             Nothing  -> return lit_expr
@@ -681,7 +681,7 @@ We generate:
 matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
 -- All NPlusKPats, for the *same* literal k
 matchNPlusKPats (var :| vars) ty (eqn1 :| eqns)
-  = do  { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus
+  = do  { let VisPat _ (L _ (NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus))
                 = firstPat eqn1
         ; lit1_expr   <- dsOverLit lit1
         ; lit2_expr   <- dsOverLit lit2
@@ -694,7 +694,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns)
                    fmap (foldr1 (.) wraps)                      $
                    match_result) }
   where
-    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats })
+    shift n1 eqn@(EqnInfo { eqn_pats = VisPat _ (L _ (NPlusKPat _ (L _ n) _ _ _ _)) : pats })
         = (wrapBind n n1, eqn { eqn_pats = pats })
         -- The wrapBind is a no-op for the first equation
     shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index 9211b52fd7..73e6b4a0bf 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -126,7 +126,7 @@ instance Outputable DsMatchContext where
   ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match
 
 data EquationInfo
-  = EqnInfo { eqn_pats :: [Pat GhcTc]
+  = EqnInfo { eqn_pats :: [MatchPat GhcTc]
               -- ^ The patterns for an equation
               --
               -- NB: We have /already/ applied 'decideBangHood' to
diff --git a/compiler/GHC/HsToCore/Pmc.hs b/compiler/GHC/HsToCore/Pmc.hs
index ab6479f75b..f2278b7472 100644
--- a/compiler/GHC/HsToCore/Pmc.hs
+++ b/compiler/GHC/HsToCore/Pmc.hs
@@ -34,7 +34,7 @@
 --     'ldiMatch'. See Section 4.1 of the paper.
 module GHC.HsToCore.Pmc (
         -- Checking and printing
-        pmcPatBind, pmcMatches, pmcGRHSs,
+        pmcPatBind, pmcMatchPatBind, pmcMatches, pmcGRHSs,
         isMatchContextPmChecked,
 
         -- See Note [Long-distance information]
@@ -108,6 +108,17 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do
   formatReportWarnings cirbsPatBind ctxt [var] result
 pmcPatBind _ _ _ = pure ()
 
+pmcMatchPatBind :: DsMatchContext -> Id -> MatchPat GhcTc -> DsM ()
+-- See Note [pmcPatBind only checks PatBindRhs]
+pmcMatchPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do
+  !missing <- getLdiNablas
+  pat_bind <- noCheckDs $ desugarMatchPatBind loc var p
+  tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing])
+  result <- unCA (checkPatBind pat_bind) missing
+  tracePm "}: " (ppr (cr_uncov result))
+  formatReportWarnings cirbsPatBind ctxt [var] result
+pmcMatchPatBind _ _ _ = pure ()
+
 -- | Exhaustive for guard matches, is used for guards in pattern bindings and
 -- in @MultiIf@ expressions. Returns the 'Nablas' covered by the RHSs.
 pmcGRHSs
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 629f32f3cd..cadf70fea0 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -11,7 +11,7 @@
 -- In terms of the paper, this module is concerned with Sections 3.1, Figure 4,
 -- in particular.
 module GHC.HsToCore.Pmc.Desugar (
-      desugarPatBind, desugarGRHSs, desugarMatches, desugarEmptyCase
+      desugarPatBind, desugarMatchPatBind, desugarGRHSs, desugarMatches, desugarEmptyCase
     ) where
 
 import GHC.Prelude
@@ -254,6 +254,15 @@ desugarPatV pat = do
 desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
 desugarLPat x = desugarPat x . unLoc
 
+desugarMatchPat :: Id -> MatchPat GhcTc -> DsM [PmGrd]
+desugarMatchPat x (VisPat _ pat) = desugarLPat x pat
+desugarMatchPat x (InvisTyVarPat _ (L _ lidp)) =
+  return $ mkPmLetVar x lidp
+desugarMatchPat _ (InvisWildTyPat _) = pure []
+
+desugarLMatchPat :: Id -> LMatchPat GhcTc -> DsM [PmGrd]
+desugarLMatchPat id lmatchpat = desugarMatchPat id (unLoc lmatchpat)
+
 -- | 'desugarLPat', but also select and return a new match var.
 desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
 desugarLPatV = desugarPatV . unLoc
@@ -320,6 +329,11 @@ desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre)
 desugarPatBind loc var pat =
   PmPatBind . flip PmGRHS (SrcInfo (L loc (ppr pat))) . GrdVec <$> desugarPat var pat
 
+desugarMatchPatBind :: SrcSpan -> Id -> MatchPat GhcTc -> DsM (PmPatBind Pre)
+  -- See 'GrdPatBind' for how this simply repurposes GrdGRHS.
+desugarMatchPatBind loc var pat =
+  PmPatBind . flip PmGRHS (SrcInfo (L loc (ppr pat))) . GrdVec <$> desugarMatchPat var pat
+
 desugarEmptyCase :: Id -> DsM PmEmptyCase
 desugarEmptyCase var = pure PmEmptyCase { pe_var = var }
 
@@ -332,7 +346,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 d6db406b44..ad0c17e866 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1667,7 +1667,7 @@ the choice in HsExpanded, but it seems simpler to consult the flag (again).
 -- Building representations of auxiliary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
-repMatchTup (L _ (Match { m_pats = [p]
+repMatchTup (L _ (Match { m_pats = [L _ (VisPat _ p)]
                         , m_grhss = GRHSs _ guards wheres })) =
   do { ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
      ; addBinds ss1 $ do {
@@ -1682,9 +1682,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 <- repLPs (toLPats ps)
      ; (ss2,ds) <- repBinds wheres
      ; addBinds ss2 $ do {
        gs <- repGuards guards
@@ -2022,10 +2022,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 <- repLPs (toLPats ps); body <- repLE e; repLam xs body })
       ; wrapGenSyms ss lam }
 
 repLambda (L _ m) = notHandled (ThGuardedLambdas m)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 2ea1bb3cbe..db86bb2cd4 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -16,7 +16,7 @@ This module exports some utility functions of no great interest.
 -- | Utility functions for constructing Core syntax, principally for desugaring
 module GHC.HsToCore.Utils (
         EquationInfo(..),
-        firstPat, shiftEqns,
+        firstPat, firstPat', shiftEqns,
 
         MatchResult (..), CaseAlt(..),
         cantFailMatchResult, alwaysFailMatchResult,
@@ -40,8 +40,9 @@ module GHC.HsToCore.Utils (
 
         mkSelectorBinds,
 
-        selectSimpleMatchVarL, selectMatchVars, selectMatchVar,
-        mkOptTickBox, mkBinaryTickBox, decideBangHood,
+        selectSimpleMatchVarL, selectMatchPatVarL, selectMatchVars, selectMatchVar,
+        selectMatchPatVar, selectMatchPatVars,
+        mkOptTickBox, mkBinaryTickBox, decideBangHood, decideBangHoodMatch,
         isTrueLHsExpr
     ) where
 
@@ -146,6 +147,17 @@ selectMatchVar _w (VarPat _ var)    = return (localiseId (unLoc var))
 selectMatchVar _w (AsPat _ var _) = assert (isManyDataConTy _w ) (return (unLoc var))
 selectMatchVar w other_pat        = newSysLocalDs w (hsPatType other_pat)
 
+selectMatchPatVar :: Mult -> MatchPat GhcTc -> DsM Id
+selectMatchPatVar w (VisPat _ pat)     = selectMatchVar w (unLoc pat)
+selectMatchPatVar _ (InvisTyVarPat _ id) = return (localiseId (unLoc id))
+selectMatchPatVar w (InvisWildTyPat ty)  = newSysLocalDs w ty
+
+selectMatchPatVarL :: Mult -> LMatchPat GhcTc -> DsM Id
+selectMatchPatVarL w lmatchpat = selectMatchPatVar w (unLoc lmatchpat)
+
+selectMatchPatVars :: [(Mult, MatchPat GhcTc)] -> DsM [Id]
+selectMatchPatVars ps = mapM (uncurry selectMatchPatVar) ps
+
 {- Note [Localise pattern binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider     module M where
@@ -196,9 +208,12 @@ The ``equation info'' used by @match@ is relatively complicated and
 worthy of a type synonym and a few handy functions.
 -}
 
-firstPat :: EquationInfo -> Pat GhcTc
+firstPat :: EquationInfo -> MatchPat GhcTc
 firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn)
 
+firstPat' :: EquationInfo -> Pat GhcTc
+firstPat' eqn = assert (notNull (eqn_pats eqn)) $ head (toPats . eqn_pats $ eqn)
+
 shiftEqns :: Functor f => f EquationInfo -> f EquationInfo
 -- Drop the first pattern in each equation
 shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) }
@@ -744,7 +759,7 @@ mkSelectorBinds ticks pat val_expr
        ; let mk_bind tick bndr_var
                -- (mk_bind sv bv)  generates  bv = case sv of { pat -> bv }
                -- Remember, 'pat' binds 'bv'
-               = do { rhs_expr <- matchSimply (Var val_var) PatBindRhs pat'
+               = do { rhs_expr <- matchSimply (Var val_var) PatBindRhs (mkVisPat pat')
                                        (Var bndr_var)
                                        (Var bndr_var)  -- Neat hack
                       -- Neat hack: since 'pat' can't fail, the
@@ -759,7 +774,7 @@ mkSelectorBinds ticks pat val_expr
   | otherwise                          -- General case (C)
   = do { tuple_var  <- newSysLocalDs Many tuple_ty
        ; error_expr <- mkErrorAppDs pAT_ERROR_ID tuple_ty (ppr pat')
-       ; tuple_expr <- matchSimply val_expr PatBindRhs pat
+       ; tuple_expr <- matchSimply val_expr PatBindRhs (mkVisPat pat)
                                    local_tuple error_expr
        ; let mk_tup_bind tick binder
                = (binder, mkOptTickBox tick $
@@ -1059,6 +1074,13 @@ decideBangHood dflags lpat
            BangPat _ _   -> lp
            _             -> L l (BangPat noExtField lp)
 
+decideBangHoodMatch :: DynFlags
+                    -> LMatchPat GhcTc  -- ^ Original pattern
+                    -> LMatchPat GhcTc  -- Pattern with bang if necessary
+decideBangHoodMatch dflags (L l (VisPat t lpat)) =
+  (L l (VisPat t (decideBangHood dflags lpat)))
+decideBangHoodMatch _      matchpat = matchpat
+
 isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 
 -- Returns Just {..} if we're sure that the expression is True
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index da8bf7901f..97c0fc7069 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -269,18 +269,18 @@ tc_cmd env
        (cmd_stk, res_ty)
   = addErrCtxt (pprMatchInCtxt match)        $
     do  { (co, arg_tys, cmd_stk') <- matchExpectedCmdArgs n_pats cmd_stk
+        ; arg_tys' <- sequenceA (map (readExpType . mkCheckExpType) arg_tys)
 
                 -- Check the patterns, and the GRHSs inside
-        ; (pats', grhss') <- setSrcSpanA mtch_loc                                 $
-                             tcPats (ArrowMatchCtxt KappaExpr)
-                               pats (map (unrestricted . mkCheckExpType) arg_tys) $
+        ; (pats', grhss') <- setSrcSpanA mtch_loc $
+                             tcLMatchPats (ArrowMatchCtxt KappaExpr) pats (unrestricted <$> arg_tys') $
                              tc_grhss grhss cmd_stk' (mkCheckExpType res_ty)
 
         ; let match' = L mtch_loc (Match { m_ext = noAnn
                                          , m_ctxt = ArrowMatchCtxt KappaExpr
                                          , m_pats = pats'
                                          , m_grhss = grhss' })
-              arg_tys = map (unrestricted . hsLPatType) pats'
+              arg_tys = map (unrestricted . hsLMatchPatType) pats'
 
         ; _concrete_evs <-
               zipWithM
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 93fa9a7e2c..d4e65ba9fe 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -645,10 +645,10 @@ tcPolyCheck prag_fn
        ; mod <- getModule
        ; tick <- funBindTicks (locA nm_loc) poly_id mod prag_sigs
 
-       ; let bind' = FunBind { fun_id      = L nm_loc poly_id2
-                             , fun_matches = matches'
-                             , fun_ext     = wrap_gen <.> wrap_res
-                             , fun_tick    = tick }
+       ; let bind' = FunBind { fun_id       = L nm_loc poly_id2
+                             , fun_matches  = matches'
+                             , fun_ext      = wrap_gen <.> wrap_res
+                             , fun_tick     = tick }
 
              export = ABE { abe_ext   = noExtField
                           , abe_wrap  = idHsWrapper
@@ -1507,7 +1507,7 @@ getMonoBindInfo :: [LocatedA TcMonoBind] -> [MonoBindInfo]
 getMonoBindInfo tc_binds
   = foldr (get_info . unLoc) [] tc_binds
   where
-    get_info (TcFunBind info _ _)    rest = info : rest
+    get_info (TcFunBind info _ _)  rest = info : rest
     get_info (TcPatBind infos _ _ _) rest = infos ++ rest
 
 
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index c9e9129251..0d7310e15c 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -83,6 +83,7 @@ import Control.Monad
 import GHC.Core.Class(classTyCon)
 import GHC.Types.Unique.Set ( UniqSet, mkUniqSet, elementOfUniqSet, nonDetEltsUniqSet )
 
+import GHC.Data.FastString (fsLit)
 import Data.Function
 import Data.List (partition, sortBy, groupBy, intersect)
 
@@ -1036,13 +1037,15 @@ tcSynArgE orig sigma_ty syn_ty thing_inside
            ; return (result, mkWpCastN list_co) }
 
     go rho_ty (SynFun arg_shape res_shape)
-      = do { ( match_wrapper                         -- :: (arg_ty -> res_ty) "->" rho_ty
+      = do { uniq <- newUnique
+           ; let name = mkSystemName uniq (mkTyVarOccFS . fsLit $ "var")
+           ; ( match_wrapper                         -- :: (arg_ty -> res_ty) "->" rho_ty
              , ( ( (result, arg_ty, res_ty, op_mult)
                  , res_wrapper )                     -- :: res_ty_out "->" res_ty
                , arg_wrapper1, [], arg_wrapper2 ) )  -- :: arg_ty "->" arg_ty_out
-               <- matchExpectedFunTys herald GenSigCtxt 1 (mkCheckExpType rho_ty) $
+               <- matchExpectedFunTys herald GenSigCtxt [L noSrcSpanA (VisPat NoExtField (L noSrcSpanA (VarPat noExtField (L noSrcSpanA name))))] (mkCheckExpType rho_ty) $
                   \ [arg_ty] res_ty ->
-                  do { arg_tc_ty <- expTypeToType (scaledThing arg_ty)
+                  do { let arg_tc_ty = varType arg_ty
                      ; res_tc_ty <- expTypeToType res_ty
 
                          -- another nested arrow is too much for now,
@@ -1053,7 +1056,7 @@ tcSynArgE orig sigma_ty syn_ty thing_inside
                                   (text "Too many nested arrows in SyntaxOpType" $$
                                    pprCtOrigin orig)
 
-                     ; let arg_mult = scaledMult arg_ty
+                     ; let arg_mult = Many
                      ; tcSynArgA orig arg_tc_ty [] arg_shape $
                        \ arg_results arg_res_mults ->
                        tcSynArgE orig res_tc_ty res_shape $
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 1b2ebf797a..e5f4974c38 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -53,6 +53,7 @@ import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep )
 import GHC.Tc.Utils.Unify
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Evidence
+import GHC.Types.Var ( Var(..) )
 
 import GHC.Core.Multiplicity
 import GHC.Core.UsageEnv
@@ -94,7 +95,7 @@ same number of arguments before using @tcMatches@ to do the work.
 
 tcMatchesFun :: LocatedN Id -- MatchContext Id
              -> MatchGroup GhcRn (LHsExpr GhcRn)
-             -> ExpRhoType    -- Expected type of function
+             -> ExpRhoType      -- Expected type of function
              -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
                                 -- Returns type of body
 tcMatchesFun fun_id matches exp_ty
@@ -107,7 +108,7 @@ tcMatchesFun fun_id matches exp_ty
           traceTc "tcMatchesFun" (ppr fun_name $$ ppr exp_ty)
         ; checkArgs fun_name matches
 
-        ; matchExpectedFunTys herald ctxt arity exp_ty $ \ pat_tys rhs_ty ->
+        ; matchExpectedFunTys herald ctxt lampats exp_ty $ \ pat_vars rhs_ty ->
              -- NB: exp_type may be polymorphic, but
              --     matchExpectedFunTys can cope with that
           tcScalingUsage Many $
@@ -117,10 +118,10 @@ tcMatchesFun fun_id matches exp_ty
           -- being scaled by Many. When let binders come with a
           -- multiplicity, then @tcMatchesFun@ will have to take
           -- a multiplicity argument, and scale accordingly.
-          tcMatches match_ctxt pat_tys rhs_ty matches }
+          tcMatches match_ctxt pat_vars rhs_ty matches }
   where
     fun_name = idName (unLoc fun_id)
-    arity  = matchGroupArity matches
+    lampats = matchGroupLMatchPats matches
     herald = text "The equation(s) for"
              <+> quotes (ppr fun_name) <+> text "have"
     ctxt   = GenSigCtxt  -- Was: FunSigCtxt fun_name True
@@ -153,8 +154,9 @@ tcMatchesCase :: (AnnoBody body) =>
                 -- Translated alternatives
                 -- wrapper goes from MatchGroup's ty to expected ty
 
-tcMatchesCase ctxt (Scaled scrut_mult scrut_ty) matches res_ty
-  = tcMatches ctxt [Scaled scrut_mult (mkCheckExpType scrut_ty)] res_ty matches
+tcMatchesCase ctxt (Scaled _ scrut_ty) matches res_ty
+  = do { var <- newFlexiTyVar scrut_ty
+       ; tcMatches ctxt [var] res_ty matches }
 
 tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
               -> TcMatchCtxt HsExpr
@@ -165,8 +167,8 @@ tcMatchLambda herald match_ctxt match res_ty
   = matchExpectedFunTys herald GenSigCtxt n_pats res_ty $ \ pat_tys rhs_ty ->
     tcMatches match_ctxt pat_tys rhs_ty match
   where
-    n_pats | isEmptyMatchGroup match = 1   -- must be lambda-case
-           | otherwise               = matchGroupArity match
+    n_pats | isEmptyMatchGroup match = []   -- must be lambda-case
+           | otherwise               = matchGroupLMatchPats match
 
 -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
 
@@ -213,7 +215,7 @@ type AnnoBody body
 
 -- | Type-check a MatchGroup.
 tcMatches :: (AnnoBody body ) => TcMatchCtxt body
-          -> [Scaled ExpSigmaType]      -- Expected pattern types
+          -> [Var]               -- Expected pattern types
           -> ExpRhoType          -- Expected result-type of the Match.
           -> MatchGroup GhcRn (LocatedA (body GhcRn))
           -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
@@ -225,44 +227,44 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
     -- when in inference mode, so we must do it ourselves,
     -- here, using expTypeToType
   = do { tcEmitBindingUsage bottomUE
-       ; pat_tys <- mapM scaledExpTypeToType pat_tys
+       ; let pat_tys' = map (unrestricted . varType) pat_tys
        ; rhs_ty  <- expTypeToType rhs_ty
        ; _concrete_evs <- zipWithM
-                       (\ i (Scaled _ pat_ty) ->
+                       (\ i pat_ty ->
                          hasFixedRuntimeRep (FRRMatch (mc_what ctxt) i) pat_ty)
-                       [1..] pat_tys
+                       [1..] (varType <$> pat_tys)
        ; return (MG { mg_alts = L l []
-                    , mg_ext = MatchGroupTc pat_tys rhs_ty
+                    , mg_ext = MatchGroupTc pat_tys' rhs_ty
                     , mg_origin = origin }) }
 
   | otherwise
   = do { umatches <- mapM (tcCollectingUsage . tcMatch ctxt pat_tys rhs_ty) matches
        ; let (usages,matches') = unzip umatches
        ; tcEmitBindingUsage $ supUEs usages
-       ; pat_tys  <- mapM readScaledExpType pat_tys
+       ; let pat_tys' = map (unrestricted . varType) pat_tys
        ; rhs_ty   <- readExpType rhs_ty
        ; _concrete_evs <- zipWithM
-                       (\ i (Scaled _ pat_ty) ->
+                       (\ i pat_ty ->
                          hasFixedRuntimeRep (FRRMatch (mc_what ctxt) i) pat_ty)
-                       [1..] pat_tys
+                       [1..] (varType <$> pat_tys)
        ; return (MG { mg_alts   = L l matches'
-                    , mg_ext    = MatchGroupTc pat_tys rhs_ty
+                    , mg_ext    = MatchGroupTc pat_tys' rhs_ty
                     , mg_origin = origin }) }
 
 -------------
 tcMatch :: (AnnoBody body) => TcMatchCtxt body
-        -> [Scaled ExpSigmaType]        -- Expected pattern types
+        -> [Var]        -- Expected pattern types
         -> ExpRhoType            -- Expected result-type of the Match.
         -> LMatch GhcRn (LocatedA (body GhcRn))
         -> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
 
-tcMatch ctxt pat_tys rhs_ty match
-  = wrapLocMA (tc_match ctxt pat_tys rhs_ty) match
+tcMatch ctxt vars rhs_ty match
+  = wrapLocMA (tc_match ctxt ((\var -> unrestricted (varType var)) <$> vars) rhs_ty) match
   where
-    tc_match ctxt pat_tys rhs_ty
-             match@(Match { m_pats = pats, m_grhss = grhss })
+    tc_match ctxt vars rhs_ty
+             match@(Match { m_pats = lampats, m_grhss = grhss })
       = add_match_ctxt match $
-        do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $
+        do { (pats', grhss') <- tcLMatchPats (mc_what ctxt) lampats vars $
                                 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 a09d77b6f7..b0177319ad 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
    , badFieldCon
    , polyPatSig
@@ -99,11 +99,11 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside
        ; tc_lpat pat_ty penv pat thing_inside }
 
 -----------------
-tcPats :: HsMatchContext GhcTc
-       -> [LPat GhcRn]            -- Patterns,
-       -> [Scaled ExpSigmaType]         --   and their types
-       -> TcM a                  --   and the checker for the body
-       -> TcM ([LPat GhcTc], a)
+tcLMatchPats :: HsMatchContext GhcTc
+          -> [LMatchPat GhcRn]            -- Patterns,
+          -> [Scaled Type]                     --   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,
@@ -116,8 +116,8 @@ tcPats :: HsMatchContext GhcTc
 --   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 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 }
 
@@ -340,6 +340,21 @@ tc_lpat pat_ty penv (L span pat) thing_inside
                                           thing_inside
         ; return (L span pat', res) }
 
+tc_lmatchpat :: Scaled Type
+          -> Checker (LMatchPat GhcRn) (LMatchPat GhcTc)
+tc_lmatchpat (Scaled mult ty') penv (L l (VisPat x pat)) thing_inside
+  = do { (pat', res) <- tc_lpat (Scaled mult (Check ty')) penv pat thing_inside
+       ; return (L l (VisPat x pat'), res) }
+tc_lmatchpat ty _ (L l' (InvisTyVarPat x (L l name))) thing_inside
+  = do { let ty' = scaledThing ty
+       ; let var = mkLocalIdOrCoVar name Many ty'
+       ; (res,_) <- tcCheckUsage name ty' $ tcExtendIdEnv1 name var thing_inside
+       ; return (L l' (InvisTyVarPat x (L l var)),res)
+       }
+tc_lmatchpat (Scaled _ ty) _ (L l' (InvisWildTyPat _)) thing_inside
+  = do { res <- thing_inside
+       ; return (L l' (InvisWildTyPat ty), res) }
+
 tc_lpats :: [Scaled ExpSigmaType]
          -> Checker [LPat GhcRn] [LPat GhcTc]
 tc_lpats tys penv pats
@@ -348,6 +363,14 @@ tc_lpats tys penv pats
                penv
                (zipEqual "tc_lpats" pats tys)
 
+tc_lmatchpats :: [Scaled Type]
+           -> 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_lampats" 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/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 1ce9ef8f82..e5e9ffc35c 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -924,7 +924,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)]
+                                 [L noSrcSpanA (VisPat noExtField (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 }
@@ -944,7 +944,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)]
+                            [L noSrcSpanA (VisPat noExtField (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/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index a0b8106a8d..fc98de6ef4 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -45,7 +45,6 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr( debugPprType )
 import GHC.Tc.Utils.Concrete ( mkWpFun )
 import GHC.Tc.Utils.Env
-import GHC.Tc.Utils.Instantiate
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.TcType
@@ -59,9 +58,11 @@ import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
 import GHC.Types.Name( isSystemName )
-
+import GHC.Types.Id
+import GHC.Tc.Utils.Instantiate
 import GHC.Core.TyCon
 import GHC.Builtin.Types
+import GHC.Types.SrcLoc
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -75,9 +76,9 @@ import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 
 import GHC.Exts      ( inline )
-import Control.Monad
 import Control.Arrow ( second )
 import qualified Data.Semigroup as S ( (<>) )
+import GHC.Data.FastString
 
 {- *********************************************************************
 *                                                                      *
@@ -287,49 +288,52 @@ passed in.
 matchExpectedFunTys :: forall a.
                        SDoc   -- See Note [Herald for matchExpectedFunTys]
                     -> UserTypeCtxt
-                    -> Arity
-                    -> ExpRhoType      -- Skolemised
-                    -> ([Scaled ExpSigmaType] -> ExpRhoType -> TcM a)
+                    -> [LMatchPat GhcRn]
+                    -> ExpSigmaType
+                    -> ([Var] -> ExpSigmaType -> TcM a)
                     -> TcM (HsWrapper, a)
 -- If    matchExpectedFunTys n ty = (_, wrap)
 -- then  wrap : (t1 -> ... -> tn -> ty_r) ~> ty,
 --   where [t1, ..., tn], ty_r are passed to the thing_inside
-matchExpectedFunTys herald ctx arity orig_ty thing_inside
+matchExpectedFunTys herald ctx lmatchpats orig_ty thing_inside
   = case orig_ty of
-      Check ty -> go [] arity ty
-      _        -> defer [] arity orig_ty
+      Check ty -> go [] lmatchpats ty
+      _        -> defer [] lmatchpats orig_ty
   where
-    -- Skolemise any foralls /before/ the zero-arg case
-    -- so that we guarantee to return a rho-type
-    go acc_arg_tys n ty
+    go vars pats ty
       | (tvs, theta, _) <- tcSplitSigmaTy ty
       , not (null tvs && null theta)
       = do { (wrap_gen, (wrap_res, result)) <- tcSkolemise ctx ty $ \ty' ->
-                                               go acc_arg_tys n ty'
+                                               go vars pats ty'
+           ; return (wrap_gen <.> wrap_res, result) }
+
+    go vars (L _ (InvisTyVarPat _ (L _ _)): pats) (ForAllTy (Bndr var _) ty')
+      = do { (wrap_res, result) <- go (var : vars) pats ty'
+           ; let wrap_gen = WpTyLam var
            ; return (wrap_gen <.> wrap_res, result) }
 
     -- No more args; do this /before/ tcView, so
     -- that we do not unnecessarily unwrap synonyms
-    go acc_arg_tys 0 rho_ty
-      = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType rho_ty)
+    go vars [] ty
+      = do { result <- thing_inside (reverse vars) (mkCheckExpType ty)
            ; return (idHsWrapper, result) }
 
-    go acc_arg_tys n ty
-      | Just ty' <- tcView ty = go acc_arg_tys n ty'
+    go vars pats ty
+      | Just ty' <- tcView ty = go vars pats ty'
 
-    go acc_arg_tys n (FunTy { ft_mult = mult, ft_af = af, ft_arg = arg_ty, ft_res = res_ty })
-      = assert (af == VisArg) $
-        do { (wrap_res, result) <- go ((Scaled mult $ mkCheckExpType arg_ty) : acc_arg_tys)
-                                      (n-1) res_ty
+    go vars (L _ (VisPat _ _):pats) (FunTy { ft_mult = mult, ft_af = VisArg, ft_arg = arg_ty, ft_res = res_ty })
+      = do { name <- newMetaTyVarName (fsLit "arg")
+           ; let var = mkLocalId name mult arg_ty
+           ; (wrap_res, result) <- go (var : vars) pats res_ty
            ; fun_wrap <- mkWpFun idHsWrapper wrap_res (Scaled mult arg_ty) res_ty (WpFunFunExpTy orig_ty)
            ; return ( fun_wrap, result ) }
 
-    go acc_arg_tys n ty@(TyVarTy tv)
+    go vars pats ty@(TyVarTy tv)
       | isMetaTyVar tv
       = do { cts <- readMetaTyVar tv
            ; case cts of
-               Indirect ty' -> go acc_arg_tys n ty'
-               Flexi        -> defer acc_arg_tys n (mkCheckExpType ty) }
+               Indirect ty' -> go vars pats ty'
+               Flexi        -> defer vars pats (mkCheckExpType ty) }
 
        -- In all other cases we bale out into ordinary unification
        -- However unlike the meta-tyvar case, we are sure that the
@@ -346,31 +350,79 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside
        --
        -- But in that case we add specialized type into error context
        -- anyway, because it may be useful. See also #9605.
-    go acc_arg_tys n ty = addErrCtxtM (mk_ctxt acc_arg_tys ty) $
-                          defer acc_arg_tys n (mkCheckExpType ty)
+    go acc_arg_tys vars ty = addErrCtxtM (mk_ctxt acc_arg_tys ty) $
+                          defer acc_arg_tys vars (mkCheckExpType ty)
 
     ------------
-    defer :: [Scaled ExpSigmaType] -> Arity -> ExpRhoType -> TcM (HsWrapper, a)
-    defer acc_arg_tys n fun_ty
-      = do { more_arg_tys <- replicateM n (mkScaled <$> newFlexiTyVarTy multiplicityTy <*> newInferExpType)
-           ; res_ty       <- newInferExpType
-           ; result       <- thing_inside (reverse acc_arg_tys ++ more_arg_tys) res_ty
-           ; more_arg_tys <- mapM (\(Scaled m t) -> Scaled m <$> readExpType t) more_arg_tys
-           ; res_ty       <- readExpType res_ty
-           ; let unif_fun_ty = mkVisFunTys more_arg_tys res_ty
+
+    defer :: [Var] -> [LMatchPat GhcRn] -> ExpSigmaType -> TcM (HsWrapper, a)
+    defer vars pats fun_ty
+      = do { arg_binds     <- sequenceA (lmatch_pats_to_bndrs <$> pats)
+           ; res_ty        <- newInferExpType
+           ; more_vars     <- sequenceA (lampat_to_var <$> pats)
+           ; result        <- thing_inside (reverse vars ++ more_vars) res_ty
+           ; res_ty        <- expTypeToType res_ty
+           ; let unif_fun_ty = mkPiTys arg_binds res_ty
            ; wrap <- tcSubType AppOrigin ctx unif_fun_ty fun_ty
                          -- Not a good origin at all :-(
            ; return (wrap, result) }
 
+    lampat_to_var (L _ (VisPat _ _))   =
+      do { name <- newMetaTyVarName (fsLit "arg")
+         ; ty <- newInferExpType >>= expTypeToType
+         ; return $ mkLocalId name Many ty
+         }
+    lampat_to_var _ = newOpenFlexiTyVar
+
     ------------
-    mk_ctxt :: [Scaled ExpSigmaType] -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
-    mk_ctxt arg_tys res_ty env
-      = mkFunTysMsg env herald arg_tys' res_ty arity
-      where
-        arg_tys' = map (\(Scaled u v) -> Scaled u (checkingExpType "matchExpectedFunTys" v)) $
-                   reverse arg_tys
+    mk_ctxt :: [Var] -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
+    mk_ctxt vars res_ty env
+      = mkPiTysMsg env herald vars res_ty lmatchpats
             -- this is safe b/c we're called from "go"
 
+    lmatch_pats_to_bndrs :: LMatchPat GhcRn -> TcM TyCoBinder
+    lmatch_pats_to_bndrs (L _ (VisPat _ _))
+      = do { fresh <- newInferExpType
+           ; ty'  <- mkScaled <$> newFlexiTyVarTy multiplicityTy <*> (expTypeToType fresh)
+           ; return $ Anon VisArg ty' }
+    lmatch_pats_to_bndrs (L _ (InvisTyVarPat _ _))
+      = do { var <- newOpenFlexiTyVar
+           ; return $ Named (Bndr var Specified) }
+    lmatch_pats_to_bndrs (L _ (InvisWildTyPat _))
+      = do { var <- newOpenFlexiTyVar
+           ; return $ Named (Bndr var Inferred) }
+
+mkPiTysMsg :: TidyEnv -> SDoc -> [Var] -> TcType -> [LMatchPat GhcRn]
+           -> TcM (TidyEnv, SDoc)
+mkPiTysMsg env herald vars res_ty lmatchpats
+  = do { let arg_binds = to_arg_bind <$> (zip vars lmatchpats)
+       ; let fun = mkPiTys arg_binds res_ty
+       ; (env', fun_ty) <- zonkTidyTcType env fun
+       ; let (all_arg_tys, _) = splitFunTys fun_ty
+             n_fun_args = length all_arg_tys
+             all_lpats  = length (toLPats lmatchpats)
+
+             (all_forall_args, _) = splitForAllTyVars fun_ty
+             n_forall_args = length all_forall_args
+             all_invis_pats = length (toInvisPats lmatchpats)
+
+             full_herald = herald <+> speakNOf all_lpats (text "value argument")
+
+             msg | all_invis_pats <= n_forall_args && all_lpats <= n_fun_args  -- Enough args, in the end
+                 = text "In the result of a function call"
+                 | otherwise
+                 = hang (full_herald <> comma)
+                      2 (sep [ text "but its type" <+> quotes (pprType fun_ty)
+                             , if n_fun_args == 0 then text "has none"
+                               else text "has only" <+> speakN n_fun_args])
+
+       ; return (env', msg) }
+  where
+    to_arg_bind :: (Var, LMatchPat GhcRn) -> TyCoBinder
+    to_arg_bind (var, (L _ (VisPat _ _))) = Anon VisArg (Scaled (varMult var) (varType var))
+    to_arg_bind (var, (L _ (InvisTyVarPat _ _))) = Named (Bndr var Specified)
+    to_arg_bind (var, (L _ (InvisWildTyPat _)))  = Named (Bndr var Inferred)
+
 mkFunTysMsg :: TidyEnv -> SDoc -> [Scaled TcType] -> TcType -> Arity
             -> TcM (TidyEnv, SDoc)
 mkFunTysMsg env herald arg_tys res_ty n_val_args_in_call
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index fec8d90d5d..1bff9ce013 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -694,7 +694,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) <- zonkLMatchPats env pats
         ; new_grhss <- zonkGRHSs env1 zBody grhss
         ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) }
 
@@ -1338,6 +1338,15 @@ zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
 -- to the right)
 zonkPat env pat = wrapLocSndMA (zonk_pat env) pat
 
+zonkLMatchPat :: ZonkEnv -> LMatchPat GhcTc -> TcM (ZonkEnv, LMatchPat GhcTc)
+zonkLMatchPat env (L l (VisPat x pat))
+  = do { (env', p') <- zonkPat env pat
+       ; return (env', L l (VisPat x p'))}
+zonkLMatchPat env (L l (InvisTyVarPat t (L l' idp)))
+  = do { (env', (L _ idp')) <- wrapLocSndM (zonkTyBndrX env) (L noSrcSpan idp)
+       ; return (env', L l (InvisTyVarPat t (L l' idp')))}
+zonkLMatchPat env p = return (env, p)
+
 zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
 zonk_pat env (ParPat x lpar p rpar)
   = do  { (env', p') <- zonkPat env p
@@ -1484,6 +1493,12 @@ zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
                              ; (env', pats') <- zonkPats env1 pats
                              ; return (env', pat':pats') }
 
+zonkLMatchPats :: ZonkEnv -> [LMatchPat GhcTc] -> TcM (ZonkEnv, [LMatchPat GhcTc])
+zonkLMatchPats env []         = return (env, [])
+zonkLMatchPats env (pat:pats) = do { (env1, pat') <- zonkLMatchPat env pat
+                                   ; (env', pats') <- zonkLMatchPats env1 pats
+                                   ; return (env', pat':pats') }
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/utils/haddock b/utils/haddock
-Subproject 1ef24e617651955f07c4fb6f2d488806cc6785e
+Subproject d8b79d35ddd96c83f4a3a0303011defc209aa31