X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=209a0949bfc236f6a8f1fbb0b8d8386eb10f5d99;hb=90dc9026b091be5cca5da4c6cbd3713ecc493361;hp=868a89402c0d6fbd1227defe31e8c4b48fe5f458;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 868a894..209a094 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -70,6 +70,7 @@ import Util
 import ListSetOps
 import FastString
 import Data.Char
+import DynFlags
 
 #ifdef DEBUG
 import Util
@@ -888,11 +889,30 @@ mkOptTickBox (Just ix) e = mkTickBox ix e
 
 mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
 mkTickBox ix e = do
+       uq <- newUnique 	
        mod <- getModuleDs
-       return $ Note (TickBox mod ix) e
+       let tick = mkTickBoxOpId 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)]
+  where
+     ty = exprType e
 
 mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
 mkBinaryTickBox ixT ixF e = do
        mod <- getModuleDs
-       return $ Note (BinaryTickBox mod ixT ixF) e
+       uq <- newUnique 	
+       mod <- getModuleDs
+       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