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