Add kind equalities to GHC.
[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,
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
292 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
293 -- that are created by the compiler out of thin air
294 mkSysLocal :: FastString -> Unique -> Type -> Id
295 mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
296 mkLocalId (mkSystemVarName uniq fs) ty
297
298 -- | Like 'mkSysLocal', but checks to see if we have a covar type
299 mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
300 mkSysLocalOrCoVar fs uniq ty
301 | isCoercionType ty = mkLocalCoVar name ty
302 | otherwise = mkLocalId name ty
303 where
304 name = mkSystemVarName uniq fs
305
306 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
307 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
308
309 mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
310 mkSysLocalOrCoVarM fs ty
311 = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
312
313 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
314 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
315 mkUserLocal occ uniq ty loc = ASSERT( not (isCoercionType ty) )
316 mkLocalId (mkInternalName uniq occ loc) ty
317
318 -- | Like 'mkUserLocal' for covars
319 mkUserLocalCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
320 mkUserLocalCoVar occ uniq ty loc
321 = mkLocalCoVar (mkInternalName uniq occ loc) ty
322
323 -- | Like 'mkUserLocal', but checks if we have a coercion type
324 mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
325 mkUserLocalOrCoVar occ uniq ty loc
326 = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
327
328 mkDerivedLocalCoVarM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
329 mkDerivedLocalCoVarM deriv_name id ty
330 = ASSERT( isCoercionType ty )
331 do { uniq <- getUniqueM
332 ; let name = mkDerivedInternalName deriv_name uniq (getName id)
333 ; return (mkLocalCoVar name ty) }
334
335 {-
336 Make some local @Ids@ for a template @CoreExpr@. These have bogus
337 @Uniques@, but that's OK because the templates are supposed to be
338 instantiated before use.
339 -}
340
341 -- | Workers get local names. "CoreTidy" will externalise these if necessary
342 mkWorkerId :: Unique -> Id -> Type -> Id
343 mkWorkerId uniq unwrkr ty
344 = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
345
346 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
347 mkTemplateLocal :: Int -> Type -> Id
348 mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "tpl") (mkBuiltinUnique i) ty
349
350 -- | Create a template local for a series of types
351 mkTemplateLocals :: [Type] -> [Id]
352 mkTemplateLocals = mkTemplateLocalsNum 1
353
354 -- | Create a template local for a series of type, but start from a specified template local
355 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
356 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
357
358 {- Note [Exported LocalIds]
359 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
360 We use mkExportedLocalId for things like
361 - Dictionary functions (DFunId)
362 - Wrapper and matcher Ids for pattern synonyms
363 - Default methods for classes
364 - Pattern-synonym matcher and builder Ids
365 - etc
366
367 They marked as "exported" in the sense that they should be kept alive
368 even if apparently unused in other bindings, and not dropped as dead
369 code by the occurrence analyser. (But "exported" here does not mean
370 "brought into lexical scope by an import declaration". Indeed these
371 things are always internal Ids that the user never sees.)
372
373 It's very important that they are *LocalIds*, not GlobalIds, for lots
374 of reasons:
375
376 * We want to treat them as free variables for the purpose of
377 dependency analysis (e.g. CoreFVs.exprFreeVars).
378
379 * Look them up in the current substitution when we come across
380 occurrences of them (in Subst.lookupIdSubst). Lacking this we
381 can get an out-of-date unfolding, which can in turn make the
382 simplifier go into an infinite loop (Trac #9857)
383
384 * Ensure that for dfuns that the specialiser does not float dict uses
385 above their defns, which would prevent good simplifications happening.
386
387 * The strictness analyser treats a occurrence of a GlobalId as
388 imported and assumes it contains strictness in its IdInfo, which
389 isn't true if the thing is bound in the same module as the
390 occurrence.
391
392 In CoreTidy we must make all these LocalIds into GlobalIds, so that in
393 importing modules (in --make mode) we treat them as properly global.
394 That is what is happening in, say tidy_insts in TidyPgm.
395
396 ************************************************************************
397 * *
398 \subsection{Special Ids}
399 * *
400 ************************************************************************
401 -}
402
403 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
404 recordSelectorTyCon :: Id -> RecSelParent
405 recordSelectorTyCon id
406 = case Var.idDetails id of
407 RecSelId { sel_tycon = parent } -> parent
408 _ -> panic "recordSelectorTyCon"
409
410
411 isRecordSelector :: Id -> Bool
412 isNaughtyRecordSelector :: Id -> Bool
413 isPatSynRecordSelector :: Id -> Bool
414 isDataConRecordSelector :: Id -> Bool
415 isPrimOpId :: Id -> Bool
416 isFCallId :: Id -> Bool
417 isDataConWorkId :: Id -> Bool
418 isDFunId :: Id -> Bool
419
420 isClassOpId_maybe :: Id -> Maybe Class
421 isPrimOpId_maybe :: Id -> Maybe PrimOp
422 isFCallId_maybe :: Id -> Maybe ForeignCall
423 isDataConWorkId_maybe :: Id -> Maybe DataCon
424
425 isRecordSelector id = case Var.idDetails id of
426 RecSelId {} -> True
427 _ -> False
428
429 isDataConRecordSelector id = case Var.idDetails id of
430 RecSelId {sel_tycon = RecSelData _} -> True
431 _ -> False
432
433 isPatSynRecordSelector id = case Var.idDetails id of
434 RecSelId {sel_tycon = RecSelPatSyn _} -> True
435 _ -> False
436
437 isNaughtyRecordSelector id = case Var.idDetails id of
438 RecSelId { sel_naughty = n } -> n
439 _ -> False
440
441 isClassOpId_maybe id = case Var.idDetails id of
442 ClassOpId cls -> Just cls
443 _other -> Nothing
444
445 isPrimOpId id = case Var.idDetails id of
446 PrimOpId _ -> True
447 _ -> False
448
449 isDFunId id = case Var.idDetails id of
450 DFunId {} -> True
451 _ -> False
452
453 isPrimOpId_maybe id = case Var.idDetails id of
454 PrimOpId op -> Just op
455 _ -> Nothing
456
457 isFCallId id = case Var.idDetails id of
458 FCallId _ -> True
459 _ -> False
460
461 isFCallId_maybe id = case Var.idDetails id of
462 FCallId call -> Just call
463 _ -> Nothing
464
465 isDataConWorkId id = case Var.idDetails id of
466 DataConWorkId _ -> True
467 _ -> False
468
469 isDataConWorkId_maybe id = case Var.idDetails id of
470 DataConWorkId con -> Just con
471 _ -> Nothing
472
473 isDataConId_maybe :: Id -> Maybe DataCon
474 isDataConId_maybe id = case Var.idDetails id of
475 DataConWorkId con -> Just con
476 DataConWrapId con -> Just con
477 _ -> Nothing
478
479 idDataCon :: Id -> DataCon
480 -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
481 --
482 -- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
483 idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
484
485 hasNoBinding :: Id -> Bool
486 -- ^ Returns @True@ of an 'Id' which may not have a
487 -- binding, even though it is defined in this module.
488
489 -- Data constructor workers used to be things of this kind, but
490 -- they aren't any more. Instead, we inject a binding for
491 -- them at the CorePrep stage.
492 -- EXCEPT: unboxed tuples, which definitely have no binding
493 hasNoBinding id = case Var.idDetails id of
494 PrimOpId _ -> True -- See Note [Primop wrappers]
495 FCallId _ -> True
496 DataConWorkId dc -> isUnboxedTupleCon dc
497 _ -> False
498
499 isImplicitId :: Id -> Bool
500 -- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
501 -- declarations, so we don't need to put its signature in an interface
502 -- file, even if it's mentioned in some other interface unfolding.
503 isImplicitId id
504 = case Var.idDetails id of
505 FCallId {} -> True
506 ClassOpId {} -> True
507 PrimOpId {} -> True
508 DataConWorkId {} -> True
509 DataConWrapId {} -> True
510 -- These are implied by their type or class decl;
511 -- remember that all type and class decls appear in the interface file.
512 -- The dfun id is not an implicit Id; it must *not* be omitted, because
513 -- it carries version info for the instance decl
514 _ -> False
515
516 idIsFrom :: Module -> Id -> Bool
517 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
518
519 {-
520 Note [Primop wrappers]
521 ~~~~~~~~~~~~~~~~~~~~~~
522 Currently hasNoBinding claims that PrimOpIds don't have a curried
523 function definition. But actually they do, in GHC.PrimopWrappers,
524 which is auto-generated from prelude/primops.txt.pp. So actually, hasNoBinding
525 could return 'False' for PrimOpIds.
526
527 But we'd need to add something in CoreToStg to swizzle any unsaturated
528 applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
529
530 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
531 used by GHCi, which does not implement primops direct at all.
532 -}
533
534 isDeadBinder :: Id -> Bool
535 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
536 | otherwise = False -- TyVars count as not dead
537
538 {-
539 ************************************************************************
540 * *
541 Evidence variables
542 * *
543 ************************************************************************
544 -}
545
546 isEvVar :: Var -> Bool
547 isEvVar var = isPredTy (varType var)
548
549 isDictId :: Id -> Bool
550 isDictId id = isDictTy (idType id)
551
552 {-
553 ************************************************************************
554 * *
555 \subsection{IdInfo stuff}
556 * *
557 ************************************************************************
558 -}
559
560 ---------------------------------
561 -- ARITY
562 idArity :: Id -> Arity
563 idArity id = arityInfo (idInfo id)
564
565 setIdArity :: Id -> Arity -> Id
566 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
567
568 idCallArity :: Id -> Arity
569 idCallArity id = callArityInfo (idInfo id)
570
571 setIdCallArity :: Id -> Arity -> Id
572 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
573
574 idRepArity :: Id -> RepArity
575 idRepArity x = typeRepArity (idArity x) (idType x)
576
577 -- | Returns true if an application to n args would diverge
578 isBottomingId :: Id -> Bool
579 isBottomingId id = isBottomingSig (idStrictness id)
580
581 idStrictness :: Id -> StrictSig
582 idStrictness id = strictnessInfo (idInfo id)
583
584 setIdStrictness :: Id -> StrictSig -> Id
585 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
586
587 zapIdStrictness :: Id -> Id
588 zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
589
590 -- | This predicate says whether the 'Id' has a strict demand placed on it or
591 -- has a type such that it can always be evaluated strictly (i.e an
592 -- unlifted type, as of GHC 7.6). We need to
593 -- check separately whether the 'Id' has a so-called \"strict type\" because if
594 -- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
595 -- type, we still want @isStrictId id@ to be @True@.
596 isStrictId :: Id -> Bool
597 isStrictId id
598 = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
599 (isStrictType (idType id)) ||
600 -- Take the best of both strictnesses - old and new
601 (isStrictDmd (idDemandInfo id))
602
603 ---------------------------------
604 -- UNFOLDING
605 idUnfolding :: Id -> Unfolding
606 -- Do not expose the unfolding of a loop breaker!
607 idUnfolding id
608 | isStrongLoopBreaker (occInfo info) = NoUnfolding
609 | otherwise = unfoldingInfo info
610 where
611 info = idInfo id
612
613 realIdUnfolding :: Id -> Unfolding
614 -- Expose the unfolding if there is one, including for loop breakers
615 realIdUnfolding id = unfoldingInfo (idInfo id)
616
617 setIdUnfoldingLazily :: Id -> Unfolding -> Id
618 setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id
619
620 setIdUnfolding :: Id -> Unfolding -> Id
621 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
622
623 idDemandInfo :: Id -> Demand
624 idDemandInfo id = demandInfo (idInfo id)
625
626 setIdDemandInfo :: Id -> Demand -> Id
627 setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) 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 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
702 -- This one is the "business end", called externally.
703 -- It works on type variables as well as Ids, returning True
704 -- Its main purpose is to encapsulate the Horrible State Hack
705 isOneShotBndr :: Var -> Bool
706 isOneShotBndr var
707 | isTyVar var = True
708 | otherwise = isOneShotLambda var
709
710 -- | Should we apply the state hack to values of this 'Type'?
711 stateHackOneShot :: OneShotInfo
712 stateHackOneShot = OneShotLam -- Or maybe ProbOneShot?
713
714 typeOneShot :: Type -> OneShotInfo
715 typeOneShot ty
716 | isStateHackType ty = stateHackOneShot
717 | otherwise = NoOneShotInfo
718
719 isStateHackType :: Type -> Bool
720 isStateHackType ty
721 | opt_NoStateHack
722 = False
723 | otherwise
724 = case tyConAppTyCon_maybe ty of
725 Just tycon -> tycon == statePrimTyCon
726 _ -> False
727 -- This is a gross hack. It claims that
728 -- every function over realWorldStatePrimTy is a one-shot
729 -- function. This is pretty true in practice, and makes a big
730 -- difference. For example, consider
731 -- a `thenST` \ r -> ...E...
732 -- The early full laziness pass, if it doesn't know that r is one-shot
733 -- will pull out E (let's say it doesn't mention r) to give
734 -- let lvl = E in a `thenST` \ r -> ...lvl...
735 -- When `thenST` gets inlined, we end up with
736 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl...
737 -- and we don't re-inline E.
738 --
739 -- It would be better to spot that r was one-shot to start with, but
740 -- I don't want to rely on that.
741 --
742 -- Another good example is in fill_in in PrelPack.hs. We should be able to
743 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
744
745
746 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
747 -- You probably want to use 'isOneShotBndr' instead
748 isOneShotLambda :: Id -> Bool
749 isOneShotLambda id = case idOneShotInfo id of
750 OneShotLam -> True
751 _ -> False
752
753 isProbablyOneShotLambda :: Id -> Bool
754 isProbablyOneShotLambda id = case idOneShotInfo id of
755 OneShotLam -> True
756 ProbOneShot -> True
757 NoOneShotInfo -> False
758
759 setOneShotLambda :: Id -> Id
760 setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
761
762 clearOneShotLambda :: Id -> Id
763 clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
764
765 setIdOneShotInfo :: Id -> OneShotInfo -> Id
766 setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
767
768 updOneShotInfo :: Id -> OneShotInfo -> Id
769 -- Combine the info in the Id with new info
770 updOneShotInfo id one_shot
771 | do_upd = setIdOneShotInfo id one_shot
772 | otherwise = id
773 where
774 do_upd = case (idOneShotInfo id, one_shot) of
775 (NoOneShotInfo, _) -> True
776 (OneShotLam, _) -> False
777 (_, NoOneShotInfo) -> False
778 _ -> True
779
780 -- The OneShotLambda functions simply fiddle with the IdInfo flag
781 -- But watch out: this may change the type of something else
782 -- f = \x -> e
783 -- If we change the one-shot-ness of x, f's type changes
784
785 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
786 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
787
788 zapLamIdInfo :: Id -> Id
789 zapLamIdInfo = zapInfo zapLamInfo
790
791 zapFragileIdInfo :: Id -> Id
792 zapFragileIdInfo = zapInfo zapFragileInfo
793
794 zapIdDemandInfo :: Id -> Id
795 zapIdDemandInfo = zapInfo zapDemandInfo
796
797 zapIdUsageInfo :: Id -> Id
798 zapIdUsageInfo = zapInfo zapUsageInfo
799
800 {-
801 Note [transferPolyIdInfo]
802 ~~~~~~~~~~~~~~~~~~~~~~~~~
803 This transfer is used in two places:
804 FloatOut (long-distance let-floating)
805 SimplUtils.abstractFloats (short-distance let-floating)
806
807 Consider the short-distance let-floating:
808
809 f = /\a. let g = rhs in ...
810
811 Then if we float thus
812
813 g' = /\a. rhs
814 f = /\a. ...[g' a/g]....
815
816 we *do not* want to lose g's
817 * strictness information
818 * arity
819 * inline pragma (though that is bit more debatable)
820 * occurrence info
821
822 Mostly this is just an optimisation, but it's *vital* to
823 transfer the occurrence info. Consider
824
825 NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
826
827 where the '*' means 'LoopBreaker'. Then if we float we must get
828
829 Rec { g'* = /\a. ...(g' a)... }
830 NonRec { f = /\a. ...[g' a/g]....}
831
832 where g' is also marked as LoopBreaker. If not, terrible things
833 can happen if we re-simplify the binding (and the Simplifier does
834 sometimes simplify a term twice); see Trac #4345.
835
836 It's not so simple to retain
837 * worker info
838 * rules
839 so we simply discard those. Sooner or later this may bite us.
840
841 If we abstract wrt one or more *value* binders, we must modify the
842 arity and strictness info before transferring it. E.g.
843 f = \x. e
844 -->
845 g' = \y. \x. e
846 + substitute (g' y) for g
847 Notice that g' has an arity one more than the original g
848 -}
849
850 transferPolyIdInfo :: Id -- Original Id
851 -> [Var] -- Abstract wrt these variables
852 -> Id -- New Id
853 -> Id
854 transferPolyIdInfo old_id abstract_wrt new_id
855 = modifyIdInfo transfer new_id
856 where
857 arity_increase = count isId abstract_wrt -- Arity increases by the
858 -- number of value binders
859
860 old_info = idInfo old_id
861 old_arity = arityInfo old_info
862 old_inline_prag = inlinePragInfo old_info
863 old_occ_info = occInfo old_info
864 new_arity = old_arity + arity_increase
865
866 old_strictness = strictnessInfo old_info
867 new_strictness = increaseStrictSigArity arity_increase old_strictness
868
869 transfer new_info = new_info `setArityInfo` new_arity
870 `setInlinePragInfo` old_inline_prag
871 `setOccInfo` old_occ_info
872 `setStrictnessInfo` new_strictness