[Git][ghc/ghc][wip/spj-apporv-Oct24] wrap last stmt expansion in a HsPar so that the error messages are prettier

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC


Commits:
e1c75108 by Apoorv Ingle at 2025-03-10T20:50:08-05:00
wrap last stmt expansion in a HsPar so that the error messages are prettier

- - - - -


2 changed files:

- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Tc/Gen/Do.hs


Changes:

=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -586,7 +586,8 @@ addTickHsExpr (HsProc x pat cmdtop) =
 addTickHsExpr (XExpr (WrapExpr w e)) =
         liftM (XExpr . WrapExpr w) $
               (addTickHsExpr e)        -- Explicitly no tick on inside
-addTickHsExpr (XExpr (ExpandedThingTc o e)) = addTickHsExpanded o e
+addTickHsExpr (XExpr (ExpandedThingTc o e)) =
+        liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e
 
 addTickHsExpr e@(XExpr (ConLikeTc {})) = return e
   -- We used to do a freeVar on a pat-syn builder, but actually
@@ -609,21 +610,6 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts))
                     ListComp -> Just $ BinBox QualBinBox
                     _        -> Nothing
 
-addTickHsExpanded :: HsThingRn -> HsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpanded o@(OrigStmt (L pos LastStmt{}) _) e
-  -- LastStmt always gets a tick for breakpoint and hpc coverage
-  = do d <- getDensity
-       case d of
-          TickForCoverage    -> liftM (XExpr . ExpandedThingTc o) $ tick_it e
-          TickForBreakPoints -> liftM (XExpr . ExpandedThingTc o) $ tick_it e
-          _                  -> liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e
-  where
-    tick_it e  = unLoc <$> allocTickBox (ExpBox False) False False (locA pos)
-                               (addTickHsExpr e)
-addTickHsExpanded o e
-  = liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e
-
-
 addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc)
 addTickTupArg (Present x e)  = do { e' <- addTickLHsExpr e
                                   ; return (Present x e') }


=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -76,14 +76,14 @@ expand_do_stmts flav [stmt@(L _loc (LastStmt _ (L body_loc body) _ ret_expr))]
 -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt`
    | NoSyntaxExprRn <- ret_expr
    -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt
-   = return $ mkExpandedStmt stmt flav body
+   = return $ mkExpandedStmt stmt flav (HsPar noExtField (L body_loc body))
    | SyntaxExprRn ret <- ret_expr
    --
    --    ------------------------------------------------
    --               return e  ~~> return e
    -- to make T18324 work
    = do let expansion = genHsApp ret (L body_loc body)
-        return $ mkExpandedStmt stmt flav expansion
+        return $ mkExpandedStmt stmt flav (HsPar noExtField (L body_loc expansion))
 
 expand_do_stmts doFlavour (stmt@(L _ (LetStmt _ bs)) : lstmts) =
 -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (3) below



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1c75108759b12df147832c57bb253f9086d0348
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/20250310/1174bd5d/attachment-0001.html>