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