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