X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FstgSyn%2FCoreToStg.lhs;h=bdb3a6622d7edfcafb47cd9dca5d3649cd50d6ce;hp=31837b904362416695b1ca620058eabbcd0e5ca3;hb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;hpb=33b8b60e0aa925962cd11a8be98d9818666d58a0

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 31837b9..bdb3a66 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -318,6 +318,15 @@ coreToStgExpr (Note (SCC cc) expr)
   = coreToStgExpr expr		`thenLne` ( \ (expr2, fvs, escs) ->
     returnLne (StgSCC cc expr2, fvs, escs) )
 
+coreToStgExpr (Note (TickBox m n) expr)
+  = coreToStgExpr expr         `thenLne` ( \ (expr2, fvs, escs) ->
+    returnLne (StgTick m n expr2, fvs, escs) )
+
+-- BinaryTickBox'es are are removed by the CorePrep pass.
+
+coreToStgExpr expr@(Note (BinaryTickBox m t e) _)	
+  = pprPanic "coreToStgExpr: " (ppr expr)
+
 coreToStgExpr (Note other_note expr)
   = coreToStgExpr expr
 
@@ -1075,6 +1084,8 @@ myCollectBinders expr
   where
     go bs (Lam b e)          = go (b:bs) e
     go bs e@(Note (SCC _) _) = (reverse bs, e) 
+    go bs e@(Note (TickBox {}) _) = (reverse bs, e)
+    go bs e@(Note (BinaryTickBox {}) _)  = (reverse bs, e)
     go bs (Cast e co)        = go bs e
     go bs (Note _ e)         = go bs e
     go bs e	             = (reverse bs, e)
@@ -1088,6 +1099,8 @@ myCollectArgs expr
     go (Var v)          as = (v, as)
     go (App f a) as        = go f (a:as)
     go (Note (SCC _) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
+    go (Note (TickBox {}) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
+    go (Note (BinaryTickBox {}) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
     go (Cast e co)      as = go e as
     go (Note n e)       as = go e as
     go _		as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)