X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=6bc70e2b8f56932cbe3ab2d2d3e83277ce65e896;hp=868a89402c0d6fbd1227defe31e8c4b48fe5f458;hb=8100cd4395e46ae747be4298c181a4730d6206bc;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048 diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 868a894..6bc70e2 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,27 @@ mkOptTickBox (Just ix) e = mkTickBox ix e mkTickBox :: Int -> CoreExpr -> DsM CoreExpr mkTickBox ix e = do + dflags <- getDOptsDs + 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 + dflags <- getDOptsDs + uq <- newUnique + mod <- getModuleDs + let tick = mkBinaryTickBoxOpId uq mod ixT ixF + return $ App (Var tick) e \end{code} \ No newline at end of file