-- Simple construction
mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
- mkSysLocal, mkUserLocal, mkVanillaGlobal,
+ mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
mkWorkerId,
isRecordSelector,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
- isDataConId, isDataConId_maybe,
+ isDataConWorkId, isDataConWorkId_maybe,
isDataConWrapId, isDataConWrapId_maybe,
isBottomingId,
hasNoBinding,
setIdArity,
setIdNewDemandInfo,
setIdNewStrictness, zapIdNewStrictness,
- setIdTyGenInfo,
setIdWorkerInfo,
setIdSpecialisation,
setIdCgInfo,
#endif
idArity,
- idNewDemandInfo,
+ idNewDemandInfo, idNewDemandInfo_maybe,
idNewStrictness, idNewStrictness_maybe,
- idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation, idCoreRules,
)
import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId )
import Type ( Type, typePrimRep, addFreeTyVars,
- usOnce, eqUsage, seqType, splitTyConApp_maybe )
+ seqType, splitTyConApp_maybe )
import IdInfo
import qualified Demand ( Demand )
-import NewDemand ( Demand, StrictSig, topSig, isBottomingSig )
+import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
import Name ( Name, OccName,
- mkSystemName, mkInternalName,
+ mkSystemName, mkSystemNameEncoded, mkInternalName,
getOccName, getSrcLoc
)
-import OccName ( EncodedFS, UserFS, mkWorkerOcc )
+import OccName ( EncodedFS, mkWorkerOcc )
import PrimRep ( PrimRep )
-import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel )
import Maybes ( orElse )
import SrcLoc ( SrcLoc )
`setIdArity`,
`setIdNewDemandInfo`,
`setIdNewStrictness`,
- `setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
-- 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}
FCallId call -> Just call
other -> Nothing
-isDataConId id = case globalIdDetails id of
- DataConId _ -> True
- other -> False
+isDataConWorkId id = case globalIdDetails id of
+ DataConWorkId _ -> True
+ other -> False
-isDataConId_maybe id = case globalIdDetails id of
- DataConId con -> Just con
- other -> Nothing
+isDataConWorkId_maybe id = case globalIdDetails id of
+ DataConWorkId con -> Just con
+ other -> Nothing
isDataConWrapId_maybe id = case globalIdDetails id of
DataConWrapId con -> Just con
RecordSelId _ -> True -- Includes dictionary selectors
FCallId _ -> True
PrimOpId _ -> True
- DataConId _ -> 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.
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
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
- -- every function over realWorldStatePrimTy is a one-shot
- -- function. This is pretty true in practice, and makes a big
- -- difference. For example, consider
- -- a `thenST` \ r -> ...E...
- -- The early full laziness pass, if it doesn't know that r is one-shot
- -- will pull out E (let's say it doesn't mention r) to give
- -- let lvl = E in a `thenST` \ r -> ...lvl...
- -- 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.
+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