Id, DictId,
-- Simple construction
- mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
- mkSysLocal, mkUserLocal, mkVanillaGlobal,
+ mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
+ mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
- mkWorkerId,
+ mkWorkerId, mkExportedLocalId,
-- Taking an Id apart
idName, idType, idUnique, idInfo,
- idPrimRep, isId, globalIdDetails,
+ isId, globalIdDetails, idPrimRep,
recordSelectorFieldLabel,
-- Modifying an Id
- setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
+ setIdName, setIdUnique, Id.setIdType, setIdLocalExported,
setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
zapLamIdInfo, zapDemandIdInfo,
isRecordSelector,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
- isDataConId, isDataConId_maybe,
- isDataConWrapId, isDataConWrapId_maybe,
- isBottomingId,
- hasNoBinding,
+ isDataConWorkId, isDataConWorkId_maybe,
+ isBottomingId, idIsFrom,
+ hasNoBinding,
-- Inline pragma stuff
idInlinePragma, setInlinePragma, modifyInlinePragma,
-- One shot lambda stuff
- isOneShotLambda, setOneShotLambda, clearOneShotLambda,
+ isOneShotBndr, isOneShotLambda, isStateHackType,
+ setOneShotLambda, clearOneShotLambda,
-- IdInfo stuff
setIdUnfolding,
setIdArity,
setIdNewDemandInfo,
setIdNewStrictness, zapIdNewStrictness,
- setIdTyGenInfo,
setIdWorkerInfo,
setIdSpecialisation,
- setIdCgInfo,
+ setIdCafInfo,
setIdOccInfo,
#ifdef OLD_STRICTNESS
#endif
idArity,
- idNewDemandInfo,
+ idNewDemandInfo, idNewDemandInfo_maybe,
idNewStrictness, idNewStrictness_maybe,
- idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation, idCoreRules,
- idCgInfo,
idCafInfo,
idLBVarInfo,
idOccInfo,
import Var ( Id, DictId,
isId, isExportedId, isSpecPragmaId, isLocalId,
idName, idType, idUnique, idInfo, isGlobalId,
- setIdName, setVarType, setIdUnique, setIdLocalExported,
+ setIdName, setIdType, setIdUnique, setIdLocalExported,
setIdInfo, lazySetIdInfo, modifyIdInfo,
maybeModifyIdInfo,
- globalIdDetails, setGlobalIdDetails
+ globalIdDetails
)
-import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId )
-import Type ( Type, typePrimRep, addFreeTyVars,
- usOnce, eqUsage, seqType, splitTyConApp_maybe )
-
+import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
+import Type ( Type, typePrimRep, addFreeTyVars, seqType,
+ splitTyConApp_maybe, PrimRep )
+import TysPrim ( statePrimTyCon )
import IdInfo
+#ifdef OLD_STRICTNESS
import qualified Demand ( Demand )
-import NewDemand ( Demand, StrictSig, topSig, isBottomingSig )
-import Name ( Name, OccName,
- mkSystemName, mkInternalName,
+#endif
+import DataCon ( isUnboxedTupleCon )
+import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
+import Name ( Name, OccName, nameIsLocalOrFrom,
+ mkSystemName, mkSystemNameEncoded, mkInternalName,
getOccName, getSrcLoc
)
-import OccName ( EncodedFS, UserFS, mkWorkerOcc )
-import PrimRep ( PrimRep )
-import TysPrim ( statePrimTyCon )
+import Module ( Module )
+import OccName ( EncodedFS, mkWorkerOcc )
import FieldLabel ( FieldLabel )
import Maybes ( orElse )
import SrcLoc ( SrcLoc )
import Outputable
import Unique ( Unique, mkBuiltinUnique )
+import CmdLineOpts ( opt_NoStateHack )
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setIdUnfolding`,
`setIdArity`,
`setIdNewDemandInfo`,
`setIdNewStrictness`,
- `setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
+mkExportedLocalId :: Name -> Type -> Id
+mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
+
mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
\end{code}
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
-mkSysLocal fs uniq ty = mkLocalId (mkSystemName uniq fs) ty
+mkSysLocal fs uniq ty = mkLocalId (mkSystemNameEncoded uniq fs) ty
+
+-- version to use when the faststring needs to be encoded
+mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName uniq fs) ty
+
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
mkVanillaGlobal = mkGlobalId VanillaGlobal
\end{code}
\begin{code}
setIdType :: Id -> Type -> Id
-- Add free tyvar info to the type
-setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
+setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
recordSelectorFieldLabel :: Id -> FieldLabel
recordSelectorFieldLabel id = case globalIdDetails id of
RecordSelId lbl -> lbl
+ other -> panic "recordSelectorFieldLabel"
isRecordSelector id = case globalIdDetails id of
RecordSelId lbl -> True
FCallId call -> Just call
other -> Nothing
-isDataConId id = case globalIdDetails id of
- DataConId _ -> True
- other -> False
-
-isDataConId_maybe id = case globalIdDetails id of
- DataConId con -> Just con
- other -> Nothing
-
-isDataConWrapId_maybe id = case globalIdDetails id of
- DataConWrapId con -> Just con
- other -> Nothing
+isDataConWorkId id = case globalIdDetails id of
+ DataConWorkId _ -> True
+ other -> False
-isDataConWrapId id = case globalIdDetails id of
- DataConWrapId con -> True
- other -> False
+isDataConWorkId_maybe id = case globalIdDetails id of
+ DataConWorkId con -> Just con
+ other -> Nothing
-- 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.
+-- them at the CorePrep stage.
+-- EXCEPT: unboxed tuples, which definitely have no binding
hasNoBinding id = case globalIdDetails id of
- PrimOpId _ -> True
- FCallId _ -> True
- other -> False
+ PrimOpId _ -> True
+ FCallId _ -> True
+ DataConWorkId dc -> isUnboxedTupleCon dc
+ other -> False
isImplicitId :: Id -> Bool
-- isImplicitId tells whether an Id's info is implied by other
-- file, even if it's mentioned in some other interface unfolding.
isImplicitId id
= case globalIdDetails id of
- RecordSelId _ -> True -- Includes dictionary selectors
+ RecordSelId _ -> True
FCallId _ -> True
PrimOpId _ -> True
- DataConId _ -> True
+ ClassOpId _ -> True
+ DataConWorkId _ -> True
DataConWrapId _ -> True
-- These are are implied by their type or class decl;
-- remember that all type and class decls appear in the interface file.
- -- The dfun id must *not* be omitted, because it carries version info for
- -- the instance decl
+ -- The dfun id is not an implicit Id; it must *not* be omitted, because
+ -- it carries version info for the instance decl
other -> False
+
+idIsFrom :: Module -> Id -> Bool
+idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
\end{code}
\begin{code}
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
---------------------------------
- -- TYPE GENERALISATION
-idTyGenInfo :: Id -> TyGenInfo
-idTyGenInfo id = tyGenInfo (idInfo id)
-
-setIdTyGenInfo :: Id -> TyGenInfo -> Id
-setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
-
- ---------------------------------
-- WORKER ID
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
#endif
-idNewDemandInfo :: Id -> NewDemand.Demand
-idNewDemandInfo id = newDemandInfo (idInfo id)
+idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
+idNewDemandInfo :: Id -> NewDemand.Demand
+
+idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
+idNewDemandInfo id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
-setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
+setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
---------------------------------
-- SPECIALISATION
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
---------------------------------
- -- CG INFO
-idCgInfo :: Id -> CgInfo
-#ifdef OLD_STRICTNESS
-idCgInfo id = case cgInfo (idInfo id) of
- NoCgInfo -> pprPanic "idCgInfo" (ppr id)
- info -> info
-#else
-idCgInfo id = cgInfo (idInfo id)
-#endif
-
-setIdCgInfo :: Id -> CgInfo -> Id
-setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
-
- ---------------------------------
-- CAF INFO
idCafInfo :: Id -> CafInfo
#ifdef OLD_STRICTNESS
NoCgInfo -> pprPanic "idCafInfo" (ppr id)
info -> cgCafInfo info
#else
-idCafInfo id = cgCafInfo (idCgInfo id)
+idCafInfo id = cafInfo (idInfo id)
#endif
+
+setIdCafInfo :: Id -> CafInfo -> Id
+setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
+
---------------------------------
-- CPR INFO
#ifdef OLD_STRICTNESS
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)
-isOneShotLambda :: Id -> Bool
-isOneShotLambda id = analysis || hack
- where analysis = case idLBVarInfo id of
- LBVarInfo u | u `eqUsage` usOnce -> True
- other -> False
- hack = case splitTyConApp_maybe (idType id) of
- Just (tycon,_) | tycon == statePrimTyCon -> True
- other -> False
-
- -- The last clause is a gross hack. It claims that
+isOneShotBndr :: Id -> Bool
+-- This one is the "business end", called externally.
+-- Its main purpose is to encapsulate the Horrible State Hack
+isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
+
+isStateHackType :: Type -> Bool
+isStateHackType ty
+ | opt_NoStateHack
+ = False
+ | otherwise
+ = case splitTyConApp_maybe ty of
+ Just (tycon,_) -> tycon == statePrimTyCon
+ other -> False
+ -- This 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
-- difference. For example, consider
-- 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.
+
+-- The OneShotLambda functions simply fiddle with the IdInfo flag
+isOneShotLambda :: Id -> Bool
+isOneShotLambda id = case idLBVarInfo id of
+ IsOneShotLambda -> True
+ NoLBVarInfo -> False
+
setOneShotLambda :: Id -> Id
-setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
clearOneShotLambda :: Id -> Id
clearOneShotLambda id
projects / ghc-hetmet.git / blobdiff