[Git][ghc/ghc][wip/expand-do] add the argument location in error ctxt if it is the first argument of a >> or a >>=

[Apoorv Ingle (@ani)]

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


Commits:
d1c9f376 by Apoorv Ingle at 2023-07-02T22:51:53-05:00
add the argument location in error ctxt if it is the first argument of a >> or a >>=

- - - - -


3 changed files:

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


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -357,11 +357,11 @@ tcApp rn_expr exp_res_ty
        ; let  perhaps_add_res_ty_ctxt thing_inside
                  | insideExpansion fun_ctxt
                  , VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ <- fun_ctxt
-                 = do traceTc "tcApp" (vcat [text "VACall stmt", ppr rn_fun, ppr fun_ctxt])
+                 = do traceTc "tcApp" (vcat [text "VACall stmt", ppr loc, ppr rn_fun, ppr fun_ctxt])
                       setSrcSpanA loc $ addStmtCtxt stmt thing_inside
                  | insideExpansion fun_ctxt
                  , XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun
-                 = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr rn_fun, ppr fun_ctxt])
+                 = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr loc, ppr rn_fun, ppr fun_ctxt])
                       setSrcSpanA loc $ addStmtCtxt stmt thing_inside
                  | insideExpansion fun_ctxt
                  = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt])
@@ -734,20 +734,24 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
                    setSrcSpanA arg_loc                    $
                      addErrCtxt (funAppCtxt fun arg arg_no) $
                      thing_inside
-           VACall fun _ _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun)
-             -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..."
+           VACall fun arg_no _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun)
+             -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." if the arg_no is > 1
                                                  -- We have already set the context "In the stmt"
-                   thing_inside
+                   if arg_no == 1                -- this arg location needs to be added
+                     then setSrcSpanA arg_loc $
+                          addExprCtxt arg     $  -- Auto-suppressed if arg_loc is generated
+                          thing_inside
+                     else 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 _)) : _))) _
+           VAExpansion (HsDo _ _ _) _
              -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block
-                   setSrcSpanA loc $
-                     addStmtCtxt stmt $
-                     thing_inside
+                   -- setSrcSpan loc $           -- skip adding "In the expression do ... "
+                   --   addExprCtxt e $
+                   thing_inside
            VAExpansion _ _
              -> do traceTc "addArgCtxt 2e" empty -- Skip setting "In the expression..."
                                                  -- as the arg will be an generated expanded stmt


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -790,8 +790,6 @@ tcInferAppHead_maybe fun args
       HsOverLit _ lit           -> Just <$> tcInferOverLit lit
       HsUntypedSplice (HsUntypedSpliceTop _ e) _
                                 -> tcInferAppHead_maybe e args
-      -- XExpr (PopSrcSpan e)            -> tcInferAppHead_maybe (unLoc e) args
-      -- XExpr (ExpandedStmt (HsExpanded _ e)) -> tcInferAppHead_maybe (unLoc e) args
       _                         -> return Nothing
 
 addHeadCtxt :: AppCtxt -> TcM a -> TcM a


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -1207,8 +1207,6 @@ expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts
 
 -- | Expand the Do statments so that it works fine with Quicklook
 --   See Note[Rebindable Do and Expanding Statements]
--- ANI Questions: 1. What should be the location information in the expanded expression?
--- Currently the error is displayed on the expanded expr and not on the unexpanded expr
 expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn)
 
 expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c9f376f483c2c7253ddb12585c027c9670b122
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/20230702/aac4c73f/attachment-0001.html>