X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=7d95266da4b186ad583f9fc138cc00fc3ee4e975;hb=ab5b8aa357c685a7c702262903bce04c66f79156;hp=e3b40b843224afcda4674bea5e3618ace3355704;hpb=4330e6f4e8f9ad2b09a3f71828d586e829227eca;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index e3b40b8..7d95266 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -18,7 +18,7 @@ module MkId (
 
 	mkDataConIds,
 	mkRecordSelId, 
-	mkPrimOpId, mkFCallId,
+	mkPrimOpId, mkFCallId, mkTickBoxOpId, 
 
 	mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         mkUnpackCase, mkProductBox,
@@ -72,6 +72,7 @@ import Util
 import Outputable
 import FastString
 import ListSetOps
+import Module
 \end{code}		
 
 %************************************************************************
@@ -903,6 +904,18 @@ mkFCallId uniq fcall ty
     (arg_tys, _) = tcSplitFunTys tau
     arity	 = length arg_tys
     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
+
+mkTickBoxOpId :: Unique 
+	      -> Module
+	      -> TickBoxId
+	      -> Id
+mkTickBoxOpId uniq mod ix =  mkGlobalId (TickBoxOpId tickbox) name ty info    
+  where
+    tickbox = TickBox mod ix
+    occ_str = showSDoc (braces (ppr tickbox))
+    name    = mkTickBoxOpName uniq occ_str
+    info    = noCafIdInfo
+    ty      = realWorldStatePrimTy 
 \end{code}
 
 
@@ -1037,8 +1050,7 @@ unsafeCoerceId
 		      (mkFunTy openAlphaTy openBetaTy)
     [x] = mkTemplateLocals [openAlphaTy]
     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
---       Note (Coerce openBetaTy openAlphaTy) (Var x)
-         Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
+          Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
 
 -- nullAddr# :: Addr#
 -- The reason is is here is because we don't provide