Haskell Program Coverage

[ghc-hetmet.git] / compiler / coreSyn / CoreSyn.lhs

diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 65ad53c..3f74dc5 100644 (file)
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -1,7 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[CoreSyn]{A data type for the Haskell compiler midsection}
+
+CoreSyn: A data type for the Haskell compiler midsection
 
 \begin{code}
 module CoreSyn (
@@ -46,18 +48,19 @@ module CoreSyn (
 
 #include "HsVersions.h"
 
-import StaticFlags     ( opt_RuntimeTypes )
-import CostCentre      ( CostCentre, noCostCentre )
-import Var             ( Var, Id, TyVar, isTyVar, isId )
-import Type            ( Type, mkTyVarTy, seqType )
-import Coercion         ( Coercion )
-import Name            ( Name )
-import OccName         ( OccName )
-import Literal         ( Literal, mkMachInt )
-import DataCon         ( DataCon, dataConWorkId, dataConTag )
-import BasicTypes      ( Activation )
+import StaticFlags
+import CostCentre
+import Var
+import Type
+import Coercion
+import Name
+import OccName
+import Literal
+import DataCon
+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)
@@ -130,6 +133,11 @@ data Note
 
   | 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
@@ -201,7 +209,7 @@ data CoreRule
        ru_local :: Bool,       -- The fn at the head of the rule is
                                -- defined in the same module as the rule
 
-       -- Orphan-hood; see comments is InstEnv.Instance( is_orph )
+       -- Orphan-hood; see Note [Orphans] in InstEnv
        ru_orph  :: Maybe OccName }
 
   | BuiltinRule {              -- Built-in rules are used for constant folding
@@ -604,7 +612,6 @@ seqExpr (Lit lit)       = lit `seq` ()
 seqExpr (App f a)       = seqExpr f `seq` seqExpr a
 seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
--- gaw 2004
 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
 seqExpr (Cast e co)     = seqExpr e `seq` seqType co
 seqExpr (Note n e)      = seqNote n `seq` seqExpr e
@@ -614,6 +621,9 @@ seqExprs [] = ()
 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` ()
@@ -652,7 +662,6 @@ data AnnExpr' bndr annot
   | AnnLit     Literal
   | AnnLam     bndr (AnnExpr bndr annot)
   | AnnApp     (AnnExpr bndr annot) (AnnExpr bndr annot)
--- gaw 2004
   | AnnCase    (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
   | AnnLet     (AnnBind bndr annot) (AnnExpr bndr annot)
   | AnnCast     (AnnExpr bndr annot) Coercion
@@ -684,7 +693,6 @@ deAnnotate' (AnnLet bind body)
     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
 
--- gaw 2004
 deAnnotate' (AnnCase scrut v t alts)
   = Case (deAnnotate scrut) v t (map deAnnAlt alts)