Id.lhs 25.4 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 5 6 7
%
\section[Id]{@Ids@: Value and constructor identifiers}

\begin{code}
batterseapower's avatar
batterseapower committed
8 9 10 11 12 13 14 15 16 17 18 19
-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'OccName.OccName': see "OccName#name_types"
--
-- * 'RdrName.RdrName': see "RdrName#name_types"
--
-- * 'Name.Name': see "Name#name_types"
--
-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TypeRep.Type' and some additional
--   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
batterseapower's avatar
batterseapower committed
21 22 23
--   be global or local, see "Var#globalvslocal"
--
-- * 'Var.Var': see "Var#name_types"
Ian Lynagh's avatar
Ian Lynagh committed
24

25
module Id (
26
        -- * The main types
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
        Var, Id, isId,

        -- ** Simple construction
        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
        mkLocalId, mkLocalIdWithInfo, mkExportedLocalId,
        mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
        mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
        mkWorkerId, mkWiredInIdName,

        -- ** Taking an Id apart
        idName, idType, idUnique, idInfo, idDetails, idRepArity,
        recordSelectorFieldLabel,

        -- ** Modifying an Id
        setIdName, setIdUnique, Id.setIdType,
        setIdExported, setIdNotExported,
        globaliseId, localiseId,
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
        zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,


        -- ** Predicates on Ids
        isImplicitId, isDeadBinder,
50
        isStrictId,
51 52 53 54 55 56
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,
        isClassOpId_maybe, isDFunId,
        isPrimOpId, isPrimOpId_maybe,
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
57
        isConLikeId, isBottomingId, idIsFrom,
58
        hasNoBinding,
59

60 61
        -- ** Evidence variables
        DictId, isDictId, dfunNSilent, isEvVar,
62

63 64
        -- ** Inline pragma stuff
        idInlinePragma, setInlinePragma, modifyInlinePragma,
65
        idInlineActivation, setInlineActivation, idRuleMatchInfo,
66

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
        -- ** One-shot lambdas
        isOneShotBndr, isOneShotLambda, isStateHackType,
        setOneShotLambda, clearOneShotLambda,

        -- ** Reading 'IdInfo' fields
        idArity,
        idDemandInfo, idDemandInfo_maybe,
        idStrictness, idStrictness_maybe,
        idUnfolding, realIdUnfolding,
        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
        idLBVarInfo,
        idOccInfo,

        -- ** Writing 'IdInfo' fields
        setIdUnfoldingLazily,
        setIdUnfolding,
        setIdArity,
        setIdDemandInfo,
        setIdStrictness, zapIdStrictness,
        setIdSpecialisation,
        setIdCafInfo,
        setIdOccInfo, zapIdOccInfo,
90

91
    ) where
92

93
#include "HsVersions.h"
sof's avatar
sof committed
94

95
import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) )
96 97

import IdInfo
Simon Marlow's avatar
Simon Marlow committed
98
import BasicTypes
99

100
-- Imported and re-exported
101
import Var( Var, Id, DictId,
102
            idInfo, idDetails, globaliseId, varType,
103
            isId, isLocalId, isGlobalId, isExportedId )
Simon Marlow's avatar
Simon Marlow committed
104
import qualified Var
105

