[project @ 2000-11-24 09:51:38 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         mkId, mkVanillaId, mkSysLocal, mkUserLocal,
12         mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
13
14         -- Taking an Id apart
15         idName, idType, idUnique, idInfo,
16         idPrimRep, isId,
17         recordSelectorFieldLabel,
18
19         -- Modifying an Id
20         setIdName, setIdUnique, setIdType, setIdNoDiscard, 
21         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
22         zapFragileIdInfo, zapLamIdInfo,
23
24         -- Predicates
25         omitIfaceSigForId, isDeadBinder,
26         externallyVisibleId,
27         isIP,
28         isSpecPragmaId, isRecordSelector,
29         isPrimOpId, isPrimOpId_maybe, 
30         isDataConId, isDataConId_maybe, isDataConWrapId, 
31                 isDataConWrapId_maybe,
32         isBottomingId,
33         isExportedId, isLocalId, 
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         setIdArityInfo,
46         setIdDemandInfo,
47         setIdStrictness,
48         setIdTyGenInfo,
49         setIdWorkerInfo,
50         setIdSpecialisation,
51         setIdCafInfo,
52         setIdCprInfo,
53         setIdOccInfo,
54
55         idArity, idArityInfo, 
56         idFlavour,
57         idDemandInfo,
58         idStrictness,
59         idTyGenInfo,
60         idWorkerInfo,
61         idUnfolding,
62         idSpecialisation,
63         idCafInfo,
64         idCprInfo,
65         idLBVarInfo,
66         idOccInfo,
67
68     ) where
69
70 #include "HsVersions.h"
71
72
73 import CoreSyn          ( Unfolding, CoreRules )
74 import BasicTypes       ( Arity )
75 import Var              ( Id, DictId,
76                           isId, mkIdVar,
77                           idName, idType, idUnique, idInfo,
78                           setIdName, setVarType, setIdUnique, 
79                           setIdInfo, lazySetIdInfo, modifyIdInfo, 
80                           maybeModifyIdInfo,
81                           externallyVisibleId
82                         )
83 import Type             ( Type, typePrimRep, addFreeTyVars, 
84                           usOnce, seqType, splitTyConApp_maybe )
85
86 import IdInfo 
87
88 import Demand           ( Demand )
89 import Name             ( Name, OccName,
90                           mkSysLocalName, mkLocalName,
91                           nameIsLocallyDefined,
92                           getOccName, isIPOcc
93                         ) 
94 import OccName          ( UserFS )
95 import PrimRep          ( PrimRep )
96 import TysPrim          ( statePrimTyCon )
97 import FieldLabel       ( FieldLabel )
98 import SrcLoc           ( SrcLoc )
99 import Unique           ( Unique, mkBuiltinUnique, getBuiltinUniques, 
100                           getNumBuiltinUniques )
101 import Outputable
102
103 infixl  1 `setIdUnfolding`,
104           `setIdArityInfo`,
105           `setIdDemandInfo`,
106           `setIdStrictness`,
107           `setIdTyGenInfo`,
108           `setIdWorkerInfo`,
109           `setIdSpecialisation`,
110           `setInlinePragma`,
111           `idCafInfo`,
112           `idCprInfo`
113
114         -- infixl so you can say (id `set` a `set` b)
115 \end{code}
116
117
118
119 %************************************************************************
120 %*                                                                      *
121 \subsection{Simple Id construction}
122 %*                                                                      *
123 %************************************************************************
124
125 Absolutely all Ids are made by mkId.  It 
126         a) Pins free-tyvar-info onto the Id's type, 
127            where it can easily be found.
128         b) Ensures that exported Ids are 
129
130 \begin{code}
131 mkId :: Name -> Type -> IdInfo -> Id
132 mkId name ty info = mkIdVar name (addFreeTyVars ty) info
133 \end{code}
134
135 \begin{code}
136 mkVanillaId :: Name -> Type -> Id
137 mkVanillaId name ty = mkId name ty vanillaIdInfo
138
139 -- SysLocal: for an Id being created by the compiler out of thin air...
140 -- UserLocal: an Id with a name the user might recognize...
141 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
142 mkSysLocal  :: UserFS  -> Unique -> Type -> Id
143
144 mkSysLocal  fs uniq ty      = mkVanillaId (mkSysLocalName uniq fs)      ty
145 mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName    uniq occ loc) ty
146 \end{code}
147
148 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
149 @Uniques@, but that's OK because the templates are supposed to be
150 instantiated before use.
151
152 \begin{code}
153 -- "Wild Id" typically used when you need a binder that you don't expect to use
154 mkWildId :: Type -> Id
155 mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
156
157 -- "Template locals" typically used in unfoldings
158 mkTemplateLocals :: [Type] -> [Id]
159 mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
160                                (getBuiltinUniques (length tys))
161                                tys
162
163 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
164 mkTemplateLocalsNum n tys = zipWith (mkSysLocal SLIT("tpl"))
165                                (getNumBuiltinUniques n (length tys))
166                                tys
167
168 mkTemplateLocal :: Int -> Type -> Id
169 mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
170 \end{code}
171
172
173 %************************************************************************
174 %*                                                                      *
175 \subsection[Id-general-funs]{General @Id@-related functions}
176 %*                                                                      *
177 %************************************************************************
178
179 \begin{code}
180 setIdType :: Id -> Type -> Id
181         -- Add free tyvar info to the type
182 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
183
184 idPrimRep :: Id -> PrimRep
185 idPrimRep id = typePrimRep (idType id)
186 \end{code}
187
188
189 %************************************************************************
190 %*                                                                      *
191 \subsection{Special Ids}
192 %*                                                                      *
193 %************************************************************************
194
195 \begin{code}
196 idFlavour :: Id -> IdFlavour
197 idFlavour id = flavourInfo (idInfo id)
198
199 setIdNoDiscard :: Id -> Id
200 setIdNoDiscard id       -- Make an Id into a NoDiscardId, unless it is already
201   = modifyIdInfo setNoDiscardInfo id
202
203 recordSelectorFieldLabel :: Id -> FieldLabel
204 recordSelectorFieldLabel id = case idFlavour id of
205                                 RecordSelId lbl -> lbl
206
207 isRecordSelector id = case idFlavour id of
208                         RecordSelId lbl -> True
209                         other           -> False
210
211 isPrimOpId id = case idFlavour id of
212                     PrimOpId op -> True
213                     other       -> False
214
215 isPrimOpId_maybe id = case idFlavour id of
216                             PrimOpId op -> Just op
217                             other       -> Nothing
218
219 isDataConId id = case idFlavour id of
220                         DataConId _ -> True
221                         other       -> False
222
223 isDataConId_maybe id = case idFlavour id of
224                           DataConId con -> Just con
225                           other         -> Nothing
226
227 isDataConWrapId_maybe id = case idFlavour id of
228                                   DataConWrapId con -> Just con
229                                   other             -> Nothing
230
231 isDataConWrapId id = case idFlavour id of
232                         DataConWrapId con -> True
233                         other             -> False
234
235 isSpecPragmaId id = case idFlavour id of
236                         SpecPragmaId -> True
237                         other        -> False
238
239 hasNoBinding id = case idFlavour id of
240                         DataConId _ -> True
241                         PrimOpId _  -> True
242                         other       -> False
243         -- hasNoBinding returns True of an Id which may not have a
244         -- binding, even though it is defined in this module.  Notably,
245         -- the constructors of a dictionary are in this situation.
246
247 -- Don't drop a binding for an exported Id,
248 -- if it otherwise looks dead.  
249 -- Perhaps a better name would be isDiscardableId
250 isExportedId :: Id -> Bool
251 isExportedId id = case idFlavour id of
252                         VanillaId  -> False
253                         other      -> True
254
255 isLocalId :: Id -> Bool
256 -- True of Ids that are locally defined, but are not constants
257 -- like data constructors, record selectors, and the like. 
258 -- See comments with CoreFVs.isLocalVar
259 isLocalId id 
260 #ifdef DEBUG
261   | not (isId id) = pprTrace "isLocalid" (ppr id) False
262   | otherwise
263 #endif
264   = case idFlavour id of
265          VanillaId    -> True
266          ExportedId   -> True
267          SpecPragmaId -> True
268          other        -> False
269 \end{code}
270
271
272 omitIfaceSigForId tells whether an Id's info is implied by other declarations,
273 so we don't need to put its signature in an interface file, even if it's mentioned
274 in some other interface unfolding.
275
276 \begin{code}
277 omitIfaceSigForId :: Id -> Bool
278 omitIfaceSigForId id
279   = ASSERT2( not (omit && nameIsLocallyDefined (idName id)
280                        && idTyGenInfo id /= TyGenNever),
281              ppr id )
282     -- mustn't omit type signature for a name whose type might change!
283     omit
284   where
285     omit = omitIfaceSigForId' id
286
287 omitIfaceSigForId' id
288   = case idFlavour id of
289         RecordSelId _   -> True -- Includes dictionary selectors
290         PrimOpId _      -> True
291         DataConId _     -> True
292         DataConWrapId _ -> True
293                 -- These are are implied by their type or class decl;
294                 -- remember that all type and class decls appear in the interface file.
295                 -- The dfun id must *not* be omitted, because it carries version info for
296                 -- the instance decl
297
298         other          -> False -- Don't omit!
299 \end{code}
300
301 \begin{code}
302 isDeadBinder :: Id -> Bool
303 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
304                   | otherwise = False   -- TyVars count as not dead
305
306 isIP id = isIPOcc (getOccName id)
307 \end{code}
308
309
310 %************************************************************************
311 %*                                                                      *
312 \subsection{IdInfo stuff}
313 %*                                                                      *
314 %************************************************************************
315
316 \begin{code}
317         ---------------------------------
318         -- ARITY
319 idArityInfo :: Id -> ArityInfo
320 idArityInfo id = arityInfo (idInfo id)
321
322 idArity :: Id -> Arity
323 idArity id = arityLowerBound (idArityInfo id)
324
325 setIdArityInfo :: Id -> ArityInfo -> Id
326 setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
327
328         ---------------------------------
329         -- STRICTNESS
330 idStrictness :: Id -> StrictnessInfo
331 idStrictness id = strictnessInfo (idInfo id)
332
333 setIdStrictness :: Id -> StrictnessInfo -> Id
334 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
335
336 -- isBottomingId returns true if an application to n args would diverge
337 isBottomingId :: Id -> Bool
338 isBottomingId id = isBottomingStrictness (idStrictness id)
339
340         ---------------------------------
341         -- TYPE GENERALISATION
342 idTyGenInfo :: Id -> TyGenInfo
343 idTyGenInfo id = tyGenInfo (idInfo id)
344
345 setIdTyGenInfo :: Id -> TyGenInfo -> Id
346 setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
347
348         ---------------------------------
349         -- WORKER ID
350 idWorkerInfo :: Id -> WorkerInfo
351 idWorkerInfo id = workerInfo (idInfo id)
352
353 setIdWorkerInfo :: Id -> WorkerInfo -> Id
354 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
355
356         ---------------------------------
357         -- UNFOLDING
358 idUnfolding :: Id -> Unfolding
359 idUnfolding id = unfoldingInfo (idInfo id)
360
361 setIdUnfolding :: Id -> Unfolding -> Id
362 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
363
364         ---------------------------------
365         -- DEMAND
366 idDemandInfo :: Id -> Demand
367 idDemandInfo id = demandInfo (idInfo id)
368
369 setIdDemandInfo :: Id -> Demand -> Id
370 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
371
372         ---------------------------------
373         -- SPECIALISATION
374 idSpecialisation :: Id -> CoreRules
375 idSpecialisation id = specInfo (idInfo id)
376
377 setIdSpecialisation :: Id -> CoreRules -> Id
378 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
379
380         ---------------------------------
381         -- CAF INFO
382 idCafInfo :: Id -> CafInfo
383 idCafInfo id = cafInfo (idInfo id)
384
385 setIdCafInfo :: Id -> CafInfo -> Id
386 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
387
388         ---------------------------------
389         -- CPR INFO
390 idCprInfo :: Id -> CprInfo
391 idCprInfo id = cprInfo (idInfo id)
392
393 setIdCprInfo :: Id -> CprInfo -> Id
394 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
395
396         ---------------------------------
397         -- Occcurrence INFO
398 idOccInfo :: Id -> OccInfo
399 idOccInfo id = occInfo (idInfo id)
400
401 setIdOccInfo :: Id -> OccInfo -> Id
402 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
403 \end{code}
404
405
406         ---------------------------------
407         -- INLINING
408 The inline pragma tells us to be very keen to inline this Id, but it's still
409 OK not to if optimisation is switched off.
410
411 \begin{code}
412 idInlinePragma :: Id -> InlinePragInfo
413 idInlinePragma id = inlinePragInfo (idInfo id)
414
415 setInlinePragma :: Id -> InlinePragInfo -> Id
416 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
417
418 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
419 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
420 \end{code}
421
422
423         ---------------------------------
424         -- ONE-SHOT LAMBDAS
425 \begin{code}
426 idLBVarInfo :: Id -> LBVarInfo
427 idLBVarInfo id = lbvarInfo (idInfo id)
428
429 isOneShotLambda :: Id -> Bool
430 isOneShotLambda id = analysis || hack
431   where analysis = case idLBVarInfo id of
432                      LBVarInfo u    | u == usOnce             -> True
433                      other                                    -> False
434         hack     = case splitTyConApp_maybe (idType id) of
435                      Just (tycon,_) | tycon == statePrimTyCon -> True
436                      other                                    -> False
437
438         -- The last clause is a gross hack.  It claims that 
439         -- every function over realWorldStatePrimTy is a one-shot
440         -- function.  This is pretty true in practice, and makes a big
441         -- difference.  For example, consider
442         --      a `thenST` \ r -> ...E...
443         -- The early full laziness pass, if it doesn't know that r is one-shot
444         -- will pull out E (let's say it doesn't mention r) to give
445         --      let lvl = E in a `thenST` \ r -> ...lvl...
446         -- When `thenST` gets inlined, we end up with
447         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
448         -- and we don't re-inline E.
449         --
450         -- It would be better to spot that r was one-shot to start with, but
451         -- I don't want to rely on that.
452         --
453         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
454         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
455
456 setOneShotLambda :: Id -> Id
457 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
458
459 clearOneShotLambda :: Id -> Id
460 clearOneShotLambda id 
461   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
462   | otherwise          = id                     
463
464 -- But watch out: this may change the type of something else
465 --      f = \x -> e
466 -- If we change the one-shot-ness of x, f's type changes
467 \end{code}
468
469 \begin{code}
470 zapFragileIdInfo :: Id -> Id
471 zapFragileIdInfo id = maybeModifyIdInfo zapFragileInfo id
472
473 zapLamIdInfo :: Id -> Id
474 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
475 \end{code}
476