-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdNoDiscard,
- setIdInfo, modifyIdInfo, maybeModifyIdInfo,
+ setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+ zapFragileIdInfo, zapLamIdInfo,
-- Predicates
omitIfaceSigForId,
+ exportWithOrigOccName,
externallyVisibleId,
idFreeTyVars,
-- Inline pragma stuff
getInlinePragma, setInlinePragma, modifyInlinePragma,
- idMustBeINLINEd, idMustNotBeINLINEd,
isSpecPragmaId, isRecordSelector,
isPrimitiveId_maybe, isDataConId_maybe,
isConstantId, isBottomingId, idAppIsBottom,
isExportedId, isUserExportedId,
+ mayHaveNoBinding,
-- One shot lambda stuff
- isOneShotLambda, setOneShotLambda,
+ isOneShotLambda, setOneShotLambda, clearOneShotLambda,
-- IdInfo stuff
setIdUnfolding,
setIdUpdateInfo,
setIdCafInfo,
setIdCprInfo,
+ setIdOccInfo,
getIdArity,
getIdDemandInfo,
getIdSpecialisation,
getIdUpdateInfo,
getIdCafInfo,
- getIdCprInfo
+ getIdCprInfo,
+ getIdOccInfo
) where
isId, mkIdVar,
idName, idType, idUnique, idInfo,
setIdName, setVarType, setIdUnique,
- setIdInfo, modifyIdInfo, maybeModifyIdInfo,
+ setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
externallyVisibleId
)
import VarSet
-import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
-import IdInfo
+import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
+
+import IdInfo
+
import Demand ( Demand, isStrict, wwLazy )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
isWiredInName, isUserExportedName
)
+import OccName ( UserFS )
import Const ( Con(..) )
import PrimRep ( PrimRep )
import PrimOp ( PrimOp )
-import TysPrim ( realWorldStatePrimTy )
+import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel(..) )
import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
-mkSysLocal :: FAST_STRING -> Unique -> Type -> Id
+mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
+mkSysLocal :: UserFS -> Unique -> Type -> Id
mkSysLocal fs uniq ty = mkVanillaId (mkSysLocalName uniq fs) ty
mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName uniq occ loc) ty
setIdType :: Id -> Type -> Id
-- Add free tyvar info to the type
-setIdType id ty = setVarType id (addFreeTyVars ty)
+setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
SpecPragmaId -> True
other -> False
+mayHaveNoBinding id = isConstantId id
+ -- mayHaveNoBinding returns True of an Id which may not have a
+ -- binding, even though it is defined in this module. Notably,
+ -- the constructors of a dictionary are in this situation.
+ --
+ -- mayHaveNoBinding returns True of some things that *do* have a local binding,
+ -- so it's only an approximation. That's ok... it's only use for assertions.
+
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.
isExportedId :: Id -> Bool
-- the instance decl
other -> False -- Don't omit!
+
+-- Certain names must be exported with their original occ names, because
+-- these names are bound by either a class declaration or a data declaration
+-- or an explicit user export.
+exportWithOrigOccName :: Id -> Bool
+exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
\end{code}
setIdCprInfo :: Id -> CprInfo -> Id
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
+
+ ---------------------------------
+ -- Occcurrence INFO
+getIdOccInfo :: Id -> OccInfo
+getIdOccInfo id = occInfo (idInfo id)
+
+setIdOccInfo :: Id -> OccInfo -> Id
+setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
\end{code}
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
-
-idMustNotBeINLINEd id = case getInlinePragma id of
- IMustNotBeINLINEd -> True
- IAmALoopBreaker -> True
- other -> False
-
-idMustBeINLINEd id = case getInlinePragma id of
- IMustBeINLINEd -> True
- other -> False
\end{code}
isOneShotLambda :: Id -> Bool
isOneShotLambda id = case lbvarInfo (idInfo id) of
IsOneShotLambda -> True
- NoLBVarInfo -> idType id == realWorldStatePrimTy
+ NoLBVarInfo -> case splitTyConApp_maybe (idType id) of
+ Just (tycon,_) -> tycon == statePrimTyCon
+ other -> False
-- The last clause is a gross hack. It claims that
-- every function over realWorldStatePrimTy is a one-shot
-- function. This is pretty true in practice, and makes a big
-- When `thenST` gets inlined, we end up with
-- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
-- and we don't re-inline E.
- --
+ --
-- It would be better to spot that r was one-shot to start with, but
-- I don't want to rely on that.
+ --
+ -- Another good example is in fill_in in PrelPack.lhs. We should be able to
+ -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
setOneShotLambda :: Id -> Id
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+
+clearOneShotLambda :: Id -> Id
+clearOneShotLambda id
+ | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
+ | otherwise = id
+
+-- But watch out: this may change the type of something else
+-- f = \x -> e
+-- If we change the one-shot-ness of x, f's type changes
\end{code}
+
+\begin{code}
+zapFragileIdInfo :: Id -> Id
+zapFragileIdInfo id = maybeModifyIdInfo zapFragileInfo id
+
+zapLamIdInfo :: Id -> Id
+zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
+\end{code}
+
projects / ghc-hetmet.git / blobdiff