2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Id]{@Ids@: Value and constructor identifiers}
10 -- Simple construction
11 mkGlobalId, mkLocalId, mkLocalIdWithInfo,
12 mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
13 mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
14 mkWorkerId, mkExportedLocalId,
17 idName, idType, idUnique, idInfo,
18 isId, globalIdDetails, idPrimRep,
19 recordSelectorFieldLabel,
22 setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported,
23 setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
24 zapLamIdInfo, zapDemandIdInfo,
27 isImplicitId, isDeadBinder, isDictId,
28 isExportedId, isLocalId, isGlobalId,
29 isRecordSelector, isNaughtyRecordSelector,
31 isPrimOpId, isPrimOpId_maybe,
32 isFCallId, isFCallId_maybe,
33 isDataConWorkId, isDataConWorkId_maybe, idDataCon,
34 isBottomingId, idIsFrom,
37 -- Inline pragma stuff
38 idInlinePragma, setInlinePragma, modifyInlinePragma,
41 -- One shot lambda stuff
42 isOneShotBndr, isOneShotLambda, isStateHackType,
43 setOneShotLambda, clearOneShotLambda,
49 setIdNewStrictness, zapIdNewStrictness,
65 idNewDemandInfo, idNewDemandInfo_maybe,
66 idNewStrictness, idNewStrictness_maybe,
69 idSpecialisation, idCoreRules,
75 newStrictnessFromOld -- Temporary
80 #include "HsVersions.h"
83 import CoreSyn ( Unfolding, CoreRule )
84 import BasicTypes ( Arity )
85 import Var ( Id, DictId,
86 isId, isExportedId, isLocalId,
87 idName, idType, idUnique, idInfo, isGlobalId,
88 setIdName, setIdType, setIdUnique,
89 setIdExported, setIdNotExported,
90 setIdInfo, lazySetIdInfo, modifyIdInfo,
94 import qualified Var ( mkLocalId, mkGlobalId, mkExportedLocalId )
95 import TyCon ( FieldLabel, TyCon )
96 import Type ( Type, typePrimRep, addFreeTyVars, seqType,
97 splitTyConApp_maybe, PrimRep )
98 import TcType ( isDictTy )
99 import TysPrim ( statePrimTyCon )
102 #ifdef OLD_STRICTNESS
103 import qualified Demand ( Demand )
105 import DataCon ( DataCon, isUnboxedTupleCon )
106 import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
107 import Name ( Name, OccName, nameIsLocalOrFrom,
108 mkSystemVarName, mkSystemVarNameEncoded, mkInternalName,
109 getOccName, getSrcLoc
111 import Module ( Module )
112 import OccName ( EncodedFS, mkWorkerOcc )
113 import Maybes ( orElse )
114 import SrcLoc ( SrcLoc )
116 import Unique ( Unique, mkBuiltinUnique )
117 import StaticFlags ( opt_NoStateHack )
119 -- infixl so you can say (id `set` a `set` b)
120 infixl 1 `setIdUnfolding`,
122 `setIdNewDemandInfo`,
123 `setIdNewStrictness`,
125 `setIdSpecialisation`,
128 #ifdef OLD_STRICTNESS
137 %************************************************************************
139 \subsection{Simple Id construction}
141 %************************************************************************
143 Absolutely all Ids are made by mkId. It is just like Var.mkId,
144 but in addition it pins free-tyvar-info onto the Id's type,
145 where it can easily be found.
148 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
149 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
151 mkExportedLocalId :: Name -> Type -> Id
152 mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
154 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
155 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
159 mkLocalId :: Name -> Type -> Id
160 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
162 -- SysLocal: for an Id being created by the compiler out of thin air...
163 -- UserLocal: an Id with a name the user might recognize...
164 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
165 mkSysLocal :: EncodedFS -> Unique -> Type -> Id
166 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
168 -- for SysLocal, we assume the base name is already encoded, to avoid
169 -- re-encoding the same string over and over again.
170 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarNameEncoded uniq fs) ty
172 -- version to use when the faststring needs to be encoded
173 mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
175 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
176 mkVanillaGlobal = mkGlobalId VanillaGlobal
179 Make some local @Ids@ for a template @CoreExpr@. These have bogus
180 @Uniques@, but that's OK because the templates are supposed to be
181 instantiated before use.
184 -- "Wild Id" typically used when you need a binder that you don't expect to use
185 mkWildId :: Type -> Id
186 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
188 mkWorkerId :: Unique -> Id -> Type -> Id
189 -- A worker gets a local name. CoreTidy will externalise it if necessary.
190 mkWorkerId uniq unwrkr ty
191 = mkLocalId wkr_name ty
193 wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
195 -- "Template locals" typically used in unfoldings
196 mkTemplateLocals :: [Type] -> [Id]
197 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
199 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
200 -- The Int gives the starting point for unique allocation
201 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
203 mkTemplateLocal :: Int -> Type -> Id
204 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
208 %************************************************************************
210 \subsection[Id-general-funs]{General @Id@-related functions}
212 %************************************************************************
215 setIdType :: Id -> Type -> Id
216 -- Add free tyvar info to the type
217 setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
219 idPrimRep :: Id -> PrimRep
220 idPrimRep id = typePrimRep (idType id)
224 %************************************************************************
226 \subsection{Special Ids}
228 %************************************************************************
231 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
232 recordSelectorFieldLabel id = case globalIdDetails id of
233 RecordSelId tycon lbl _ -> (tycon,lbl)
234 other -> panic "recordSelectorFieldLabel"
236 isRecordSelector id = case globalIdDetails id of
237 RecordSelId {} -> True
240 isNaughtyRecordSelector id = case globalIdDetails id of
241 RecordSelId { sel_naughty = n } -> n
244 isClassOpId_maybe id = case globalIdDetails id of
245 ClassOpId cls -> Just cls
248 isPrimOpId id = case globalIdDetails id of
252 isPrimOpId_maybe id = case globalIdDetails id of
253 PrimOpId op -> Just op
256 isFCallId id = case globalIdDetails id of
260 isFCallId_maybe id = case globalIdDetails id of
261 FCallId call -> Just call
264 isDataConWorkId id = case globalIdDetails id of
265 DataConWorkId _ -> True
268 isDataConWorkId_maybe id = case globalIdDetails id of
269 DataConWorkId con -> Just con
272 isDictId :: Id -> Bool
273 isDictId id = isDictTy (idType id)
275 idDataCon :: Id -> DataCon
276 -- Get from either the worker or the wrapper to the DataCon
277 -- Currently used only in the desugarer
278 -- INVARIANT: idDataCon (dataConWrapId d) = d
279 -- (Remember, dataConWrapId can return either the wrapper or the worker.)
280 idDataCon id = case globalIdDetails id of
281 DataConWorkId con -> con
282 DataConWrapId con -> con
283 other -> pprPanic "idDataCon" (ppr id)
286 -- hasNoBinding returns True of an Id which may not have a
287 -- binding, even though it is defined in this module.
288 -- Data constructor workers used to be things of this kind, but
289 -- they aren't any more. Instead, we inject a binding for
290 -- them at the CorePrep stage.
291 -- EXCEPT: unboxed tuples, which definitely have no binding
292 hasNoBinding id = case globalIdDetails id of
295 DataConWorkId dc -> isUnboxedTupleCon dc
298 isImplicitId :: Id -> Bool
299 -- isImplicitId tells whether an Id's info is implied by other
300 -- declarations, so we don't need to put its signature in an interface
301 -- file, even if it's mentioned in some other interface unfolding.
303 = case globalIdDetails id of
304 RecordSelId {} -> True
308 DataConWorkId _ -> True
309 DataConWrapId _ -> True
310 -- These are are implied by their type or class decl;
311 -- remember that all type and class decls appear in the interface file.
312 -- The dfun id is not an implicit Id; it must *not* be omitted, because
313 -- it carries version info for the instance decl
316 idIsFrom :: Module -> Id -> Bool
317 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
321 isDeadBinder :: Id -> Bool
322 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
323 | otherwise = False -- TyVars count as not dead
327 %************************************************************************
329 \subsection{IdInfo stuff}
331 %************************************************************************
334 ---------------------------------
336 idArity :: Id -> Arity
337 idArity id = arityInfo (idInfo id)
339 setIdArity :: Id -> Arity -> Id
340 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
342 #ifdef OLD_STRICTNESS
343 ---------------------------------
345 idStrictness :: Id -> StrictnessInfo
346 idStrictness id = strictnessInfo (idInfo id)
348 setIdStrictness :: Id -> StrictnessInfo -> Id
349 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
352 -- isBottomingId returns true if an application to n args would diverge
353 isBottomingId :: Id -> Bool
354 isBottomingId id = isBottomingSig (idNewStrictness id)
356 idNewStrictness_maybe :: Id -> Maybe StrictSig
357 idNewStrictness :: Id -> StrictSig
359 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
360 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
362 setIdNewStrictness :: Id -> StrictSig -> Id
363 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
365 zapIdNewStrictness :: Id -> Id
366 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
368 ---------------------------------
370 idWorkerInfo :: Id -> WorkerInfo
371 idWorkerInfo id = workerInfo (idInfo id)
373 setIdWorkerInfo :: Id -> WorkerInfo -> Id
374 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
376 ---------------------------------
378 idUnfolding :: Id -> Unfolding
379 idUnfolding id = unfoldingInfo (idInfo id)
381 setIdUnfolding :: Id -> Unfolding -> Id
382 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
384 #ifdef OLD_STRICTNESS
385 ---------------------------------
387 idDemandInfo :: Id -> Demand.Demand
388 idDemandInfo id = demandInfo (idInfo id)
390 setIdDemandInfo :: Id -> Demand.Demand -> Id
391 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
394 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
395 idNewDemandInfo :: Id -> NewDemand.Demand
397 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
398 idNewDemandInfo id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
400 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
401 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
403 ---------------------------------
405 idSpecialisation :: Id -> SpecInfo
406 idSpecialisation id = specInfo (idInfo id)
408 idCoreRules :: Id -> [CoreRule]
409 idCoreRules id = specInfoRules (idSpecialisation id)
411 setIdSpecialisation :: Id -> SpecInfo -> Id
412 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
414 ---------------------------------
416 idCafInfo :: Id -> CafInfo
417 #ifdef OLD_STRICTNESS
418 idCafInfo id = case cgInfo (idInfo id) of
419 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
420 info -> cgCafInfo info
422 idCafInfo id = cafInfo (idInfo id)
425 setIdCafInfo :: Id -> CafInfo -> Id
426 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
428 ---------------------------------
430 #ifdef OLD_STRICTNESS
431 idCprInfo :: Id -> CprInfo
432 idCprInfo id = cprInfo (idInfo id)
434 setIdCprInfo :: Id -> CprInfo -> Id
435 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
438 ---------------------------------
440 idOccInfo :: Id -> OccInfo
441 idOccInfo id = occInfo (idInfo id)
443 setIdOccInfo :: Id -> OccInfo -> Id
444 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
448 ---------------------------------
450 The inline pragma tells us to be very keen to inline this Id, but it's still
451 OK not to if optimisation is switched off.
454 idInlinePragma :: Id -> InlinePragInfo
455 idInlinePragma id = inlinePragInfo (idInfo id)
457 setInlinePragma :: Id -> InlinePragInfo -> Id
458 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
460 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
461 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
465 ---------------------------------
468 idLBVarInfo :: Id -> LBVarInfo
469 idLBVarInfo id = lbvarInfo (idInfo id)
471 isOneShotBndr :: Id -> Bool
472 -- This one is the "business end", called externally.
473 -- Its main purpose is to encapsulate the Horrible State Hack
474 isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
476 isStateHackType :: Type -> Bool
481 = case splitTyConApp_maybe ty of
482 Just (tycon,_) -> tycon == statePrimTyCon
484 -- This is a gross hack. It claims that
485 -- every function over realWorldStatePrimTy is a one-shot
486 -- function. This is pretty true in practice, and makes a big
487 -- difference. For example, consider
488 -- a `thenST` \ r -> ...E...
489 -- The early full laziness pass, if it doesn't know that r is one-shot
490 -- will pull out E (let's say it doesn't mention r) to give
491 -- let lvl = E in a `thenST` \ r -> ...lvl...
492 -- When `thenST` gets inlined, we end up with
493 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
494 -- and we don't re-inline E.
496 -- It would be better to spot that r was one-shot to start with, but
497 -- I don't want to rely on that.
499 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
500 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
503 -- The OneShotLambda functions simply fiddle with the IdInfo flag
504 isOneShotLambda :: Id -> Bool
505 isOneShotLambda id = case idLBVarInfo id of
506 IsOneShotLambda -> True
509 setOneShotLambda :: Id -> Id
510 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
512 clearOneShotLambda :: Id -> Id
513 clearOneShotLambda id
514 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
517 -- But watch out: this may change the type of something else
519 -- If we change the one-shot-ness of x, f's type changes
523 zapLamIdInfo :: Id -> Id
524 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
526 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id