Small refactor in desugar of pattern matching

In reviewing Phab:D4968 for Trac #15385 I saw a small
but simple refactor to avoid unnecessary work in the
desugarer.

This patch just arranges to call
   matchSinglePatVar v ...
rather than
   matchSinglePat (Var v) ...

The more specialised function already existed, as
   match_single_pat_var

I also added more comments about decideBangHood

(cherry picked from commit 45cfe651)

compiler/deSugar/DsExpr.hs

@@ -901,7 +901,7 @@ dsDo stmts
       = do  { body     <- goL stmts
             ; rhs'     <- dsLExpr rhs
             ; var   <- selectSimpleMatchVarL pat
-            ; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
+            ; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
                                       res1_ty (cantFailMatchResult body)
             ; match_code <- handle_failure pat match fail_op
             ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }

compiler/deSugar/DsListComp.hs

@@ -621,7 +621,7 @@ dsMcBindStmt :: LPat GhcTc
 dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
   = do  { body     <- dsMcStmts stmts
         ; var      <- selectSimpleMatchVarL pat
-        ; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
+        ; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
                                   res1_ty (cantFailMatchResult body)
         ; match_code <- handle_failure pat match fail_op
         ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }

compiler/deSugar/DsMonad.hs

@@ -104,6 +104,9 @@ instance Outputable DsMatchContext where
 
 data EquationInfo
   = EqnInfo { eqn_pats :: [Pat GhcTc],  -- The patterns for an eqn
+                -- NB: We have /already/ applied decideBangHood to
+                -- these patterns.  See Note [decideBangHood] in DsUtils
+
               eqn_rhs  :: MatchResult } -- What to do after match
 
 instance Outputable EquationInfo where

compiler/deSugar/DsUtils.hs

@@ -97,6 +97,7 @@ otherwise, make one up.
 -}
 
 selectSimpleMatchVarL :: LPat GhcTc -> DsM Id
+-- Postcondition: the returned Id has an Internal Name
 selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
 
 -- (selectMatchVars ps tys) chooses variables of type tys
@@ -116,9 +117,11 @@ selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
 -- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat
 
 selectMatchVars :: [Pat GhcTc] -> DsM [Id]
+-- Postcondition: the returned Ids have Internal Names
 selectMatchVars ps = mapM selectMatchVar ps
 
 selectMatchVar :: Pat GhcTc -> DsM Id
+-- Postcondition: the returned Id has an Internal Name
 selectMatchVar (BangPat _ pat) = selectMatchVar (unLoc pat)
 selectMatchVar (LazyPat _ pat) = selectMatchVar (unLoc pat)
 selectMatchVar (ParPat _ pat)  = selectMatchVar (unLoc pat)
@@ -128,9 +131,8 @@ selectMatchVar (AsPat _ var _) = return (unLoc var)
 selectMatchVar other_pat       = newSysLocalDsNoLP (hsPatType other_pat)
                                   -- OK, better make up one...
 
-{-
-Note [Localise pattern binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Localise pattern binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider     module M where
                [Just a] = e
 After renaming it looks like
@@ -166,6 +168,7 @@ In fact, even CoreSubst.simplOptExpr will do this, and simpleOptExpr
 runs on the output of the desugarer, so all is well by the end of
 the desugaring pass.
 
+See also Note [MatchIds] in Match.hs
 
 ************************************************************************
 *                                                                      *
@@ -903,13 +906,38 @@ mkBinaryTickBox ixT ixF e = do
 
 -- *******************************************************************
 
+{- Note [decideBangHood]
+~~~~~~~~~~~~~~~~~~~~~~~~
+With -XStrict we may make /outermost/ patterns more strict.
+E.g.
+       let (Just x) = e in ...
+          ==>
+       let !(Just x) = e in ...
+and
+       f x = e
+          ==>
+       f !x = e
+
+This adjustment is done by decideBangHood,
+
+  * Just before constructing an EqnInfo, in Match
+      (matchWrapper and matchSinglePat)
+
+  * When desugaring a pattern-binding in DsBinds.dsHsBind
+
+Note that it is /not/ done recursively.  See the -XStrict
+spec in the user manual.
+
+Specifically:
+   ~pat    => pat    -- when -XStrict (even if pat = ~pat')
+   !pat    => !pat   -- always
+   pat     => !pat   -- when -XStrict
+   pat     => pat    -- otherwise
+-}
+
+
 -- | Use -XStrict to add a ! or remove a ~
---
--- Examples:
--- ~pat    => pat    -- when -XStrict (even if pat = ~pat')
--- !pat    => !pat   -- always
--- pat     => !pat   -- when -XStrict
--- pat     => pat    -- otherwise
+-- See Note [decideBangHood]
 decideBangHood :: DynFlags
                -> LPat GhcTc  -- ^ Original pattern
                -> LPat GhcTc  -- Pattern with bang if necessary

compiler/deSugar/Match.hs

@@ -9,7 +9,8 @@ The @match@ function
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
+module Match ( match, matchEquations, matchWrapper, matchSimply
+             , matchSinglePat, matchSinglePatVar ) where
 
 #include "HsVersions.h"
 
@@ -152,6 +153,8 @@ is the scrutinee(s) of the match. The desugared expression may
 sometimes use that Id in a local binding or as a case binder.  So it
 should not have an External name; Lint rejects non-top-level binders
 with External names (Trac #13043).
+
+See also Note [Localise pattern binders] in DsUtils
 -}
 
 type MatchId = Id   -- See Note [Match Ids]
@@ -728,7 +731,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
            ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
                              addTmCsDs tm_cs  $ -- See Note [Type and Term Equality Propagation]
                              dsGRHSs ctxt grhss rhs_ty
-           ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
+           ; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) }
     mk_eqn_info _ (L _ (XMatch _)) = panic "matchWrapper"
 
     handleWarnings = if isGenerated origin
@@ -777,7 +780,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
 matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
                -> Type -> MatchResult -> DsM MatchResult
 -- matchSinglePat ensures that the scrutinee is a variable
+-- and then calls matchSinglePatVar
 --
 -- matchSinglePat does not warn about incomplete patterns
 -- Used for things like [ e | pat <- stuff ], where
@@ -785,17 +788,17 @@ matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
 
 matchSinglePat (Var var) ctx pat ty match_result
   | not (isExternalName (idName var))
-  = match_single_pat_var var ctx pat ty match_result
+  = matchSinglePatVar var ctx pat ty match_result
 
 matchSinglePat scrut hs_ctx pat ty match_result
   = do { var           <- selectSimpleMatchVarL pat
-       ; match_result' <- match_single_pat_var var hs_ctx pat ty match_result
+       ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result
        ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
 
-match_single_pat_var :: Id   -- See Note [Match Ids]
-                     -> HsMatchContext Name -> LPat GhcTc
-                     -> Type -> MatchResult -> DsM MatchResult
-match_single_pat_var var ctx pat ty match_result
+matchSinglePatVar :: Id   -- See Note [Match Ids]
+                  -> HsMatchContext Name -> LPat GhcTc
+                  -> Type -> MatchResult -> DsM MatchResult
+matchSinglePatVar var ctx pat ty match_result
   = ASSERT2( isInternalName (idName var), ppr var )
     do { dflags <- getDynFlags
        ; locn   <- getSrcSpanDs