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, 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, isDataConId_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, idHasRules,
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, mkInternalName, getOccName,
110 import Module ( Module )
111 import OccName ( mkWorkerOcc )
112 import Maybes ( orElse )
113 import SrcLoc ( SrcLoc )
115 import Unique ( Unique, mkBuiltinUnique )
116 import FastString ( FastString )
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 mkSysLocal :: FastString -> Unique -> Type -> Id
164 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
167 -- UserLocal: an Id with a name the user might recognize...
168 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
169 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
171 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
172 mkVanillaGlobal = mkGlobalId VanillaGlobal
175 Make some local @Ids@ for a template @CoreExpr@. These have bogus
176 @Uniques@, but that's OK because the templates are supposed to be
177 instantiated before use.
180 -- "Wild Id" typically used when you need a binder that you don't expect to use
181 mkWildId :: Type -> Id
182 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
184 mkWorkerId :: Unique -> Id -> Type -> Id
185 -- A worker gets a local name. CoreTidy will externalise it if necessary.
186 mkWorkerId uniq unwrkr ty
187 = mkLocalId wkr_name ty
189 wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
191 -- "Template locals" typically used in unfoldings
192 mkTemplateLocals :: [Type] -> [Id]
193 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
195 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
196 -- The Int gives the starting point for unique allocation
197 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
199 mkTemplateLocal :: Int -> Type -> Id
200 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
204 %************************************************************************
206 \subsection[Id-general-funs]{General @Id@-related functions}
208 %************************************************************************
211 setIdType :: Id -> Type -> Id
212 -- Add free tyvar info to the type
213 setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
215 idPrimRep :: Id -> PrimRep
216 idPrimRep id = typePrimRep (idType id)
220 %************************************************************************
222 \subsection{Special Ids}
224 %************************************************************************
227 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
228 recordSelectorFieldLabel id = case globalIdDetails id of
229 RecordSelId tycon lbl _ -> (tycon,lbl)
230 other -> panic "recordSelectorFieldLabel"
232 isRecordSelector id = case globalIdDetails id of
233 RecordSelId {} -> True
236 isNaughtyRecordSelector id = case globalIdDetails id of
237 RecordSelId { sel_naughty = n } -> n
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 isDataConId_maybe :: Id -> Maybe DataCon
269 isDataConId_maybe id = case globalIdDetails id of
270 DataConWorkId con -> Just con
271 DataConWrapId con -> Just con
274 idDataCon :: Id -> DataCon
275 -- Get from either the worker or the wrapper to the DataCon
276 -- Currently used only in the desugarer
277 -- INVARIANT: idDataCon (dataConWrapId d) = d
278 -- (Remember, dataConWrapId can return either the wrapper or the worker.)
279 idDataCon id = case globalIdDetails id of
280 DataConWorkId con -> con
281 DataConWrapId con -> con
282 other -> pprPanic "idDataCon" (ppr id)
285 isDictId :: Id -> Bool
286 isDictId id = isDictTy (idType id)
288 -- hasNoBinding returns True of an Id which may not have a
289 -- binding, even though it is defined in this module.
290 -- Data constructor workers used to be things of this kind, but
291 -- they aren't any more. Instead, we inject a binding for
292 -- them at the CorePrep stage.
293 -- EXCEPT: unboxed tuples, which definitely have no binding
294 hasNoBinding id = case globalIdDetails id of
297 DataConWorkId dc -> isUnboxedTupleCon dc
300 isImplicitId :: Id -> Bool
301 -- isImplicitId tells whether an Id's info is implied by other
302 -- declarations, so we don't need to put its signature in an interface
303 -- file, even if it's mentioned in some other interface unfolding.
305 = case globalIdDetails id of
306 RecordSelId {} -> True
310 DataConWorkId _ -> True
311 DataConWrapId _ -> True
312 -- These are are implied by their type or class decl;
313 -- remember that all type and class decls appear in the interface file.
314 -- The dfun id is not an implicit Id; it must *not* be omitted, because
315 -- it carries version info for the instance decl
318 idIsFrom :: Module -> Id -> Bool
319 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
323 isDeadBinder :: Id -> Bool
324 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
325 | otherwise = False -- TyVars count as not dead
329 %************************************************************************
331 \subsection{IdInfo stuff}
333 %************************************************************************
336 ---------------------------------
338 idArity :: Id -> Arity
339 idArity id = arityInfo (idInfo id)
341 setIdArity :: Id -> Arity -> Id
342 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
344 #ifdef OLD_STRICTNESS
345 ---------------------------------
347 idStrictness :: Id -> StrictnessInfo
348 idStrictness id = strictnessInfo (idInfo id)
350 setIdStrictness :: Id -> StrictnessInfo -> Id
351 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
354 -- isBottomingId returns true if an application to n args would diverge
355 isBottomingId :: Id -> Bool
356 isBottomingId id = isBottomingSig (idNewStrictness id)
358 idNewStrictness_maybe :: Id -> Maybe StrictSig
359 idNewStrictness :: Id -> StrictSig
361 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
362 idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
364 setIdNewStrictness :: Id -> StrictSig -> Id
365 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
367 zapIdNewStrictness :: Id -> Id
368 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
370 ---------------------------------
372 idWorkerInfo :: Id -> WorkerInfo
373 idWorkerInfo id = workerInfo (idInfo id)
375 setIdWorkerInfo :: Id -> WorkerInfo -> Id
376 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
378 ---------------------------------
380 idUnfolding :: Id -> Unfolding
381 idUnfolding id = unfoldingInfo (idInfo id)
383 setIdUnfolding :: Id -> Unfolding -> Id
384 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
386 #ifdef OLD_STRICTNESS
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
396 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
397 idNewDemandInfo :: Id -> NewDemand.Demand
399 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
400 idNewDemandInfo id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
402 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
403 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
405 ---------------------------------
407 idSpecialisation :: Id -> SpecInfo
408 idSpecialisation id = specInfo (idInfo id)
410 idCoreRules :: Id -> [CoreRule]
411 idCoreRules id = specInfoRules (idSpecialisation id)
413 idHasRules :: Id -> Bool
414 idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
416 setIdSpecialisation :: Id -> SpecInfo -> Id
417 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
419 ---------------------------------
421 idCafInfo :: Id -> CafInfo
422 #ifdef OLD_STRICTNESS
423 idCafInfo id = case cgInfo (idInfo id) of
424 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
425 info -> cgCafInfo info
427 idCafInfo id = cafInfo (idInfo id)
430 setIdCafInfo :: Id -> CafInfo -> Id
431 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
433 ---------------------------------
435 #ifdef OLD_STRICTNESS
436 idCprInfo :: Id -> CprInfo
437 idCprInfo id = cprInfo (idInfo id)
439 setIdCprInfo :: Id -> CprInfo -> Id
440 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
443 ---------------------------------
445 idOccInfo :: Id -> OccInfo
446 idOccInfo id = occInfo (idInfo id)
448 setIdOccInfo :: Id -> OccInfo -> Id
449 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
453 ---------------------------------
455 The inline pragma tells us to be very keen to inline this Id, but it's still
456 OK not to if optimisation is switched off.
459 idInlinePragma :: Id -> InlinePragInfo
460 idInlinePragma id = inlinePragInfo (idInfo id)
462 setInlinePragma :: Id -> InlinePragInfo -> Id
463 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
465 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
466 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
470 ---------------------------------
473 idLBVarInfo :: Id -> LBVarInfo
474 idLBVarInfo id = lbvarInfo (idInfo id)
476 isOneShotBndr :: Id -> Bool
477 -- This one is the "business end", called externally.
478 -- Its main purpose is to encapsulate the Horrible State Hack
479 isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
481 isStateHackType :: Type -> Bool
486 = case splitTyConApp_maybe ty of
487 Just (tycon,_) -> tycon == statePrimTyCon
489 -- This is a gross hack. It claims that
490 -- every function over realWorldStatePrimTy is a one-shot
491 -- function. This is pretty true in practice, and makes a big
492 -- difference. For example, consider
493 -- a `thenST` \ r -> ...E...
494 -- The early full laziness pass, if it doesn't know that r is one-shot
495 -- will pull out E (let's say it doesn't mention r) to give
496 -- let lvl = E in a `thenST` \ r -> ...lvl...
497 -- When `thenST` gets inlined, we end up with
498 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
499 -- and we don't re-inline E.
501 -- It would be better to spot that r was one-shot to start with, but
502 -- I don't want to rely on that.
504 -- Another good example is in fill_in in PrelPack.lhs. We should be able to
505 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
508 -- The OneShotLambda functions simply fiddle with the IdInfo flag
509 isOneShotLambda :: Id -> Bool
510 isOneShotLambda id = case idLBVarInfo id of
511 IsOneShotLambda -> True
514 setOneShotLambda :: Id -> Id
515 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
517 clearOneShotLambda :: Id -> Id
518 clearOneShotLambda id
519 | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
522 -- But watch out: this may change the type of something else
524 -- If we change the one-shot-ness of x, f's type changes
528 zapLamIdInfo :: Id -> Id
529 zapLamIdInfo id = maybeModifyIdInfo (zapLamInfo (idInfo id)) id
531 zapDemandIdInfo id = maybeModifyIdInfo (zapDemandInfo (idInfo id)) id