dsSyntaxTable, lookupEvidence,
- selectSimpleMatchVarL, selectMatchVars, selectMatchVar
+ selectSimpleMatchVarL, selectMatchVars, selectMatchVar,
+ mkTickBox, mkOptTickBox, mkBinaryTickBox
) where
#include "HsVersions.h"
import ListSetOps
import FastString
import Data.Char
+import DynFlags
#ifdef DEBUG
import Util
ty = exprType expr
\end{code}
-
+\begin{code}
+mkOptTickBox :: Maybe Int -> CoreExpr -> DsM CoreExpr
+mkOptTickBox Nothing e = return e
+mkOptTickBox (Just ix) e = mkTickBox ix e
+
+mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
+mkTickBox ix e = do
+ uq <- newUnique
+ mod <- getModuleDs
+ 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
+ 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