-- IdInfo stuff
setIdUnfolding,
- setIdArityInfo,
+ setIdArity,
setIdDemandInfo, setIdNewDemandInfo,
setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
setIdTyGenInfo,
setIdCprInfo,
setIdOccInfo,
- idArity, idArityInfo,
+ idArity,
idDemandInfo, idNewDemandInfo,
- idStrictness, idNewStrictness, idNewStrictness_maybe, getNewStrictness,
+ idStrictness, idNewStrictness, idNewStrictness_maybe,
idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation,
idCgInfo,
idCafInfo,
- idCgArity,
idCprInfo,
idLBVarInfo,
idOccInfo,
import IdInfo
import qualified Demand ( Demand )
-import NewDemand ( Demand, DmdResult(..), StrictSig, topSig, isBotRes,
- isBottomingSig, splitStrictSig, strictSigResInfo
- )
+import NewDemand ( Demand, StrictSig, topSig, isBottomingSig )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
getOccName, getSrcLoc
import Unique ( Unique, mkBuiltinUnique )
infixl 1 `setIdUnfolding`,
- `setIdArityInfo`,
+ `setIdArity`,
`setIdDemandInfo`,
`setIdStrictness`,
`setIdNewDemandInfo`,
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
-mkSpecPragmaId :: OccName -> Unique -> Type -> SrcLoc -> Id
-mkSpecPragmaId occ uniq ty loc = Var.mkSpecPragmaId (mkLocalName uniq occ loc)
- (addFreeTyVars ty)
- vanillaIdInfo
+mkSpecPragmaId :: Name -> Type -> Id
+mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
DataConWrapId con -> True
other -> False
- -- hasNoBinding 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.
+-- hasNoBinding returns True of an Id which may not have a
+-- binding, even though it is defined in this module.
+-- Data constructor workers used to be things of this kind, but
+-- they aren't any more. Instead, we inject a binding for
+-- them at the CorePrep stage.
hasNoBinding id = case globalIdDetails id of
- DataConId _ -> True
PrimOpId _ -> True
FCallId _ -> True
other -> False
\begin{code}
---------------------------------
-- ARITY
-idArityInfo :: Id -> ArityInfo
-idArityInfo id = arityInfo (idInfo id)
-
idArity :: Id -> Arity
-idArity id = arityLowerBound (idArityInfo id)
+idArity id = arityInfo (idInfo id)
-setIdArityInfo :: Id -> Arity -> Id
-setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
+setIdArity :: Id -> Arity -> Id
+setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
---------------------------------
-- STRICTNESS
idStrictness :: Id -> StrictnessInfo
-idStrictness id = case strictnessInfo (idInfo id) of
- NoStrictnessInfo -> case idNewStrictness_maybe id of
- Just sig -> oldStrictnessFromNew sig
- Nothing -> NoStrictnessInfo
- strictness -> strictness
+idStrictness id = strictnessInfo (idInfo id)
setIdStrictness :: Id -> StrictnessInfo -> Id
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
-getNewStrictness :: Id -> StrictSig
--- First tries the "new-strictness" field, and then
--- reverts to the old one. This is just until we have
--- cross-module info for new strictness
-getNewStrictness id = idNewStrictness_maybe id `orElse` newStrictnessFromOld id
-
-newStrictnessFromOld :: Id -> StrictSig
-newStrictnessFromOld id = mkNewStrictnessInfo id (idArity id) (idStrictness id) (idCprInfo id)
-
-oldStrictnessFromNew :: StrictSig -> StrictnessInfo
-oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
- where
- (dmds, res_info) = splitStrictSig sig
-
setIdNewStrictness :: Id -> StrictSig -> Id
setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
#endif
---------------------------------
- -- CG ARITY
-idCgArity :: Id -> Arity
-#ifdef DEBUG
-idCgArity id = case cgInfo (idInfo id) of
- NoCgInfo -> pprPanic "idCgArity" (ppr id)
- info -> cgArity info
-#else
-idCgArity id = cgArity (idCgInfo id)
-#endif
-
- ---------------------------------
-- CPR INFO
idCprInfo :: Id -> CprInfo
-idCprInfo id = case cprInfo (idInfo id) of
- NoCPRInfo -> case strictSigResInfo (idNewStrictness id) of
- RetCPR -> ReturnsCPR
- other -> NoCPRInfo
- ReturnsCPR -> ReturnsCPR
+idCprInfo id = cprInfo (idInfo id)
setIdCprInfo :: Id -> CprInfo -> Id
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
+