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