experimentwip/17594-another-approach-typecheck-2

16 files changed, 34 insertions, 51 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 8a06e54f5c..a9379f054d 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1295,7 +1295,7 @@ pprFunBind matches = pprMatches matches
 -- Exported to GHC.Hs.Binds, which can't see the defn of HsMatchContext
 pprPatBind :: forall bndr p . (OutputableBndrId bndr,
                                OutputableBndrId p)
-           => LMatchPat (GhcPass bndr) -> GRHSs (GhcPass p) (LHsExpr (GhcPass p)) -> SDoc
+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) (LHsExpr (GhcPass p)) -> SDoc
 pprPatBind pat grhss
  = sep [ppr pat,
        nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (GhcPass p)) grhss)]
diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot
index c5a158e11a..204af54681 100644
--- a/compiler/GHC/Hs/Expr.hs-boot
+++ b/compiler/GHC/Hs/Expr.hs-boot
@@ -8,7 +8,7 @@
 module GHC.Hs.Expr where
 
 import GHC.Utils.Outputable ( SDoc, Outputable )
-import Language.Haskell.Syntax.Pat ( LMatchPat )
+import Language.Haskell.Syntax.Pat ( LPat )
 import {-# SOURCE #-} GHC.Hs.Pat () -- for Outputable
 import GHC.Types.Basic ( SpliceExplicitFlag(..))
 import Language.Haskell.Syntax.Expr
@@ -34,7 +34,7 @@ pprSpliceDecl ::  (OutputableBndrId p)
 
 pprPatBind :: forall bndr p . (OutputableBndrId bndr,
                                OutputableBndrId p)
-           => LMatchPat (GhcPass bndr) -> GRHSs (GhcPass p) (LHsExpr (GhcPass p)) -> SDoc
+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) (LHsExpr (GhcPass p)) -> SDoc
 
 pprFunBind :: (OutputableBndrId idR)
            => MatchGroup (GhcPass idR) (LHsExpr (GhcPass idR)) -> SDoc
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index cd95f1be7d..694c27744d 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -494,9 +494,7 @@ looksLazyPatBind :: HsBind (GhcPass p) -> Bool
 -- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
 -- Looks through AbsBinds
 looksLazyPatBind (PatBind { pat_lhs = p })
-  = case unLoc p of
-      VisPat _ lpat -> looksLazyLPat lpat
-      _             -> False
+  = looksLazyLPat p
 looksLazyPatBind (AbsBinds { abs_binds = binds })
   = anyBag (looksLazyPatBind . unLoc) binds
 looksLazyPatBind _
diff --git a/compiler/GHC/Hs/Stats.hs b/compiler/GHC/Hs/Stats.hs
index cc799066e5..bd3e2e6b6d 100644
--- a/compiler/GHC/Hs/Stats.hs
+++ b/compiler/GHC/Hs/Stats.hs
@@ -105,7 +105,7 @@ ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = impor
     (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds)
         = sum5 (map inst_info inst_decls)
 
-    count_bind (PatBind { pat_lhs = L _ (VisPat _ (L _ (VarPat{}))) }) = (1,0,0)
+    count_bind (PatBind { pat_lhs = L _ (VarPat{}) }) = (1,0,0)
     count_bind (PatBind {})                           = (0,1,0)
     count_bind (FunBind {})                           = (0,1,0)
     count_bind (PatSynBind {})                        = (0,0,1)
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 7b22ab3aa8..9d76513842 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1000,9 +1000,7 @@ isBangedHsBind (FunBind {fun_matches = matches})
   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
   = True
 isBangedHsBind (PatBind {pat_lhs = pat})
-  = case unLoc pat of
-      VisPat _ lpat -> isBangedLPat lpat
-      _             -> False
+  = isBangedLPat pat
 isBangedHsBind _
   = False
 
@@ -1080,7 +1078,7 @@ collect_bind :: forall p idR. CollectPass p
              -> HsBindLR p idR
              -> [IdP p]
              -> [IdP p]
-collect_bind _ flag (PatBind { pat_lhs = p })           acc = collect_lmatchpat flag p acc
+collect_bind _ flag (PatBind { pat_lhs = p })           acc = collect_lpat flag p acc
 collect_bind _ _ (FunBind { fun_id = f })            acc = unXRec @p f : acc
 collect_bind _ _ (VarBind { var_id = f })            acc = f : acc
 collect_bind _ _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc
