X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FId.lhs;h=549a58bb5d2773d7608e804cd61154566049cf04;hb=ab5b8aa357c685a7c702262903bce04c66f79156;hp=edaeb7a0ab45b7f0f3e43e3f2ce0143c1b148f98;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index edaeb7a..549a58b 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -22,7 +22,7 @@ module Id ( -- Modifying an Id setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, - zapLamIdInfo, zapDemandIdInfo, + zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, -- Predicates isImplicitId, isDeadBinder, isDictId, @@ -33,6 +33,7 @@ module Id ( isFCallId, isFCallId_maybe, isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon, isBottomingId, idIsFrom, + isTickBoxOp, isTickBoxOp_maybe, hasNoBinding, -- Inline pragma stuff @@ -313,6 +314,19 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) | 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} %************************************************************************ %* * @@ -513,9 +527,15 @@ clearOneShotLambda id \end{code} \begin{code} +zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id +zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id + zapLamIdInfo :: Id -> Id -zapLamIdInfo id = maybeModifyIdInfo (zapLamInfo (idInfo id)) id +zapLamIdInfo = zapInfo zapLamInfo + +zapDemandIdInfo = zapInfo zapDemandInfo -zapDemandIdInfo id = maybeModifyIdInfo (zapDemandInfo (idInfo id)) id +zapFragileIdInfo :: Id -> Id +zapFragileIdInfo = zapInfo zapFragileInfo \end{code}