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