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