TickBox representation change

This changes the internal representation of TickBoxes,
from
        Note (TickBox "module" n)  <expr>
into

        case tick<module,n> of
          _ -> <expr>

tick has type :: #State #World, when the module and tick numbe
are stored inside IdInfo.

Binary tick boxes change from

         Note (BinaryTickBox "module" t f) <expr>

into

          btick<module,t,f> <expr>

btick has type :: Bool -> Bool, with the module and tick number
stored inside IdInfo.

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index cc9587e..549a58b 100644 (file)
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -33,6 +33,7 @@ module Id (
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
        isBottomingId, idIsFrom,
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
        isBottomingId, idIsFrom,

+        isTickBoxOp, isTickBoxOp_maybe,

        hasNoBinding, 
 
        -- Inline pragma stuff
        hasNoBinding, 
 
        -- Inline pragma stuff

@@ -313,6 +314,19 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
                  | otherwise = False   -- TyVars count as not dead
 \end{code}
 
                  | otherwise = False   -- TyVars count as not dead
 \end{code}
 

+\begin{code}
+isTickBoxOp :: Id -> Bool
+isTickBoxOp id = 
+  case globalIdDetails id of
+    TickBoxOpId tick -> True
+    _                -> False
+
+isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
+isTickBoxOp_maybe id = 
+  case globalIdDetails id of
+    TickBoxOpId tick -> Just tick
+    _                -> Nothing
+\end{code}

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index 38e2a2e..9b39ccb 100644 (file)
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -71,7 +71,10 @@ module IdInfo (
        CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
 
         -- Lambda-bound variable info
        CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
 
         -- Lambda-bound variable info

-        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
+        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo,
+
+        -- Tick-box info
+        TickBoxOp(..), TickBoxId,

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -87,6 +90,7 @@ import TyCon
 import ForeignCall
 import NewDemand
 import Outputable      
 import ForeignCall
 import NewDemand
 import Outputable      

+import Module

 
 import Data.Maybe
 
 
 import Data.Maybe
 

@@ -215,7 +219,7 @@ seqNewDemandInfo (Just dmd) = seqDemand dmd
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

-\subsection{GlobalIdDetails
+\subsection{GlobalIdDetails}

 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

@@ -246,6 +250,8 @@ data GlobalIdDetails
   | PrimOpId PrimOp            -- The Id for a primitive operator
   | FCallId ForeignCall                -- The Id for a foreign call
 
   | PrimOpId PrimOp            -- The Id for a primitive operator
   | FCallId ForeignCall                -- The Id for a foreign call
 

+  | TickBoxOpId TickBoxOp      -- The Id for a tick box (both traditional and binary)
+

   | NotGlobalId                        -- Used as a convenient extra return value from globalIdDetails
     
 notGlobalId = NotGlobalId
   | NotGlobalId                        -- Used as a convenient extra return value from globalIdDetails
     
 notGlobalId = NotGlobalId

@@ -258,6 +264,7 @@ instance Outputable GlobalIdDetails where
     ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
     ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")

+    ppr (TickBoxOpId _)   = ptext SLIT("[TickBoxOp]")

     ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
 \end{code}
 
     ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
 \end{code}
 

@@ -698,3 +705,23 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo
 zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo
                                  `setUnfoldingInfo` NoUnfolding)
 \end{code}
 zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo
                                  `setUnfoldingInfo` NoUnfolding)
 \end{code}

+
+%************************************************************************
+%*                                                                     *
+\subsection{TickBoxOp}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type TickBoxId = Int
+
+data TickBoxOp 
+   = TickBox Module !TickBoxId  -- ^Tick box for Hpc-style coverage,
+                               -- type = State# Void#
+   | BinaryTickBox Module !TickBoxId !TickBoxId
+                         -- ^Binary tick box, with a tick for result = True, result = False,
+                         -- type = Bool -> Bool
+instance Outputable TickBoxOp where
+    ppr (TickBox mod n)         = ptext SLIT("tick") <+> ppr (mod,n)
+    ppr (BinaryTickBox mod t f) = ptext SLIT("btick") <+> ppr (mod,t,f)
+\end{code}

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index e3b40b8..8e04b55 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -18,7 +18,7 @@ module MkId (
 
        mkDataConIds,
        mkRecordSelId, 
 
        mkDataConIds,
        mkRecordSelId, 

-       mkPrimOpId, mkFCallId,
+       mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBinaryTickBoxOpId,

 
        mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         mkUnpackCase, mkProductBox,
 
        mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         mkUnpackCase, mkProductBox,

@@ -72,6 +72,7 @@ import Util
 import Outputable
 import FastString
 import ListSetOps
 import Outputable
 import FastString
 import ListSetOps

+import Module

 \end{code}             
 
 %************************************************************************
 \end{code}             
 
 %************************************************************************

@@ -903,6 +904,38 @@ mkFCallId uniq fcall ty
     (arg_tys, _) = tcSplitFunTys tau
     arity       = length arg_tys
     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
     (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 
+
+mkBinaryTickBoxOpId 
+              :: Unique 
+             -> Module
+             -> TickBoxId
+             -> TickBoxId
+             -> Id
+mkBinaryTickBoxOpId uniq mod ixT ixF =  mkGlobalId (TickBoxOpId tickbox) name ty info    
+  where
+    tickbox  = BinaryTickBox mod ixT ixF
+    occ_str = showSDoc (braces (ppr tickbox))
+    name    = mkTickBoxOpName uniq occ_str
+    info    = noCafIdInfo
+               `setArityInfo`          arity
+               `setAllStrictnessInfo`  Just strict_sig
+    ty      = mkFunTy boolTy boolTy
+
+    arity       = 1
+    strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
+                  --- ?? mkStrictSig (mkTopDmdType [seqDmd] TopRes)

 \end{code}
 
 
 \end{code}
 
 

diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index feda0b1..75198bb 100644 (file)
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -15,6 +15,7 @@ module Name (
        mkInternalName, mkSystemName,
        mkSystemVarName, mkSysTvName, 
        mkFCallName, mkIPName,
        mkInternalName, mkSystemName,
        mkSystemVarName, mkSysTvName, 
        mkFCallName, mkIPName,

+        mkTickBoxOpName,

        mkExternalName, mkWiredInName,
 
        nameUnique, setNameUnique,
        mkExternalName, mkWiredInName,
 
        nameUnique, setNameUnique,

@@ -220,6 +221,11 @@ mkFCallName :: Unique -> String -> Name
 mkFCallName uniq str =  Name { n_uniq = getKey# uniq, n_sort = Internal, 
                               n_occ = mkVarOcc str, n_loc = noSrcLoc }
 
 mkFCallName uniq str =  Name { n_uniq = getKey# uniq, n_sort = Internal, 
                               n_occ = mkVarOcc str, n_loc = noSrcLoc }
 

+mkTickBoxOpName :: Unique -> String -> Name
+mkTickBoxOpName uniq str 
+   = Name { n_uniq = getKey# uniq, n_sort = Internal, 
+           n_occ = mkVarOcc str, n_loc = noSrcLoc }
+

 mkIPName :: Unique -> OccName -> Name
 mkIPName uniq occ
   = Name { n_uniq = getKey# uniq,
 mkIPName :: Unique -> OccName -> Name
 mkIPName uniq occ
   = Name { n_uniq = getKey# uniq,

diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index fb31e45..88fa8b7 100644 (file)
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -23,6 +23,7 @@ import Var
 import VarSet
 import VarEnv
 import Id
 import VarSet
 import VarEnv
 import Id

+import IdInfo

 import DataCon
 import PrimOp
 import BasicTypes
 import DataCon
 import PrimOp
 import BasicTypes

@@ -34,6 +35,8 @@ import DynFlags
 import Util
 import Outputable
 import TysWiredIn
 import Util
 import Outputable
 import TysWiredIn

+import MkId
+import TysPrim

 \end{code}
 
 -- ---------------------------------------------------------------------------
 \end{code}
 
 -- ---------------------------------------------------------------------------

@@ -334,8 +337,6 @@ exprIsTrivial (Type _)                     = True
 exprIsTrivial (Lit lit)               = True
 exprIsTrivial (App e arg)             = isTypeArg arg && exprIsTrivial e
 exprIsTrivial (Note (SCC _) e)                = False
 exprIsTrivial (Lit lit)               = True
 exprIsTrivial (App e arg)             = isTypeArg arg && exprIsTrivial e
 exprIsTrivial (Note (SCC _) e)                = False

-exprIsTrivial (Note (TickBox {}) e)    = False
-exprIsTrivial (Note (BinaryTickBox {}) e) = False

 exprIsTrivial (Note _ e)              = exprIsTrivial e
 exprIsTrivial (Cast e co)              = exprIsTrivial e
 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
 exprIsTrivial (Note _ e)              = exprIsTrivial e
 exprIsTrivial (Cast e co)              = exprIsTrivial e
 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body

@@ -383,21 +384,34 @@ corePrepExprFloat env (Note n@(SCC _) expr)
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->
     returnUs (floats, Note n expr2)
 
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->
     returnUs (floats, Note n expr2)
 

-corePrepExprFloat env (Note note@(TickBox {}) expr)
+corePrepExprFloat env (Case (Var id) bndr ty [(DEFAULT,[],expr)])
+  | Just (TickBox {}) <- isTickBoxOp_maybe id

   = corePrepAnExpr env expr            `thenUs` \ expr1 ->
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->
   = corePrepAnExpr env expr            `thenUs` \ expr1 ->
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->

-    return (floats, Note note expr2)
+    return (floats, Case (Var id) bndr ty [(DEFAULT,[],expr2)])

 
 

-corePrepExprFloat env (Note note@(BinaryTickBox m t e) expr)
+-- Translate Binary tickBox into standard tickBox
+corePrepExprFloat env (App (Var id) expr)
+  | Just (BinaryTickBox m t e) <- isTickBoxOp_maybe id

   = corePrepAnExpr env expr            `thenUs` \ expr1 ->
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->
   = corePrepAnExpr env expr            `thenUs` \ expr1 ->
     deLamFloat expr1                   `thenUs` \ (floats, expr2) ->

-    getUniqueUs                        `thenUs` \ u ->
-    let bndr = mkSysLocal FSLIT("t") u boolTy in
+    getUniqueUs                        `thenUs` \ u1 ->
+    getUniqueUs                        `thenUs` \ u2 ->
+    getUniqueUs                        `thenUs` \ u3 ->
+    getUniqueUs                        `thenUs` \ u4 ->
+    getUniqueUs                        `thenUs` \ u5 ->
+    let bndr1 = mkSysLocal FSLIT("t1") u1 boolTy in
+    let bndr2 = mkSysLocal FSLIT("t2") u2 realWorldStatePrimTy in
+    let bndr3 = mkSysLocal FSLIT("t3") u3 realWorldStatePrimTy in
+    let tick_e  = mkTickBoxOpId u4 m e in
+    let tick_t  = mkTickBoxOpId u5 m t in

     return (floats, Case expr2
     return (floats, Case expr2

-                       bndr
+                       bndr1

                        boolTy
                        boolTy

-                       [ (DataAlt falseDataCon, [], Note (TickBox m e) (Var falseDataConId))
-                       , (DataAlt trueDataCon,  [], Note (TickBox m t) (Var trueDataConId))
+                       [ (DataAlt falseDataCon, [], 
+                         Case (Var tick_e) bndr2 boolTy [(DEFAULT,[],Var falseDataConId)])
+                       , (DataAlt trueDataCon,  [], 
+                         Case (Var tick_t) bndr3 boolTy [(DEFAULT,[],Var trueDataConId)])

                        ])
 
 corePrepExprFloat env (Note other_note expr)
                        ])
 
 corePrepExprFloat env (Note other_note expr)

@@ -415,17 +429,34 @@ corePrepExprFloat env expr@(Lam _ _)
   where
     (bndrs,body) = collectBinders expr
 
   where
     (bndrs,body) = collectBinders expr
 

-corePrepExprFloat env (Case (Note note@(TickBox m n) expr) bndr ty alts)
-  = corePrepExprFloat env (Note note (Case expr bndr ty alts))
-
-corePrepExprFloat env (Case (Note note@(BinaryTickBox m t e) expr) bndr ty alts)
-  = do { ASSERT(exprType expr `coreEqType` boolTy)
-         corePrepExprFloat env $
-               Case expr bndr ty
-                       [ (DataAlt falseDataCon, [], Note (TickBox m e) falseBranch)
-                       , (DataAlt trueDataCon,  [], Note (TickBox m t) trueBranch)
+-- This is an (important) optimization.
+-- case <btick,A,B>  e of { T -> e1 ; F -> e2 }
+--  ==> case e of { T -> <tick,A> e1 ; F -> <tick,B> e2 }
+-- This could move into the simplifier.
+
+corePrepExprFloat env (Case (App (Var id) expr) bndr ty alts)
+  | Just (BinaryTickBox m t e) <- isTickBoxOp_maybe id
+  = getUniqueUs                        `thenUs` \ u1 ->
+    getUniqueUs                        `thenUs` \ u2 ->
+    getUniqueUs                        `thenUs` \ u3 ->
+    getUniqueUs                        `thenUs` \ u4 ->
+    getUniqueUs                        `thenUs` \ u5 ->
+    let bndr1 = mkSysLocal FSLIT("t1") u1 boolTy in
+    let bndr2 = mkSysLocal FSLIT("t2") u2 realWorldStatePrimTy in
+    let bndr3 = mkSysLocal FSLIT("t3") u3 realWorldStatePrimTy in
+    let tick_e  = mkTickBoxOpId u4 m e in
+    let tick_t  = mkTickBoxOpId u5 m t in
+    ASSERT (exprType expr `coreEqType` boolTy)
+    corePrepExprFloat env $
+               Case expr
+                       bndr1
+                       ty
+                       [ (DataAlt falseDataCon, [], 
+                         Case (Var tick_e) bndr2 ty [(DEFAULT,[],falseBranch)])
+                       , (DataAlt trueDataCon,  [], 
+                         Case (Var tick_t) bndr3 ty [(DEFAULT,[],trueBranch)])

                        ]
                        ]

-       }
+

    where
        (_,_,trueBranch)  = findAlt (DataAlt trueDataCon) alts
        (_,_,falseBranch) = findAlt (DataAlt falseDataCon) alts
    where
        (_,_,trueBranch)  = findAlt (DataAlt trueDataCon) alts
        (_,_,falseBranch) = findAlt (DataAlt falseDataCon) alts

diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 67245d1..e580bed 100644 (file)
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -60,7 +60,6 @@ import DataCon
 import BasicTypes
 import FastString
 import Outputable
 import BasicTypes
 import FastString
 import Outputable

-import Module

 
 infixl 4 `mkApps`, `mkValApps`, `mkTyApps`, `mkVarApps`
 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
 
 infixl 4 `mkApps`, `mkValApps`, `mkTyApps`, `mkVarApps`
 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)

@@ -133,11 +132,6 @@ data Note
 
   | CoreNote String     -- A generic core annotation, propagated but not used by GHC
 
 
   | CoreNote String     -- A generic core annotation, propagated but not used by GHC
 

-  | TickBox Module !Int -- ^Tick box for Hpc-style coverage
-  | BinaryTickBox Module !Int !Int
-                       -- ^Binary tick box, with a tick for result = True, result = False
-
-

 -- NOTE: we also treat expressions wrapped in InlineMe as
 -- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
 -- What this means is that we obediently inline even things that don't
 -- NOTE: we also treat expressions wrapped in InlineMe as
 -- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
 -- What this means is that we obediently inline even things that don't

@@ -626,9 +620,6 @@ seqExprs [] = ()
 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 
 seqNote (CoreNote s)   = s `seq` ()
 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 
 seqNote (CoreNote s)   = s `seq` ()

-seqNote (TickBox m n)  = m `seq` ()  -- no need for seq on n, because n is strict
-seqNote (BinaryTickBox m t f)   
-                      = m `seq` ()  -- likewise on t and f.

 seqNote other         = ()
 
 seqBndr b = b `seq` ()
 seqNote other         = ()
 
 seqBndr b = b `seq` ()

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 78da0e3..b847df0 100644 (file)
--- 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
 exprOkForSpeculation :: CoreExpr -> Bool
 exprOkForSpeculation (Lit _)     = True
 exprOkForSpeculation (Type _)    = True

+    -- Tick boxes are *not* suitable for speculation

 exprOkForSpeculation (Var v)     = isUnLiftedType (idType v)
 exprOkForSpeculation (Var v)     = isUnLiftedType (idType v)

+                                && not (isTickBoxOp v)

 exprOkForSpeculation (Note _ e)  = exprOkForSpeculation e
 exprOkForSpeculation (Cast e co) = exprOkForSpeculation e
 exprOkForSpeculation other_expr
 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 (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
 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)
     }}
 
     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.
 -- 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
   = Nothing
 exprIsConApp_maybe (Note (BinaryTickBox {}) expr)
   = Nothing

+-}

 
 exprIsConApp_maybe (Note _ expr)
   = exprIsConApp_maybe expr
 
 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 (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
              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 (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`
 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 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
   
   is_static in_arg (Note _ e)       = is_static in_arg e
   is_static in_arg (Cast e co)      = is_static in_arg e
   

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index ab3257e..13c8fb7 100644 (file)
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -213,21 +213,6 @@ ppr_expr add_par (Note (SCC cc) expr)
 ppr_expr add_par (Note InlineMe expr)
   = add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr
 
 ppr_expr add_par (Note InlineMe expr)
   = add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr
 

-ppr_expr add_par (Note (TickBox mod n) expr)
-  = add_par $
-    sep [sep [ptext SLIT("__tick_box"),
-               pprModule mod,
-              text (show n)],
-         pprParendExpr expr]
-
-ppr_expr add_par (Note (BinaryTickBox mod t e) expr)
-  = add_par $
-    sep [sep [ptext SLIT("__binary_tick_box"),
-               pprModule mod,
-              text (show t),
-              text (show e)],
-         pprParendExpr expr]
-

 ppr_expr add_par (Note (CoreNote s) expr)
   = add_par $ 
     sep [sep [ptext SLIT("__core_note"), pprHsString (mkFastString s)],
 ppr_expr add_par (Note (CoreNote s) expr)
   = add_par $ 
     sep [sep [ptext SLIT("__core_note"), pprHsString (mkFastString s)],

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 68bd17f..af9f002 100644 (file)
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -58,11 +58,23 @@ import System.Directory ( createDirectoryIfMissing )
 
 \begin{code}
 addCoverageTicksToBinds dflags mod mod_loc binds = do 
 
 \begin{code}
 addCoverageTicksToBinds dflags mod mod_loc binds = do 

+  { let orig_file = 
+             case ml_hs_file mod_loc of
+                   Just file -> file
+                   Nothing -> error "can not find the original file during hpc trans"
+
+  ; if "boot" `isSuffixOf` orig_file then return (binds, 0)  
+    else addCoverageTicksToBinds2 dflags mod orig_file binds 
+  }
+
+addCoverageTicksToBinds2 dflags mod orig_file binds = do 

   let main_mod = mainModIs dflags
       main_is  = case mainFunIs dflags of
                  Nothing -> "main"
                  Just main -> main 
 
   let main_mod = mainModIs dflags
       main_is  = case mainFunIs dflags of
                  Nothing -> "main"
                  Just main -> main 
 

+  modTime <- getModificationTime' orig_file
+

   let mod_name = moduleNameString (moduleName mod)
 
   let (binds1,st)
   let mod_name = moduleNameString (moduleName mod)
 
   let (binds1,st)

@@ -78,12 +90,6 @@ addCoverageTicksToBinds dflags mod mod_loc binds = do
   -- write the mix entries for this module
   let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
 
   -- write the mix entries for this module
   let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
 

-  let orig_file = case ml_hs_file mod_loc of
-                   Just file -> file
-                   Nothing -> error "can not find the original file during hpc trans"
-
-  modTime <- getModificationTime' orig_file
-

   createDirectoryIfMissing True hpc_dir
 
   mixCreate hpc_dir mod_name (Mix orig_file modTime tabStop $ reverse $ mixEntries st)
   createDirectoryIfMissing True hpc_dir
 
   mixCreate hpc_dir mod_name (Mix orig_file modTime tabStop $ reverse $ mixEntries st)

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 868a894..6bc70e2 100644 (file)
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -70,6 +70,7 @@ import Util
 import ListSetOps
 import FastString
 import Data.Char
 import ListSetOps
 import FastString
 import Data.Char

+import DynFlags

 
 #ifdef DEBUG
 import Util
 
 #ifdef DEBUG
 import Util

@@ -888,11 +889,27 @@ mkOptTickBox (Just ix) e = mkTickBox ix e
 
 mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
 mkTickBox ix e = do
 
 mkTickBox :: Int -> CoreExpr -> DsM CoreExpr
 mkTickBox ix e = do

+       dflags <- getDOptsDs
+       uq <- newUnique         

        mod <- getModuleDs
        mod <- getModuleDs

-       return $ Note (TickBox mod ix) e
+       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
 
 mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
 mkBinaryTickBox ixT ixF e = do
        mod <- getModuleDs

-       return $ Note (BinaryTickBox mod ixT ixF) e
+       dflags <- getDOptsDs
+       uq <- newUnique         
+       mod <- getModuleDs
+       let tick = mkBinaryTickBoxOpId uq mod ixT ixF
+       return $ App (Var tick) e

 \end{code}
\ No newline at end of file
 \end{code}
\ No newline at end of file

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 72ea80d..782bada 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1002,15 +1002,6 @@ instance Binary IfaceNote where
     put_ bh (IfaceCoreNote s) = do
             putByte bh 4
             put_ bh s
     put_ bh (IfaceCoreNote s) = do
             putByte bh 4
             put_ bh s

-    put_ bh (IfaceTickBox m n) = do
-            putByte bh 5
-            put_ bh m
-            put_ bh n
-    put_ bh (IfaceBinaryTickBox m t e) = do
-            putByte bh 6
-            put_ bh m
-            put_ bh t
-            put_ bh e

     get bh = do
            h <- getByte bh
            case h of
     get bh = do
            h <- getByte bh
            case h of

@@ -1019,13 +1010,6 @@ instance Binary IfaceNote where
              3 -> do return IfaceInlineMe
               4 -> do ac <- get bh
                       return (IfaceCoreNote ac)
              3 -> do return IfaceInlineMe
               4 -> do ac <- get bh
                       return (IfaceCoreNote ac)

-              5 -> do m <- get bh
-                      n <- get bh
-                      return (IfaceTickBox m n)
-              6 -> do m <- get bh
-                      t <- get bh
-                      e <- get bh
-                      return (IfaceBinaryTickBox m t e)

 
 -------------------------------------------------------------------------
 --             IfaceDecl and friends
 
 -------------------------------------------------------------------------
 --             IfaceDecl and friends

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 55cd6d1..bcff5f0 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -210,8 +210,6 @@ data IfaceExpr
 data IfaceNote = IfaceSCC CostCentre
               | IfaceInlineMe
                | IfaceCoreNote String
 data IfaceNote = IfaceSCC CostCentre
               | IfaceInlineMe
                | IfaceCoreNote String

-               | IfaceTickBox Module Int
-               | IfaceBinaryTickBox Module Int Int

 
 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
        -- Note: FastString, not IfaceBndr (and same with the case binder)
 
 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
        -- Note: FastString, not IfaceBndr (and same with the case binder)

@@ -485,12 +483,6 @@ instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
     ppr IfaceInlineMe     = ptext SLIT("__inline_me")
     ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
     ppr IfaceInlineMe     = ptext SLIT("__inline_me")
     ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)

-    ppr (IfaceTickBox m n)  = ptext SLIT("__tick_box") <+> pprModule m <+>  text (show n)
-    ppr (IfaceBinaryTickBox m t e)
-                         = ptext SLIT("__binary_tick_box")
-                               <+> pprModule m
-                               <+> text (show t)
-                               <+> text (show e)

 
 
 instance Outputable IfaceConAlt where
 
 
 instance Outputable IfaceConAlt where

@@ -759,8 +751,6 @@ eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
 eq_ifaceNote env (IfaceSCC c1)    (IfaceSCC c2)        = bool (c1==c2)
 eq_ifaceNote env IfaceInlineMe    IfaceInlineMe        = Equal
 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
 eq_ifaceNote env (IfaceSCC c1)    (IfaceSCC c2)        = bool (c1==c2)
 eq_ifaceNote env IfaceInlineMe    IfaceInlineMe        = Equal
 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)

-eq_ifaceNote env (IfaceTickBox m1 n1) (IfaceTickBox m2 n2)   = bool (m1==m2 && n1==n2)
-eq_ifaceNote env (IfaceBinaryTickBox m1 t1 e1) (IfaceBinaryTickBox m2 t2 e2) = bool (m1==m2 && t1==t2 && e1 == e2)

 eq_ifaceNote env _ _ = NotEqual
 \end{code}
 
 eq_ifaceNote env _ _ = NotEqual
 \end{code}
 

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index f7cb28a..7518111 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1240,9 +1240,6 @@ toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
 toIfaceNote (SCC cc)      = IfaceSCC cc
 toIfaceNote InlineMe      = IfaceInlineMe
 toIfaceNote (CoreNote s)  = IfaceCoreNote s
 toIfaceNote (SCC cc)      = IfaceSCC cc
 toIfaceNote InlineMe      = IfaceInlineMe
 toIfaceNote (CoreNote s)  = IfaceCoreNote s

-toIfaceNote (TickBox m n) = IfaceTickBox m n
-toIfaceNote (BinaryTickBox m t e)
-                          = IfaceBinaryTickBox m t e

 
 ---------------------
 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceIdBndr b) (toIfaceExpr r)
 
 ---------------------
 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceIdBndr b) (toIfaceExpr r)

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 6c60af8..4232195 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -686,8 +686,6 @@ tcIfaceExpr (IfaceNote note expr)
        IfaceInlineMe     -> returnM (Note InlineMe   expr')
        IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
        IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')
        IfaceInlineMe     -> returnM (Note InlineMe   expr')
        IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
        IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')

-        IfaceTickBox m n  -> returnM (Note (TickBox m n) expr')
-        IfaceBinaryTickBox m t e -> returnM (Note (BinaryTickBox m t e) expr')

 
 -------------------------
 tcIfaceAlt _ (IfaceDefault, names, rhs)
 
 -------------------------
 tcIfaceAlt _ (IfaceDefault, names, rhs)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fc3f434..2ba6172 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -200,7 +200,7 @@ data DynFlag
    | Opt_PrintBindResult
    | Opt_Haddock
    | Opt_Hpc
    | Opt_PrintBindResult
    | Opt_Haddock
    | Opt_Hpc

-   | Opt_Hpc_Trace
+   | Opt_Hpc_Tracer

 
    -- keeping stuff
    | Opt_KeepHiDiffs
 
    -- keeping stuff
    | Opt_KeepHiDiffs

@@ -1053,7 +1053,7 @@ fFlags = [
   ( "print-bind-result",               Opt_PrintBindResult ),
   ( "force-recomp",                    Opt_ForceRecomp ),
   ( "hpc",                             Opt_Hpc ),
   ( "print-bind-result",               Opt_PrintBindResult ),
   ( "force-recomp",                    Opt_ForceRecomp ),
   ( "hpc",                             Opt_Hpc ),

-  ( "hpc-tracer",                      Opt_Hpc )
+  ( "hpc-tracer",                      Opt_Hpc_Tracer )

   ]
 
 
   ]
 
 

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 331d921..a8dede8 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -21,7 +21,8 @@ import VarSet
 import Var             ( Id, Var )
 import Id              ( idType, idInfo, idName, idCoreRules, isGlobalId,
                          isExportedId, mkVanillaGlobal, isLocalId, isNaughtyRecordSelector,
 import Var             ( Id, Var )
 import Id              ( idType, idInfo, idName, idCoreRules, isGlobalId,
                          isExportedId, mkVanillaGlobal, isLocalId, isNaughtyRecordSelector,

-                         idArity, idCafInfo, idUnfolding, isImplicitId, setIdInfo
+                         idArity, idCafInfo, idUnfolding, isImplicitId, setIdInfo,
+                         isTickBoxOp

                        ) 
 import IdInfo          {- loads of stuff -}
 import InstEnv         ( Instance, DFunId, instanceDFunId, setInstanceDFunId )
                        ) 
 import IdInfo          {- loads of stuff -}
 import InstEnv         ( Instance, DFunId, instanceDFunId, setInstanceDFunId )

@@ -791,17 +792,13 @@ CAF list to keep track of non-collectable CAFs.
 \begin{code}
 hasCafRefs  :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
 hasCafRefs this_pkg p arity expr 
 \begin{code}
 hasCafRefs  :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
 hasCafRefs this_pkg p arity expr 

-  | is_caf || mentions_cafs || is_tick
+  | is_caf || mentions_cafs 

                             = MayHaveCafRefs
   | otherwise              = NoCafRefs
  where
   mentions_cafs = isFastTrue (cafRefs p expr)
   is_caf = not (arity > 0 || rhsIsStatic this_pkg expr)
                             = MayHaveCafRefs
   | otherwise              = NoCafRefs
  where
   mentions_cafs = isFastTrue (cafRefs p expr)
   is_caf = not (arity > 0 || rhsIsStatic this_pkg expr)

-  is_tick = case expr of
-             Note (TickBox {}) _       -> True
-             Note (BinaryTickBox {}) _ -> True
-             _                         -> False
-        
+

   -- NB. we pass in the arity of the expression, which is expected
   -- to be calculated by exprArity.  This is because exprArity
   -- knows how much eta expansion is going to be done by 
   -- NB. we pass in the arity of the expression, which is expected
   -- to be calculated by exprArity.  This is because exprArity
   -- knows how much eta expansion is going to be done by 

diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index b80a8e0..e32a8ea 100644 (file)
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -214,13 +214,6 @@ fiExpr to_drop (_, AnnNote InlineMe expr)
   =    -- Ditto... don't float anything into an INLINE expression
     mkCoLets' to_drop (Note InlineMe (fiExpr [] expr))
 
   =    -- Ditto... don't float anything into an INLINE expression
     mkCoLets' to_drop (Note InlineMe (fiExpr [] expr))
 

-fiExpr to_drop (_, AnnNote note@(TickBox {}) expr)
-  =    -- Wimp out for now
-    mkCoLets' to_drop (Note note (fiExpr [] expr))
-fiExpr to_drop (_, AnnNote note@(BinaryTickBox {}) expr)
-  =    -- Wimp out for now
-    mkCoLets' to_drop (Note note (fiExpr [] expr))
-

 fiExpr to_drop (_, AnnNote note@(CoreNote _) expr)
   = Note note (fiExpr to_drop expr)
 \end{code}
 fiExpr to_drop (_, AnnNote note@(CoreNote _) expr)
   = Note note (fiExpr to_drop expr)
 \end{code}

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 28193eb..62f226c 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -875,16 +875,8 @@ simplNote env InlineMe e cont
   = simplExprF env e cont
 
 simplNote env (CoreNote s) e cont
   = simplExprF env e cont
 
 simplNote env (CoreNote s) e cont

-  = do { e' <- simplExpr env e
-       ; rebuild env (Note (CoreNote s) e') cont }
-
-simplNote env note@(TickBox {}) e cont
-  = do { e' <- simplExpr env e
-       ; rebuild env (Note note e') cont }
-
-simplNote env note@(BinaryTickBox {}) e cont
-  = do { e' <- simplExpr env e
-       ; rebuild env (Note note e') cont }
+  = simplExpr env e    `thenSmpl` \ e' ->
+    rebuild env (Note (CoreNote s) e') cont

 \end{code}
 
 
 \end{code}
 
 

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 64f9fe3..994b900 100644 (file)
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -317,15 +317,11 @@ coreToStgExpr (Note (SCC cc) expr)
   = coreToStgExpr expr         `thenLne` ( \ (expr2, fvs, escs) ->
     returnLne (StgSCC cc expr2, fvs, escs) )
 
   = coreToStgExpr expr         `thenLne` ( \ (expr2, fvs, escs) ->
     returnLne (StgSCC cc expr2, fvs, escs) )
 

-coreToStgExpr (Note (TickBox m n) expr)
+coreToStgExpr (Case (Var id) _bndr ty [(DEFAULT,[],expr)])
+  | Just (TickBox m n) <- isTickBoxOp_maybe id

   = coreToStgExpr expr         `thenLne` ( \ (expr2, fvs, escs) ->
     returnLne (StgTick m n expr2, fvs, escs) )
 
   = 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
 
 coreToStgExpr (Note other_note expr)
   = coreToStgExpr expr
 

@@ -451,6 +447,7 @@ coreToStgApp
        -> [CoreArg]                    -- Arguments
        -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
 
        -> [CoreArg]                    -- Arguments
        -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
 

+

 coreToStgApp maybe_thunk_body f args
   = coreToStgArgs args         `thenLne` \ (args', args_fvs) ->
     lookupVarLne f             `thenLne` \ how_bound ->
 coreToStgApp maybe_thunk_body f args
   = coreToStgArgs args         `thenLne` \ (args', args_fvs) ->
     lookupVarLne f             `thenLne` \ how_bound ->

@@ -508,6 +505,7 @@ coreToStgApp maybe_thunk_body f args
                                    StgOpApp (StgPrimOp op) args' res_ty
                FCallId call     -> ASSERT( saturated )
                                    StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
                                    StgOpApp (StgPrimOp op) args' res_ty
                FCallId call     -> ASSERT( saturated )
                                    StgOpApp (StgFCallOp call (idUnique f)) args' res_ty

+                TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,args')

                _other           -> StgApp f args'
 
     in
                _other           -> StgApp f args'
 
     in

@@ -1098,8 +1096,6 @@ myCollectBinders expr
   where
     go bs (Lam b e)          = go (b:bs) e
     go bs e@(Note (SCC _) _) = (reverse bs, e) 
   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)
     go bs (Cast e co)        = go bs e
     go bs (Note _ e)         = go bs e
     go bs e                 = (reverse bs, e)

@@ -1113,8 +1109,6 @@ 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 (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)
     go (Cast e co)      as = go e as
     go (Note n e)       as = go e as
     go _               as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)