X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=b847df0f17dc26cccce5803c3a518a6ce8aefd03;hb=8100cd4395e46ae747be4298c181a4730d6206bc;hp=78da0e37faff422d182710bb9cb7ac9452a27ab5;hpb=859001105a5cbb15959f04519911da86e597f2e1;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 78da0e3..b847df0 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -517,7 +517,9 @@ side effects, and can't diverge or raise an exception.
 exprOkForSpeculation :: CoreExpr -> Bool
 exprOkForSpeculation (Lit _)     = True
 exprOkForSpeculation (Type _)    = True
+    -- Tick boxes are *not* suitable for speculation
 exprOkForSpeculation (Var v)     = isUnLiftedType (idType v)
+				 && not (isTickBoxOp v)
 exprOkForSpeculation (Note _ e)  = exprOkForSpeculation e
 exprOkForSpeculation (Cast e co) = exprOkForSpeculation e
 exprOkForSpeculation other_expr
@@ -621,10 +623,6 @@ exprIsHNF (Lit l)	   = True
 exprIsHNF (Type ty)	   = True	-- Types are honorary Values; 
 			   		-- we don't mind copying them
 exprIsHNF (Lam b e)  	   = isRuntimeVar b || exprIsHNF e
-exprIsHNF (Note (TickBox {}) _)
-	                   = False
-exprIsHNF (Note (BinaryTickBox {}) _)
-	                   = False
 exprIsHNF (Note _ e) 	   = exprIsHNF e
 exprIsHNF (Cast e co)      = exprIsHNF e
 exprIsHNF (App e (Type _)) = exprIsHNF e
@@ -805,6 +803,7 @@ exprIsConApp_maybe (Cast expr co)
     Just (dc, map Type to_tc_arg_tys ++ ex_args ++ new_co_args ++ new_val_args)
     }}
 
+{-
 -- We do not want to tell the world that we have a
 -- Cons, to *stop* Case of Known Cons, which removes
 -- the TickBox.
@@ -812,6 +811,7 @@ exprIsConApp_maybe (Note (TickBox {}) expr)
   = Nothing
 exprIsConApp_maybe (Note (BinaryTickBox {}) expr)
   = Nothing
+-}
 
 exprIsConApp_maybe (Note _ expr)
   = exprIsConApp_maybe expr
@@ -1197,9 +1197,6 @@ exprArity e = go e
 	      go (Var v) 	       	   = idArity v
 	      go (Lam x e) | isId x    	   = go e + 1
 			   | otherwise 	   = go e
-              go (Note (TickBox {}) _)     = 0
-              go (Note (BinaryTickBox {}) _) 
-		                           = 0
 	      go (Note n e) 		   = go e
               go (Cast e _)                = go e
 	      go (App e (Type t))      	   = go e
@@ -1317,9 +1314,7 @@ exprSize (Type t)        = seqType t `seq` 1
 noteSize (SCC cc)       = cc `seq` 1
 noteSize InlineMe       = 1
 noteSize (CoreNote s)   = s `seq` 1  -- hdaume: core annotations
-noteSize (TickBox m n)    = m `seq` n `seq` 1 
-noteSize (BinaryTickBox m t e)  = m `seq` t `seq` e `seq` 1 
-
+ 
 varSize :: Var -> Int
 varSize b  | isTyVar b = 1
 	   | otherwise = seqType (idType b)		`seq`
@@ -1480,8 +1475,6 @@ rhsIsStatic this_pkg rhs = is_static False rhs
   is_static False (Lam b e) = isRuntimeVar b || is_static False e
   
   is_static in_arg (Note (SCC _) e) = False
-  is_static in_arg (Note (TickBox {}) e) = False
-  is_static in_arg (Note (BinaryTickBox {}) e) = False
   is_static in_arg (Note _ e)       = is_static in_arg e
   is_static in_arg (Cast e co)      = is_static in_arg e