Haskell. [WDP 94/11])
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module IdInfo (
GlobalIdDetails(..), notGlobalId, -- Not abstract
seqIdInfo, megaSeqIdInfo,
-- Zapping
- zapLamInfo, zapDemandInfo,
+ zapLamInfo, zapDemandInfo, zapFragileInfo,
-- Arity
ArityInfo,
-- Specialisation
SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
- specInfoFreeVars, specInfoRules, seqSpecInfo,
+ specInfoFreeVars, specInfoRules, seqSpecInfo, setSpecInfoHead,
-- CAF 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"
import CoreSyn
import Class
import PrimOp
+import Name
import Var
import VarSet
import BasicTypes
import ForeignCall
import NewDemand
import Outputable
+import Module
import Data.Maybe
#ifdef OLD_STRICTNESS
-import Name
import Demand
import qualified Demand
import Util
%************************************************************************
%* *
-\subsection{GlobalIdDetails
+\subsection{GlobalIdDetails}
%* *
%************************************************************************
= VanillaGlobal -- Imported from elsewhere, a default method Id.
| RecordSelId -- The Id for a record selector
- { sel_tycon :: TyCon
+ { sel_tycon :: TyCon -- For a data type family, this is the *instance* TyCon
+ -- not the family TyCon
, sel_label :: FieldLabel
, sel_naughty :: Bool -- True <=> naughty
} -- See Note [Naughty record selectors]
| 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
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}
%************************************************************************
\begin{code}
--- CoreRules is used only in an idSpecialisation (move to IdInfo?)
data SpecInfo
- = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs
+ = SpecInfo
+ [CoreRule]
+ VarSet -- Locally-defined free vars of *both* LHS and RHS
+ -- of rules. I don't think it needs to include the
+ -- ru_fn though.
+ -- Note [Rule dependency info] in OccurAnal
emptySpecInfo :: SpecInfo
emptySpecInfo = SpecInfo [] emptyVarSet
specInfoRules :: SpecInfo -> [CoreRule]
specInfoRules (SpecInfo rules _) = rules
+setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
+setSpecInfoHead fn (SpecInfo rules fvs)
+ = SpecInfo (map set_head rules) fvs
+ where
+ set_head rule = rule { ru_fn = fn }
+
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
\end{code}
+
%************************************************************************
%* *
\subsection[worker-IdInfo]{Worker info about an @Id@}
-- The "unsafe" occ info is the ones that say I'm not in a lambda
-- because that might not be true for an unsaturated lambda
is_safe_occ (OneOcc in_lam _ _) = in_lam
- is_safe_occ other = True
+ is_safe_occ _other = True
safe_occ = case occ of
OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
- other -> occ
+ _other -> occ
is_safe_dmd Nothing = True
is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
| otherwise = Nothing
\end{code}
+\begin{code}
+zapFragileInfo :: IdInfo -> Maybe IdInfo
+-- Zap info that depends on free variables
+zapFragileInfo info
+ = Just (info `setSpecInfo` emptySpecInfo
+ `setWorkerInfo` NoWorker
+ `setUnfoldingInfo` NoUnfolding
+ `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
+ where
+ occ = occInfo info
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{TickBoxOp}
+%* *
+%************************************************************************
+
+\begin{code}
+type TickBoxId = Int
+
+data TickBoxOp
+ = TickBox Module {-# UNPACK #-} !TickBoxId
+ -- ^Tick box for Hpc-style coverage
+
+instance Outputable TickBoxOp where
+ ppr (TickBox mod n) = ptext SLIT("tick") <+> ppr (mod,n)
+\end{code}