Fixed uninitialised FunBind fun_tick field

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

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 6bc70e2..209a094 100644 (file)
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -889,7 +889,6 @@ mkOptTickBox (Just ix) e = mkTickBox ix e
 
 mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
 mkTickBox ix e = do
-       dflags <- getDOptsDs
        uq <- newUnique         
        mod <- getModuleDs
        let tick = mkTickBoxOpId uq mod ix
@@ -907,9 +906,13 @@ mkTickBox ix e = do
 mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
 mkBinaryTickBox ixT ixF e = do
        mod <- getModuleDs
-       dflags <- getDOptsDs
        uq <- newUnique         
        mod <- getModuleDs
-       let tick = mkBinaryTickBoxOpId uq mod ixT ixF
-       return $ App (Var tick) e
+       let bndr1 = mkSysLocal FSLIT("t1") uq boolTy 
+       falseBox <- mkTickBox ixF $ Var falseDataConId
+       trueBox  <- mkTickBox ixT $ Var trueDataConId
+       return $ Case e bndr1 boolTy
+                       [ (DataAlt falseDataCon, [], falseBox)
+                       , (DataAlt trueDataCon,  [], trueBox)
+                       ]
 \end{code}
\ No newline at end of file