X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=209a0949bfc236f6a8f1fbb0b8d8386eb10f5d99;hb=3a99fa889bdff0c86df20cb18c71d30e30a79b43;hp=6bc70e2b8f56932cbe3ab2d2d3e83277ce65e896;hpb=8100cd4395e46ae747be4298c181a4730d6206bc;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 6bc70e2..209a094 100644 --- 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