[project @ 2003-10-13 10:41:43 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[Id]{@Ids@: Value and constructor identifiers}
5
6 \begin{code}
7 module Id (
8         Id, DictId,
9
10         -- Simple construction
11         mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
12         mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
13         mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
14         mkWorkerId,
15
16         -- Taking an Id apart
17         idName, idType, idUnique, idInfo,
18         idPrimRep, isId, globalIdDetails,
19         recordSelectorFieldLabel,
20
21         -- Modifying an Id
22         setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
23         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
24         zapLamIdInfo, zapDemandIdInfo, 
25
26         -- Predicates
27         isImplicitId, isDeadBinder,
28         isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
29         isRecordSelector,
30         isPrimOpId, isPrimOpId_maybe, 
31         isFCallId, isFCallId_maybe,
32         isDataConWorkId, isDataConWorkId_maybe, 
33         isBottomingId, idIsFrom,
34         hasNoBinding, 
35
36         -- Inline pragma stuff
37         idInlinePragma, setInlinePragma, modifyInlinePragma, 
38
39
40         -- One shot lambda stuff
41         isOneShotLambda, setOneShotLambda, clearOneShotLambda,
42
43         -- IdInfo stuff
44         setIdUnfolding,
45         setIdArity,
46         setIdNewDemandInfo, 
47         setIdNewStrictness, zapIdNewStrictness,
48         setIdWorkerInfo,
49         setIdSpecialisation,
50         setIdCafInfo,
51         setIdOccInfo,
52
53 #ifdef OLD_STRICTNESS
54         idDemandInfo, 
55         idStrictness, 
56         idCprInfo,
57         setIdStrictness, 
58         setIdDemandInfo, 
59         setIdCprInfo,
60 #endif
61
62         idArity, 
63         idNewDemandInfo, idNewDemandInfo_maybe,
64         idNewStrictness, idNewStrictness_maybe, 
65         idWorkerInfo,
66         idUnfolding,
67         idSpecialisation, idCoreRules,
68         idCafInfo,
69         idLBVarInfo,
70         idOccInfo,
71
72 #ifdef OLD_STRICTNESS
73         newStrictnessFromOld    -- Temporary
74 #endif
75
76     ) where
77
78 #include "HsVersions.h"
79
80
81 import CoreSyn          ( Unfolding, CoreRules, IdCoreRule, rulesRules )
82 import BasicTypes       ( Arity )
83 import Var              ( Id, DictId,
84                           isId, isExportedId, isSpecPragmaId, isLocalId,
85                           idName, idType, idUnique, idInfo, isGlobalId,
86                           setIdName, setVarType, setIdUnique, setIdLocalExported,
87                           setIdInfo, lazySetIdInfo, modifyIdInfo, 
88                           maybeModifyIdInfo,
89                           globalIdDetails, setGlobalIdDetails
90                         )
91 import qualified Var    ( mkLocalId, mkGlobalId, mkSpecPragmaId )
92 import Type             ( Type, typePrimRep, addFreeTyVars, seqType)
93
94 import IdInfo 
95
96 #ifdef OLD_STRICTNESS
97 import qualified Demand ( Demand )
98 #endif
99 import DataCon          ( isUnboxedTupleCon )
100 import NewDemand        ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
101 import Name             ( Name, OccName, nameIsLocalOrFrom, 
102                           mkSystemName, mkSystemNameEncoded, mkInternalName,
103                           getOccName, getSrcLoc
104                         ) 
105 import Module           ( Module )
106 import OccName          ( EncodedFS, mkWorkerOcc )
107 import PrimRep          ( PrimRep )
108 import FieldLabel       ( FieldLabel )
109 import Maybes           ( orElse )
110 import SrcLoc           ( SrcLoc )
111 import Outputable
112 import Unique           ( Unique, mkBuiltinUnique )
113
114 -- infixl so you can say (id `set` a `set` b)
115 infixl  1 `setIdUnfolding`,
116           `setIdArity`,
117           `setIdNewDemandInfo`,
118           `setIdNewStrictness`,
119           `setIdWorkerInfo`,
120           `setIdSpecialisation`,
121           `setInlinePragma`,
122           `idCafInfo`
123 #ifdef OLD_STRICTNESS
124           ,`idCprInfo`
125           ,`setIdStrictness`
126           ,`setIdDemandInfo`
127 #endif
128 \end{code}
129
130
131
132 %************************************************************************
133 %*                                                                      *
134 \subsection{Simple Id construction}
135 %*                                                                      *
136 %************************************************************************
137
138 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
139 but in addition it pins free-tyvar-info onto the Id's type, 
140 where it can easily be found.
141
142 \begin{code}
143 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
144 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
145
146 mkSpecPragmaId :: Name -> Type -> Id
147 mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
148
149 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
150 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
151 \end{code}
152
153 \begin{code}
154 mkLocalId :: Name -> Type -> Id
155 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
156
157 -- SysLocal: for an Id being created by the compiler out of thin air...
158 -- UserLocal: an Id with a name the user might recognize...
159 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
160 mkSysLocal  :: EncodedFS  -> Unique -> Type -> Id
161 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
162
163 -- for SysLocal, we assume the base name is already encoded, to avoid
164 -- re-encoding the same string over and over again.
165 mkSysLocal          fs uniq ty = mkLocalId (mkSystemNameEncoded uniq fs) ty
166
167 -- version to use when the faststring needs to be encoded
168 mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName uniq fs)        ty
169
170 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
171 mkVanillaGlobal             = mkGlobalId VanillaGlobal
172 \end{code}
173
174 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
175 @Uniques@, but that's OK because the templates are supposed to be
176 instantiated before use.
177  
178 \begin{code}
179 -- "Wild Id" typically used when you need a binder that you don't expect to use
180 mkWildId :: Type -> Id
181 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
182
183 mkWorkerId :: Unique -> Id -> Type -> Id
184 -- A worker gets a local name.  CoreTidy will externalise it if necessary.
185 mkWorkerId uniq unwrkr ty
186   = mkLocalId wkr_name ty
187   where
188     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
189
190 -- "Template locals" typically used in unfoldings
191 mkTemplateLocals :: [Type] -> [Id]
192 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
193
194 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
195 -- The Int gives the starting point for unique allocation
196 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
197
198 mkTemplateLocal :: Int -> Type -> Id
199 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
200 \end{code}
201
202
203 %************************************************************************
204 %*                                                                      *
205 \subsection[Id-general-funs]{General @Id@-related functions}
206 %*                                                                      *
207 %************************************************************************
208
209 \begin{code}
210 setIdType :: Id -> Type -> Id
211         -- Add free tyvar info to the type
212 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
213
214 idPrimRep :: Id -> PrimRep
215 idPrimRep id = typePrimRep (idType id)
216 \end{code}
217
218
219 %************************************************************************
220 %*                                                                      *
221 \subsection{Special Ids}
222 %*                                                                      *
223 %************************************************************************
224
225 The @SpecPragmaId@ exists only to make Ids that are
226 on the *LHS* of bindings created by SPECIALISE pragmas; 
227 eg:             s = f Int d
228 The SpecPragmaId is never itself mentioned; it
229 exists solely so that the specialiser will find
230 the call to f, and make specialised version of it.
231 The SpecPragmaId binding is discarded by the specialiser
232 when it gathers up overloaded calls.
233 Meanwhile, it is not discarded as dead code.
234
235
236 \begin{code}
237 recordSelectorFieldLabel :: Id -> FieldLabel
238 recordSelectorFieldLabel id = case globalIdDetails id of
239                                  RecordSelId lbl -> lbl
240                                  other -> panic "recordSelectorFieldLabel"
241
242 isRecordSelector id = case globalIdDetails id of
243                         RecordSelId lbl -> True
244                         other           -> False
245
246 isPrimOpId id = case globalIdDetails id of
247                     PrimOpId op -> True
248                     other       -> False
249
250 isPrimOpId_maybe id = case globalIdDetails id of
251                             PrimOpId op -> Just op
252                             other       -> Nothing
253
254 isFCallId id = case globalIdDetails id of
255                     FCallId call -> True
256                     other        -> False
257
258 isFCallId_maybe id = case globalIdDetails id of
259                             FCallId call -> Just call
260                             other        -> Nothing
261
262 isDataConWorkId id = case globalIdDetails id of
263                         DataConWorkId _ -> True
264                         other           -> False
265
266 isDataConWorkId_maybe id = case globalIdDetails id of
267                           DataConWorkId con -> Just con
268                           other             -> Nothing
269
270 -- hasNoBinding returns True of an Id which may not have a
271 -- binding, even though it is defined in this module.  
272 -- Data constructor workers used to be things of this kind, but
273 -- they aren't any more.  Instead, we inject a binding for 
274 -- them at the CorePrep stage. 
275 -- EXCEPT: unboxed tuples, which definitely have no binding
276 hasNoBinding id = case globalIdDetails id of
277                         PrimOpId _       -> True
278                         FCallId _        -> True
279                         DataConWorkId dc -> isUnboxedTupleCon dc
280                         other            -> False
281
282 isImplicitId :: Id -> Bool
283         -- isImplicitId tells whether an Id's info is implied by other
284         -- declarations, so we don't need to put its signature in an interface
285         -- file, even if it's mentioned in some other interface unfolding.
286 isImplicitId id
287   = case globalIdDetails id of
288         RecordSelId _   -> True
289         FCallId _       -> True
290         PrimOpId _      -> True
291         ClassOpId _     -> True
292         DataConWorkId _ -> True
293         DataConWrapId _ -> True
294                 -- These are are implied by their type or class decl;
295                 -- remember that all type and class decls appear in the interface file.
296                 -- The dfun id is not an implicit Id; it must *not* be omitted, because 
297                 -- it carries version info for the instance decl
298         other           -> False
299
300 idIsFrom :: Module -> Id -> Bool
301 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
302 \end{code}
303
304 \begin{code}
305 isDeadBinder :: Id -> Bool
306 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
307                   | otherwise = False   -- TyVars count as not dead
308 \end{code}
309
310
311 %************************************************************************
312 %*                                                                      *
313 \subsection{IdInfo stuff}
314 %*                                                                      *
315 %************************************************************************
316
317 \begin{code}
318         ---------------------------------
319         -- ARITY
320 idArity :: Id -> Arity
321 idArity id = arityInfo (idInfo id)
322
323 setIdArity :: Id -> Arity -> Id
324 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
325
326 #ifdef OLD_STRICTNESS
327         ---------------------------------
328         -- (OLD) STRICTNESS 
329 idStrictness :: Id -> StrictnessInfo
330 idStrictness id = strictnessInfo (idInfo id)
331
332 setIdStrictness :: Id -> StrictnessInfo -> Id
333 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
334 #endif
335
336 -- isBottomingId returns true if an application to n args would diverge
337 isBottomingId :: Id -> Bool
338 isBottomingId id = isBottomingSig (idNewStrictness id)
339
340 idNewStrictness_maybe :: Id -> Maybe StrictSig
341 idNewStrictness :: Id -> StrictSig
342
343 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
344 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
345
346 setIdNewStrictness :: Id -> StrictSig -> Id
347 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
348
349 zapIdNewStrictness :: Id -> Id
350 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
351
352         ---------------------------------
353         -- WORKER ID
354 idWorkerInfo :: Id -> WorkerInfo
355 idWorkerInfo id = workerInfo (idInfo id)
356
357 setIdWorkerInfo :: Id -> WorkerInfo -> Id
358 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
359
360         ---------------------------------
361         -- UNFOLDING
362 idUnfolding :: Id -> Unfolding
363 idUnfolding id = unfoldingInfo (idInfo id)
364
365 setIdUnfolding :: Id -> Unfolding -> Id
366 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
367
368 #ifdef OLD_STRICTNESS
369         ---------------------------------
370         -- (OLD) DEMAND
371 idDemandInfo :: Id -> Demand.Demand
372 idDemandInfo id = demandInfo (idInfo id)
373
374 setIdDemandInfo :: Id -> Demand.Demand -> Id
375 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
376 #endif
377
378 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
379 idNewDemandInfo       :: Id -> NewDemand.Demand
380
381 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
382 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
383
384 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
385 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
386
387         ---------------------------------
388         -- SPECIALISATION
389 idSpecialisation :: Id -> CoreRules
390 idSpecialisation id = specInfo (idInfo id)
391
392 idCoreRules :: Id -> [IdCoreRule]
393 idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]
394
395 setIdSpecialisation :: Id -> CoreRules -> Id
396 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
397
398         ---------------------------------
399         -- CAF INFO
400 idCafInfo :: Id -> CafInfo
401 #ifdef OLD_STRICTNESS
402 idCafInfo id = case cgInfo (idInfo id) of
403                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
404                   info     -> cgCafInfo info
405 #else
406 idCafInfo id = cafInfo (idInfo id)
407 #endif
408
409 setIdCafInfo :: Id -> CafInfo -> Id
410 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
411
412         ---------------------------------
413         -- CPR INFO
414 #ifdef OLD_STRICTNESS
415 idCprInfo :: Id -> CprInfo
416 idCprInfo id = cprInfo (idInfo id)
417
418 setIdCprInfo :: Id -> CprInfo -> Id
419 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
420 #endif
421
422         ---------------------------------
423         -- Occcurrence INFO
424 idOccInfo :: Id -> OccInfo
425 idOccInfo id = occInfo (idInfo id)
426
427 setIdOccInfo :: Id -> OccInfo -> Id
428 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
429 \end{code}
430
431
432         ---------------------------------
433         -- INLINING
434 The inline pragma tells us to be very keen to inline this Id, but it's still
435 OK not to if optimisation is switched off.
436
437 \begin{code}
438 idInlinePragma :: Id -> InlinePragInfo
439 idInlinePragma id = inlinePragInfo (idInfo id)
440
441 setInlinePragma :: Id -> InlinePragInfo -> Id
442 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
443
444 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
445 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
446 \end{code}
447
448
449         ---------------------------------
450         -- ONE-SHOT LAMBDAS
451 \begin{code}
452 idLBVarInfo :: Id -> LBVarInfo
453 idLBVarInfo id = lbvarInfo (idInfo id)
454
455 isOneShotLambda :: Id -> Bool
456 isOneShotLambda id = case idLBVarInfo id of
457                        IsOneShotLambda  -> True
458                        NoLBVarInfo      -> False
459
460 setOneShotLambda :: Id -> Id
461 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
462
463 clearOneShotLambda :: Id -> Id
464 clearOneShotLambda id 
465   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
466   | otherwise          = id                     
467
468 -- But watch out: this may change the type of something else
469 --      f = \x -> e
470 -- If we change the one-shot-ness of x, f's type changes
471 \end{code}
472
473 \begin{code}
474 zapLamIdInfo :: Id -> Id
475 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
476
477 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
478 \end{code}
479