Update the panic msg from #1257 to be an ordinary error, not a panic

[ghc-hetmet.git] / compiler / deSugar / Coverage.lhs

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index a011df6..f46d9cd 100644 (file)
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -177,10 +177,13 @@ addTickLHsBind (VarBind var_id var_rhs) = do
 -}
 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
@@ -273,10 +276,10 @@ addTickHsExpr (HsIf        e1 e2 e3) =
                (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)
@@ -550,8 +553,8 @@ instance Monad TM where
                                        (r2,fv2,st2) -> 
                                           (r2, fv1 `plusOccEnv` fv2, st2)
 
-getState :: TM TickTransState
-getState = TM $ \ env st -> (st, noFVs, st)
+-- getState :: TM TickTransState
+-- getState = TM $ \ env st -> (st, noFVs, st)
 
 setState :: (TickTransState -> TickTransState) -> TM ()
 setState f = TM $ \ env st -> ((), noFVs, f st)