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,
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 isClassOpId_maybe id = case globalIdDetails id of
241 ClassOpId cls -> Just cls
244 isPrimOpId id = case globalIdDetails id of
248 isPrimOpId_maybe id = case globalIdDetails id of
249 PrimOpId op -> Just op
252 isFCallId id = case globalIdDetails id of
256 isFCallId_maybe id = case globalIdDetails id of
257 FCallId call -> Just call
260 isDataConWorkId id = case globalIdDetails id of
261 DataConWorkId _ -> True
264 isDataConWorkId_maybe id = case globalIdDetails id of
265 DataConWorkId con -> Just con
268 isDictId :: Id -> Bool
269 isDictId id = isDictTy (idType id)
271 idDataCon :: Id -> DataCon
272 -- Get from either the worker or the wrapper to the DataCon
273 -- Currently used only in the desugarer
274 -- INVARIANT: idDataCon (dataConWrapId d) = d
275 -- (Remember, dataConWrapId can return either the wrapper or the worker.)
276 idDataCon id = case globalIdDetails id of
277 DataConWorkId con -> con
278 DataConWrapId con -> con
279 other -> pprPanic "idDataCon" (ppr id)
282 -- hasNoBinding returns True of an Id which may not have a
283 -- binding, even though it is defined in this module.
284 -- Data constructor workers used to be things of this kind, but
285 -- they aren't any more. Instead, we inject a binding for
286 -- them at the CorePrep stage.
287 -- EXCEPT: unboxed tuples, which definitely have no binding
288 hasNoBinding id = case globalIdDetails id of
291 DataConWorkId dc -> isUnboxedTupleCon dc
294 isImplicitId :: Id -> Bool
295 -- isImplicitId tells whether an Id's info is implied by other
296 -- declarations, so we don't need to put its signature in an interface
297 -- file, even if it's mentioned in some other interface unfolding.
299 = case globalIdDetails id of
300 RecordSelId _ _ -> True
304 DataConWorkId _ -> True
305 DataConWrapId _ -> True
306 -- These are are implied by their type or class decl;
307 -- remember that all type and class decls appear in the interface file.
308 -- The dfun id is not an implicit Id; it must *not* be omitted, because
309 -- it carries version info for the instance decl
312 idIsFrom :: Module -> Id -> Bool
313 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
317 isDeadBinder :: Id -> Bool
318 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
319 | otherwise = False -- TyVars count as not dead
323 %************************************************************************
325 \subsection{IdInfo stuff}
327 %************************************************************************
330 ---------------------------------
332 idArity :: Id -> Arity
333 idArity id = arityInfo (idInfo id)
335 setIdArity :: Id -> Arity -> Id
336 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
338 #ifdef OLD_STRICTNESS
339 ---------------------------------
341 idStrictness :: Id -> StrictnessInfo
342 idStrictness id = strictnessInfo (idInfo id)
344 setIdStrictness :: Id -> StrictnessInfo -> Id
345 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
348 -- isBottomingId returns true if an application to n args would diverge
349 isBottomingId :: Id -> Bool
350 isBottomingId id = isBottomingSig (idNewStrictness id)
352 idNewStrictness_maybe :: Id -> Maybe StrictSig
353 idNewStrictness :: Id -> StrictSig
355 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
356 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
358 setIdNewStrictness :: Id -> StrictSig -> Id
359 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
361 zapIdNewStrictness :: Id -> Id
362 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
364 ---------------------------------
366 idWorkerInfo :: Id -> WorkerInfo
367 idWorkerInfo id = workerInfo (idInfo id)
369 setIdWorkerInfo :: Id -> WorkerInfo -> Id
370 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
372 ---------------------------------
374 idUnfolding :: Id -> Unfolding
375 idUnfolding id = unfoldingInfo (idInfo id)
377 setIdUnfolding :: Id -> Unfolding -> Id
378 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
380 #ifdef OLD_STRICTNESS
381 ---------------------------------
383 idDemandInfo :: Id -> Demand.Demand
384 idDemandInfo id = demandInfo (idInfo id)
386 setIdDemandInfo :: Id -> Demand.Demand -> Id
387 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
390 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
391 idNewDemandInfo :: Id -> NewDemand.Demand
393 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
394 idNewDemandInfo id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
396 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
397 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
399 ---------------------------------
401 idSpecialisation :: Id -> SpecInfo
402 idSpecialisation id = specInfo (idInfo id)
404 idCoreRules :: Id -> [CoreRule]
405 idCoreRules id = specInfoRules (idSpecialisation id)
407 setIdSpecialisation :: Id -> SpecInfo -> Id
408 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
410 ---------------------------------
412 idCafInfo :: Id -> CafInfo
413 #ifdef OLD_STRICTNESS
414 idCafInfo id = case cgInfo (idInfo id) of
415 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
416 info -> cgCafInfo info
418 idCafInfo id = cafInfo (idInfo id)
421 setIdCafInfo :: Id -> CafInfo -> Id
422 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
424 ---------------------------------
426 #ifdef OLD_STRICTNESS
427 idCprInfo :: Id -> CprInfo
428 idCprInfo id = cprInfo (idInfo id)
430 setIdCprInfo :: Id -> CprInfo -> Id
431 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
434 ---------------------------------
436 idOccInfo :: Id -> OccInfo
437 idOccInfo id = occInfo (idInfo id)
439 setIdOccInfo :: Id -> OccInfo -> Id
440 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
444 ---------------------------------
446 The inline pragma tells us to be very keen to inline this Id, but it's still
447 OK not to if optimisation is switched off.
450 idInlinePragma :: Id -> InlinePragInfo
451 idInlinePragma id = inlinePragInfo (idInfo id)
453 setInlinePragma :: Id -> InlinePragInfo -> Id
454 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
456 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
457 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
461 ---------------------------------
464 idLBVarInfo :: Id -> LBVarInfo
465 idLBVarInfo id = lbvarInfo (idInfo id)
467 isOneShotBndr :: Id -> Bool
468 -- This one is the "business end", called externally.
469 -- Its main purpose is to encapsulate the Horrible State Hack
470 isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
472 isStateHackType :: Type -> Bool
477 = case splitTyConApp_maybe ty of
478 Just (tycon,_) -> tycon == statePrimTyCon
480 -- This is a gross hack. It claims that
481 -- every function over realWorldStatePrimTy is a one-shot
482 -- function. This is pretty true in practice, and makes a big
483 -- difference. For example, consider
484 -- a `thenST` \ r -> ...E...
485 -- The early full laziness pass, if it doesn't know that r is one-shot
486 -- will pull out E (let's say it doesn't mention r) to give
487 -- let lvl = E in a `thenST` \ r -> ...lvl...
488 -- When `thenST` gets inlined, we end up with
489 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
490 -- and we don't re-inline E.
492 -- It would be better to spot that r was one-shot to start with, but
493 -- I don't want to rely on that.
495 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
496 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
499 -- The OneShotLambda functions simply fiddle with the IdInfo flag
500 isOneShotLambda :: Id -> Bool
501 isOneShotLambda id = case idLBVarInfo id of
502 IsOneShotLambda -> True
505 setOneShotLambda :: Id -> Id
506 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
508 clearOneShotLambda :: Id -> Id
509 clearOneShotLambda id
510 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
513 -- But watch out: this may change the type of something else
515 -- If we change the one-shot-ness of x, f's type changes
519 zapLamIdInfo :: Id -> Id
520 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
522 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id