Simon Marlow's avatar
Simon Marlow committed
106 107
import TyCon
import Type
batterseapower's avatar
batterseapower committed
108
import TysPrim
Simon Marlow's avatar
Simon Marlow committed
109
import DataCon
110
import Demand
Simon Marlow's avatar
Simon Marlow committed
111 112
import Name
import Module
twanvl's avatar
twanvl committed
113
import Class
114
import {-# SOURCE #-} PrimOp (PrimOp)
twanvl's avatar
twanvl committed
115
import ForeignCall
Simon Marlow's avatar
Simon Marlow committed
116 117
import Maybes
import SrcLoc
118
import Outputable
Simon Marlow's avatar
Simon Marlow committed
119
import Unique
120
import UniqSupply
Simon Marlow's avatar
Simon Marlow committed
121
import FastString
122
import Util
Simon Marlow's avatar
Simon Marlow committed
123
import StaticFlags
124

125
-- infixl so you can say (id `set` a `set` b)
126 127 128 129 130 131 132 133 134 135
infixl  1 `setIdUnfoldingLazily`,
          `setIdUnfolding`,
          `setIdArity`,
          `setIdOccInfo`,
          `setIdDemandInfo`,
          `setIdStrictness`,
          `setIdSpecialisation`,
          `setInlinePragma`,
          `setInlineActivation`,
          `idCafInfo`
136
\end{code}
batterseapower's avatar
batterseapower committed
137

138
%************************************************************************
139
%*                                                                      *
140
\subsection{Basic Id manipulation}
141
%*                                                                      *
142 143 144 145 146 147 148
%************************************************************************

\begin{code}
idName   :: Id -> Name
idName    = Var.varName

idUnique :: Id -> Unique
149
idUnique  = Var.varUnique
150 151

idType   :: Id -> Kind
152
idType    = Var.varType
batterseapower's avatar
batterseapower committed
153

154
setIdName :: Id -> Name -> Id
155
setIdName = Var.setVarName
156

batterseapower's avatar
batterseapower committed
157
setIdUnique :: Id -> Unique -> Id
158
setIdUnique = Var.setVarUnique
batterseapower's avatar
batterseapower committed
159 160 161

-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
-- reduce space usage
162 163
setIdType :: Id -> Type -> Id
setIdType id ty = seqType ty `seq` Var.setVarType id ty
164

165
setIdExported :: Id -> Id
166
setIdExported = Var.setIdExported
167

168
setIdNotExported :: Id -> Id
169
setIdNotExported = Var.setIdNotExported
170

171
localiseId :: Id -> Id
172
-- Make an with the same unique and type as the
173
-- incoming Id, but with an *Internal* Name and *LocalId* flavour
174
localiseId id
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
175
  | ASSERT( isId id ) isLocalId id && isInternalName name
176 177 178 179 180 181
  = id
  | otherwise
  = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id)
  where
    name = idName id

182
lazySetIdInfo :: Id -> IdInfo -> Id
183
lazySetIdInfo = Var.lazySetIdInfo
184 185 186 187 188 189 190 191 192 193 194

setIdInfo :: Id -> IdInfo -> Id
setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
        -- Try to avoid spack leaks by seq'ing

modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo fn id = setIdInfo id (fn (idInfo id))

-- maybeModifyIdInfo tries to avoid unnecesary thrashing
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
195
maybeModifyIdInfo Nothing         id = id
196
\end{code}
197

198
%************************************************************************
199
%*                                                                      *
200
\subsection{Simple Id construction}
201
%*                                                                      *
202 203
%************************************************************************

204
Absolutely all Ids are made by mkId.  It is just like Var.mkId,
205
but in addition it pins free-tyvar-info onto the Id's type,
206
where it can easily be found.
207

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
208 209 210 211 212 213
Note [Free type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~
At one time we cached the free type variables of the type of an Id
at the root of the type in a TyNote.  The idea was to avoid repeating
the free-type-variable calculation.  But it turned out to slow down
the compiler overall. I don't quite know why; perhaps finding free
214
type variables of an Id isn't all that common whereas applying a
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
215 216 217
substitution (which changes the free type variables) is more common.
Anyway, we removed it in March 2008.

218
\begin{code}
batterseapower's avatar
batterseapower committed
219
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
220 221
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
222

batterseapower's avatar
batterseapower committed
223
-- | Make a global 'Id' without any extra information at all
224 225
mkVanillaGlobal :: Name -> Type -> Id
mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
226

batterseapower's avatar
batterseapower committed
227
-- | Make a global 'Id' with no global information but some generic 'IdInfo'
228
mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
229
mkVanillaGlobalWithInfo = mkGlobalId VanillaId
230

231

batterseapower's avatar
batterseapower committed
232
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
233
mkLocalId :: Name -> Type -> Id
234
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
235

236
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
237
mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
238
        -- Note [Free type variables]
239

240
-- | Create a local 'Id' that is marked as exported.
241
-- This prevents things attached to it from being removed as dead code.
242
mkExportedLocalId :: Name -> Type -> Id
243
mkExportedLocalId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
244
        -- Note [Free type variables]
245 246


247
-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
248
-- that are created by the compiler out of thin air
249 250 251
mkSysLocal :: FastString -> Unique -> Type -> Id
mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty

252 253 254
mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))

255

batterseapower's avatar
batterseapower committed
256
-- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
257
mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
258
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
259

260 261
mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id
mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc))
batterseapower's avatar
batterseapower committed
262

263 264 265
mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName mod fs uniq id
 = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
266
\end{code}
267 268 269 270

Make some local @Ids@ for a template @CoreExpr@.  These have bogus
@Uniques@, but that's OK because the templates are supposed to be
instantiated before use.
271

272
\begin{code}
batterseapower's avatar
batterseapower committed
273
-- | Workers get local names. "CoreTidy" will externalise these if necessary
274 275
mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty
276
  = mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
277

batterseapower's avatar
batterseapower committed
278
-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
279 280 281 282
mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty

-- | Create a template local for a series of types
283
mkTemplateLocals :: [Type] -> [Id]
284
mkTemplateLocals = mkTemplateLocalsNum 1
285

286
-- | Create a template local for a series of type, but start from a specified template local
287
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
288
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
289 290 291
\end{code}


292
%************************************************************************
293
%*                                                                      *
294
\subsection{Special Ids}
295
%*                                                                      *
296 297
%************************************************************************

298
\begin{code}
batterseapower's avatar
batterseapower committed
299
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
300
recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
301
recordSelectorFieldLabel id
302 303
  = case Var.idDetails id of
        RecSelId { sel_tycon = tycon } -> (tycon, idName id)
twanvl's avatar
twanvl committed
304 305
        _ -> panic "recordSelectorFieldLabel"

306 307 308 309 310
isRecordSelector        :: Id -> Bool
isNaughtyRecordSelector :: Id -> Bool
isPrimOpId              :: Id -> Bool
isFCallId               :: Id -> Bool
isDataConWorkId         :: Id -> Bool
311
isDFunId                :: Id -> Bool
twanvl's avatar
twanvl committed
312

313 314 315 316
isClassOpId_maybe       :: Id -> Maybe Class
isPrimOpId_maybe        :: Id -> Maybe PrimOp
isFCallId_maybe         :: Id -> Maybe ForeignCall
isDataConWorkId_maybe   :: Id -> Maybe DataCon
sof's avatar
sof committed
317

318 319
isRecordSelector id = case Var.idDetails id of
                        RecSelId {}  -> True
twanvl's avatar
twanvl committed
320
                        _               -> False
sof's avatar
sof committed
321

322 323
isNaughtyRecordSelector id = case Var.idDetails id of
                        RecSelId { sel_naughty = n } -> n
twanvl's avatar
twanvl committed
324
                        _                               -> False
325

326
isClassOpId_maybe id = case Var.idDetails id of
327 328
                        ClassOpId cls -> Just cls
                        _other        -> Nothing
329

330
isPrimOpId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
331 332
                        PrimOpId _ -> True
                        _          -> False
333

334
isDFunId id = case Var.idDetails id of
335 336 337
                        DFunId {} -> True
                        _         -> False

338 339 340 341 342
dfunNSilent :: Id -> Int
dfunNSilent id = case Var.idDetails id of
                   DFunId ns _ -> ns
                   _ -> pprPanic "dfunSilent: not a dfun:" (ppr id)

343
isPrimOpId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
344 345
                        PrimOpId op -> Just op
                        _           -> Nothing
346

347
isFCallId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
348 349
                        FCallId _ -> True
                        _         -> False
350

351
isFCallId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
352 353
                        FCallId call -> Just call
                        _            -> Nothing
354

355
isDataConWorkId id = case Var.idDetails id of
twanvl's avatar
twanvl committed
356 357
                        DataConWorkId _ -> True
                        _               -> False
sof's avatar
sof committed
358

359
isDataConWorkId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
360 361
                        DataConWorkId con -> Just con
                        _                 -> Nothing
sof's avatar
sof committed
362

363
isDataConId_maybe :: Id -> Maybe DataCon
364
isDataConId_maybe id = case Var.idDetails id of
twanvl's avatar
twanvl committed
365 366 367
                         DataConWorkId con -> Just con
                         DataConWrapId con -> Just con
                         _                 -> Nothing
368

369
idDataCon :: Id -> DataCon
batterseapower's avatar
batterseapower committed
370
-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
371
--
batterseapower's avatar
batterseapower committed
372 373
-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
374

375
hasNoBinding :: Id -> Bool
batterseapower's avatar
batterseapower committed
376 377 378
-- ^ Returns @True@ of an 'Id' which may not have a
-- binding, even though it is defined in this module.

379
-- Data constructor workers used to be things of this kind, but
380 381
-- they aren't any more.  Instead, we inject a binding for
-- them at the CorePrep stage.
382
-- EXCEPT: unboxed tuples, which definitely have no binding
383
hasNoBinding id = case Var.idDetails id of
384 385 386 387
                        PrimOpId _       -> True        -- See Note [Primop wrappers]
                        FCallId _        -> True
                        DataConWorkId dc -> isUnboxedTupleCon dc
                        _                -> False
388

389
isImplicitId :: Id -> Bool
batterseapower's avatar
batterseapower committed
390
-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
391 392
-- declarations, so we don't need to put its signature in an interface
-- file, even if it's mentioned in some other interface unfolding.
393
isImplicitId id
394
  = case Var.idDetails id of
395
        FCallId {}       -> True
396
        ClassOpId {}     -> True
397 398
        PrimOpId {}      -> True
        DataConWorkId {} -> True
399 400 401 402 403
        DataConWrapId {} -> True
                -- These are are implied by their type or class decl;
                -- remember that all type and class decls appear in the interface file.
                -- The dfun id is not an implicit Id; it must *not* be omitted, because
                -- it carries version info for the instance decl
twanvl's avatar
twanvl committed
404
        _               -> False
405 406 407

idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
408 409
\end{code}

410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
Note [Primop wrappers]
~~~~~~~~~~~~~~~~~~~~~~
Currently hasNoBinding claims that PrimOpIds don't have a curried
function definition.  But actually they do, in GHC.PrimopWrappers,
which is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding
could return 'False' for PrimOpIds.

But we'd need to add something in CoreToStg to swizzle any unsaturated
applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.

Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
used by GHCi, which does not implement primops direct at all.



425 426
\begin{code}
isDeadBinder :: Id -> Bool
427
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
428
                  | otherwise = False   -- TyVars count as not dead
429 430
\end{code}

431
%************************************************************************
432 433 434
%*                                                                      *
              Evidence variables
%*                                                                      *
435 436 437
%************************************************************************

\begin{code}
438 439
isEvVar :: Var -> Bool
isEvVar var = isPredTy (varType var)
440 441 442 443 444

isDictId :: Id -> Bool
isDictId id = isDictTy (idType id)
\end{code}

445
%************************************************************************
446
%*                                                                      *
447
\subsection{IdInfo stuff}
448
%*                                                                      *
449 450
%************************************************************************

451
\begin{code}
452 453
        ---------------------------------
        -- ARITY
454
idArity :: Id -> Arity
455
idArity id = arityInfo (idInfo id)
456

457 458
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
459

460 461 462
idRepArity :: Id -> RepArity
idRepArity x = typeRepArity (idArity x) (idType x)

463
-- | Returns true if an application to n args would diverge
464
isBottomingId :: Id -> Bool
465
isBottomingId id = isBottomingSig (idStrictness id)
466

467 468
idStrictness_maybe :: Id -> Maybe StrictSig
idStrictness :: Id -> StrictSig
469

470 471
idStrictness_maybe id = strictnessInfo (idInfo id)
idStrictness       id = idStrictness_maybe id `orElse` topSig
472

473 474
setIdStrictness :: Id -> StrictSig -> Id
setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` Just sig) id
475

476 477
zapIdStrictness :: Id -> Id
zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` Nothing) id
478

batterseapower's avatar
batterseapower committed
479
-- | This predicate says whether the 'Id' has a strict demand placed on it or
480 481
-- has a type such that it can always be evaluated strictly (e.g., an
-- unlifted type, but see the comment for 'isStrictType').  We need to
batterseapower's avatar
batterseapower committed
482 483 484
-- check separately whether the 'Id' has a so-called \"strict type\" because if
-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
-- type, we still want @isStrictId id@ to be @True@.
485 486 487
isStrictId :: Id -> Bool
isStrictId id
  = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
488
           (isStrictDmd (idDemandInfo id)) ||
489
           (isStrictType (idType id))
490

491 492
        ---------------------------------
        -- UNFOLDING
493
idUnfolding :: Id -> Unfolding
494
-- Do not expose the unfolding of a loop breaker!
495
idUnfolding id
496 497
  | isStrongLoopBreaker (occInfo info) = NoUnfolding
  | otherwise                          = unfoldingInfo info
498 499 500 501 502 503
  where
    info = idInfo id

realIdUnfolding :: Id -> Unfolding
-- Expose the unfolding if there is one, including for loop breakers
realIdUnfolding id = unfoldingInfo (idInfo id)
504

505 506 507
setIdUnfoldingLazily :: Id -> Unfolding -> Id
setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id

508
setIdUnfolding :: Id -> Unfolding -> Id
509
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
510

511 512
idDemandInfo_maybe :: Id -> Maybe Demand
idDemandInfo       :: Id -> Demand
513

514 515
idDemandInfo_maybe id = demandInfo (idInfo id)
idDemandInfo       id = demandInfo (idInfo id) `orElse` topDmd
516

517 518
setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` Just dmd) id
519

520 521
        ---------------------------------
        -- SPECIALISATION
522 523 524

-- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs

525
idSpecialisation :: Id -> SpecInfo
526
idSpecialisation id = specInfo (idInfo id)
527

528 529
idCoreRules :: Id -> [CoreRule]
idCoreRules id = specInfoRules (idSpecialisation id)
530

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
531 532 533
idHasRules :: Id -> Bool
idHasRules id = not (isEmptySpecInfo (idSpecialisation id))

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 541 542 543 544
idCafInfo id = cafInfo (idInfo id)

setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id

545 546
        ---------------------------------
        -- Occcurrence INFO
547 548
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
549 550 551

setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
552 553 554

zapIdOccInfo :: Id -> Id
zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
555 556
\end{code}

sof's avatar
sof committed
557

558 559
        ---------------------------------
        -- INLINING
560 561
The inline pragma tells us to be very keen to inline this Id, but it's still
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 574 575 576

idInlineActivation :: Id -> Activation
idInlineActivation id = inlinePragmaActivation (idInlinePragma id)

setInlineActivation :: Id -> Activation -> Id
577
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
578 579 580 581 582 583

idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)

isConLikeId :: Id -> Bool
isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
584
\end{code}
585 586


587 588
        ---------------------------------
        -- ONE-SHOT LAMBDAS
589
\begin{code}
590 591 592
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

batterseapower's avatar
batterseapower committed
593 594 595
-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
-- OR we are applying the \"state hack\" which makes it appear as if theis is the case for
-- lambdas used in @IO@. You should prefer using this over 'isOneShotLambda'
596 597 598
isOneShotBndr :: Id -> Bool
-- This one is the "business end", called externally.
-- Its main purpose is to encapsulate the Horrible State Hack
599
isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
600

batterseapower's avatar
batterseapower committed
601
-- | Should we apply the state hack to values of this 'Type'?
602 603
isStateHackType :: Type -> Bool
isStateHackType ty
604
  | opt_NoStateHack
605 606
  = False
  | otherwise
607
  = case tyConAppTyCon_maybe ty of
608
        Just tycon -> tycon == statePrimTyCon
609
        _          -> False
610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626
        -- This is a gross hack.  It claims that
        -- every function over realWorldStatePrimTy is a one-shot
        -- function.  This is pretty true in practice, and makes a big
        -- difference.  For example, consider
        --      a `thenST` \ r -> ...E...
        -- The early full laziness pass, if it doesn't know that r is one-shot
        -- will pull out E (let's say it doesn't mention r) to give
        --      let lvl = E in a `thenST` \ r -> ...lvl...
        -- When `thenST` gets inlined, we end up with
        --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
        -- and we don't re-inline E.
        --
        -- It would be better to spot that r was one-shot to start with, but
        -- I don't want to rely on that.
        --
        -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
        -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
627 628


batterseapower's avatar
batterseapower committed
629 630
-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
-- You probably want to use 'isOneShotBndr' instead
631
isOneShotLambda :: Id -> Bool
632 633 634
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       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

batterseapower's avatar
batterseapower committed
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 652 653
zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id

654
zapLamIdInfo :: Id -> Id
655 656
zapLamIdInfo = zapInfo zapLamInfo

twanvl's avatar
twanvl committed
657
zapDemandIdInfo :: Id -> Id
658
zapDemandIdInfo = zapInfo zapDemandInfo
659

660
zapFragileIdInfo :: Id -> Id
661
zapFragileIdInfo = zapInfo zapFragileInfo
662
\end{code}
663

664 665
Note [transferPolyIdInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~
666 667 668
This transfer is used in two places:
        FloatOut (long-distance let-floating)
        SimplUtils.abstractFloats (short-distance let-floating)
669 670

Consider the short-distance let-floating:
671 672 673

   f = /\a. let g = rhs in ...

674
Then if we float thus
675 676

   g' = /\a. rhs
677
   f = /\a. ...[g' a/g]....
678

679 680
we *do not* want to lose g's
  * strictness information
681
  * arity
682
  * inline pragma (though that is bit more debatable)
683 684 685 686
  * occurrence info

Mostly this is just an optimisation, but it's *vital* to
transfer the occurrence info.  Consider
687

688 689 690
   NonRec { f = /\a. let Rec { g* = ..g.. } in ... }

where the '*' means 'LoopBreaker'.  Then if we float we must get
691

692 693 694 695 696 697 698 699
   Rec { g'* = /\a. ...(g' a)... }
   NonRec { f = /\a. ...[g' a/g]....}

where g' is also marked as LoopBreaker.  If not, terrible things
can happen if we re-simplify the binding (and the Simplifier does
sometimes simplify a term twice); see Trac #4345.

It's not so simple to retain
700 701
  * worker info
  * rules
702 703
so we simply discard those.  Sooner or later this may bite us.

704 705
If we abstract wrt one or more *value* binders, we must modify the
arity and strictness info before transferring it.  E.g.
706 707 708 709 710 711
      f = \x. e
-->
      g' = \y. \x. e
      + substitute (g' y) for g
Notice that g' has an arity one more than the original g

712
\begin{code}
713 714 715 716
transferPolyIdInfo :: Id        -- Original Id
                   -> [Var]     -- Abstract wrt these variables
                   -> Id        -- New Id
                   -> Id
717
transferPolyIdInfo old_id abstract_wrt new_id
718 719
  = modifyIdInfo transfer new_id
  where
720 721
    arity_increase = count isId abstract_wrt    -- Arity increases by the
                                                -- number of value binders
722

723
    old_info        = idInfo old_id
724 725
    old_arity       = arityInfo old_info
    old_inline_prag = inlinePragInfo old_info
726
    old_occ_info    = occInfo old_info
727
    new_arity       = old_arity + arity_increase
728
    old_strictness  = strictnessInfo old_info
729 730
    new_strictness  = fmap (increaseStrictSigArity arity_increase) old_strictness

731
    transfer new_info = new_info `setStrictnessInfo` new_strictness
732 733 734
                                 `setArityInfo` new_arity
                                 `setInlinePragInfo` old_inline_prag
                                 `setOccInfo` old_occ_info
735
\end{code}