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