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,
69 newStrictnessFromOld -- Temporary
73 #include "HsVersions.h"
76 import CoreSyn ( Unfolding, CoreRules )
77 import BasicTypes ( Arity )
78 import Var ( Id, DictId,
79 isId, isExportedId, isSpecPragmaId, isLocalId,
80 idName, idType, idUnique, idInfo, isGlobalId,
81 setIdName, setVarType, setIdUnique, setIdLocalExported,
82 setIdInfo, lazySetIdInfo, modifyIdInfo,
84 globalIdDetails, setGlobalIdDetails
86 import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId )
87 import Type ( Type, typePrimRep, addFreeTyVars,
88 usOnce, eqUsage, seqType, splitTyConApp_maybe )
92 import qualified Demand ( Demand )
93 import NewDemand ( Demand, DmdResult(..), StrictSig, topSig, isBotRes,
94 isBottomingSig, splitStrictSig, strictSigResInfo
96 import Name ( Name, OccName,
97 mkSysLocalName, mkLocalName,
100 import OccName ( UserFS, mkWorkerOcc )
101 import PrimRep ( PrimRep )
102 import TysPrim ( statePrimTyCon )
103 import FieldLabel ( FieldLabel )
104 import Maybes ( orElse )
105 import SrcLoc ( SrcLoc )
107 import Unique ( Unique, mkBuiltinUnique )
109 infixl 1 `setIdUnfolding`,
113 `setIdNewDemandInfo`,
114 `setIdNewStrictness`,
117 `setIdSpecialisation`,
122 -- infixl so you can say (id `set` a `set` b)
127 %************************************************************************
129 \subsection{Simple Id construction}
131 %************************************************************************
133 Absolutely all Ids are made by mkId. It is just like Var.mkId,
134 but in addition it pins free-tyvar-info onto the Id's type,
135 where it can easily be found.
138 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
139 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
141 mkSpecPragmaId :: OccName -> Unique -> Type -> SrcLoc -> Id
142 mkSpecPragmaId occ uniq ty loc = Var.mkSpecPragmaId (mkLocalName uniq occ loc)
146 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
147 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
151 mkLocalId :: Name -> Type -> Id
152 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
154 -- SysLocal: for an Id being created by the compiler out of thin air...
155 -- UserLocal: an Id with a name the user might recognize...
156 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
157 mkSysLocal :: UserFS -> Unique -> Type -> Id
158 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
160 mkSysLocal fs uniq ty = mkLocalId (mkSysLocalName uniq fs) ty
161 mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName uniq occ loc) ty
162 mkVanillaGlobal = mkGlobalId VanillaGlobal
165 Make some local @Ids@ for a template @CoreExpr@. These have bogus
166 @Uniques@, but that's OK because the templates are supposed to be
167 instantiated before use.
170 -- "Wild Id" typically used when you need a binder that you don't expect to use
171 mkWildId :: Type -> Id
172 mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
174 mkWorkerId :: Unique -> Id -> Type -> Id
175 -- A worker gets a local name. CoreTidy will globalise it if necessary.
176 mkWorkerId uniq unwrkr ty
177 = mkLocalId wkr_name ty
179 wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
181 -- "Template locals" typically used in unfoldings
182 mkTemplateLocals :: [Type] -> [Id]
183 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
185 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
186 -- The Int gives the starting point for unique allocation
187 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
189 mkTemplateLocal :: Int -> Type -> Id
190 mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
194 %************************************************************************
196 \subsection[Id-general-funs]{General @Id@-related functions}
198 %************************************************************************
201 setIdType :: Id -> Type -> Id
202 -- Add free tyvar info to the type
203 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
205 idPrimRep :: Id -> PrimRep
206 idPrimRep id = typePrimRep (idType id)
210 %************************************************************************
212 \subsection{Special Ids}
214 %************************************************************************
216 The @SpecPragmaId@ exists only to make Ids that are
217 on the *LHS* of bindings created by SPECIALISE pragmas;
219 The SpecPragmaId is never itself mentioned; it
220 exists solely so that the specialiser will find
221 the call to f, and make specialised version of it.
222 The SpecPragmaId binding is discarded by the specialiser
223 when it gathers up overloaded calls.
224 Meanwhile, it is not discarded as dead code.
228 recordSelectorFieldLabel :: Id -> FieldLabel
229 recordSelectorFieldLabel id = case globalIdDetails id of
230 RecordSelId lbl -> lbl
232 isRecordSelector id = case globalIdDetails id of
233 RecordSelId lbl -> True
236 isPrimOpId id = case globalIdDetails id of
240 isPrimOpId_maybe id = case globalIdDetails id of
241 PrimOpId op -> Just op
244 isFCallId id = case globalIdDetails id of
248 isFCallId_maybe id = case globalIdDetails id of
249 FCallId call -> Just call
252 isDataConId id = case globalIdDetails id of
256 isDataConId_maybe id = case globalIdDetails id of
257 DataConId con -> Just con
260 isDataConWrapId_maybe id = case globalIdDetails id of
261 DataConWrapId con -> Just con
264 isDataConWrapId id = case globalIdDetails id of
265 DataConWrapId con -> True
268 -- hasNoBinding returns True of an Id which may not have a
269 -- binding, even though it is defined in this module.
270 -- Data constructor workers used to be things of this kind, but
271 -- they aren't any more. Instead, we inject a binding for
272 -- them at the CorePrep stage.
273 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 idArity :: Id -> Arity
313 idArity id = arityInfo (idInfo id)
315 setIdArity :: Id -> Arity -> Id
316 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
318 ---------------------------------
320 idStrictness :: Id -> StrictnessInfo
321 idStrictness id = strictnessInfo (idInfo id)
323 setIdStrictness :: Id -> StrictnessInfo -> Id
324 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
326 -- isBottomingId returns true if an application to n args would diverge
327 isBottomingId :: Id -> Bool
328 isBottomingId id = isBottomingSig (idNewStrictness id)
330 idNewStrictness_maybe :: Id -> Maybe StrictSig
331 idNewStrictness :: Id -> StrictSig
333 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
334 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
336 setIdNewStrictness :: Id -> StrictSig -> Id
337 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
339 zapIdNewStrictness :: Id -> Id
340 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
342 ---------------------------------
343 -- TYPE GENERALISATION
344 idTyGenInfo :: Id -> TyGenInfo
345 idTyGenInfo id = tyGenInfo (idInfo id)
347 setIdTyGenInfo :: Id -> TyGenInfo -> Id
348 setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
350 ---------------------------------
352 idWorkerInfo :: Id -> WorkerInfo
353 idWorkerInfo id = workerInfo (idInfo id)
355 setIdWorkerInfo :: Id -> WorkerInfo -> Id
356 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
358 ---------------------------------
360 idUnfolding :: Id -> Unfolding
361 idUnfolding id = unfoldingInfo (idInfo id)
363 setIdUnfolding :: Id -> Unfolding -> Id
364 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
366 ---------------------------------
368 idDemandInfo :: Id -> Demand.Demand
369 idDemandInfo id = demandInfo (idInfo id)
371 setIdDemandInfo :: Id -> Demand.Demand -> Id
372 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
374 idNewDemandInfo :: Id -> NewDemand.Demand
375 idNewDemandInfo id = newDemandInfo (idInfo id)
377 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
378 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
380 ---------------------------------
382 idSpecialisation :: Id -> CoreRules
383 idSpecialisation id = specInfo (idInfo id)
385 setIdSpecialisation :: Id -> CoreRules -> Id
386 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
388 ---------------------------------
390 idCgInfo :: Id -> CgInfo
392 idCgInfo id = case cgInfo (idInfo id) of
393 NoCgInfo -> pprPanic "idCgInfo" (ppr id)
396 idCgInfo id = cgInfo (idInfo id)
399 setIdCgInfo :: Id -> CgInfo -> Id
400 setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
402 ---------------------------------
404 idCafInfo :: Id -> CafInfo
406 idCafInfo id = case cgInfo (idInfo id) of
407 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
408 info -> cgCafInfo info
410 idCafInfo id = cgCafInfo (idCgInfo id)
413 ---------------------------------
415 idCprInfo :: Id -> CprInfo
416 idCprInfo id = cprInfo (idInfo id)
418 setIdCprInfo :: Id -> CprInfo -> Id
419 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
421 ---------------------------------
423 idOccInfo :: Id -> OccInfo
424 idOccInfo id = occInfo (idInfo id)
426 setIdOccInfo :: Id -> OccInfo -> Id
427 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
431 ---------------------------------
433 The inline pragma tells us to be very keen to inline this Id, but it's still
434 OK not to if optimisation is switched off.
437 idInlinePragma :: Id -> InlinePragInfo
438 idInlinePragma id = inlinePragInfo (idInfo id)
440 setInlinePragma :: Id -> InlinePragInfo -> Id
441 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
443 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
444 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
448 ---------------------------------
451 idLBVarInfo :: Id -> LBVarInfo
452 idLBVarInfo id = lbvarInfo (idInfo id)
454 isOneShotLambda :: Id -> Bool
455 isOneShotLambda id = analysis || hack
456 where analysis = case idLBVarInfo id of
457 LBVarInfo u | u `eqUsage` usOnce -> True
459 hack = case splitTyConApp_maybe (idType id) of
460 Just (tycon,_) | tycon == statePrimTyCon -> True
463 -- The last clause is a gross hack. It claims that
464 -- every function over realWorldStatePrimTy is a one-shot
465 -- function. This is pretty true in practice, and makes a big
466 -- difference. For example, consider
467 -- a `thenST` \ r -> ...E...
468 -- The early full laziness pass, if it doesn't know that r is one-shot
469 -- will pull out E (let's say it doesn't mention r) to give
470 -- let lvl = E in a `thenST` \ r -> ...lvl...
471 -- When `thenST` gets inlined, we end up with
472 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
473 -- and we don't re-inline E.
475 -- It would be better to spot that r was one-shot to start with, but
476 -- I don't want to rely on that.
478 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
479 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
481 setOneShotLambda :: Id -> Id
482 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
484 clearOneShotLambda :: Id -> Id
485 clearOneShotLambda id
486 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
489 -- But watch out: this may change the type of something else
491 -- If we change the one-shot-ness of x, f's type changes
495 zapLamIdInfo :: Id -> Id
496 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
498 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id