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, StrictSig, topSig, isBottomingSig )
94 import Name ( Name, OccName,
95 mkSysLocalName, mkLocalName,
98 import OccName ( UserFS, mkWorkerOcc )
99 import PrimRep ( PrimRep )
100 import TysPrim ( statePrimTyCon )
101 import FieldLabel ( FieldLabel )
102 import Maybes ( orElse )
103 import SrcLoc ( SrcLoc )
105 import Unique ( Unique, mkBuiltinUnique )
107 infixl 1 `setIdUnfolding`,
111 `setIdNewDemandInfo`,
112 `setIdNewStrictness`,
115 `setIdSpecialisation`,
120 -- infixl so you can say (id `set` a `set` b)
125 %************************************************************************
127 \subsection{Simple Id construction}
129 %************************************************************************
131 Absolutely all Ids are made by mkId. It is just like Var.mkId,
132 but in addition it pins free-tyvar-info onto the Id's type,
133 where it can easily be found.
136 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
137 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
139 mkSpecPragmaId :: Name -> Type -> Id
140 mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
142 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
143 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
147 mkLocalId :: Name -> Type -> Id
148 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
150 -- SysLocal: for an Id being created by the compiler out of thin air...
151 -- UserLocal: an Id with a name the user might recognize...
152 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
153 mkSysLocal :: UserFS -> Unique -> Type -> Id
154 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
156 mkSysLocal fs uniq ty = mkLocalId (mkSysLocalName uniq fs) ty
157 mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName uniq occ loc) ty
158 mkVanillaGlobal = mkGlobalId VanillaGlobal
161 Make some local @Ids@ for a template @CoreExpr@. These have bogus
162 @Uniques@, but that's OK because the templates are supposed to be
163 instantiated before use.
166 -- "Wild Id" typically used when you need a binder that you don't expect to use
167 mkWildId :: Type -> Id
168 mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
170 mkWorkerId :: Unique -> Id -> Type -> Id
171 -- A worker gets a local name. CoreTidy will globalise it if necessary.
172 mkWorkerId uniq unwrkr ty
173 = mkLocalId wkr_name ty
175 wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
177 -- "Template locals" typically used in unfoldings
178 mkTemplateLocals :: [Type] -> [Id]
179 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
181 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
182 -- The Int gives the starting point for unique allocation
183 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
185 mkTemplateLocal :: Int -> Type -> Id
186 mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
190 %************************************************************************
192 \subsection[Id-general-funs]{General @Id@-related functions}
194 %************************************************************************
197 setIdType :: Id -> Type -> Id
198 -- Add free tyvar info to the type
199 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
201 idPrimRep :: Id -> PrimRep
202 idPrimRep id = typePrimRep (idType id)
206 %************************************************************************
208 \subsection{Special Ids}
210 %************************************************************************
212 The @SpecPragmaId@ exists only to make Ids that are
213 on the *LHS* of bindings created by SPECIALISE pragmas;
215 The SpecPragmaId is never itself mentioned; it
216 exists solely so that the specialiser will find
217 the call to f, and make specialised version of it.
218 The SpecPragmaId binding is discarded by the specialiser
219 when it gathers up overloaded calls.
220 Meanwhile, it is not discarded as dead code.
224 recordSelectorFieldLabel :: Id -> FieldLabel
225 recordSelectorFieldLabel id = case globalIdDetails id of
226 RecordSelId lbl -> lbl
228 isRecordSelector id = case globalIdDetails id of
229 RecordSelId lbl -> True
232 isPrimOpId id = case globalIdDetails id of
236 isPrimOpId_maybe id = case globalIdDetails id of
237 PrimOpId op -> Just op
240 isFCallId id = case globalIdDetails id of
244 isFCallId_maybe id = case globalIdDetails id of
245 FCallId call -> Just call
248 isDataConId id = case globalIdDetails id of
252 isDataConId_maybe id = case globalIdDetails id of
253 DataConId con -> Just con
256 isDataConWrapId_maybe id = case globalIdDetails id of
257 DataConWrapId con -> Just con
260 isDataConWrapId id = case globalIdDetails id of
261 DataConWrapId con -> True
264 -- hasNoBinding returns True of an Id which may not have a
265 -- binding, even though it is defined in this module.
266 -- Data constructor workers used to be things of this kind, but
267 -- they aren't any more. Instead, we inject a binding for
268 -- them at the CorePrep stage.
269 hasNoBinding id = case globalIdDetails id of
274 isImplicitId :: Id -> Bool
275 -- isImplicitId tells whether an Id's info is implied by other
276 -- declarations, so we don't need to put its signature in an interface
277 -- file, even if it's mentioned in some other interface unfolding.
279 = case globalIdDetails id of
280 RecordSelId _ -> True -- Includes dictionary selectors
284 DataConWrapId _ -> True
285 -- These are are implied by their type or class decl;
286 -- remember that all type and class decls appear in the interface file.
287 -- The dfun id must *not* be omitted, because it carries version info for
293 isDeadBinder :: Id -> Bool
294 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
295 | otherwise = False -- TyVars count as not dead
299 %************************************************************************
301 \subsection{IdInfo stuff}
303 %************************************************************************
306 ---------------------------------
308 idArity :: Id -> Arity
309 idArity id = arityInfo (idInfo id)
311 setIdArity :: Id -> Arity -> Id
312 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
314 ---------------------------------
316 idStrictness :: Id -> StrictnessInfo
317 idStrictness id = strictnessInfo (idInfo id)
319 setIdStrictness :: Id -> StrictnessInfo -> Id
320 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
322 -- isBottomingId returns true if an application to n args would diverge
323 isBottomingId :: Id -> Bool
324 isBottomingId id = isBottomingSig (idNewStrictness id)
326 idNewStrictness_maybe :: Id -> Maybe StrictSig
327 idNewStrictness :: Id -> StrictSig
329 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
330 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
332 setIdNewStrictness :: Id -> StrictSig -> Id
333 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
335 zapIdNewStrictness :: Id -> Id
336 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
338 ---------------------------------
339 -- TYPE GENERALISATION
340 idTyGenInfo :: Id -> TyGenInfo
341 idTyGenInfo id = tyGenInfo (idInfo id)
343 setIdTyGenInfo :: Id -> TyGenInfo -> Id
344 setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
346 ---------------------------------
348 idWorkerInfo :: Id -> WorkerInfo
349 idWorkerInfo id = workerInfo (idInfo id)
351 setIdWorkerInfo :: Id -> WorkerInfo -> Id
352 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
354 ---------------------------------
356 idUnfolding :: Id -> Unfolding
357 idUnfolding id = unfoldingInfo (idInfo id)
359 setIdUnfolding :: Id -> Unfolding -> Id
360 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
362 ---------------------------------
364 idDemandInfo :: Id -> Demand.Demand
365 idDemandInfo id = demandInfo (idInfo id)
367 setIdDemandInfo :: Id -> Demand.Demand -> Id
368 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
370 idNewDemandInfo :: Id -> NewDemand.Demand
371 idNewDemandInfo id = newDemandInfo (idInfo id)
373 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
374 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
376 ---------------------------------
378 idSpecialisation :: Id -> CoreRules
379 idSpecialisation id = specInfo (idInfo id)
381 setIdSpecialisation :: Id -> CoreRules -> Id
382 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
384 ---------------------------------
386 idCgInfo :: Id -> CgInfo
388 idCgInfo id = case cgInfo (idInfo id) of
389 NoCgInfo -> pprPanic "idCgInfo" (ppr id)
392 idCgInfo id = cgInfo (idInfo id)
395 setIdCgInfo :: Id -> CgInfo -> Id
396 setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
398 ---------------------------------
400 idCafInfo :: Id -> CafInfo
402 idCafInfo id = case cgInfo (idInfo id) of
403 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
404 info -> cgCafInfo info
406 idCafInfo id = cgCafInfo (idCgInfo id)
409 ---------------------------------
411 idCprInfo :: Id -> CprInfo
412 idCprInfo id = cprInfo (idInfo id)
414 setIdCprInfo :: Id -> CprInfo -> Id
415 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
417 ---------------------------------
419 idOccInfo :: Id -> OccInfo
420 idOccInfo id = occInfo (idInfo id)
422 setIdOccInfo :: Id -> OccInfo -> Id
423 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
427 ---------------------------------
429 The inline pragma tells us to be very keen to inline this Id, but it's still
430 OK not to if optimisation is switched off.
433 idInlinePragma :: Id -> InlinePragInfo
434 idInlinePragma id = inlinePragInfo (idInfo id)
436 setInlinePragma :: Id -> InlinePragInfo -> Id
437 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
439 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
440 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
444 ---------------------------------
447 idLBVarInfo :: Id -> LBVarInfo
448 idLBVarInfo id = lbvarInfo (idInfo id)
450 isOneShotLambda :: Id -> Bool
451 isOneShotLambda id = analysis || hack
452 where analysis = case idLBVarInfo id of
453 LBVarInfo u | u `eqUsage` usOnce -> True
455 hack = case splitTyConApp_maybe (idType id) of
456 Just (tycon,_) | tycon == statePrimTyCon -> True
459 -- The last clause is a gross hack. It claims that
460 -- every function over realWorldStatePrimTy is a one-shot
461 -- function. This is pretty true in practice, and makes a big
462 -- difference. For example, consider
463 -- a `thenST` \ r -> ...E...
464 -- The early full laziness pass, if it doesn't know that r is one-shot
465 -- will pull out E (let's say it doesn't mention r) to give
466 -- let lvl = E in a `thenST` \ r -> ...lvl...
467 -- When `thenST` gets inlined, we end up with
468 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
469 -- and we don't re-inline E.
471 -- It would be better to spot that r was one-shot to start with, but
472 -- I don't want to rely on that.
474 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
475 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
477 setOneShotLambda :: Id -> Id
478 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
480 clearOneShotLambda :: Id -> Id
481 clearOneShotLambda id
482 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
485 -- But watch out: this may change the type of something else
487 -- If we change the one-shot-ness of x, f's type changes
491 zapLamIdInfo :: Id -> Id
492 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
494 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id