0d15b20f22c750da90563caf1686279fc8ef4de3
[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, mkLocalIdWithInfo, 
12         mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
13         mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
14         mkWorkerId, mkExportedLocalId,
15
16         -- Taking an Id apart
17         idName, idType, idUnique, idInfo,
18         isId, globalIdDetails, idPrimRep,
19         recordSelectorFieldLabel,
20
21         -- Modifying an Id
22         setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, 
23         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
24         zapLamIdInfo, zapDemandIdInfo, 
25
26         -- Predicates
27         isImplicitId, isDeadBinder, isDictId,
28         isExportedId, isLocalId, isGlobalId,
29         isRecordSelector, isNaughtyRecordSelector,
30         isClassOpId_maybe,
31         isPrimOpId, isPrimOpId_maybe, 
32         isFCallId, isFCallId_maybe,
33         isDataConWorkId, isDataConWorkId_maybe, idDataCon,
34         isBottomingId, idIsFrom,
35         hasNoBinding, 
36
37         -- Inline pragma stuff
38         idInlinePragma, setInlinePragma, modifyInlinePragma, 
39
40
41         -- One shot lambda stuff
42         isOneShotBndr, isOneShotLambda, isStateHackType,
43         setOneShotLambda, clearOneShotLambda,
44
45         -- IdInfo stuff
46         setIdUnfolding,
47         setIdArity,
48         setIdNewDemandInfo, 
49         setIdNewStrictness, zapIdNewStrictness,
50         setIdWorkerInfo,
51         setIdSpecialisation,
52         setIdCafInfo,
53         setIdOccInfo,
54
55 #ifdef OLD_STRICTNESS
56         idDemandInfo, 
57         idStrictness, 
58         idCprInfo,
59         setIdStrictness, 
60         setIdDemandInfo, 
61         setIdCprInfo,
62 #endif
63
64         idArity, 
65         idNewDemandInfo, idNewDemandInfo_maybe,
66         idNewStrictness, idNewStrictness_maybe, 
67         idWorkerInfo,
68         idUnfolding,
69         idSpecialisation, idCoreRules,
70         idCafInfo,
71         idLBVarInfo,
72         idOccInfo,
73
74 #ifdef OLD_STRICTNESS
75         newStrictnessFromOld    -- Temporary
76 #endif
77
78     ) where
79
80 #include "HsVersions.h"
81
82
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, 
91                           maybeModifyIdInfo,
92                           globalIdDetails
93                         )
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 )
100 import IdInfo 
101
102 #ifdef OLD_STRICTNESS
103 import qualified Demand ( Demand )
104 #endif
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
110                         ) 
111 import Module           ( Module )
112 import OccName          ( EncodedFS, mkWorkerOcc )
113 import Maybes           ( orElse )
114 import SrcLoc           ( SrcLoc )
115 import Outputable
116 import Unique           ( Unique, mkBuiltinUnique )
117 import StaticFlags      ( opt_NoStateHack )
118
119 -- infixl so you can say (id `set` a `set` b)
120 infixl  1 `setIdUnfolding`,
121           `setIdArity`,
122           `setIdNewDemandInfo`,
123           `setIdNewStrictness`,
124           `setIdWorkerInfo`,
125           `setIdSpecialisation`,
126           `setInlinePragma`,
127           `idCafInfo`
128 #ifdef OLD_STRICTNESS
129           ,`idCprInfo`
130           ,`setIdStrictness`
131           ,`setIdDemandInfo`
132 #endif
133 \end{code}
134
135
136
137 %************************************************************************
138 %*                                                                      *
139 \subsection{Simple Id construction}
140 %*                                                                      *
141 %************************************************************************
142
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.
146
147 \begin{code}
148 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
149 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
150
151 mkExportedLocalId :: Name -> Type -> Id
152 mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
153
154 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
155 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
156 \end{code}
157
158 \begin{code}
159 mkLocalId :: Name -> Type -> Id
160 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
161
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
167
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
171
172 -- version to use when the faststring needs to be encoded
173 mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemVarName uniq fs)  ty
174
175 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
176 mkVanillaGlobal             = mkGlobalId VanillaGlobal
177 \end{code}
178
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.
182  
183 \begin{code}
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
187
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
192   where
193     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
194
195 -- "Template locals" typically used in unfoldings
196 mkTemplateLocals :: [Type] -> [Id]
197 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
198
199 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
200 -- The Int gives the starting point for unique allocation
201 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
202
203 mkTemplateLocal :: Int -> Type -> Id
204 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
205 \end{code}
206
207
208 %************************************************************************
209 %*                                                                      *
210 \subsection[Id-general-funs]{General @Id@-related functions}
211 %*                                                                      *
212 %************************************************************************
213
214 \begin{code}
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)
218
219 idPrimRep :: Id -> PrimRep
220 idPrimRep id = typePrimRep (idType id)
221 \end{code}
222
223
224 %************************************************************************
225 %*                                                                      *
226 \subsection{Special Ids}
227 %*                                                                      *
228 %************************************************************************
229
230 \begin{code}
231 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
232 recordSelectorFieldLabel id = case globalIdDetails id of
233                                  RecordSelId tycon lbl _ -> (tycon,lbl)
234                                  other -> panic "recordSelectorFieldLabel"
235
236 isRecordSelector id = case globalIdDetails id of
237                         RecordSelId {}  -> True
238                         other           -> False
239
240 isNaughtyRecordSelector id = case globalIdDetails id of
241                         RecordSelId { sel_naughty = n } -> n
242                         other                           -> False
243
244 isClassOpId_maybe id = case globalIdDetails id of
245                         ClassOpId cls -> Just cls
246                         _other        -> Nothing
247
248 isPrimOpId id = case globalIdDetails id of
249                     PrimOpId op -> True
250                     other       -> False
251
252 isPrimOpId_maybe id = case globalIdDetails id of
253                             PrimOpId op -> Just op
254                             other       -> Nothing
255
256 isFCallId id = case globalIdDetails id of
257                     FCallId call -> True
258                     other        -> False
259
260 isFCallId_maybe id = case globalIdDetails id of
261                             FCallId call -> Just call
262                             other        -> Nothing
263
264 isDataConWorkId id = case globalIdDetails id of
265                         DataConWorkId _ -> True
266                         other           -> False
267
268 isDataConWorkId_maybe id = case globalIdDetails id of
269                           DataConWorkId con -> Just con
270                           other             -> Nothing
271
272 isDictId :: Id -> Bool
273 isDictId id = isDictTy (idType id)
274
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)
284
285
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
293                         PrimOpId _       -> True
294                         FCallId _        -> True
295                         DataConWorkId dc -> isUnboxedTupleCon dc
296                         other            -> False
297
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.
302 isImplicitId id
303   = case globalIdDetails id of
304         RecordSelId {}  -> True
305         FCallId _       -> True
306         PrimOpId _      -> True
307         ClassOpId _     -> 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
314         other           -> False
315
316 idIsFrom :: Module -> Id -> Bool
317 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
318 \end{code}
319
320 \begin{code}
321 isDeadBinder :: Id -> Bool
322 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
323                   | otherwise = False   -- TyVars count as not dead
324 \end{code}
325
326
327 %************************************************************************
328 %*                                                                      *
329 \subsection{IdInfo stuff}
330 %*                                                                      *
331 %************************************************************************
332
333 \begin{code}
334         ---------------------------------
335         -- ARITY
336 idArity :: Id -> Arity
337 idArity id = arityInfo (idInfo id)
338
339 setIdArity :: Id -> Arity -> Id
340 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
341
342 #ifdef OLD_STRICTNESS
343         ---------------------------------
344         -- (OLD) STRICTNESS 
345 idStrictness :: Id -> StrictnessInfo
346 idStrictness id = strictnessInfo (idInfo id)
347
348 setIdStrictness :: Id -> StrictnessInfo -> Id
349 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
350 #endif
351
352 -- isBottomingId returns true if an application to n args would diverge
353 isBottomingId :: Id -> Bool
354 isBottomingId id = isBottomingSig (idNewStrictness id)
355
356 idNewStrictness_maybe :: Id -> Maybe StrictSig
357 idNewStrictness :: Id -> StrictSig
358
359 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
360 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
361
362 setIdNewStrictness :: Id -> StrictSig -> Id
363 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
364
365 zapIdNewStrictness :: Id -> Id
366 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
367
368         ---------------------------------
369         -- WORKER ID
370 idWorkerInfo :: Id -> WorkerInfo
371 idWorkerInfo id = workerInfo (idInfo id)
372
373 setIdWorkerInfo :: Id -> WorkerInfo -> Id
374 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
375
376         ---------------------------------
377         -- UNFOLDING
378 idUnfolding :: Id -> Unfolding
379 idUnfolding id = unfoldingInfo (idInfo id)
380
381 setIdUnfolding :: Id -> Unfolding -> Id
382 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
383
384 #ifdef OLD_STRICTNESS
385         ---------------------------------
386         -- (OLD) DEMAND
387 idDemandInfo :: Id -> Demand.Demand
388 idDemandInfo id = demandInfo (idInfo id)
389
390 setIdDemandInfo :: Id -> Demand.Demand -> Id
391 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
392 #endif
393
394 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
395 idNewDemandInfo       :: Id -> NewDemand.Demand
396
397 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
398 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
399
400 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
401 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
402
403         ---------------------------------
404         -- SPECIALISATION
405 idSpecialisation :: Id -> SpecInfo
406 idSpecialisation id = specInfo (idInfo id)
407
408 idCoreRules :: Id -> [CoreRule]
409 idCoreRules id = specInfoRules (idSpecialisation id)
410
411 setIdSpecialisation :: Id -> SpecInfo -> Id
412 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
413
414         ---------------------------------
415         -- CAF INFO
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
421 #else
422 idCafInfo id = cafInfo (idInfo id)
423 #endif
424
425 setIdCafInfo :: Id -> CafInfo -> Id
426 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
427
428         ---------------------------------
429         -- CPR INFO
430 #ifdef OLD_STRICTNESS
431 idCprInfo :: Id -> CprInfo
432 idCprInfo id = cprInfo (idInfo id)
433
434 setIdCprInfo :: Id -> CprInfo -> Id
435 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
436 #endif
437
438         ---------------------------------
439         -- Occcurrence INFO
440 idOccInfo :: Id -> OccInfo
441 idOccInfo id = occInfo (idInfo id)
442
443 setIdOccInfo :: Id -> OccInfo -> Id
444 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
445 \end{code}
446
447
448         ---------------------------------
449         -- INLINING
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.
452
453 \begin{code}
454 idInlinePragma :: Id -> InlinePragInfo
455 idInlinePragma id = inlinePragInfo (idInfo id)
456
457 setInlinePragma :: Id -> InlinePragInfo -> Id
458 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
459
460 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
461 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
462 \end{code}
463
464
465         ---------------------------------
466         -- ONE-SHOT LAMBDAS
467 \begin{code}
468 idLBVarInfo :: Id -> LBVarInfo
469 idLBVarInfo id = lbvarInfo (idInfo id)
470
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))
475
476 isStateHackType :: Type -> Bool
477 isStateHackType ty
478   | opt_NoStateHack 
479   = False
480   | otherwise
481   = case splitTyConApp_maybe ty of
482         Just (tycon,_) -> tycon == statePrimTyCon
483         other          -> False
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.
495         --
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.
498         --
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.
501
502
503 -- The OneShotLambda functions simply fiddle with the IdInfo flag
504 isOneShotLambda :: Id -> Bool
505 isOneShotLambda id = case idLBVarInfo id of
506                        IsOneShotLambda  -> True
507                        NoLBVarInfo      -> False
508
509 setOneShotLambda :: Id -> Id
510 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
511
512 clearOneShotLambda :: Id -> Id
513 clearOneShotLambda id 
514   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
515   | otherwise          = id                     
516
517 -- But watch out: this may change the type of something else
518 --      f = \x -> e
519 -- If we change the one-shot-ness of x, f's type changes
520 \end{code}
521
522 \begin{code}
523 zapLamIdInfo :: Id -> Id
524 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
525
526 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
527 \end{code}
528