-}
addTickLHsBind other = return other
--- add a tick to the expression no matter what it is
+-- Add a tick to the expression no matter what it is. There is one exception:
+-- for the debugger, if the expression is a 'let', then we don't want to add
+-- a tick here because there will definititely be a tick on the body anyway.
addTickLHsExprAlways :: LHsExpr Id -> TM (LHsExpr Id)
-addTickLHsExprAlways (L pos e0) = do
- allocTickBox (ExpBox False) pos $ addTickHsExpr e0
+addTickLHsExprAlways (L pos e0)
+ | not opt_Hpc, HsLet _ _ <- e0 = addTickLHsExprNever (L pos e0)
+ | otherwise = allocTickBox (ExpBox False) pos $ addTickHsExpr e0
addTickLHsExprNeverOrAlways :: LHsExpr Id -> TM (LHsExpr Id)
addTickLHsExprNeverOrAlways e
(addTickLHsExprOptAlt True e2)
(addTickLHsExprOptAlt True e3)
addTickHsExpr (HsLet binds e) =
+ bindLocals (map unLoc $ collectLocalBinders binds) $
liftM2 HsLet
- (addTickHsLocalBinds binds) -- to think about: !patterns.
- (bindLocals (map unLoc $ collectLocalBinders binds) $
- addTickLHsExprNeverOrAlways e)
+ (addTickHsLocalBinds binds) -- to think about: !patterns.
+ (addTickLHsExprNeverOrAlways e)
addTickHsExpr (HsDo cxt stmts last_exp srcloc) = do
(stmts', last_exp') <- addTickLStmts' forQual stmts
(addTickLHsExpr last_exp)