[Git][ghc/ghc][wip/expand-do] add context of first do statement in addArgCtxt, somehow it goes missing

[Apoorv Ingle (@ani)]

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


Commits:
fb923fa2 by Apoorv Ingle at 2023-06-26T16:03:34-05:00
add context of first do statement in addArgCtxt, somehow it goes missing

- - - - -


2 changed files:

- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/Tc/Gen/App.hs


Changes:

=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -228,7 +228,10 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun
                 = [id]
                 | otherwise
                 = []
-        ; return (force_var, [core_binds]) } }
+        ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun)
+          --                          , ppr (mg_alts matches)
+          --                          , ppr args, ppr core_binds, ppr body']) $
+          return (force_var, [core_binds]) } }
 
 dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss
                          , pat_ext = (ty, (rhs_tick, var_ticks))


=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -554,7 +554,7 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
 
     maybeSetCtxt :: HsExpr GhcRn -> TcM a -> TcM a
     maybeSetCtxt (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) thing_inside
-      = do traceTc "tcInstFun" (text "set stmt ctxt" <+> ppr stmt)
+      = do traceTc "tcInstFun" (text "set stmt ctxt" <+> ppr stmt <+> ppr loc)
            setSrcSpanA loc $
              addStmtCtxt stmt thing_inside
     maybeSetCtxt _ thing_inside = thing_inside
@@ -738,6 +738,22 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
              -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..."
                                                  -- We have already set the context "In the stmt"
                    thing_inside
+           VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _
+             -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .."
+                   setSrcSpanA loc $
+                     addStmtCtxt stmt $
+                     thing_inside
+           VAExpansion (HsDo _ _ (L _ ((stmt@(L loc _)) : _))) _
+             -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block
+                   setSrcSpanA loc $
+                     addStmtCtxt stmt $
+                     thing_inside
+           VAExpansion _ _
+             -> do traceTc "addArgCtxt 2e" empty -- Skip setting "In the expression..."
+                                                 -- as the arg will be an generated expanded stmt
+                   -- setSrcSpan loc $
+                   --   addExprCtxt orig $
+                   thing_inside
            _ -> do traceTc "addArgCtxt 3" empty
                    setSrcSpanA arg_loc $
                      addExprCtxt arg     $  -- Auto-suppressed if arg_loc is generated



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb923fa2cd34e2ba6525e7375fb613d819cf5758
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/20230626/60f660c7/attachment-0001.html>