[Git][ghc/ghc][wip/spj-apporv-Oct24] undo ticks changes for hpc

[Apoorv Ingle (@ani)]

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


Commits:
a1a228ce by Apoorv Ingle at 2025-03-12T15:50:12-05:00
undo ticks changes for hpc

- - - - -


2 changed files:

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


Changes:

=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -586,8 +586,7 @@ 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)) =
-        liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e
+addTickHsExpr (XExpr (ExpandedThingTc o e)) = addTickHsExpanded o e
 
 addTickHsExpr e@(XExpr (ConLikeTc {})) = return e
   -- We used to do a freeVar on a pat-syn builder, but actually
@@ -606,10 +605,25 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts))
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
        ; return (HsDo srcloc cxt (L l stmts')) }
   where
-        forQual = case cxt of
+    forQual = case cxt of
                     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/App.hs
=====================================
@@ -876,7 +876,7 @@ looks_like_type_arg _ = False
 
 addArgCtxt :: AppCtxt -> LHsExpr GhcRn
            -> TcM a -> TcM a
--- There are 3 cases:
+-- There are 2 cases:
 -- 1. In the normal case, we add an informative context
 --          "In the third argument of f, namely blah"
 -- 2. If we are deep inside generated code (`isGeneratedCode` is `True`)
@@ -885,9 +885,6 @@ addArgCtxt :: AppCtxt -> LHsExpr GhcRn
 --          "In the expression: arg"
 --   Unless the arg is also a generated thing, in which case do nothing.
 --   See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
--- 3. We are in an expanded `do`-block statement
---      Do nothing as we have already added the error
---      context in GHC.Tc.Do.tcXExpr
 --  See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
 addArgCtxt ctxt (L arg_loc arg) thing_inside
   = do { in_generated_code <- inGeneratedCode



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1a228ce32b7f8f37ec4dba6fee899d3e78ec715
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/20250312/0e88eed7/attachment-0001.html>