Refactoring on IdInfo and system derived names
[ghc.git] / compiler / basicTypes / Id.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[Id]{@Ids@: Value and constructor identifiers}
6 -}
7
8 {-# LANGUAGE CPP #-}
9
10 -- |
11 -- #name_types#
12 -- GHC uses several kinds of name internally:
13 --
14 -- * 'OccName.OccName': see "OccName#name_types"
15 --
16 -- * 'RdrName.RdrName': see "RdrName#name_types"
17 --
18 -- * 'Name.Name': see "Name#name_types"
19 --
20 -- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional
21 -- details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that
22 -- are added, modified and inspected by various compiler passes. These 'Var.Var' names may either
23 -- be global or local, see "Var#globalvslocal"
24 --
25 -- * 'Var.Var': see "Var#name_types"
26
27 module Id (
28 -- * The main types
29 Var, Id, isId,
30
31 -- ** Simple construction
32 mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
33 mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
34 mkLocalIdOrCoVarWithInfo,
35 mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
36 mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
37 mkUserLocal, mkUserLocalCoVar, mkUserLocalOrCoVar,
38 mkDerivedLocalCoVarM,
39 mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
40 mkWorkerId,
41
42 -- ** Taking an Id apart
43 idName, idType, idUnique, idInfo, idDetails, idRepArity,
44 recordSelectorTyCon,
45
46 -- ** Modifying an Id
47 setIdName, setIdUnique, Id.setIdType,
48 setIdExported, setIdNotExported,
49 globaliseId, localiseId,
50 setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
51 zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapFragileIdInfo,
52 zapIdStrictness,
53 transferPolyIdInfo,
54
55 -- ** Predicates on Ids
56 isImplicitId, isDeadBinder,
57 isStrictId,
58 isExportedId, isLocalId, isGlobalId,
59 isRecordSelector, isNaughtyRecordSelector,
60 isPatSynRecordSelector,
61 isDataConRecordSelector,
62 isClassOpId_maybe, isDFunId,
63 isPrimOpId, isPrimOpId_maybe,
64 isFCallId, isFCallId_maybe,
65 isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
66 isConLikeId, isBottomingId, idIsFrom,
67 hasNoBinding,
68
69 -- ** Evidence variables
70 DictId, isDictId, isEvVar,
71
72 -- ** Inline pragma stuff
73 idInlinePragma, setInlinePragma, modifyInlinePragma,
74 idInlineActivation, setInlineActivation, idRuleMatchInfo,
75
76 -- ** One-shot lambdas
77 isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
78 setOneShotLambda, clearOneShotLambda,
79 updOneShotInfo, setIdOneShotInfo,
80 isStateHackType, stateHackOneShot, typeOneShot,
81
82 -- ** Reading 'IdInfo' fields
83 idArity,
84 idCallArity,
85 idUnfolding, realIdUnfolding,
86 idSpecialisation, idCoreRules, idHasRules,
87 idCafInfo,
88 idOneShotInfo,
89 idOccInfo,
90
91 -- ** Writing 'IdInfo' fields
92 setIdUnfoldingLazily,
93 setIdUnfolding,
94 setIdArity,
95 setIdCallArity,
96
97 setIdSpecialisation,
98 setIdCafInfo,
99 setIdOccInfo, zapIdOccInfo,
100
101 setIdDemandInfo,
102 setIdStrictness,
103
104 idDemandInfo,
105 idStrictness,
106
107 ) where
108
109 #include "HsVersions.h"
110
111 import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) )
112
113 import IdInfo
114 import BasicTypes
115
116 -- Imported and re-exported
117 import Var( Id, CoVar, DictId,
118 idInfo, idDetails, globaliseId, varType,
119 isId, isLocalId, isGlobalId, isExportedId )
120 import qualified Var
121
122 import Type
123 import TysPrim
124 import DataCon
125 import Demand
126 import Name
127 import Module
128 import Class
129 import {-# SOURCE #-} PrimOp (PrimOp)
130 import ForeignCall
131 import Maybes
132 import SrcLoc
133 import Outputable
134 import Unique
135 import UniqSupply
136 import FastString
137 import Util
138 import StaticFlags
139
140 -- infixl so you can say (id `set` a `set` b)
141 infixl 1 `setIdUnfoldingLazily`,
142 `setIdUnfolding`,
143 `setIdArity`,
144 `setIdCallArity`,
145 `setIdOccInfo`,
146 `setIdOneShotInfo`,
147
148 `setIdSpecialisation`,
149 `setInlinePragma`,
150 `setInlineActivation`,
151 `idCafInfo`,
152
153 `setIdDemandInfo`,
154 `setIdStrictness`
155
156 {-
157 ************************************************************************
158 * *
159 \subsection{Basic Id manipulation}
160 * *
161 ************************************************************************
162 -}
163
164 idName :: Id -> Name
165 idName = Var.varName
166
167 idUnique :: Id -> Unique
168 idUnique = Var.varUnique
169
170 idType :: Id -> Kind
171 idType = Var.varType
172
173 setIdName :: Id -> Name -> Id
174 setIdName = Var.setVarName
175
176 setIdUnique :: Id -> Unique -> Id
177 setIdUnique = Var.setVarUnique
178
179 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
180 -- reduce space usage
181 setIdType :: Id -> Type -> Id
182 setIdType id ty = seqType ty `seq` Var.setVarType id ty
183
184 setIdExported :: Id -> Id
185 setIdExported = Var.setIdExported
186
187 setIdNotExported :: Id -> Id
188 setIdNotExported = Var.setIdNotExported
189
190 localiseId :: Id -> Id
191 -- Make an with the same unique and type as the
192 -- incoming Id, but with an *Internal* Name and *LocalId* flavour
193 localiseId id
194 | ASSERT( isId id ) isLocalId id && isInternalName name
195 = id
196 | otherwise
197 = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
198 where
199 name = idName id
200
201 lazySetIdInfo :: Id -> IdInfo -> Id
202 lazySetIdInfo = Var.lazySetIdInfo
203
204 setIdInfo :: Id -> IdInfo -> Id
205 setIdInfo id info = info `seq` (lazySetIdInfo id info)
206 -- Try to avoid spack leaks by seq'ing
207
208 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
209 modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
210
211 -- maybeModifyIdInfo tries to avoid unnecessary thrashing
212 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
213 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
214 maybeModifyIdInfo Nothing id = id
215
216 {-
217 ************************************************************************
218 * *
219 \subsection{Simple Id construction}
220 * *
221 ************************************************************************
222
223 Absolutely all Ids are made by mkId. It is just like Var.mkId,
224 but in addition it pins free-tyvar-info onto the Id's type,
225 where it can easily be found.
226
227 Note [Free type variables]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~
229 At one time we cached the free type variables of the type of an Id
230 at the root of the type in a TyNote. The idea was to avoid repeating
231 the free-type-variable calculation. But it turned out to slow down
232 the compiler overall. I don't quite know why; perhaps finding free
233 type variables of an Id isn't all that common whereas applying a
234 substitution (which changes the free type variables) is more common.
235 Anyway, we removed it in March 2008.
236 -}
237
238 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
239 mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
240 mkGlobalId = Var.mkGlobalVar
241
242 -- | Make a global 'Id' without any extra information at all
243 mkVanillaGlobal :: Name -> Type -> Id
244 mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
245
246 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
247 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
248 mkVanillaGlobalWithInfo = mkGlobalId VanillaId
249
250
251 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
252 mkLocalId :: Name -> Type -> Id
253 mkLocalId name ty = mkLocalIdWithInfo name ty
254 (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
255 -- It's tempting to ASSERT( not (isCoercionType ty) ), but don't. Sometimes,
256 -- the type is a panic. (Search invented_id)
257
258 -- | Make a local CoVar
259 mkLocalCoVar :: Name -> Type -> CoVar
260 mkLocalCoVar name ty
261 = ASSERT( isCoercionType ty )
262 Var.mkLocalVar CoVarId name ty (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
263
264 -- | Like 'mkLocalId', but checks the type to see if it should make a covar
265 mkLocalIdOrCoVar :: Name -> Type -> Id
266 mkLocalIdOrCoVar name ty
267 | isCoercionType ty = mkLocalCoVar name ty
268 | otherwise = mkLocalId name ty
269
270 -- | Make a local id, with the IdDetails set to CoVarId if the type indicates
271 -- so.
272 mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
273 mkLocalIdOrCoVarWithInfo name ty info
274 = Var.mkLocalVar details name ty info
275 where
276 details | isCoercionType ty = CoVarId
277 | otherwise = VanillaId
278
279 -- proper ids only; no covars!
280 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
281 mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
282 -- Note [Free type variables]
283
284 -- | Create a local 'Id' that is marked as exported.
285 -- This prevents things attached to it from being removed as dead code.
286 -- See Note [Exported LocalIds]
287 mkExportedLocalId :: IdDetails -> Name -> Type -> Id
288 mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
289 -- Note [Free type variables]
290
291 mkExportedVanillaId :: Name -> Type -> Id
292 mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
293 -- Note [Free type variables]
294
295
296 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
297 -- that are created by the compiler out of thin air
298 mkSysLocal :: FastString -> Unique -> Type -> Id
299 mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
300 mkLocalId (mkSystemVarName uniq fs) ty
301
302 -- | Like 'mkSysLocal', but checks to see if we have a covar type
303 mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
304 mkSysLocalOrCoVar fs uniq ty
305 | isCoercionType ty = mkLocalCoVar name ty
306 | otherwise = mkLocalId name ty
307 where
308 name = mkSystemVarName uniq fs
309
310 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
311 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
312
313 mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
314 mkSysLocalOrCoVarM fs ty
315 = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
316
317 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
318 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
319 mkUserLocal occ uniq ty loc = ASSERT( not (isCoercionType ty) )
320 mkLocalId (mkInternalName uniq occ loc) ty
321
322 -- | Like 'mkUserLocal' for covars
323 mkUserLocalCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
324 mkUserLocalCoVar occ uniq ty loc
325 = mkLocalCoVar (mkInternalName uniq occ loc) ty
326
327 -- | Like 'mkUserLocal', but checks if we have a coercion type
328 mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
329 mkUserLocalOrCoVar occ uniq ty loc
330 = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
331
332 mkDerivedLocalCoVarM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
333 mkDerivedLocalCoVarM deriv_name id ty
334 = ASSERT( isCoercionType ty )
335 do { uniq <- getUniqueM
336 ; let name = mkDerivedInternalName deriv_name uniq (getName id)
337 ; return (mkLocalCoVar name ty) }
338
339 {-
340 Make some local @Ids@ for a template @CoreExpr@. These have bogus
341 @Uniques@, but that's OK because the templates are supposed to be
342 instantiated before use.
343 -}
344
345 -- | Workers get local names. "CoreTidy" will externalise these if necessary
346 mkWorkerId :: Unique -> Id -> Type -> Id
347 mkWorkerId uniq unwrkr ty
348 = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
349
350 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
351 mkTemplateLocal :: Int -> Type -> Id
352 mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "tpl") (mkBuiltinUnique i) ty
353
354 -- | Create a template local for a series of types
355 mkTemplateLocals :: [Type] -> [Id]
356 mkTemplateLocals = mkTemplateLocalsNum 1
357
358 -- | Create a template local for a series of type, but start from a specified template local
359 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
360 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
361
362 {- Note [Exported LocalIds]
363 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
364 We use mkExportedLocalId for things like
365 - Dictionary functions (DFunId)
366 - Wrapper and matcher Ids for pattern synonyms
367 - Default methods for classes
368 - Pattern-synonym matcher and builder Ids
369 - etc
370
371 They marked as "exported" in the sense that they should be kept alive
372 even if apparently unused in other bindings, and not dropped as dead
373 code by the occurrence analyser. (But "exported" here does not mean
374 "brought into lexical scope by an import declaration". Indeed these
375 things are always internal Ids that the user never sees.)
376
377 It's very important that they are *LocalIds*, not GlobalIds, for lots
378 of reasons:
379
380 * We want to treat them as free variables for the purpose of
381 dependency analysis (e.g. CoreFVs.exprFreeVars).
382
383 * Look them up in the current substitution when we come across
384 occurrences of them (in Subst.lookupIdSubst). Lacking this we
385 can get an out-of-date unfolding, which can in turn make the
386 simplifier go into an infinite loop (Trac #9857)
387
388 * Ensure that for dfuns that the specialiser does not float dict uses
389 above their defns, which would prevent good simplifications happening.
390
391 * The strictness analyser treats a occurrence of a GlobalId as
392 imported and assumes it contains strictness in its IdInfo, which
393 isn't true if the thing is bound in the same module as the
394 occurrence.
395
396 In CoreTidy we must make all these LocalIds into GlobalIds, so that in
397 importing modules (in --make mode) we treat them as properly global.
398 That is what is happening in, say tidy_insts in TidyPgm.
399
400 ************************************************************************
401 * *
402 \subsection{Special Ids}
403 * *
404 ************************************************************************
405 -}
406
407 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
408 recordSelectorTyCon :: Id -> RecSelParent
409 recordSelectorTyCon id
410 = case Var.idDetails id of
411 RecSelId { sel_tycon = parent } -> parent
412 _ -> panic "recordSelectorTyCon"
413
414
415 isRecordSelector :: Id -> Bool
416 isNaughtyRecordSelector :: Id -> Bool
417 isPatSynRecordSelector :: Id -> Bool
418 isDataConRecordSelector :: Id -> Bool
419 isPrimOpId :: Id -> Bool
420 isFCallId :: Id -> Bool
421 isDataConWorkId :: Id -> Bool
422 isDFunId :: Id -> Bool
423
424 isClassOpId_maybe :: Id -> Maybe Class
425 isPrimOpId_maybe :: Id -> Maybe PrimOp
426 isFCallId_maybe :: Id -> Maybe ForeignCall
427 isDataConWorkId_maybe :: Id -> Maybe DataCon
428
429 isRecordSelector id = case Var.idDetails id of
430 RecSelId {} -> True
431 _ -> False
432
433 isDataConRecordSelector id = case Var.idDetails id of
434 RecSelId {sel_tycon = RecSelData _} -> True
435 _ -> False
436
437 isPatSynRecordSelector id = case Var.idDetails id of
438 RecSelId {sel_tycon = RecSelPatSyn _} -> True
439 _ -> False
440
441 isNaughtyRecordSelector id = case Var.idDetails id of
442 RecSelId { sel_naughty = n } -> n
443 _ -> False
444
445 isClassOpId_maybe id = case Var.idDetails id of
446 ClassOpId cls -> Just cls
447 _other -> Nothing
448
449 isPrimOpId id = case Var.idDetails id of
450 PrimOpId _ -> True
451 _ -> False
452
453 isDFunId id = case Var.idDetails id of
454 DFunId {} -> True
455 _ -> False
456
457 isPrimOpId_maybe id = case Var.idDetails id of
458 PrimOpId op -> Just op
459 _ -> Nothing
460
461 isFCallId id = case Var.idDetails id of
462 FCallId _ -> True
463 _ -> False
464
465 isFCallId_maybe id = case Var.idDetails id of
466 FCallId call -> Just call
467 _ -> Nothing
468
469 isDataConWorkId id = case Var.idDetails id of
470 DataConWorkId _ -> True
471 _ -> False
472
473 isDataConWorkId_maybe id = case Var.idDetails id of
474 DataConWorkId con -> Just con
475 _ -> Nothing
476
477 isDataConId_maybe :: Id -> Maybe DataCon
478 isDataConId_maybe id = case Var.idDetails id of
479 DataConWorkId con -> Just con
480 DataConWrapId con -> Just con
481 _ -> Nothing
482
483 idDataCon :: Id -> DataCon
484 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
485 --
486 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
487 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
488
489 hasNoBinding :: Id -> Bool
490 -- ^ Returns @True@ of an 'Id' which may not have a
491 -- binding, even though it is defined in this module.
492
493 -- Data constructor workers used to be things of this kind, but
494 -- they aren't any more. Instead, we inject a binding for
495 -- them at the CorePrep stage.
496 -- EXCEPT: unboxed tuples, which definitely have no binding
497 hasNoBinding id = case Var.idDetails id of
498 PrimOpId _ -> True -- See Note [Primop wrappers]
499 FCallId _ -> True
500 DataConWorkId dc -> isUnboxedTupleCon dc
501 _ -> False
502
503 isImplicitId :: Id -> Bool
504 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
505 -- declarations, so we don't need to put its signature in an interface
506 -- file, even if it's mentioned in some other interface unfolding.
507 isImplicitId id
508 = case Var.idDetails id of
509 FCallId {} -> True
510 ClassOpId {} -> True
511 PrimOpId {} -> True
512 DataConWorkId {} -> True
513 DataConWrapId {} -> True
514 -- These are implied by their type or class decl;
515 -- remember that all type and class decls appear in the interface file.
516 -- The dfun id is not an implicit Id; it must *not* be omitted, because
517 -- it carries version info for the instance decl
518 _ -> False
519
520 idIsFrom :: Module -> Id -> Bool
521 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
522
523 {-
524 Note [Primop wrappers]
525 ~~~~~~~~~~~~~~~~~~~~~~
526 Currently hasNoBinding claims that PrimOpIds don't have a curried
527 function definition. But actually they do, in GHC.PrimopWrappers,
528 which is auto-generated from prelude/primops.txt.pp. So actually, hasNoBinding
529 could return 'False' for PrimOpIds.
530
531 But we'd need to add something in CoreToStg to swizzle any unsaturated
532 applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
533
534 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
535 used by GHCi, which does not implement primops direct at all.
536 -}
537
538 isDeadBinder :: Id -> Bool
539 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
540 | otherwise = False -- TyVars count as not dead
541
542 {-
543 ************************************************************************
544 * *
545 Evidence variables
546 * *
547 ************************************************************************
548 -}
549
550 isEvVar :: Var -> Bool
551 isEvVar var = isPredTy (varType var)
552
553 isDictId :: Id -> Bool
554 isDictId id = isDictTy (idType id)
555
556 {-
557 ************************************************************************
558 * *
559 \subsection{IdInfo stuff}
560 * *
561 ************************************************************************
562 -}
563
564 ---------------------------------
565 -- ARITY
566 idArity :: Id -> Arity
567 idArity id = arityInfo (idInfo id)
568
569 setIdArity :: Id -> Arity -> Id
570 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
571
572 idCallArity :: Id -> Arity
573 idCallArity id = callArityInfo (idInfo id)
574
575 setIdCallArity :: Id -> Arity -> Id
576 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
577
578 idRepArity :: Id -> RepArity
579 idRepArity x = typeRepArity (idArity x) (idType x)
580
581 -- | Returns true if an application to n args would diverge
582 isBottomingId :: Id -> Bool
583 isBottomingId id = isBottomingSig (idStrictness id)
584
585 idStrictness :: Id -> StrictSig
586 idStrictness id = strictnessInfo (idInfo id)
587
588 setIdStrictness :: Id -> StrictSig -> Id
589 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
590
591 zapIdStrictness :: Id -> Id
592 zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
593
594 -- | This predicate says whether the 'Id' has a strict demand placed on it or
595 -- has a type such that it can always be evaluated strictly (i.e an
596 -- unlifted type, as of GHC 7.6). We need to
597 -- check separately whether the 'Id' has a so-called \"strict type\" because if
598 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
599 -- type, we still want @isStrictId id@ to be @True@.
600 isStrictId :: Id -> Bool
601 isStrictId id
602 = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
603 (isStrictType (idType id)) ||
604 -- Take the best of both strictnesses - old and new
605 (isStrictDmd (idDemandInfo id))
606
607 ---------------------------------
608 -- UNFOLDING
609 idUnfolding :: Id -> Unfolding
610 -- Do not expose the unfolding of a loop breaker!
611 idUnfolding id
612 | isStrongLoopBreaker (occInfo info) = NoUnfolding
613 | otherwise = unfoldingInfo info
614 where
615 info = idInfo id
616
617 realIdUnfolding :: Id -> Unfolding
618 -- Expose the unfolding if there is one, including for loop breakers
619 realIdUnfolding id = unfoldingInfo (idInfo id)
620
621 setIdUnfoldingLazily :: Id -> Unfolding -> Id
622 setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id
623
624 setIdUnfolding :: Id -> Unfolding -> Id
625 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
626
627 idDemandInfo :: Id -> Demand
628 idDemandInfo id = demandInfo (idInfo id)
629
630 setIdDemandInfo :: Id -> Demand -> Id
631 setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
632
633 ---------------------------------
634 -- SPECIALISATION
635
636 -- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
637
638 idSpecialisation :: Id -> RuleInfo
639 idSpecialisation id = ruleInfo (idInfo id)
640
641 idCoreRules :: Id -> [CoreRule]
642 idCoreRules id = ruleInfoRules (idSpecialisation id)
643
644 idHasRules :: Id -> Bool
645 idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
646
647 setIdSpecialisation :: Id -> RuleInfo -> Id
648 setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
649
650 ---------------------------------
651 -- CAF INFO
652 idCafInfo :: Id -> CafInfo
653 idCafInfo id = cafInfo (idInfo id)
654
655 setIdCafInfo :: Id -> CafInfo -> Id
656 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
657
658 ---------------------------------
659 -- Occcurrence INFO
660 idOccInfo :: Id -> OccInfo
661 idOccInfo id = occInfo (idInfo id)
662
663 setIdOccInfo :: Id -> OccInfo -> Id
664 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
665
666 zapIdOccInfo :: Id -> Id
667 zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
668
669 {-
670 ---------------------------------
671 -- INLINING
672 The inline pragma tells us to be very keen to inline this Id, but it's still
673 OK not to if optimisation is switched off.
674 -}
675
676 idInlinePragma :: Id -> InlinePragma
677 idInlinePragma id = inlinePragInfo (idInfo id)
678
679 setInlinePragma :: Id -> InlinePragma -> Id
680 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
681
682 modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
683 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
684
685 idInlineActivation :: Id -> Activation
686 idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
687
688 setInlineActivation :: Id -> Activation -> Id
689 setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
690
691 idRuleMatchInfo :: Id -> RuleMatchInfo
692 idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
693
694 isConLikeId :: Id -> Bool
695 isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
696
697 {-
698 ---------------------------------
699 -- ONE-SHOT LAMBDAS
700 -}
701
702 idOneShotInfo :: Id -> OneShotInfo
703 idOneShotInfo id = oneShotInfo (idInfo id)
704
705 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
706 -- This one is the "business end", called externally.
707 -- It works on type variables as well as Ids, returning True
708 -- Its main purpose is to encapsulate the Horrible State Hack
709 isOneShotBndr :: Var -> Bool
710 isOneShotBndr var
711 | isTyVar var = True
712 | otherwise = isOneShotLambda var
713
714 -- | Should we apply the state hack to values of this 'Type'?
715 stateHackOneShot :: OneShotInfo
716 stateHackOneShot = OneShotLam -- Or maybe ProbOneShot?
717
718 typeOneShot :: Type -> OneShotInfo
719 typeOneShot ty
720 | isStateHackType ty = stateHackOneShot
721 | otherwise = NoOneShotInfo
722
723 isStateHackType :: Type -> Bool
724 isStateHackType ty
725 | opt_NoStateHack
726 = False
727 | otherwise
728 = case tyConAppTyCon_maybe ty of
729 Just tycon -> tycon == statePrimTyCon
730 _ -> False
731 -- This is a gross hack. It claims that
732 -- every function over realWorldStatePrimTy is a one-shot
733 -- function. This is pretty true in practice, and makes a big
734 -- difference. For example, consider
735 -- a `thenST` \ r -> ...E...
736 -- The early full laziness pass, if it doesn't know that r is one-shot
737 -- will pull out E (let's say it doesn't mention r) to give
738 -- let lvl = E in a `thenST` \ r -> ...lvl...
739 -- When `thenST` gets inlined, we end up with
740 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
741 -- and we don't re-inline E.
742 --
743 -- It would be better to spot that r was one-shot to start with, but
744 -- I don't want to rely on that.
745 --
746 -- Another good example is in fill_in in PrelPack.hs. We should be able to
747 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
748
749
750 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
751 -- You probably want to use 'isOneShotBndr' instead
752 isOneShotLambda :: Id -> Bool
753 isOneShotLambda id = case idOneShotInfo id of
754 OneShotLam -> True
755 _ -> False
756
757 isProbablyOneShotLambda :: Id -> Bool
758 isProbablyOneShotLambda id = case idOneShotInfo id of
759 OneShotLam -> True
760 ProbOneShot -> True
761 NoOneShotInfo -> False
762
763 setOneShotLambda :: Id -> Id
764 setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
765
766 clearOneShotLambda :: Id -> Id
767 clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
768
769 setIdOneShotInfo :: Id -> OneShotInfo -> Id
770 setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
771
772 updOneShotInfo :: Id -> OneShotInfo -> Id
773 -- Combine the info in the Id with new info
774 updOneShotInfo id one_shot
775 | do_upd = setIdOneShotInfo id one_shot
776 | otherwise = id
777 where
778 do_upd = case (idOneShotInfo id, one_shot) of
779 (NoOneShotInfo, _) -> True
780 (OneShotLam, _) -> False
781 (_, NoOneShotInfo) -> False
782 _ -> True
783
784 -- The OneShotLambda functions simply fiddle with the IdInfo flag
785 -- But watch out: this may change the type of something else
786 -- f = \x -> e
787 -- If we change the one-shot-ness of x, f's type changes
788
789 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
790 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
791
792 zapLamIdInfo :: Id -> Id
793 zapLamIdInfo = zapInfo zapLamInfo
794
795 zapFragileIdInfo :: Id -> Id
796 zapFragileIdInfo = zapInfo zapFragileInfo
797
798 zapIdDemandInfo :: Id -> Id
799 zapIdDemandInfo = zapInfo zapDemandInfo
800
801 zapIdUsageInfo :: Id -> Id
802 zapIdUsageInfo = zapInfo zapUsageInfo
803
804 {-
805 Note [transferPolyIdInfo]
806 ~~~~~~~~~~~~~~~~~~~~~~~~~
807 This transfer is used in two places:
808 FloatOut (long-distance let-floating)
809 SimplUtils.abstractFloats (short-distance let-floating)
810
811 Consider the short-distance let-floating:
812
813 f = /\a. let g = rhs in ...
814
815 Then if we float thus
816
817 g' = /\a. rhs
818 f = /\a. ...[g' a/g]....
819
820 we *do not* want to lose g's
821 * strictness information
822 * arity
823 * inline pragma (though that is bit more debatable)
824 * occurrence info
825
826 Mostly this is just an optimisation, but it's *vital* to
827 transfer the occurrence info. Consider
828
829 NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
830
831 where the '*' means 'LoopBreaker'. Then if we float we must get
832
833 Rec { g'* = /\a. ...(g' a)... }
834 NonRec { f = /\a. ...[g' a/g]....}
835
836 where g' is also marked as LoopBreaker. If not, terrible things
837 can happen if we re-simplify the binding (and the Simplifier does
838 sometimes simplify a term twice); see Trac #4345.
839
840 It's not so simple to retain
841 * worker info
842 * rules
843 so we simply discard those. Sooner or later this may bite us.
844
845 If we abstract wrt one or more *value* binders, we must modify the
846 arity and strictness info before transferring it. E.g.
847 f = \x. e
848 -->
849 g' = \y. \x. e
850 + substitute (g' y) for g
851 Notice that g' has an arity one more than the original g
852 -}
853
854 transferPolyIdInfo :: Id -- Original Id
855 -> [Var] -- Abstract wrt these variables
856 -> Id -- New Id
857 -> Id
858 transferPolyIdInfo old_id abstract_wrt new_id
859 = modifyIdInfo transfer new_id
860 where
861 arity_increase = count isId abstract_wrt -- Arity increases by the
862 -- number of value binders
863
864 old_info = idInfo old_id
865 old_arity = arityInfo old_info
866 old_inline_prag = inlinePragInfo old_info
867 old_occ_info = occInfo old_info
868 new_arity = old_arity + arity_increase
869
870 old_strictness = strictnessInfo old_info
871 new_strictness = increaseStrictSigArity arity_increase old_strictness
872
873 transfer new_info = new_info `setArityInfo` new_arity
874 `setInlinePragInfo` old_inline_prag
875 `setOccInfo` old_occ_info
876 `setStrictnessInfo` new_strictness