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         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, 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 (mkSystemName uniq fs)      ty
 166 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
 167 mkVanillaGlobal             = mkGlobalId VanillaGlobal
 168 \end{code}
 169
 170 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 171 @Uniques@, but that's OK because the templates are supposed to be
 172 instantiated before use.
 173
 174 \begin{code}
 175 -- "Wild Id" typically used when you need a binder that you don't expect to use
 176 mkWildId :: Type -> Id
 177 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
 178
 179 mkWorkerId :: Unique -> Id -> Type -> Id
 180 -- A worker gets a local name.  CoreTidy will externalise it if necessary.
 181 mkWorkerId uniq unwrkr ty
 182   = mkLocalId wkr_name ty
 183   where
 184     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
 185
 186 -- "Template locals" typically used in unfoldings
 187 mkTemplateLocals :: [Type] -> [Id]
 188 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
 189
 190 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 191 -- The Int gives the starting point for unique allocation
 192 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 193
 194 mkTemplateLocal :: Int -> Type -> Id
 195 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
 196 \end{code}
 197
 198
 199 %************************************************************************
 200 %*                                                                      *
 201 \subsection[Id-general-funs]{General @Id@-related functions}
 202 %*                                                                      *
 203 %************************************************************************
 204
 205 \begin{code}
 206 setIdType :: Id -> Type -> Id
 207         -- Add free tyvar info to the type
 208 setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
 209
 210 idPrimRep :: Id -> PrimRep
 211 idPrimRep id = typePrimRep (idType id)
 212 \end{code}
 213
 214
 215 %************************************************************************
 216 %*                                                                      *
 217 \subsection{Special Ids}
 218 %*                                                                      *
 219 %************************************************************************
 220
 221 The @SpecPragmaId@ exists only to make Ids that are
 222 on the *LHS* of bindings created by SPECIALISE pragmas;
 223 eg:             s = f Int d
 224 The SpecPragmaId is never itself mentioned; it
 225 exists solely so that the specialiser will find
 226 the call to f, and make specialised version of it.
 227 The SpecPragmaId binding is discarded by the specialiser
 228 when it gathers up overloaded calls.
 229 Meanwhile, it is not discarded as dead code.
 230
 231
 232 \begin{code}
 233 recordSelectorFieldLabel :: Id -> FieldLabel
 234 recordSelectorFieldLabel id = case globalIdDetails id of
 235                                  RecordSelId lbl -> lbl
 236
 237 isRecordSelector id = case globalIdDetails id of
 238                         RecordSelId lbl -> True
 239                         other           -> False
 240
 241 isPrimOpId id = case globalIdDetails id of
 242                     PrimOpId op -> True
 243                     other       -> False
 244
 245 isPrimOpId_maybe id = case globalIdDetails id of
 246                             PrimOpId op -> Just op
 247                             other       -> Nothing
 248
 249 isFCallId id = case globalIdDetails id of
 250                     FCallId call -> True
 251                     other        -> False
 252
 253 isFCallId_maybe id = case globalIdDetails id of
 254                             FCallId call -> Just call
 255                             other        -> Nothing
 256
 257 isDataConId id = case globalIdDetails id of
 258                         DataConId _ -> True
 259                         other       -> False
 260
 261 isDataConId_maybe id = case globalIdDetails id of
 262                           DataConId con -> Just con
 263                           other         -> Nothing
 264
 265 isDataConWrapId_maybe id = case globalIdDetails id of
 266                                   DataConWrapId con -> Just con
 267                                   other             -> Nothing
 268
 269 isDataConWrapId id = case globalIdDetails id of
 270                         DataConWrapId con -> True
 271                         other             -> False
 272
 273 -- hasNoBinding returns True of an Id which may not have a
 274 -- binding, even though it is defined in this module.
 275 -- Data constructor workers used to be things of this kind, but
 276 -- they aren't any more.  Instead, we inject a binding for
 277 -- them at the CorePrep stage.
 278 hasNoBinding id = case globalIdDetails id of
 279                         PrimOpId _  -> True
 280                         FCallId _   -> True
 281                         other       -> False
 282
 283 isImplicitId :: Id -> Bool
 284         -- isImplicitId tells whether an Id's info is implied by other
 285         -- declarations, so we don't need to put its signature in an interface
 286         -- file, even if it's mentioned in some other interface unfolding.
 287 isImplicitId id
 288   = case globalIdDetails id of
 289         RecordSelId _   -> True -- Includes dictionary selectors
 290         FCallId _       -> True
 291         PrimOpId _      -> True
 292         DataConId _     -> True
 293         DataConWrapId _ -> True
 294                 -- These are are implied by their type or class decl;
 295                 -- remember that all type and class decls appear in the interface file.
 296                 -- The dfun id must *not* be omitted, because it carries version info for
 297                 -- the instance decl
 298         other           -> False
 299 \end{code}
 300
 301 \begin{code}
 302 isDeadBinder :: Id -> Bool
 303 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 304                   | otherwise = False   -- TyVars count as not dead
 305 \end{code}
 306
 307
 308 %************************************************************************
 309 %*                                                                      *
 310 \subsection{IdInfo stuff}
 311 %*                                                                      *
 312 %************************************************************************
 313
 314 \begin{code}
 315         ---------------------------------
 316         -- ARITY
 317 idArity :: Id -> Arity
 318 idArity id = arityInfo (idInfo id)
 319
 320 setIdArity :: Id -> Arity -> Id
 321 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 322
 323 #ifdef OLD_STRICTNESS
 324         ---------------------------------
 325         -- (OLD) STRICTNESS
 326 idStrictness :: Id -> StrictnessInfo
 327 idStrictness id = strictnessInfo (idInfo id)
 328
 329 setIdStrictness :: Id -> StrictnessInfo -> Id
 330 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
 331 #endif
 332
 333 -- isBottomingId returns true if an application to n args would diverge
 334 isBottomingId :: Id -> Bool
 335 isBottomingId id = isBottomingSig (idNewStrictness id)
 336
 337 idNewStrictness_maybe :: Id -> Maybe StrictSig
 338 idNewStrictness :: Id -> StrictSig
 339
 340 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
 341 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
 342
 343 setIdNewStrictness :: Id -> StrictSig -> Id
 344 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
 345
 346 zapIdNewStrictness :: Id -> Id
 347 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 348
 349         ---------------------------------
 350         -- WORKER ID
 351 idWorkerInfo :: Id -> WorkerInfo
 352 idWorkerInfo id = workerInfo (idInfo id)
 353
 354 setIdWorkerInfo :: Id -> WorkerInfo -> Id
 355 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
 356
 357         ---------------------------------
 358         -- UNFOLDING
 359 idUnfolding :: Id -> Unfolding
 360 idUnfolding id = unfoldingInfo (idInfo id)
 361
 362 setIdUnfolding :: Id -> Unfolding -> Id
 363 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 364
 365 #ifdef OLD_STRICTNESS
 366         ---------------------------------
 367         -- (OLD) DEMAND
 368 idDemandInfo :: Id -> Demand.Demand
 369 idDemandInfo id = demandInfo (idInfo id)
 370
 371 setIdDemandInfo :: Id -> Demand.Demand -> Id
 372 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 373 #endif
 374
 375 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
 376 idNewDemandInfo       :: Id -> NewDemand.Demand
 377
 378 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
 379 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
 380
 381 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
 382 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 383
 384         ---------------------------------
 385         -- SPECIALISATION
 386 idSpecialisation :: Id -> CoreRules
 387 idSpecialisation id = specInfo (idInfo id)
 388
 389 idCoreRules :: Id -> [IdCoreRule]
 390 idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]
 391
 392 setIdSpecialisation :: Id -> CoreRules -> Id
 393 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 394
 395         ---------------------------------
 396         -- CG INFO
 397 idCgInfo :: Id -> CgInfo
 398 #ifdef OLD_STRICTNESS
 399 idCgInfo id = case cgInfo (idInfo id) of
 400                   NoCgInfo -> pprPanic "idCgInfo" (ppr id)
 401                   info     -> info
 402 #else
 403 idCgInfo id = cgInfo (idInfo id)
 404 #endif
 405
 406 setIdCgInfo :: Id -> CgInfo -> Id
 407 setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
 408
 409         ---------------------------------
 410         -- CAF INFO
 411 idCafInfo :: Id -> CafInfo
 412 #ifdef OLD_STRICTNESS
 413 idCafInfo id = case cgInfo (idInfo id) of
 414                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
 415                   info     -> cgCafInfo info
 416 #else
 417 idCafInfo id = cgCafInfo (idCgInfo id)
 418 #endif
 419         ---------------------------------
 420         -- CPR INFO
 421 #ifdef OLD_STRICTNESS
 422 idCprInfo :: Id -> CprInfo
 423 idCprInfo id = cprInfo (idInfo id)
 424
 425 setIdCprInfo :: Id -> CprInfo -> Id
 426 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
 427 #endif
 428
 429         ---------------------------------
 430         -- Occcurrence INFO
 431 idOccInfo :: Id -> OccInfo
 432 idOccInfo id = occInfo (idInfo id)
 433
 434 setIdOccInfo :: Id -> OccInfo -> Id
 435 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 436 \end{code}
 437
 438
 439         ---------------------------------
 440         -- INLINING
 441 The inline pragma tells us to be very keen to inline this Id, but it's still
 442 OK not to if optimisation is switched off.
 443
 444 \begin{code}
 445 idInlinePragma :: Id -> InlinePragInfo
 446 idInlinePragma id = inlinePragInfo (idInfo id)
 447
 448 setInlinePragma :: Id -> InlinePragInfo -> Id
 449 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 450
 451 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 452 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 453 \end{code}
 454
 455
 456         ---------------------------------
 457         -- ONE-SHOT LAMBDAS
 458 \begin{code}
 459 idLBVarInfo :: Id -> LBVarInfo
 460 idLBVarInfo id = lbvarInfo (idInfo id)
 461
 462 isOneShotLambda :: Id -> Bool
 463 isOneShotLambda id = analysis || hack
 464   where analysis = case idLBVarInfo id of
 465                      LBVarInfo u    | u `eqUsage` usOnce      -> True
 466                      other                                    -> False
 467         hack     = case splitTyConApp_maybe (idType id) of
 468                      Just (tycon,_) | tycon == statePrimTyCon -> True
 469                      other                                    -> False
 470
 471         -- The last clause is a gross hack.  It claims that
 472         -- every function over realWorldStatePrimTy is a one-shot
 473         -- function.  This is pretty true in practice, and makes a big
 474         -- difference.  For example, consider
 475         --      a `thenST` \ r -> ...E...
 476         -- The early full laziness pass, if it doesn't know that r is one-shot
 477         -- will pull out E (let's say it doesn't mention r) to give
 478         --      let lvl = E in a `thenST` \ r -> ...lvl...
 479         -- When `thenST` gets inlined, we end up with
 480         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 481         -- and we don't re-inline E.
 482         --
 483         -- It would be better to spot that r was one-shot to start with, but
 484         -- I don't want to rely on that.
 485         --
 486         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
 487         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 488
 489 setOneShotLambda :: Id -> Id
 490 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
 491
 492 clearOneShotLambda :: Id -> Id
 493 clearOneShotLambda id
 494   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
 495   | otherwise          = id
 496
 497 -- But watch out: this may change the type of something else
 498 --      f = \x -> e
 499 -- If we change the one-shot-ness of x, f's type changes
 500 \end{code}
 501
 502 \begin{code}
 503 zapLamIdInfo :: Id -> Id
 504 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
 505
 506 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
 507 \end{code}
 508