@@ -1591,13 +1589,9 @@ hsValBindsImplicits (ValBinds _ binds _)
 lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
 lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []
   where
-    lhs_bind (PatBind { pat_lhs = lpat }) = lMatchPatImplicits lpat
+    lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
     lhs_bind _ = []
 
-lMatchPatImplicits :: LMatchPat GhcRn -> [(SrcSpan, [Name])]
-lMatchPatImplicits (L _ (VisPat _ lpat)) = lPatImplicits lpat
-lMatchPatImplicits _                     = []
-
 lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
 lPatImplicits = hs_lpat
   where
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 510c7d96e8..96b7a82f91 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -186,7 +186,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun
           --                          , ppr args, ppr core_binds, ppr body']) $
           return (force_var, [core_binds]) }
 
-dsHsBind dflags (PatBind { pat_lhs = L _ (VisPat _ pat), pat_rhs = grhss
+dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss
                          , pat_ext = ty
                          , pat_ticks = (rhs_tick, var_ticks) })
   = do  { rhss_nablas <- pmcGRHSs PatBindGuards grhss
@@ -201,13 +201,6 @@ dsHsBind dflags (PatBind { pat_lhs = L _ (VisPat _ pat), pat_rhs = grhss
                            else []
         ; return (force_var', sel_binds) }
 
-dsHsBind _ (PatBind { pat_lhs = L _ (InvisTyVarPat _ lidp) })
-  = do { let id = varToCoreExpr (unLoc lidp)
-       ; return ([], [(unLoc lidp, id)])}
-
-dsHsBind _ (PatBind { pat_lhs = L _ (InvisWildTyPat _) })
-  = pure ([], [])
-
 dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
                           , abs_exports = exports
                           , abs_ev_binds = ev_binds
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index b60fe7b805..a6ebd06e38 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -345,7 +345,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id }))) = do
 addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
                                     , pat_rhs = rhs }))) = do
 
-  let simplePatId = isSimpleMatchPat lhs
+  let simplePatId = isSimplePat lhs
 
   -- TODO: better name for rhs's for non-simple patterns?
   let name = maybe "(...)" getOccString simplePatId
@@ -373,7 +373,7 @@ addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
     patvar_tickss <- case simplePatId of
       Just{} -> return initial_patvar_tickss
       Nothing -> do
