X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=3c565674f2cea68b4f7f2dc76cfa5f3012c0f03e;hp=455db042f927bbe19b04b922ef8b196a2059ab87;hb=cdce647711c0f46f5799b24de087622cb77e647f;hpb=dc8ffcb9797ade3e3a68e6ec0a89fe2e7444e0ef

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 455db04..3c56567 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}