ghc/compiler/basicTypes/Id.lhs

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