[Git][ghc/ghc][wip/expand-do] do not pop anthing in tcMatch

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC


Commits:
c845874f by Apoorv Ingle at 2023-07-24T10:49:49-05:00
do not pop anthing in tcMatch

- - - - -


2 changed files:

- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1548,9 +1548,8 @@ addStmtCtxt doc stmt thing_inside
   where
     pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc
     pprStmtInCtxt isRebindable ctxt stmt
-      = vcat [ text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of"
-                     <+> pprAStmtContext ctxt <> colon
-             , nest 2 (pprStmt stmt)
+      = vcat [ hang (text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of"
+                     <+> pprAStmtContext ctxt <> colon) 2 (pprStmt stmt)
              , optionalNote isRebindable
              ]
     optionalExpansionClause :: Bool -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -84,7 +84,7 @@ import qualified GHC.LanguageExtensions as LangExt
 import Control.Monad
 import Control.Arrow ( second )
 import qualified Data.List.NonEmpty as NE
-
+import Data.List((\\))
 {-
 ************************************************************************
 *                                                                      *
@@ -256,11 +256,7 @@ tcMatch ctxt pat_tys rhs_ty match
              match@(Match { m_pats = pats, m_grhss = grhss })
       = add_match_ctxt match $
         do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $
-                                maybeErrPopCtxt (mc_what ctxt) $ -- we are likely in a do expansion generated match
-                                                                 -- pop the previous context as it is
-                                                                 -- the one for previous statement context
-                                do { traceTc "tcMatch" (ppr pats)
-                                   ; tcGRHSs ctxt grhss rhs_ty }
+                                  tcGRHSs ctxt grhss rhs_ty
            ; return (Match { m_ext = noAnn
                            , m_ctxt = mc_what ctxt, m_pats = pats'
                            , m_grhss = grhss' }) }
@@ -273,9 +269,6 @@ tcMatch ctxt pat_tys rhs_ty match
             StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt
             _          -> addErrCtxt (pprMatchInCtxt match) thing_inside
 
-    maybeErrPopCtxt (StmtCtxt (HsDoStmt{})) thing_inside = do traceTc "tcMatch popErrCtxt" empty
-                                                              popErrCtxt thing_inside
-    maybeErrPopCtxt _ thing_inside = thing_inside
 -------------
 tcGRHSs :: AnnoBody body
         => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c845874fe60517e1bd772c803d59a3a6372f5244

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c845874fe60517e1bd772c803d59a3a6372f5244
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230724/f7135507/attachment-0001.html>