compiler/basicTypes/Id.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[Id]{@Ids@: Value and constructor identifiers}
   6
   7 \begin{code}
   8 {-# OPTIONS -w #-}
   9 -- The above warning supression flag is a temporary kludge.
  10 -- While working on this module you are encouraged to remove it and fix
  11 -- any warnings in the module. See
  12 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  13 -- for details
  14
  15 module Id (
  16         Id, DictId,
  17
  18         -- Simple construction
  19         mkGlobalId, mkLocalId, mkLocalIdWithInfo,
  20         mkSysLocal, mkUserLocal, mkVanillaGlobal,
  21         mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
  22         mkWorkerId, mkExportedLocalId,
  23
  24         -- Taking an Id apart
  25         idName, idType, idUnique, idInfo,
  26         isId, globalIdDetails, idPrimRep,
  27         recordSelectorFieldLabel,
  28
  29         -- Modifying an Id
  30         setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported,
  31         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
  32         zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo,
  33
  34         -- Predicates
  35         isImplicitId, isDeadBinder, isDictId, isStrictId,
  36         isExportedId, isLocalId, isGlobalId,
  37         isRecordSelector, isNaughtyRecordSelector,
  38         isClassOpId_maybe,
  39         isPrimOpId, isPrimOpId_maybe,
  40         isFCallId, isFCallId_maybe,
  41         isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
  42         isBottomingId, idIsFrom,
  43         isTickBoxOp, isTickBoxOp_maybe,
  44         hasNoBinding,
  45
  46         -- Inline pragma stuff
  47         idInlinePragma, setInlinePragma, modifyInlinePragma,
  48
  49
  50         -- One shot lambda stuff
  51         isOneShotBndr, isOneShotLambda, isStateHackType,
  52         setOneShotLambda, clearOneShotLambda,
  53
  54         -- IdInfo stuff
  55         setIdUnfolding,
  56         setIdArity,
  57         setIdNewDemandInfo,
  58         setIdNewStrictness, zapIdNewStrictness,
  59         setIdWorkerInfo,
  60         setIdSpecialisation,
  61         setIdCafInfo,
  62         setIdOccInfo,
  63
  64 #ifdef OLD_STRICTNESS
  65         idDemandInfo,
  66         idStrictness,
  67         idCprInfo,
  68         setIdStrictness,
  69         setIdDemandInfo,
  70         setIdCprInfo,
  71 #endif
  72
  73         idArity,
  74         idNewDemandInfo, idNewDemandInfo_maybe,
  75         idNewStrictness, idNewStrictness_maybe,
  76         idWorkerInfo,
  77         idUnfolding,
  78         idSpecialisation, idCoreRules, idHasRules,
  79         idCafInfo,
  80         idLBVarInfo,
  81         idOccInfo,
  82
  83 #ifdef OLD_STRICTNESS
  84         newStrictnessFromOld    -- Temporary
  85 #endif
  86
  87     ) where
  88
  89 #include "HsVersions.h"
  90
  91 import CoreSyn
  92 import BasicTypes
  93 import qualified Var
  94 import Var hiding (mkLocalId, mkGlobalId, mkExportedLocalId)
  95 import TyCon
  96 import Type
  97 import TcType
  98 import TysPrim
  99 import IdInfo
 100 #ifdef OLD_STRICTNESS
 101 import qualified Demand
 102 #endif
 103 import DataCon
 104 import NewDemand
 105 import Name
 106 import Module
 107 import OccName
 108 import Maybes
 109 import SrcLoc
 110 import Outputable
 111 import Unique
 112 import FastString
 113 import StaticFlags
 114
 115 -- infixl so you can say (id `set` a `set` b)
 116 infixl  1 `setIdUnfolding`,
 117           `setIdArity`,
 118           `setIdNewDemandInfo`,
 119           `setIdNewStrictness`,
 120           `setIdWorkerInfo`,
 121           `setIdSpecialisation`,
 122           `setInlinePragma`,
 123           `idCafInfo`
 124 #ifdef OLD_STRICTNESS
 125           ,`idCprInfo`
 126           ,`setIdStrictness`
 127           ,`setIdDemandInfo`
 128 #endif
 129 \end{code}
 130
 131
 132
 133 %************************************************************************
 134 %*                                                                      *
 135 \subsection{Simple Id construction}
 136 %*                                                                      *
 137 %************************************************************************
 138
 139 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
 140 but in addition it pins free-tyvar-info onto the Id's type,
 141 where it can easily be found.
 142
 143 \begin{code}
 144 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 145 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
 146
 147 mkExportedLocalId :: Name -> Type -> Id
 148 mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
 149
 150 mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
 151 mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
 152 \end{code}
 153
 154 \begin{code}
 155 mkLocalId :: Name -> Type -> Id
 156 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 157
 158 -- SysLocal: for an Id being created by the compiler out of thin air...
 159 mkSysLocal :: FastString -> Unique -> Type -> Id
 160 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 161
 162
 163 -- UserLocal: an Id with a name the user might recognize...
 164 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
 165 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 166
 167 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
 168 mkVanillaGlobal             = mkGlobalId VanillaGlobal
 169 \end{code}
 170
 171 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 172 @Uniques@, but that's OK because the templates are supposed to be
 173 instantiated before use.
 174
 175 \begin{code}
 176 -- "Wild Id" typically used when you need a binder that you don't expect to use
 177 mkWildId :: Type -> Id
 178 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
 179
 180 mkWorkerId :: Unique -> Id -> Type -> Id
 181 -- A worker gets a local name.  CoreTidy will externalise it if necessary.
 182 mkWorkerId uniq unwrkr ty
 183   = mkLocalId wkr_name ty
 184   where
 185     wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
 186
 187 -- "Template locals" typically used in unfoldings
 188 mkTemplateLocals :: [Type] -> [Id]
 189 mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
 190
 191 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 192 -- The Int gives the starting point for unique allocation
 193 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 194
 195 mkTemplateLocal :: Int -> Type -> Id
 196 mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
 197 \end{code}
 198
 199
 200 %************************************************************************
 201 %*                                                                      *
 202 \subsection[Id-general-funs]{General @Id@-related functions}
 203 %*                                                                      *
 204 %************************************************************************
 205
 206 \begin{code}
 207 setIdType :: Id -> Type -> Id
 208         -- Add free tyvar info to the type
 209 setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
 210
 211 idPrimRep :: Id -> PrimRep
 212 idPrimRep id = typePrimRep (idType id)
 213 \end{code}
 214
 215
 216 %************************************************************************
 217 %*                                                                      *
 218 \subsection{Special Ids}
 219 %*                                                                      *
 220 %************************************************************************
 221
 222 \begin{code}
 223 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 224 recordSelectorFieldLabel id
 225   = case globalIdDetails id of
 226         RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl)
 227         other -> panic "recordSelectorFieldLabel"
 228
 229 isRecordSelector id = case globalIdDetails id of
 230                         RecordSelId {}  -> True
 231                         other           -> False
 232
 233 isNaughtyRecordSelector id = case globalIdDetails id of
 234                         RecordSelId { sel_naughty = n } -> n
 235                         other                           -> False
 236
 237 isClassOpId_maybe id = case globalIdDetails id of
 238                         ClassOpId cls -> Just cls
 239                         _other        -> Nothing
 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 isDataConWorkId id = case globalIdDetails id of
 258                         DataConWorkId _ -> True
 259                         other           -> False
 260
 261 isDataConWorkId_maybe id = case globalIdDetails id of
 262                           DataConWorkId con -> Just con
 263                           other             -> Nothing
 264
 265 isDataConId_maybe :: Id -> Maybe DataCon
 266 isDataConId_maybe id = case globalIdDetails id of
 267                          DataConWorkId con -> Just con
 268                          DataConWrapId con -> Just con
 269                          other              -> Nothing
 270
 271 idDataCon :: Id -> DataCon
 272 -- Get from either the worker or the wrapper to the DataCon
 273 -- Currently used only in the desugarer
 274 --       INVARIANT: idDataCon (dataConWrapId d) = d
 275 -- (Remember, dataConWrapId can return either the wrapper or the worker.)
 276 idDataCon id = case globalIdDetails id of
 277                   DataConWorkId con -> con
 278                   DataConWrapId con -> con
 279                   other             -> pprPanic "idDataCon" (ppr id)
 280
 281
 282 isDictId :: Id -> Bool
 283 isDictId id = isDictTy (idType id)
 284
 285 -- hasNoBinding returns True of an Id which may not have a
 286 -- binding, even though it is defined in this module.
 287 -- Data constructor workers used to be things of this kind, but
 288 -- they aren't any more.  Instead, we inject a binding for
 289 -- them at the CorePrep stage.
 290 -- EXCEPT: unboxed tuples, which definitely have no binding
 291 hasNoBinding id = case globalIdDetails id of
 292                         PrimOpId _       -> True
 293                         FCallId _        -> True
 294                         DataConWorkId dc -> isUnboxedTupleCon dc
 295                         other            -> False
 296
 297 isImplicitId :: Id -> Bool
 298         -- isImplicitId tells whether an Id's info is implied by other
 299         -- declarations, so we don't need to put its signature in an interface
 300         -- file, even if it's mentioned in some other interface unfolding.
 301 isImplicitId id
 302   = case globalIdDetails id of
 303         RecordSelId {}  -> True
 304         FCallId _       -> True
 305         PrimOpId _      -> True
 306         ClassOpId _     -> True
 307         DataConWorkId _ -> True
 308         DataConWrapId _ -> True
 309                 -- These are are implied by their type or class decl;
 310                 -- remember that all type and class decls appear in the interface file.
 311                 -- The dfun id is not an implicit Id; it must *not* be omitted, because
 312                 -- it carries version info for the instance decl
 313         other           -> False
 314
 315 idIsFrom :: Module -> Id -> Bool
 316 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
 317 \end{code}
 318
 319 \begin{code}
 320 isDeadBinder :: Id -> Bool
 321 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 322                   | otherwise = False   -- TyVars count as not dead
 323 \end{code}
 324
 325 \begin{code}
 326 isTickBoxOp :: Id -> Bool
 327 isTickBoxOp id =
 328   case globalIdDetails id of
 329     TickBoxOpId tick -> True
 330     _                -> False
 331
 332 isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
 333 isTickBoxOp_maybe id =
 334   case globalIdDetails id of
 335     TickBoxOpId tick -> Just tick
 336     _                -> Nothing
 337 \end{code}
 338
 339 %************************************************************************
 340 %*                                                                      *
 341 \subsection{IdInfo stuff}
 342 %*                                                                      *
 343 %************************************************************************
 344
 345 \begin{code}
 346         ---------------------------------
 347         -- ARITY
 348 idArity :: Id -> Arity
 349 idArity id = arityInfo (idInfo id)
 350
 351 setIdArity :: Id -> Arity -> Id
 352 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 353
 354 #ifdef OLD_STRICTNESS
 355         ---------------------------------
 356         -- (OLD) STRICTNESS
 357 idStrictness :: Id -> StrictnessInfo
 358 idStrictness id = strictnessInfo (idInfo id)
 359
 360 setIdStrictness :: Id -> StrictnessInfo -> Id
 361 setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
 362 #endif
 363
 364 -- isBottomingId returns true if an application to n args would diverge
 365 isBottomingId :: Id -> Bool
 366 isBottomingId id = isBottomingSig (idNewStrictness id)
 367
 368 idNewStrictness_maybe :: Id -> Maybe StrictSig
 369 idNewStrictness :: Id -> StrictSig
 370
 371 idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
 372 idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
 373
 374 setIdNewStrictness :: Id -> StrictSig -> Id
 375 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
 376
 377 zapIdNewStrictness :: Id -> Id
 378 zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 379 \end{code}
 380
 381 This predicate says whether the id has a strict demand placed on it or
 382 has a type such that it can always be evaluated strictly (e.g., an
 383 unlifted type, but see the comment for isStrictType).  We need to
 384 check separately whether <id> has a so-called "strict type" because if
 385 the demand for <id> hasn't been computed yet but <id> has a strict
 386 type, we still want (isStrictId <id>) to be True.
 387 \begin{code}
 388 isStrictId :: Id -> Bool
 389 isStrictId id
 390   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
 391            (isStrictDmd (idNewDemandInfo id)) ||
 392            (isStrictType (idType id))
 393
 394         ---------------------------------
 395         -- WORKER ID
 396 idWorkerInfo :: Id -> WorkerInfo
 397 idWorkerInfo id = workerInfo (idInfo id)
 398
 399 setIdWorkerInfo :: Id -> WorkerInfo -> Id
 400 setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
 401
 402         ---------------------------------
 403         -- UNFOLDING
 404 idUnfolding :: Id -> Unfolding
 405 idUnfolding id = unfoldingInfo (idInfo id)
 406
 407 setIdUnfolding :: Id -> Unfolding -> Id
 408 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 409
 410 #ifdef OLD_STRICTNESS
 411         ---------------------------------
 412         -- (OLD) DEMAND
 413 idDemandInfo :: Id -> Demand.Demand
 414 idDemandInfo id = demandInfo (idInfo id)
 415
 416 setIdDemandInfo :: Id -> Demand.Demand -> Id
 417 setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 418 #endif
 419
 420 idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
 421 idNewDemandInfo       :: Id -> NewDemand.Demand
 422
 423 idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
 424 idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
 425
 426 setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
 427 setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 428
 429         ---------------------------------
 430         -- SPECIALISATION
 431 idSpecialisation :: Id -> SpecInfo
 432 idSpecialisation id = specInfo (idInfo id)
 433
 434 idCoreRules :: Id -> [CoreRule]
 435 idCoreRules id = specInfoRules (idSpecialisation id)
 436
 437 idHasRules :: Id -> Bool
 438 idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
 439
 440 setIdSpecialisation :: Id -> SpecInfo -> Id
 441 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 442
 443         ---------------------------------
 444         -- CAF INFO
 445 idCafInfo :: Id -> CafInfo
 446 #ifdef OLD_STRICTNESS
 447 idCafInfo id = case cgInfo (idInfo id) of
 448                   NoCgInfo -> pprPanic "idCafInfo" (ppr id)
 449                   info     -> cgCafInfo info
 450 #else
 451 idCafInfo id = cafInfo (idInfo id)
 452 #endif
 453
 454 setIdCafInfo :: Id -> CafInfo -> Id
 455 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 456
 457         ---------------------------------
 458         -- CPR INFO
 459 #ifdef OLD_STRICTNESS
 460 idCprInfo :: Id -> CprInfo
 461 idCprInfo id = cprInfo (idInfo id)
 462
 463 setIdCprInfo :: Id -> CprInfo -> Id
 464 setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
 465 #endif
 466
 467         ---------------------------------
 468         -- Occcurrence INFO
 469 idOccInfo :: Id -> OccInfo
 470 idOccInfo id = occInfo (idInfo id)
 471
 472 setIdOccInfo :: Id -> OccInfo -> Id
 473 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 474 \end{code}
 475
 476
 477         ---------------------------------
 478         -- INLINING
 479 The inline pragma tells us to be very keen to inline this Id, but it's still
 480 OK not to if optimisation is switched off.
 481
 482 \begin{code}
 483 idInlinePragma :: Id -> InlinePragInfo
 484 idInlinePragma id = inlinePragInfo (idInfo id)
 485
 486 setInlinePragma :: Id -> InlinePragInfo -> Id
 487 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 488
 489 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 490 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 491 \end{code}
 492
 493
 494         ---------------------------------
 495         -- ONE-SHOT LAMBDAS
 496 \begin{code}
 497 idLBVarInfo :: Id -> LBVarInfo
 498 idLBVarInfo id = lbvarInfo (idInfo id)
 499
 500 isOneShotBndr :: Id -> Bool
 501 -- This one is the "business end", called externally.
 502 -- Its main purpose is to encapsulate the Horrible State Hack
 503 isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
 504
 505 isStateHackType :: Type -> Bool
 506 isStateHackType ty
 507   | opt_NoStateHack
 508   = False
 509   | otherwise
 510   = case splitTyConApp_maybe ty of
 511         Just (tycon,_) -> tycon == statePrimTyCon
 512         other          -> False
 513         -- This is a gross hack.  It claims that
 514         -- every function over realWorldStatePrimTy is a one-shot
 515         -- function.  This is pretty true in practice, and makes a big
 516         -- difference.  For example, consider
 517         --      a `thenST` \ r -> ...E...
 518         -- The early full laziness pass, if it doesn't know that r is one-shot
 519         -- will pull out E (let's say it doesn't mention r) to give
 520         --      let lvl = E in a `thenST` \ r -> ...lvl...
 521         -- When `thenST` gets inlined, we end up with
 522         --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
 523         -- and we don't re-inline E.
 524         --
 525         -- It would be better to spot that r was one-shot to start with, but
 526         -- I don't want to rely on that.
 527         --
 528         -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
 529         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 530
 531
 532 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 533 isOneShotLambda :: Id -> Bool
 534 isOneShotLambda id = case idLBVarInfo id of
 535                        IsOneShotLambda  -> True
 536                        NoLBVarInfo      -> False
 537
 538 setOneShotLambda :: Id -> Id
 539 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
 540
 541 clearOneShotLambda :: Id -> Id
 542 clearOneShotLambda id
 543   | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
 544   | otherwise          = id
 545
 546 -- But watch out: this may change the type of something else
 547 --      f = \x -> e
 548 -- If we change the one-shot-ness of x, f's type changes
 549 \end{code}
 550
 551 \begin{code}
 552 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 553 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 554
 555 zapLamIdInfo :: Id -> Id
 556 zapLamIdInfo = zapInfo zapLamInfo
 557
 558 zapDemandIdInfo = zapInfo zapDemandInfo
 559
 560 zapFragileIdInfo :: Id -> Id
 561 zapFragileIdInfo = zapInfo zapFragileInfo
 562 \end{code}
 563