diff options
Diffstat (limited to 'compiler/deSugar/DsUtils.lhs')
| -rw-r--r-- | compiler/deSugar/DsUtils.lhs | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 455db042f9..3c565674f2 100644 --- a/compiler/deSugar/DsUtils.lhs +++ b/compiler/deSugar/DsUtils.lhs @@ -69,6 +69,8 @@ import SrcLoc import Util import ListSetOps import FastString +import StaticFlags + import Data.Char infixl 4 `mkDsApp`, `mkDsApps` @@ -942,15 +944,22 @@ mkTickBox :: Int -> CoreExpr -> DsM CoreExpr mkTickBox ix e = do uq <- newUnique mod <- getModuleDs - let tick = mkTickBoxOpId uq mod ix + let tick | opt_Hpc = mkTickBoxOpId uq mod ix + | otherwise = mkBreakPointOpId uq mod ix uq2 <- newUnique let occName = mkVarOcc "tick" let name = mkInternalName uq2 occName noSrcLoc -- use mkSysLocal? let var = Id.mkLocalId name realWorldStatePrimTy - return $ Case (Var tick) - var - ty - [(DEFAULT,[],e)] + scrut <- + if opt_Hpc + then return (Var tick) + else do + locals <- getLocalBindsDs + let tickVar = Var tick + let tickType = mkFunTys (map idType locals) realWorldStatePrimTy + let scrutApTy = App tickVar (Type tickType) + return (mkApps scrutApTy (map Var locals) :: Expr Id) + return $ Case scrut var ty [(DEFAULT,[],e)] where ty = exprType e @@ -966,4 +975,4 @@ mkBinaryTickBox ixT ixF e = do [ (DataAlt falseDataCon, [], falseBox) , (DataAlt trueDataCon, [], trueBox) ] -\end{code}
\ No newline at end of file +\end{code} |