[Git][ghc/ghc][wip/expand-do] remove isGoodCoverateExpr. it is not needed

[Apoorv Ingle (@ani)]

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


Commits:
47cb6dc5 by Apoorv Ingle at 2023-12-18T07:26:49-06:00
remove isGoodCoverateExpr. it is not needed

- - - - -


1 changed file:

- compiler/GHC/HsToCore/Ticks.hs


Changes:

=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -375,7 +375,7 @@ addTickLHsExpr e@(L pos e0) = do
   d <- getDensity
   case d of
     TickForBreakPoints | isGoodBreakExpr e0 -> tick_it
-    TickForCoverage    | isGoodCoverageExpr e0 -> tick_it
+    TickForCoverage    -> tick_it
     TickCallSites      | isCallSite e0      -> tick_it
     _other             -> dont_tick_it
  where
@@ -393,7 +393,7 @@ addTickLHsExprRHS e@(L pos e0) = do
   case d of
      TickForBreakPoints | HsLet{} <- e0 -> dont_tick_it
                         | otherwise     -> tick_it
-     TickForCoverage    | isGoodCoverageExpr e0 -> tick_it
+     TickForCoverage    -> tick_it
      TickCallSites   | isCallSite e0 -> tick_it
      _other          -> dont_tick_it
  where
@@ -409,8 +409,7 @@ addTickLHsExprEvalInner :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprEvalInner e = do
    d <- getDensity
    case d of
-     TickForCoverage | isGoodCoverageExpr (unLoc e) -> addTickLHsExpr e
-                     | otherwise -> addTickLHsExprNever e
+     TickForCoverage -> addTickLHsExprNever e
      _otherwise      -> addTickLHsExpr e
 
 -- | A let body is treated differently from addTickLHsExprEvalInner
@@ -441,30 +440,12 @@ addTickLHsExprNever (L pos e0) = do
 -- General heuristic: expressions which are calls (do not denote
 -- values) are good break points.
 isGoodBreakExpr :: HsExpr GhcTc -> Bool
-isGoodBreakExpr (XExpr (ExpandedThingTc thing e))
-  | OrigStmt (L _ BodyStmt{}) <- thing
-  = False
-  | OrigStmt (L _ BindStmt{}) <- thing
-  = False
-  | OrigStmt (L _ LastStmt{}) <- thing
+isGoodBreakExpr (XExpr (ExpandedThingTc (OrigStmt stmt) _))
+  | LastStmt{} <- unLoc stmt
   = True
   | otherwise
-  = isCallSite e
-isGoodBreakExpr e = isCallSite e
-
--- Should coverage ticks be added to this expr?
--- The general heuristic: Expanded `do`-stmts do not get
--- the coverage ticks as they are accounted for in the expansions
-isGoodCoverageExpr :: HsExpr GhcTc -> Bool
-isGoodCoverageExpr (XExpr (ExpandedThingTc thing _))
-  | OrigStmt (L _ BodyStmt{}) <- thing
   = False
-  | OrigStmt (L _ BindStmt{}) <- thing
-  = False
-  | OrigStmt (L _ LetStmt{}) <- thing
-  = False
-isGoodCoverageExpr _ = True
-
+isGoodBreakExpr e = isCallSite e
 
 isCallSite :: HsExpr GhcTc -> Bool
 isCallSite HsApp{}     = True
@@ -479,12 +460,12 @@ isCallSite _           = False
 addTickLHsExprOptAlt :: Bool -> Bool {- is do expansion -}
                      -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprOptAlt oneOfMany isExpansion e@(L pos e0)
-  = if not (isExpansion)
-    then ifDensity TickForCoverage
-        (allocTickBox (ExpBox oneOfMany) False False (locA pos)
-          $ addTickHsExpr e0)
-        (addTickLHsExpr e)
-    else (addTickLHsExprNever e)
+  = if isExpansion
+    then addTickLHsExprNever e
+    else ifDensity TickForCoverage
+         (allocTickBox (ExpBox oneOfMany) False False (locA pos)
+                  $ addTickHsExpr e0)
+         (addTickLHsExpr e)
 
 addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addBinTickLHsExpr boxLabel (L pos e0)
@@ -650,7 +631,7 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches, mg_ext = ctxt }) = do
   matches' <- mapM (traverse (addTickMatch isOneOfMany is_lam isDoExp)) matches
   return $ mg { mg_alts = L l matches' }
 
-addTickMatch :: Bool -> Bool -> Bool {-Is Do Expanion-} ->  Match GhcTc (LHsExpr GhcTc)
+addTickMatch :: Bool -> Bool -> Bool {-Is this Do Expansion-} ->  Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
 addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = pats
                                                        , m_grhss = gRHSs }) =



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47cb6dc58d3875e40ef995f88dddaa1e792a1536
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/20231218/ae87d92c/attachment-0001.html>