Commit e04f4903 authored by andy@galois.com's avatar andy@galois.com
Browse files

Adding tick boxes to the interface syntax; fixes #1510

parent 6abf4f53
......@@ -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
......
......@@ -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}
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment