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 module Id (
   9         Id, DictId,
  10
  11         -- Simple construction
  12         mkGlobalId, mkLocalId, mkLocalIdWithInfo,
  13         mkSysLocal, mkUserLocal, mkVanillaGlobal,
  14         mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
  15         mkWorkerId, mkExportedLocalId,
  16
  17         -- Taking an Id apart
  18         idName, idType, idUnique, idInfo,
  19         isId, globalIdDetails, idPrimRep,
  20         recordSelectorFieldLabel,
  21
  22         -- Modifying an Id
  23         setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported,
  24         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
  25         zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo,
  26
  27         -- Predicates
  28         isImplicitId, isDeadBinder, isDictId,
  29         isExportedId, isLocalId, isGlobalId,
  30         isRecordSelector, isNaughtyRecordSelector,
  31         isClassOpId_maybe,
  32         isPrimOpId, isPrimOpId_maybe,
  33         isFCallId, isFCallId_maybe,
  34         isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
  35         isBottomingId, idIsFrom,
  36         isTickBoxOp, isTickBoxOp_maybe,
  37         hasNoBinding,
  38
  39         -- Inline pragma stuff
  40         idInlinePragma, setInlinePragma, modifyInlinePragma,
  41
  42
  43         -- One shot lambda stuff
  44         isOneShotBndr, isOneShotLambda, isStateHackType,
  45         setOneShotLambda, clearOneShotLambda,
  46
  47         -- IdInfo stuff
  48         setIdUnfolding,
  49         setIdArity,
  50         setIdNewDemandInfo,
  51         setIdNewStrictness, zapIdNewStrictness,
  52         setIdWorkerInfo,
  53         setIdSpecialisation,
  54         setIdCafInfo,
  55         setIdOccInfo,
  56
  57 #ifdef OLD_STRICTNESS
  58         idDemandInfo,
  59         idStrictness,
  60         idCprInfo,
  61         setIdStrictness,
  62         setIdDemandInfo,
  63         setIdCprInfo,
  64 #endif
  65
  66         idArity,
  67         idNewDemandInfo, idNewDemandInfo_maybe,
  68         idNewStrictness, idNewStrictness_maybe,
  69         idWorkerInfo,
  70         idUnfolding,
  71         idSpecialisation, idCoreRules, idHasRules,
  72         idCafInfo,
  73         idLBVarInfo,
  74         idOccInfo,
  75
  76 #ifdef OLD_STRICTNESS
  77         newStrictnessFromOld    -- Temporary
  78 #endif
  79
  80     ) where
  81
  82 #include "HsVersions.h"
  83
  84 import CoreSyn
  85 import BasicTypes
  86 import qualified Var
  87 import Var hiding (mkLocalId, mkGlobalId, mkExportedLocalId)
  88 import TyCon
  89 import Type
  90 import TcType
  91 import TysPrim
  92 import IdInfo
  93 #ifdef OLD_STRICTNESS
  94 import qualified Demand
  95 #endif
  96 import DataCon
  97 import NewDemand
  98 import Name
  99 import Module
 100 import OccName
 101 import Maybes
 102 import SrcLoc
 103 import Outputable
 104 import Unique
 105 import FastString
 106 import StaticFlags
 107
 108 -- infixl so you can say (id `set` a `set` b)
 109 infixl  1 `setIdUnfolding`,
 110           `setIdArity`,
 111           `setIdNewDemandInfo`,
 112           `setIdNewStrictness`,
 113           `setIdWorkerInfo`,
 114           `setIdSpecialisation`,
 115           `setInlinePragma`,
 116           `idCafInfo`
 117 #ifdef OLD_STRICTNESS
 118           ,`idCprInfo`
 119           ,`setIdStrictness`
 120           ,`setIdDemandInfo`
 121 #endif
 122 \end{code}
 123
 124
 125
 126 %************************************************************************
 127 %*                                                                      *
 128 \subsection{Simple Id construction}
 129 %*                                                                      *
 130 %************************************************************************
 131
 132 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
 133 but in addition it pins free-tyvar-info onto the Id's type,
 134 where it can easily be found.
 135
 136 \begin{code}
 137 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 138 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
 139
 140 mkExportedLocalId :: Name -> Type -> Id
 141 mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
 142
 143 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
 144 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
 145 \end{code}
 146
 147 \begin{code}
 148 mkLocalId :: Name -> Type -> Id
 149 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 150
 151 -- SysLocal: for an Id being created by the compiler out of thin air...
 152 mkSysLocal :: FastString -> Unique -> Type -> Id
 153 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 154
 155
 156 -- UserLocal: an Id with a name the user might recognize...
 157 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
 158 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 159
 160 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
 161 mkVanillaGlobal             = mkGlobalId VanillaGlobal
 162 \end{code}
 163
 164 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 165 @Uniques@, but that's OK because the templates are supposed to be
 166 instantiated before use.
 167
 168 \begin{code}
 169 -- "Wild Id" typically used when you need a binder that you don't expect to use
 170 mkWildId :: Type -> Id
 171 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
 172
 173 mkWorkerId :: Unique -> Id -> Type -> Id
 174 -- A worker gets a local name.  CoreTidy will externalise it if necessary.
 175 mkWorkerId uniq unwrkr ty
 176   = mkLocalId wkr_name ty
 177   where
 178     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
 179
 180 -- "Template locals" typically used in unfoldings
 181 mkTemplateLocals :: [Type] -> [Id]
 182 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
 183
 184 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 185 -- The Int gives the starting point for unique allocation
 186 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 187
 188 mkTemplateLocal :: Int -> Type -> Id
 189 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
 190 \end{code}
 191
 192
 193 %************************************************************************
 194 %*                                                                      *
 195 \subsection[Id-general-funs]{General @Id@-related functions}
 196 %*                                                                      *
 197 %************************************************************************
 198
 199 \begin{code}
 200 setIdType :: Id -> Type -> Id
 201         -- Add free tyvar info to the type
 202 setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
 203
 204 idPrimRep :: Id -> PrimRep
 205 idPrimRep id = typePrimRep (idType id)
 206 \end{code}
 207
 208
 209 %************************************************************************
 210 %*                                                                      *
 211 \subsection{Special Ids}
 212 %*                                                                      *
 213 %************************************************************************
 214
 215 \begin{code}
 216 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 217 recordSelectorFieldLabel id = case globalIdDetails id of
 218                                  RecordSelId tycon lbl _ -> (tycon,lbl)
 219                                  other -> panic "recordSelectorFieldLabel"
 220
 221 isRecordSelector id = case globalIdDetails id of
 222                         RecordSelId {}  -> True
 223                         other           -> False
 224
 225 isNaughtyRecordSelector id = case globalIdDetails id of
 226                         RecordSelId { sel_naughty = n } -> n
 227                         other                           -> False
 228
 229 isClassOpId_maybe id = case globalIdDetails id of
 230                         ClassOpId cls -> Just cls
 231                         _other        -> Nothing
 232
 233 isPrimOpId id = case globalIdDetails id of
 234                     PrimOpId op -> True
 235                     other       -> False
 236
 237 isPrimOpId_maybe id = case globalIdDetails id of
 238                             PrimOpId op -> Just op
 239                             other       -> Nothing
 240
 241 isFCallId id = case globalIdDetails id of
 242                     FCallId call -> True
 243                     other        -> False
 244
 245 isFCallId_maybe id = case globalIdDetails id of
 246                             FCallId call -> Just call
 247                             other        -> Nothing
 248
 249 isDataConWorkId id = case globalIdDetails id of
 250                         DataConWorkId _ -> True
 251                         other           -> False
 252
 253 isDataConWorkId_maybe id = case globalIdDetails id of
 254                           DataConWorkId con -> Just con
 255                           other             -> Nothing
 256
 257 isDataConId_maybe :: Id -> Maybe DataCon
 258 isDataConId_maybe id = case globalIdDetails id of
 259                          DataConWorkId con -> Just con
 260                          DataConWrapId con -> Just con
 261                          other              -> Nothing
 262
 263 idDataCon :: Id -> DataCon
 264 -- Get from either the worker or the wrapper to the DataCon
 265 -- Currently used only in the desugarer
 266 --       INVARIANT: idDataCon (dataConWrapId d) = d
 267 -- (Remember, dataConWrapId can return either the wrapper or the worker.)
 268 idDataCon id = case globalIdDetails id of
 269                   DataConWorkId con -> con
 270                   DataConWrapId con -> con
 271                   other             -> pprPanic "idDataCon" (ppr id)
 272
 273
 274 isDictId :: Id -> Bool
 275 isDictId id = isDictTy (idType id)
 276
 277 -- hasNoBinding returns True of an Id which may not have a
 278 -- binding, even though it is defined in this module.
 279 -- Data constructor workers used to be things of this kind, but
 280 -- they aren't any more.  Instead, we inject a binding for
 281 -- them at the CorePrep stage.
 282 -- EXCEPT: unboxed tuples, which definitely have no binding
 283 hasNoBinding id = case globalIdDetails id of
 284                         PrimOpId _       -> True
 285                         FCallId _        -> True
 286                         DataConWorkId dc -> isUnboxedTupleCon dc
 287                         other            -> False
 288
 289 isImplicitId :: Id -> Bool
 290         -- isImplicitId tells whether an Id's info is implied by other
 291         -- declarations, so we don't need to put its signature in an interface
 292         -- file, even if it's mentioned in some other interface unfolding.
 293 isImplicitId id
 294   = case globalIdDetails id of
 295         RecordSelId {}  -> True
 296         FCallId _       -> True
 297         PrimOpId _      -> True
 298         ClassOpId _     -> True
 299         DataConWorkId _ -> True
 300         DataConWrapId _ -> True
 301                 -- These are are implied by their type or class decl;
 302                 -- remember that all type and class decls appear in the interface file.
 303                 -- The dfun id is not an implicit Id; it must *not* be omitted, because
 304                 -- it carries version info for the instance decl
 305         other           -> False
 306
 307 idIsFrom :: Module -> Id -> Bool
 308 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
 309 \end{code}
 310
 311 \begin{code}
 312 isDeadBinder :: Id -> Bool
 313 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 314                   | otherwise = False   -- TyVars count as not dead
 315 \end{code}
 316
 317 \begin{code}
 318 isTickBoxOp :: Id -> Bool
 319 isTickBoxOp id =
 320   case globalIdDetails id of
 321     TickBoxOpId tick -> True
 322     _                -> False
 323
 324 isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
 325 isTickBoxOp_maybe id =
 326   case globalIdDetails id of
 327     TickBoxOpId tick -> Just tick
 328     _                -> Nothing
 329 \end{code}
 330
 331 %************************************************************************
 332 %*                                                                      *
 333 \subsection{IdInfo stuff}
 334 %*                                                                      *
 335 %************************************************************************
 336
 337 \begin{code}
 338         ---------------------------------
 339         -- ARITY
 340 idArity :: Id -> Arity
 341 idArity id = arityInfo (idInfo id)
 342
 343 setIdArity :: Id -> Arity -> Id
 344 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 345
 346 #ifdef OLD_STRICTNESS
 347         ---------------------------------
 348         -- (OLD) STRICTNESS
 349 idStrictness :: Id -> StrictnessInfo
 350 idStrictness id = strictnessInfo (idInfo id)
 351
 352 setIdStrictness :: Id -> StrictnessInfo -> Id
 353 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
 354 #endif
 355
 356 -- isBottomingId returns true if an application to n args would diverge
 357 isBottomingId :: Id -> Bool
 358 isBottomingId id = isBottomingSig (idNewStrictness id)
 359
 360 idNewStrictness_maybe :: Id -> Maybe StrictSig
 361 idNewStrictness :: Id -> StrictSig
 362
 363 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
 364 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
 365
 366 setIdNewStrictness :: Id -> StrictSig -> Id
 367 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
 368
 369 zapIdNewStrictness :: Id -> Id
 370 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 371
 372         ---------------------------------
 373         -- WORKER ID
 374 idWorkerInfo :: Id -> WorkerInfo
 375 idWorkerInfo id = workerInfo (idInfo id)
 376
 377 setIdWorkerInfo :: Id -> WorkerInfo -> Id
 378 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
 379
 380         ---------------------------------
 381         -- UNFOLDING
 382 idUnfolding :: Id -> Unfolding
 383 idUnfolding id = unfoldingInfo (idInfo id)
 384
 385 setIdUnfolding :: Id -> Unfolding -> Id
 386 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 387
 388 #ifdef OLD_STRICTNESS
 389         ---------------------------------
 390         -- (OLD) DEMAND
 391 idDemandInfo :: Id -> Demand.Demand
 392 idDemandInfo id = demandInfo (idInfo id)
 393
 394 setIdDemandInfo :: Id -> Demand.Demand -> Id
 395 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 396 #endif
 397
 398 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
 399 idNewDemandInfo       :: Id -> NewDemand.Demand
 400
 401 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
 402 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
 403
 404 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
 405 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 406
 407         ---------------------------------
 408         -- SPECIALISATION
 409 idSpecialisation :: Id -> SpecInfo
 410 idSpecialisation id = specInfo (idInfo id)
 411
 412 idCoreRules :: Id -> [CoreRule]
 413 idCoreRules id = specInfoRules (idSpecialisation id)
 414
 415 idHasRules :: Id -> Bool
 416 idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
 417
 418 setIdSpecialisation :: Id -> SpecInfo -> Id
 419 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 420
 421         ---------------------------------
 422         -- CAF INFO
 423 idCafInfo :: Id -> CafInfo
 424 #ifdef OLD_STRICTNESS
 425 idCafInfo id = case cgInfo (idInfo id) of
 426                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
 427                   info     -> cgCafInfo info
 428 #else
 429 idCafInfo id = cafInfo (idInfo id)
 430 #endif
 431
 432 setIdCafInfo :: Id -> CafInfo -> Id
 433 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 434
 435         ---------------------------------
 436         -- CPR INFO
 437 #ifdef OLD_STRICTNESS
 438 idCprInfo :: Id -> CprInfo
 439 idCprInfo id = cprInfo (idInfo id)
 440
 441 setIdCprInfo :: Id -> CprInfo -> Id
 442 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
 443 #endif
 444
 445         ---------------------------------
 446         -- Occcurrence INFO
 447 idOccInfo :: Id -> OccInfo
 448 idOccInfo id = occInfo (idInfo id)
 449
 450 setIdOccInfo :: Id -> OccInfo -> Id
 451 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 452 \end{code}
 453
 454
 455         ---------------------------------
 456         -- INLINING
 457 The inline pragma tells us to be very keen to inline this Id, but it's still
 458 OK not to if optimisation is switched off.
 459
 460 \begin{code}
 461 idInlinePragma :: Id -> InlinePragInfo
 462 idInlinePragma id = inlinePragInfo (idInfo id)
 463
 464 setInlinePragma :: Id -> InlinePragInfo -> Id
 465 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 466
 467 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 468 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 469 \end{code}
 470
 471
 472         ---------------------------------
 473         -- ONE-SHOT LAMBDAS
 474 \begin{code}
 475 idLBVarInfo :: Id -> LBVarInfo
 476 idLBVarInfo id = lbvarInfo (idInfo id)
 477
 478 isOneShotBndr :: Id -> Bool
 479 -- This one is the "business end", called externally.
 480 -- Its main purpose is to encapsulate the Horrible State Hack
 481 isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
 482
 483 isStateHackType :: Type -> Bool
 484 isStateHackType ty
 485   | opt_NoStateHack
 486   = False
 487   | otherwise
 488   = case splitTyConApp_maybe ty of
 489         Just (tycon,_) -> tycon == statePrimTyCon
 490         other          -> False
 491         -- This is a gross hack.  It claims that
 492         -- every function over realWorldStatePrimTy is a one-shot
 493         -- function.  This is pretty true in practice, and makes a big
 494         -- difference.  For example, consider
 495         --      a `thenST` \ r -> ...E...
 496         -- The early full laziness pass, if it doesn't know that r is one-shot
 497         -- will pull out E (let's say it doesn't mention r) to give
 498         --      let lvl = E in a `thenST` \ r -> ...lvl...
 499         -- When `thenST` gets inlined, we end up with
 500         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 501         -- and we don't re-inline E.
 502         --
 503         -- It would be better to spot that r was one-shot to start with, but
 504         -- I don't want to rely on that.
 505         --
 506         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
 507         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 508
 509
 510 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 511 isOneShotLambda :: Id -> Bool
 512 isOneShotLambda id = case idLBVarInfo id of
 513                        IsOneShotLambda  -> True
 514                        NoLBVarInfo      -> False
 515
 516 setOneShotLambda :: Id -> Id
 517 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
 518
 519 clearOneShotLambda :: Id -> Id
 520 clearOneShotLambda id
 521   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
 522   | otherwise          = id
 523
 524 -- But watch out: this may change the type of something else
 525 --      f = \x -> e
 526 -- If we change the one-shot-ness of x, f's type changes
 527 \end{code}
 528
 529 \begin{code}
 530 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 531 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 532
 533 zapLamIdInfo :: Id -> Id
 534 zapLamIdInfo = zapInfo zapLamInfo
 535
 536 zapDemandIdInfo = zapInfo zapDemandInfo
 537
 538 zapFragileIdInfo :: Id -> Id
 539 zapFragileIdInfo = zapInfo zapFragileInfo
 540 \end{code}
 541