Adding tick boxes to the interface syntax; fixes #1510

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 392873b..d852559 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -889,6 +889,10 @@ instance Binary IfaceExpr where
             putByte bh 11
             put_ bh ie
             put_ bh ico
+    put_ bh (IfaceTick m ix) = do
+            putByte bh 12
+            put_ bh m
+            put_ bh ix
     get bh = do
            h <- getByte bh
            case h of
@@ -928,6 +932,9 @@ instance Binary IfaceExpr where
               11 -> do ie <- get bh
                        ico <- get bh
                        return (IfaceCast ie ico)
+              12 -> do m <- get bh
+                       ix <- get bh
+                       return (IfaceTick m ix)
 
 instance Binary IfaceConAlt where
     put_ bh IfaceDefault = do

diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index acdddb6..d62aad1 100644 (file)
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -8,6 +8,7 @@ module IfaceEnv (
        newIfaceName, newIfaceNames,
        extendIfaceIdEnv, extendIfaceTyVarEnv, 
        tcIfaceLclId,     tcIfaceTyVar, 
+       tcIfaceTick,
 
        ifaceExportNames,
 
@@ -34,6 +35,7 @@ import UniqSupply
 import FiniteMap
 import BasicTypes
 import SrcLoc
+import MkId
 
 import Outputable
 \end{code}
@@ -300,3 +302,19 @@ newIfaceNames occs
        ; return [ mkInternalName uniq occ noSrcSpan
                 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
 \end{code}
+
+%************************************************************************
+%*                                                                     *
+               (Re)creating tick boxes
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcIfaceTick :: Module -> Int -> IfL Id
+tcIfaceTick modName tickNo 
+  = do { uniq <- newUnique
+       ; return $ mkTickBoxOpId uniq modName tickNo
+       }
+\end{code}
+
+

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 1e9e00f..f6a5cad 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -39,6 +39,7 @@ import ForeignCall
 import BasicTypes
 import Outputable
 import FastString
+import Module
 
 import Data.List
 import Data.Maybe
@@ -208,6 +209,7 @@ data IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion
   | IfaceLit   Literal
   | IfaceFCall ForeignCall IfaceType
+  | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
               | IfaceInlineMe
@@ -520,6 +522,7 @@ pprIfaceExpr add_par (IfaceLcl v)       = ppr v
 pprIfaceExpr add_par (IfaceExt v)       = ppr v
 pprIfaceExpr add_par (IfaceLit l)       = ppr l
 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
+pprIfaceExpr add_par (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 pprIfaceExpr add_par (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
@@ -815,6 +818,7 @@ eq_ifaceExpr env (IfaceLcl v1)            (IfaceLcl v2)        = eqIfOcc env v1 v2
 eq_ifaceExpr env (IfaceExt v1)       (IfaceExt v2)        = eqIfExt v1 v2
 eq_ifaceExpr env (IfaceLit l1)        (IfaceLit l2)       = bool (l1 == l2)
 eq_ifaceExpr env (IfaceFCall c1 ty1)  (IfaceFCall c2 ty2)  = bool (c1==c2) &&& eq_ifType env ty1 ty2
+eq_ifaceExpr env (IfaceTick m1 ix1)   (IfaceTick m2 ix2)   = bool (m1==m2) &&& bool (ix1 == ix2)
 eq_ifaceExpr env (IfaceType ty1)      (IfaceType ty2)     = eq_ifType env ty1 ty2
 eq_ifaceExpr env (IfaceTuple n1 as1)  (IfaceTuple n2 as2)  = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
 eq_ifaceExpr env (IfaceLam b1 body1)  (IfaceLam b2 body2)  = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 22fd309..8213cb1 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1359,6 +1359,8 @@ toIfaceVar v
   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
          -- Foreign calls have special syntax
   | isExternalName name                    = IfaceExt name
+  | Just (TickBox m ix) <- isTickBoxOp_maybe v
+                                   = IfaceTick m ix
   | otherwise                      = IfaceLcl (getFS name)
   where
     name = idName v

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 7e6406f..1b24684 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -711,6 +711,10 @@ tcIfaceExpr (IfaceLcl name)
   = tcIfaceLclId name  `thenM` \ id ->
     returnM (Var id)
 
+tcIfaceExpr (IfaceTick modName tickNo)
+  = tcIfaceTick modName tickNo `thenM` \ id ->
+    returnM (Var id)
+
 tcIfaceExpr (IfaceExt gbl)
   = tcIfaceExtId gbl   `thenM` \ id ->
     returnM (Var id)