-        let patvars = map getOccString (collectLMatchPatBinders CollNoDictBinders lhs)
+        let patvars = map getOccString (collectPatBinders CollNoDictBinders lhs)
         patvar_ticks <- mapM (\v -> bindTick density v (locA pos) fvs) patvars
         return
           (zipWith mbCons patvar_ticks
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index edca4c0afb..081afbca16 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -208,10 +208,10 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss
     do { match_nablas <- pmcGRHSs PatBindGuards grhss
        ; rhs          <- dsGuarded grhss ty match_nablas
        ; let upat = unLoc pat
-             eqn = EqnInfo { eqn_pats = [upat],
+             eqn = EqnInfo { eqn_pats = [mkVisMatchPat' upat],
                              eqn_orig = FromSource,
                              eqn_rhs = cantFailMatchResult body }
-       ; var    <- selectMatchPatVar Many (unLoc pat)
+       ; var    <- selectMatchVar Many (unLoc pat)
                     -- `var` will end up in a let binder, so the multiplicity
                     -- doesn't matter.
        ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 142cfb9fd4..faeced50e8 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1896,7 +1896,7 @@ rep_bind (L loc (FunBind { fun_id = fn
         ; ans <- repFun fn' (nonEmptyCoreList ms1)
         ; return (locA loc, ans) }
 
-rep_bind (L loc (PatBind { pat_lhs = L _ (VisPat _ pat)
+rep_bind (L loc (PatBind { pat_lhs = pat
                          , pat_rhs = GRHSs _ guards wheres }))
  =   do { patcore <- repLP pat
         ; (ss,wherecore) <- repBinds wheres
@@ -1905,8 +1905,6 @@ rep_bind (L loc (PatBind { pat_lhs = L _ (VisPat _ pat)
         ; ans' <- wrapGenSyms ss ans
         ; return (locA loc, ans') }
 
-rep_bind (L _ (PatBind {})) = panic "rep_bind: other match pats"
-
 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
  =   do { v' <- lookupBinder v
         ; e2 <- repLE e
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 8ad8bd1e42..a4fec5a08c 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -653,7 +653,7 @@ mkPatSynMatchGroup (L loc patsyn_name) (L ld decls) =
   where
     fromDecl (L loc decl@(ValD _ (PatBind _
                                  -- AZ: where should these anns come from?
-                         (L _ (VisPat _ pat'@(L _ (ConPat noAnn ln@(L _ name) details))))
+                         pat@(L _ (ConPat noAnn ln@(L _ name) details))
                                rhs _))) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr (locA loc) decl
@@ -676,7 +676,7 @@ mkPatSynMatchGroup (L loc patsyn_name) (L ld decls) =
                                    , mc_fixity = Infix
                                    , mc_strictness = NoSrcStrict }
 
-               RecCon{} -> recordPatSynErr (locA loc) pat'
+               RecCon{} -> recordPatSynErr (locA loc) pat
            ; return $ L loc match }
     fromDecl (L loc decl) = extraDeclErr (locA loc) decl
 
@@ -1310,7 +1310,7 @@ checkPatBind loc annsIn (L _ (BangPat (EpAnn _ ans cs) (L _ (VarPat _ v))))
 
 checkPatBind loc annsIn lhs (L _ grhss) = do
   cs <- getCommentsFor loc
-  return (PatBind (EpAnn (spanAsAnchor loc) annsIn cs) (mkVisMatchPat lhs) grhss ([],[]))
+  return (PatBind (EpAnn (spanAsAnchor loc) annsIn cs) lhs grhss ([],[]))
 
 checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
 checkValSigLhs (L _ (HsVar _ lrdr@(L _ v)))
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 075dbdf4c6..7d30a36192 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -432,7 +432,7 @@ rnBindLHS :: NameMaker
 rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })
   = do
       -- we don't actually use the FV processing of rnPatsAndThen here
-      (pat',pat'_fvs) <- rnBindMatchPat name_maker pat
+      (pat',pat'_fvs) <- rnBindPat name_maker pat
       return (bind { pat_lhs = pat', pat_ext = pat'_fvs })
                 -- We temporarily store the pat's FVs in bind_fvs;
                 -- gets updated to the FVs of the whole bind
@@ -487,16 +487,16 @@ rnBind _ bind@(PatBind { pat_lhs = pat
                 -- Keep locally-defined Names
                 -- As well as dependency analysis, we need these for the
                 -- MonoLocalBinds test in GHC.Tc.Gen.Bind.decideGeneralisationPlan
-              bndrs = collectLMatchPatBinders CollNoDictBinders pat
+              bndrs = collectPatBinders CollNoDictBinders pat
               bind' = bind { pat_rhs  = grhss'
                            , pat_ext = fvs' }
 
               ok_nobind_pat
                   = -- See Note [Pattern bindings that bind no variables]
                     case unLoc pat of
-                       VisPat _ (L _ WildPat {})   -> True
-                       VisPat _ (L _ BangPat {})   -> True -- #9127, #13646
-                       VisPat _ (L _ SplicePat {}) -> True
+                       WildPat {}   -> True
+                       BangPat {}   -> True -- #9127, #13646
+                       SplicePat {} -> True
                        _            -> False
 
         -- Warn if the pattern binds no variables
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 6220133232..93fa9a7e2c 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -1236,7 +1236,7 @@ tcMonoBinds is_rec sig_fn no_gen
 
                 , mbis ) }
   where
-    bndrs = collectLMatchPatBinders CollNoDictBinders pat
+    bndrs = collectPatBinders CollNoDictBinders pat
 
 -- GENERAL CASE
 tcMonoBinds _ sig_fn no_gen binds
@@ -1354,7 +1354,7 @@ mono_id in the first place.
 
 data TcMonoBind         -- Half completed; LHS done, RHS not done
   = TcFunBind  MonoBindInfo  SrcSpan (MatchGroup GhcRn (LHsExpr GhcRn))
-  | TcPatBind [MonoBindInfo] (LMatchPat GhcTc) (GRHSs GhcRn (LHsExpr GhcRn))
+  | TcPatBind [MonoBindInfo] (LPat GhcTc) (GRHSs GhcRn (LHsExpr GhcRn))
               TcSigmaType
 
 tcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind
@@ -1412,7 +1412,7 @@ tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss })
 
         ; return (TcPatBind mbis pat' grhss pat_ty) }
   where
-    bndr_names = collectLMatchPatBinders CollNoDictBinders pat
+    bndr_names = collectPatBinders CollNoDictBinders pat
     (nosig_names, sig_names) = partitionWith find_sig bndr_names
 
     find_sig :: Name -> Either Name (Name, TcIdSigInfo)
@@ -1730,7 +1730,7 @@ isClosedBndrGroup type_env binds
          in [(f, open_fvs)]
     bindFvs (PatBind { pat_lhs = pat, pat_ext = fvs })
        = let open_fvs = get_open_fvs fvs
-         in [(b, open_fvs) | b <- collectLMatchPatBinders CollNoDictBinders pat]
+         in [(b, open_fvs) | b <- collectPatBinders CollNoDictBinders pat]
     bindFvs _
        = []
 
@@ -1775,6 +1775,6 @@ isClosedBndrGroup type_env binds
 -- This one is called on LHS, when pat and grhss are both Name
 -- and on RHS, when pat is TcId and grhss is still Name
 patMonoBindsCtxt :: (OutputableBndrId p)
-                 => LMatchPat (GhcPass p) -> GRHSs GhcRn (LHsExpr GhcRn) -> SDoc
+                 => LPat (GhcPass p) -> GRHSs GhcRn (LHsExpr GhcRn) -> SDoc
 patMonoBindsCtxt pat grhss
   = hang (text "In a pattern binding:") 2 (pprPatBind pat grhss)
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 5fe6ac649d..59b6b73fbf 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -84,9 +84,9 @@ import GHC.Data.List.SetOps ( getNth )
 
 tcLetPat :: (Name -> Maybe TcId)
          -> LetBndrSpec
-         -> LMatchPat GhcRn -> Scaled ExpSigmaType
+         -> LPat GhcRn -> Scaled ExpSigmaType
          -> TcM a
-         -> TcM (LMatchPat GhcTc, a)
+         -> TcM (LPat GhcTc, a)
 tcLetPat sig_fn no_gen pat pat_ty thing_inside
   = do { bind_lvl <- getTcLevel
        ; let ctxt = LetPat { pc_lvl    = bind_lvl
@@ -96,7 +96,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside
                        , pe_ctxt = ctxt
                        , pe_orig = PatOrigin }
 
-       ; tc_lmatchpat pat_ty penv pat thing_inside }
+       ; tc_lpat pat_ty penv pat thing_inside }
 
 -----------------
 tcLMatchPats :: HsMatchContext GhcTc
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index d00cdfc5b5..73d5b0310f 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -538,7 +538,7 @@ zonk_lbind env = wrapLocMA (zonk_bind env)
 zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
 zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss
                             , pat_ext = ty})
-  = do  { (_env, new_pat) <- zonkLMatchPat env pat            -- Env already extended
+  = do  { (_env, new_pat) <- zonkPat env pat            -- Env already extended
         ; new_grhss <- zonkGRHSs env zonkLExpr grhss
         ; new_ty    <- zonkTcTypeToTypeX env ty
         ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 2c1db954bf..cd19f9faa1 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -182,7 +182,7 @@ cvtDec (TH.ValD pat body ds)
         ; body' <- cvtGuard body
         ; ds' <- cvtLocalDecs (text "a where clause") ds
         ; returnJustLA $ Hs.ValD noExtField $
-          PatBind { pat_lhs = mkVisMatchPat pat'
+          PatBind { pat_lhs = pat'
                   , pat_rhs = GRHSs emptyComments body' ds'
                   , pat_ext = noAnn
                   , pat_ticks = ([],[]) } }
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index d00a1e2864..e3e611674c 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -29,7 +29,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
   , MatchGroup
   , GRHSs )
 import {-# SOURCE #-} Language.Haskell.Syntax.Pat
-  ( LPat, LMatchPat )
+  ( LPat )
 
 import Language.Haskell.Syntax.Extension
 import Language.Haskell.Syntax.Type
@@ -245,7 +245,7 @@ data HsBindLR idL idR
   -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
   | PatBind {
         pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]
-        pat_lhs    :: LMatchPat idL,
+        pat_lhs    :: LPat idL,
         pat_rhs    :: GRHSs idR (LHsExpr idR),
         pat_ticks  :: ([CoreTickish], [[CoreTickish]])
                -- ^ Ticks to put on the rhs, if any, and ticks to put on