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