2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Id]{@Ids@: Value and constructor identifiers}
10 -- Simple construction
11 mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
12 mkSysLocal, mkUserLocal, mkVanillaGlobal,
13 mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
17 idName, idType, idUnique, idInfo,
18 idPrimRep, isId, globalIdDetails,
19 recordSelectorFieldLabel,
22 setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
23 setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
24 zapLamIdInfo, zapDemandIdInfo,
27 isImplicitId, isDeadBinder,
28 isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
30 isPrimOpId, isPrimOpId_maybe,
31 isFCallId, isFCallId_maybe,
32 isDataConId, isDataConId_maybe,
33 isDataConWrapId, isDataConWrapId_maybe,
37 -- Inline pragma stuff
38 idInlinePragma, setInlinePragma, modifyInlinePragma,
41 -- One shot lambda stuff
42 isOneShotLambda, setOneShotLambda, clearOneShotLambda,
47 setIdDemandInfo, setIdNewDemandInfo,
48 setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
57 idDemandInfo, idNewDemandInfo,
58 idStrictness, idNewStrictness, idNewStrictness_maybe, getNewStrictness,
70 newStrictnessFromOld -- Temporary
74 #include "HsVersions.h"
77 import CoreSyn ( Unfolding, CoreRules )
78 import BasicTypes ( Arity )
79 import Var ( Id, DictId,
80 isId, isExportedId, isSpecPragmaId, isLocalId,
81 idName, idType, idUnique, idInfo, isGlobalId,
82 setIdName, setVarType, setIdUnique, setIdLocalExported,
83 setIdInfo, lazySetIdInfo, modifyIdInfo,
85 globalIdDetails, setGlobalIdDetails
87 import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId )
88 import Type ( Type, typePrimRep, addFreeTyVars,
89 usOnce, eqUsage, seqType, splitTyConApp_maybe )
93 import qualified Demand ( Demand )
94 import NewDemand ( Demand, DmdResult(..), StrictSig, topSig, isBotRes,
95 isBottomingSig, splitStrictSig, strictSigResInfo
97 import Name ( Name, OccName,
98 mkSysLocalName, mkLocalName,
101 import OccName ( UserFS, mkWorkerOcc )
102 import PrimRep ( PrimRep )
103 import TysPrim ( statePrimTyCon )
104 import FieldLabel ( FieldLabel )
105 import Maybes ( orElse )
106 import SrcLoc ( SrcLoc )
108 import Unique ( Unique, mkBuiltinUnique )
110 infixl 1 `setIdUnfolding`,
114 `setIdNewDemandInfo`,
115 `setIdNewStrictness`,
118 `setIdSpecialisation`,
123 -- infixl so you can say (id `set` a `set` b)
128 %************************************************************************
130 \subsection{Simple Id construction}
132 %************************************************************************
134 Absolutely all Ids are made by mkId. It is just like Var.mkId,
135 but in addition it pins free-tyvar-info onto the Id's type,
136 where it can easily be found.
139 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
140 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
142 mkSpecPragmaId :: OccName -> Unique -> Type -> SrcLoc -> Id
143 mkSpecPragmaId occ uniq ty loc = Var.mkSpecPragmaId (mkLocalName uniq occ loc)
147 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
148 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
152 mkLocalId :: Name -> Type -> Id
153 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
155 -- SysLocal: for an Id being created by the compiler out of thin air...
156 -- UserLocal: an Id with a name the user might recognize...
157 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
158 mkSysLocal :: UserFS -> Unique -> Type -> Id
159 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
161 mkSysLocal fs uniq ty = mkLocalId (mkSysLocalName uniq fs) ty
162 mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName uniq occ loc) ty
163 mkVanillaGlobal = mkGlobalId VanillaGlobal
166 Make some local @Ids@ for a template @CoreExpr@. These have bogus
167 @Uniques@, but that's OK because the templates are supposed to be
168 instantiated before use.
171 -- "Wild Id" typically used when you need a binder that you don't expect to use
172 mkWildId :: Type -> Id
173 mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
175 mkWorkerId :: Unique -> Id -> Type -> Id
176 -- A worker gets a local name. CoreTidy will globalise it if necessary.
177 mkWorkerId uniq unwrkr ty
178 = mkLocalId wkr_name ty
180 wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
182 -- "Template locals" typically used in unfoldings
183 mkTemplateLocals :: [Type] -> [Id]
184 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
186 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
187 -- The Int gives the starting point for unique allocation
188 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
190 mkTemplateLocal :: Int -> Type -> Id
191 mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
195 %************************************************************************
197 \subsection[Id-general-funs]{General @Id@-related functions}
199 %************************************************************************
202 setIdType :: Id -> Type -> Id
203 -- Add free tyvar info to the type
204 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
206 idPrimRep :: Id -> PrimRep
207 idPrimRep id = typePrimRep (idType id)
211 %************************************************************************
213 \subsection{Special Ids}
215 %************************************************************************
217 The @SpecPragmaId@ exists only to make Ids that are
218 on the *LHS* of bindings created by SPECIALISE pragmas;
220 The SpecPragmaId is never itself mentioned; it
221 exists solely so that the specialiser will find
222 the call to f, and make specialised version of it.
223 The SpecPragmaId binding is discarded by the specialiser
224 when it gathers up overloaded calls.
225 Meanwhile, it is not discarded as dead code.
229 recordSelectorFieldLabel :: Id -> FieldLabel
230 recordSelectorFieldLabel id = case globalIdDetails id of
231 RecordSelId lbl -> lbl
233 isRecordSelector id = case globalIdDetails id of
234 RecordSelId lbl -> True
237 isPrimOpId id = case globalIdDetails id of
241 isPrimOpId_maybe id = case globalIdDetails id of
242 PrimOpId op -> Just op
245 isFCallId id = case globalIdDetails id of
249 isFCallId_maybe id = case globalIdDetails id of
250 FCallId call -> Just call
253 isDataConId id = case globalIdDetails id of
257 isDataConId_maybe id = case globalIdDetails id of
258 DataConId con -> Just con
261 isDataConWrapId_maybe id = case globalIdDetails id of
262 DataConWrapId con -> Just con
265 isDataConWrapId id = case globalIdDetails id of
266 DataConWrapId con -> True
269 -- hasNoBinding returns True of an Id which may not have a
270 -- binding, even though it is defined in this module. Notably,
271 -- the constructors of a dictionary are in this situation.
272 hasNoBinding id = case globalIdDetails id of
278 isImplicitId :: Id -> Bool
279 -- isImplicitId tells whether an Id's info is implied by other
280 -- declarations, so we don't need to put its signature in an interface
281 -- file, even if it's mentioned in some other interface unfolding.
283 = case globalIdDetails id of
284 RecordSelId _ -> True -- Includes dictionary selectors
288 DataConWrapId _ -> True
289 -- These are are implied by their type or class decl;
290 -- remember that all type and class decls appear in the interface file.
291 -- The dfun id must *not* be omitted, because it carries version info for
297 isDeadBinder :: Id -> Bool
298 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
299 | otherwise = False -- TyVars count as not dead
303 %************************************************************************
305 \subsection{IdInfo stuff}
307 %************************************************************************
310 ---------------------------------
312 idArityInfo :: Id -> ArityInfo
313 idArityInfo id = arityInfo (idInfo id)
315 idArity :: Id -> Arity
316 idArity id = arityLowerBound (idArityInfo id)
318 setIdArityInfo :: Id -> Arity -> Id
319 setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
321 ---------------------------------
323 idStrictness :: Id -> StrictnessInfo
324 idStrictness id = case strictnessInfo (idInfo id) of
325 NoStrictnessInfo -> case idNewStrictness_maybe id of
326 Just sig -> oldStrictnessFromNew sig
327 Nothing -> NoStrictnessInfo
328 strictness -> strictness
330 setIdStrictness :: Id -> StrictnessInfo -> Id
331 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
333 -- isBottomingId returns true if an application to n args would diverge
334 isBottomingId :: Id -> Bool
335 isBottomingId id = isBottomingSig (idNewStrictness id)
337 idNewStrictness_maybe :: Id -> Maybe StrictSig
338 idNewStrictness :: Id -> StrictSig
340 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
341 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
343 getNewStrictness :: Id -> StrictSig
344 -- First tries the "new-strictness" field, and then
345 -- reverts to the old one. This is just until we have
346 -- cross-module info for new strictness
347 getNewStrictness id = idNewStrictness_maybe id `orElse` newStrictnessFromOld id
349 newStrictnessFromOld :: Id -> StrictSig
350 newStrictnessFromOld id = mkNewStrictnessInfo id (idArity id) (idStrictness id) (idCprInfo id)
352 oldStrictnessFromNew :: StrictSig -> StrictnessInfo
353 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
355 (dmds, res_info) = splitStrictSig sig
357 setIdNewStrictness :: Id -> StrictSig -> Id
358 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
360 zapIdNewStrictness :: Id -> Id
361 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
363 ---------------------------------
364 -- TYPE GENERALISATION
365 idTyGenInfo :: Id -> TyGenInfo
366 idTyGenInfo id = tyGenInfo (idInfo id)
368 setIdTyGenInfo :: Id -> TyGenInfo -> Id
369 setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
371 ---------------------------------
373 idWorkerInfo :: Id -> WorkerInfo
374 idWorkerInfo id = workerInfo (idInfo id)
376 setIdWorkerInfo :: Id -> WorkerInfo -> Id
377 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
379 ---------------------------------
381 idUnfolding :: Id -> Unfolding
382 idUnfolding id = unfoldingInfo (idInfo id)
384 setIdUnfolding :: Id -> Unfolding -> Id
385 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
387 ---------------------------------
389 idDemandInfo :: Id -> Demand.Demand
390 idDemandInfo id = demandInfo (idInfo id)
392 setIdDemandInfo :: Id -> Demand.Demand -> Id
393 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
395 idNewDemandInfo :: Id -> NewDemand.Demand
396 idNewDemandInfo id = newDemandInfo (idInfo id)
398 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
399 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
401 ---------------------------------
403 idSpecialisation :: Id -> CoreRules
404 idSpecialisation id = specInfo (idInfo id)
406 setIdSpecialisation :: Id -> CoreRules -> Id
407 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
409 ---------------------------------
411 idCgInfo :: Id -> CgInfo
413 idCgInfo id = case cgInfo (idInfo id) of
414 NoCgInfo -> pprPanic "idCgInfo" (ppr id)
417 idCgInfo id = cgInfo (idInfo id)
420 setIdCgInfo :: Id -> CgInfo -> Id
421 setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
423 ---------------------------------
425 idCafInfo :: Id -> CafInfo
427 idCafInfo id = case cgInfo (idInfo id) of
428 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
429 info -> cgCafInfo info
431 idCafInfo id = cgCafInfo (idCgInfo id)
434 ---------------------------------
436 idCgArity :: Id -> Arity
438 idCgArity id = case cgInfo (idInfo id) of
439 NoCgInfo -> pprPanic "idCgArity" (ppr id)
442 idCgArity id = cgArity (idCgInfo id)
445 ---------------------------------
447 idCprInfo :: Id -> CprInfo
448 idCprInfo id = case cprInfo (idInfo id) of
449 NoCPRInfo -> case strictSigResInfo (idNewStrictness id) of
452 ReturnsCPR -> ReturnsCPR
454 setIdCprInfo :: Id -> CprInfo -> Id
455 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
457 ---------------------------------
459 idOccInfo :: Id -> OccInfo
460 idOccInfo id = occInfo (idInfo id)
462 setIdOccInfo :: Id -> OccInfo -> Id
463 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
467 ---------------------------------
469 The inline pragma tells us to be very keen to inline this Id, but it's still
470 OK not to if optimisation is switched off.
473 idInlinePragma :: Id -> InlinePragInfo
474 idInlinePragma id = inlinePragInfo (idInfo id)
476 setInlinePragma :: Id -> InlinePragInfo -> Id
477 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
479 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
480 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
484 ---------------------------------
487 idLBVarInfo :: Id -> LBVarInfo
488 idLBVarInfo id = lbvarInfo (idInfo id)
490 isOneShotLambda :: Id -> Bool
491 isOneShotLambda id = analysis || hack
492 where analysis = case idLBVarInfo id of
493 LBVarInfo u | u `eqUsage` usOnce -> True
495 hack = case splitTyConApp_maybe (idType id) of
496 Just (tycon,_) | tycon == statePrimTyCon -> True
499 -- The last clause is a gross hack. It claims that
500 -- every function over realWorldStatePrimTy is a one-shot
501 -- function. This is pretty true in practice, and makes a big
502 -- difference. For example, consider
503 -- a `thenST` \ r -> ...E...
504 -- The early full laziness pass, if it doesn't know that r is one-shot
505 -- will pull out E (let's say it doesn't mention r) to give
506 -- let lvl = E in a `thenST` \ r -> ...lvl...
507 -- When `thenST` gets inlined, we end up with
508 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
509 -- and we don't re-inline E.
511 -- It would be better to spot that r was one-shot to start with, but
512 -- I don't want to rely on that.
514 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
515 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
517 setOneShotLambda :: Id -> Id
518 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
520 clearOneShotLambda :: Id -> Id
521 clearOneShotLambda id
522 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
525 -- But watch out: this may change the type of something else
527 -- If we change the one-shot-ness of x, f's type changes
531 zapLamIdInfo :: Id -> Id
532 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
534 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id