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 8{-# LANGUAGE CPP #-} 9 10-- | 11-- #name_types# 12-- GHC uses several kinds of name internally: 13-- 14-- * 'OccName.OccName': see "OccName#name_types" 15-- 16-- * 'RdrName.RdrName': see "RdrName#name_types" 17-- 18-- * 'Name.Name': see "Name#name_types" 19-- 20-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional 21-- details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that 22-- are added, modified and inspected by various compiler passes. These 'Var.Var' names may either 23-- be global or local, see "Var#globalvslocal" 24-- 25-- * 'Var.Var': see "Var#name_types" 26 27module Id ( 28 -- * The main types 29 Var, Id, isId, 30 31 -- * In and Out variants 32 InVar, InId, 33 OutVar, OutId, 34 35 -- ** Simple construction 36 mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo, 37 mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar, 38 mkLocalIdOrCoVarWithInfo, 39 mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId, 40 mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM, 41 mkUserLocal, mkUserLocalOrCoVar, 42 mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal, 43 mkWorkerId, 44 45 -- ** Taking an Id apart 46 idName, idType, idUnique, idInfo, idDetails, 47 recordSelectorTyCon, 48 49 -- ** Modifying an Id 50 setIdName, setIdUnique, Id.setIdType, 51 setIdExported, setIdNotExported, 52 globaliseId, localiseId, 53 setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, 54 zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo, 55 zapIdUsedOnceInfo, zapIdTailCallInfo, 56 zapFragileIdInfo, zapIdStrictness, zapStableUnfolding, 57 transferPolyIdInfo, 58 59 -- ** Predicates on Ids 60 isImplicitId, isDeadBinder, 61 isStrictId, 62 isExportedId, isLocalId, isGlobalId, 63 isRecordSelector, isNaughtyRecordSelector, 64 isPatSynRecordSelector, 65 isDataConRecordSelector, 66 isClassOpId_maybe, isDFunId, 67 isPrimOpId, isPrimOpId_maybe, 68 isFCallId, isFCallId_maybe, 69 isDataConWorkId, isDataConWorkId_maybe, 70 isDataConWrapId, isDataConWrapId_maybe, 71 isDataConId_maybe, 72 idDataCon, 73 isConLikeId, isBottomingId, idIsFrom, 74 hasNoBinding, 75 76 -- ** Join variables 77 JoinId, isJoinId, isJoinId_maybe, idJoinArity, 78 asJoinId, asJoinId_maybe, zapJoinId, 79 80 -- ** Inline pragma stuff 81 idInlinePragma, setInlinePragma, modifyInlinePragma, 82 idInlineActivation, setInlineActivation, idRuleMatchInfo, 83 84 -- ** One-shot lambdas 85 isOneShotBndr, isProbablyOneShotLambda, 86 setOneShotLambda, clearOneShotLambda, 87 updOneShotInfo, setIdOneShotInfo, 88 isStateHackType, stateHackOneShot, typeOneShot, 89 90 -- ** Reading 'IdInfo' fields 91 idArity, 92 idCallArity, idFunRepArity, 93 idUnfolding, realIdUnfolding, 94 idSpecialisation, idCoreRules, idHasRules, 95 idCafInfo, 96 idOneShotInfo, idStateHackOneShotInfo, 97 idOccInfo, 98 isNeverLevPolyId, 99 100 -- ** Writing 'IdInfo' fields 101 setIdUnfolding, setCaseBndrEvald, 102 setIdArity, 103 setIdCallArity, 104 105 setIdSpecialisation, 106 setIdCafInfo, 107 setIdOccInfo, zapIdOccInfo, 108 109 setIdDemandInfo, 110 setIdStrictness, 111 112 idDemandInfo, 113 idStrictness, 114 115 ) where 116 117#include "GhclibHsVersions.h" 118 119import GhcPrelude 120 121import DynFlags 122import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding, 123 isCompulsoryUnfolding, Unfolding( NoUnfolding ) ) 124 125import IdInfo 126import BasicTypes 127 128-- Imported and re-exported 129import Var( Id, CoVar, JoinId, 130 InId, InVar, 131 OutId, OutVar, 132 idInfo, idDetails, setIdDetails, globaliseId, varType, 133 isId, isLocalId, isGlobalId, isExportedId ) 134import qualified Var 135 136import Type 137import RepType 138import TysPrim 139import DataCon 140import Demand 141import Name 142import Module 143import Class 144import {-# SOURCE #-} PrimOp (PrimOp) 145import ForeignCall 146import Maybes 147import SrcLoc 148import Outputable 149import Unique 150import UniqSupply 151import FastString 152import Util 153 154-- infixl so you can say (id `set` a `set` b) 155infixl 1 `setIdUnfolding`, 156 `setIdArity`, 157 `setIdCallArity`, 158 `setIdOccInfo`, 159 `setIdOneShotInfo`, 160 161 `setIdSpecialisation`, 162 `setInlinePragma`, 163 `setInlineActivation`, 164 `idCafInfo`, 165 166 `setIdDemandInfo`, 167 `setIdStrictness`, 168 169 `asJoinId`, 170 `asJoinId_maybe` 171 172{- 173************************************************************************ 174* * 175\subsection{Basic Id manipulation} 176* * 177************************************************************************ 178-} 179 180idName :: Id -> Name 181idName = Var.varName 182 183idUnique :: Id -> Unique 184idUnique = Var.varUnique 185 186idType :: Id -> Kind 187idType = Var.varType 188 189setIdName :: Id -> Name -> Id 190setIdName = Var.setVarName 191 192setIdUnique :: Id -> Unique -> Id 193setIdUnique = Var.setVarUnique 194 195-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and 196-- reduce space usage 197setIdType :: Id -> Type -> Id 198setIdType id ty = seqType ty `seq` Var.setVarType id ty 199 200setIdExported :: Id -> Id 201setIdExported = Var.setIdExported 202 203setIdNotExported :: Id -> Id 204setIdNotExported = Var.setIdNotExported 205 206localiseId :: Id -> Id 207-- Make an Id with the same unique and type as the 208-- incoming Id, but with an *Internal* Name and *LocalId* flavour 209localiseId id 210 | ASSERT( isId id ) isLocalId id && isInternalName name 211 = id 212 | otherwise 213 = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id) 214 where 215 name = idName id 216 217lazySetIdInfo :: Id -> IdInfo -> Id 218lazySetIdInfo = Var.lazySetIdInfo 219 220setIdInfo :: Id -> IdInfo -> Id 221setIdInfo id info = info `seq` (lazySetIdInfo id info) 222 -- Try to avoid space leaks by seq'ing 223 224modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id 225modifyIdInfo fn id = setIdInfo id (fn (idInfo id)) 226 227-- maybeModifyIdInfo tries to avoid unnecessary thrashing 228maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id 229maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info 230maybeModifyIdInfo Nothing id = id 231 232{- 233************************************************************************ 234* * 235\subsection{Simple Id construction} 236* * 237************************************************************************ 238 239Absolutely all Ids are made by mkId. It is just like Var.mkId, 240but in addition it pins free-tyvar-info onto the Id's type, 241where it can easily be found. 242 243Note [Free type variables] 244~~~~~~~~~~~~~~~~~~~~~~~~~~ 245At one time we cached the free type variables of the type of an Id 246at the root of the type in a TyNote. The idea was to avoid repeating 247the free-type-variable calculation. But it turned out to slow down 248the compiler overall. I don't quite know why; perhaps finding free 249type variables of an Id isn't all that common whereas applying a 250substitution (which changes the free type variables) is more common. 251Anyway, we removed it in March 2008. 252-} 253 254-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" 255mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id 256mkGlobalId = Var.mkGlobalVar 257 258-- | Make a global 'Id' without any extra information at all 259mkVanillaGlobal :: Name -> Type -> Id 260mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo 261 262-- | Make a global 'Id' with no global information but some generic 'IdInfo' 263mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id 264mkVanillaGlobalWithInfo = mkGlobalId VanillaId 265 266 267-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" 268mkLocalId :: Name -> Type -> Id 269mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo 270 -- It's tempting to ASSERT( not (isCoVarType ty) ), but don't. Sometimes, 271 -- the type is a panic. (Search invented_id) 272 273-- | Make a local CoVar 274mkLocalCoVar :: Name -> Type -> CoVar 275mkLocalCoVar name ty 276 = ASSERT( isCoVarType ty ) 277 Var.mkLocalVar CoVarId name ty vanillaIdInfo 278 279-- | Like 'mkLocalId', but checks the type to see if it should make a covar 280mkLocalIdOrCoVar :: Name -> Type -> Id 281mkLocalIdOrCoVar name ty 282 | isCoVarType ty = mkLocalCoVar name ty 283 | otherwise = mkLocalId name ty 284 285-- | Make a local id, with the IdDetails set to CoVarId if the type indicates 286-- so. 287mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id 288mkLocalIdOrCoVarWithInfo name ty info 289 = Var.mkLocalVar details name ty info 290 where 291 details | isCoVarType ty = CoVarId 292 | otherwise = VanillaId 293 294 -- proper ids only; no covars! 295mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id 296mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info 297 -- Note [Free type variables] 298 299-- | Create a local 'Id' that is marked as exported. 300-- This prevents things attached to it from being removed as dead code. 301-- See Note [Exported LocalIds] 302mkExportedLocalId :: IdDetails -> Name -> Type -> Id 303mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo 304 -- Note [Free type variables] 305 306mkExportedVanillaId :: Name -> Type -> Id 307mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo 308 -- Note [Free type variables] 309 310 311-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal") 312-- that are created by the compiler out of thin air 313mkSysLocal :: FastString -> Unique -> Type -> Id 314mkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) ) 315 mkLocalId (mkSystemVarName uniq fs) ty 316 317-- | Like 'mkSysLocal', but checks to see if we have a covar type 318mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id 319mkSysLocalOrCoVar fs uniq ty 320 = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty 321 322mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id 323mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty)) 324 325mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id 326mkSysLocalOrCoVarM fs ty 327 = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty)) 328 329-- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize 330mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id 331mkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) ) 332 mkLocalId (mkInternalName uniq occ loc) ty 333 334-- | Like 'mkUserLocal', but checks if we have a coercion type 335mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id 336mkUserLocalOrCoVar occ uniq ty loc 337 = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty 338 339{- 340Make some local @Ids@ for a template @CoreExpr@. These have bogus 341@Uniques@, but that's OK because the templates are supposed to be 342instantiated before use. 343-} 344 345-- | Workers get local names. "CoreTidy" will externalise these if necessary 346mkWorkerId :: Unique -> Id -> Type -> Id 347mkWorkerId uniq unwrkr ty 348 = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty 349 350-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings 351mkTemplateLocal :: Int -> Type -> Id 352mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty 353 354-- | Create a template local for a series of types 355mkTemplateLocals :: [Type] -> [Id] 356mkTemplateLocals = mkTemplateLocalsNum 1 357 358-- | Create a template local for a series of type, but start from a specified template local 359mkTemplateLocalsNum :: Int -> [Type] -> [Id] 360mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys 361 362{- Note [Exported LocalIds] 363~~~~~~~~~~~~~~~~~~~~~~~~~~~ 364We use mkExportedLocalId for things like 365 - Dictionary functions (DFunId) 366 - Wrapper and matcher Ids for pattern synonyms 367 - Default methods for classes 368 - Pattern-synonym matcher and builder Ids 369 - etc 370 371They marked as "exported" in the sense that they should be kept alive 372even if apparently unused in other bindings, and not dropped as dead 373code by the occurrence analyser. (But "exported" here does not mean 374"brought into lexical scope by an import declaration". Indeed these 375things are always internal Ids that the user never sees.) 376 377It's very important that they are *LocalIds*, not GlobalIds, for lots 378of reasons: 379 380 * We want to treat them as free variables for the purpose of 381 dependency analysis (e.g. CoreFVs.exprFreeVars). 382 383 * Look them up in the current substitution when we come across 384 occurrences of them (in Subst.lookupIdSubst). Lacking this we 385 can get an out-of-date unfolding, which can in turn make the 386 simplifier go into an infinite loop (#9857) 387 388 * Ensure that for dfuns that the specialiser does not float dict uses 389 above their defns, which would prevent good simplifications happening. 390 391 * The strictness analyser treats a occurrence of a GlobalId as 392 imported and assumes it contains strictness in its IdInfo, which 393 isn't true if the thing is bound in the same module as the 394 occurrence. 395 396In CoreTidy we must make all these LocalIds into GlobalIds, so that in 397importing modules (in --make mode) we treat them as properly global. 398That is what is happening in, say tidy_insts in TidyPgm. 399 400************************************************************************ 401* * 402\subsection{Special Ids} 403* * 404************************************************************************ 405-} 406 407-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise. 408recordSelectorTyCon :: Id -> RecSelParent 409recordSelectorTyCon id 410 = case Var.idDetails id of 411 RecSelId { sel_tycon = parent } -> parent 412 _ -> panic "recordSelectorTyCon" 413 414 415isRecordSelector :: Id -> Bool 416isNaughtyRecordSelector :: Id -> Bool 417isPatSynRecordSelector :: Id -> Bool 418isDataConRecordSelector :: Id -> Bool 419isPrimOpId :: Id -> Bool 420isFCallId :: Id -> Bool 421isDataConWorkId :: Id -> Bool 422isDataConWrapId :: Id -> Bool 423isDFunId :: Id -> Bool 424 425isClassOpId_maybe :: Id -> Maybe Class 426isPrimOpId_maybe :: Id -> Maybe PrimOp 427isFCallId_maybe :: Id -> Maybe ForeignCall 428isDataConWorkId_maybe :: Id -> Maybe DataCon 429isDataConWrapId_maybe :: Id -> Maybe DataCon 430 431isRecordSelector id = case Var.idDetails id of 432 RecSelId {} -> True 433 _ -> False 434 435isDataConRecordSelector id = case Var.idDetails id of 436 RecSelId {sel_tycon = RecSelData _} -> True 437 _ -> False 438 439isPatSynRecordSelector id = case Var.idDetails id of 440 RecSelId {sel_tycon = RecSelPatSyn _} -> True 441 _ -> False 442 443isNaughtyRecordSelector id = case Var.idDetails id of 444 RecSelId { sel_naughty = n } -> n 445 _ -> False 446 447isClassOpId_maybe id = case Var.idDetails id of 448 ClassOpId cls -> Just cls 449 _other -> Nothing 450 451isPrimOpId id = case Var.idDetails id of 452 PrimOpId _ -> True 453 _ -> False 454 455isDFunId id = case Var.idDetails id of 456 DFunId {} -> True 457 _ -> False 458 459isPrimOpId_maybe id = case Var.idDetails id of 460 PrimOpId op -> Just op 461 _ -> Nothing 462 463isFCallId id = case Var.idDetails id of 464 FCallId _ -> True 465 _ -> False 466 467isFCallId_maybe id = case Var.idDetails id of 468 FCallId call -> Just call 469 _ -> Nothing 470 471isDataConWorkId id = case Var.idDetails id of 472 DataConWorkId _ -> True 473 _ -> False 474 475isDataConWorkId_maybe id = case Var.idDetails id of 476 DataConWorkId con -> Just con 477 _ -> Nothing 478 479isDataConWrapId id = case Var.idDetails id of 480 DataConWrapId _ -> True 481 _ -> False 482 483isDataConWrapId_maybe id = case Var.idDetails id of 484 DataConWrapId con -> Just con 485 _ -> Nothing 486 487isDataConId_maybe :: Id -> Maybe DataCon 488isDataConId_maybe id = case Var.idDetails id of 489 DataConWorkId con -> Just con 490 DataConWrapId con -> Just con 491 _ -> Nothing 492 493isJoinId :: Var -> Bool 494-- It is convenient in SetLevels.lvlMFE to apply isJoinId 495-- to the free vars of an expression, so it's convenient 496-- if it returns False for type variables 497isJoinId id 498 | isId id = case Var.idDetails id of 499 JoinId {} -> True 500 _ -> False 501 | otherwise = False 502 503isJoinId_maybe :: Var -> Maybe JoinArity 504isJoinId_maybe id 505 | isId id = ASSERT2( isId id, ppr id ) 506 case Var.idDetails id of 507 JoinId arity -> Just arity 508 _ -> Nothing 509 | otherwise = Nothing 510 511idDataCon :: Id -> DataCon 512-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer. 513-- 514-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker 515idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id) 516 517hasNoBinding :: Id -> Bool 518-- ^ Returns @True@ of an 'Id' which may not have a 519-- binding, even though it is defined in this module. 520 521-- Data constructor workers used to be things of this kind, but 522-- they aren't any more. Instead, we inject a binding for 523-- them at the CorePrep stage. 524-- 525-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs. 526-- for the history of this. 527-- 528-- Note that CorePrep currently eta expands things no-binding things and this 529-- can cause quite subtle bugs. See Note [Eta expansion of hasNoBinding things 530-- in CorePrep] in CorePrep for details. 531-- 532-- EXCEPT: unboxed tuples, which definitely have no binding 533hasNoBinding id = case Var.idDetails id of 534 PrimOpId _ -> False -- See Note [Primop wrappers] in PrimOp.hs 535 FCallId _ -> True 536 DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc 537 _ -> isCompulsoryUnfolding (idUnfolding id) 538 -- See Note [Levity-polymorphic Ids] 539 540isImplicitId :: Id -> Bool 541-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other 542-- declarations, so we don't need to put its signature in an interface 543-- file, even if it's mentioned in some other interface unfolding. 544isImplicitId id 545 = case Var.idDetails id of 546 FCallId {} -> True 547 ClassOpId {} -> True 548 PrimOpId {} -> True 549 DataConWorkId {} -> True 550 DataConWrapId {} -> True 551 -- These are implied by their type or class decl; 552 -- remember that all type and class decls appear in the interface file. 553 -- The dfun id is not an implicit Id; it must *not* be omitted, because 554 -- it carries version info for the instance decl 555 _ -> False 556 557idIsFrom :: Module -> Id -> Bool 558idIsFrom mod id = nameIsLocalOrFrom mod (idName id) 559 560{- Note [Levity-polymorphic Ids] 561~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 562Some levity-polymorphic Ids must be applied and and inlined, not left 563un-saturated. Example: 564 unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b 565 566This has a compulsory unfolding because we can't lambda-bind those 567arguments. But the compulsory unfolding may leave levity-polymorphic 568lambdas if it is not applied to enough arguments; e.g. (#14561) 569 bad :: forall (a :: TYPE r). a -> a 570 bad = unsafeCoerce# 571 572The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop. 573And we want that magic to apply to levity-polymorphic compulsory-inline things. 574The easiest way to do this is for hasNoBinding to return True of all things 575that have compulsory unfolding. Some Ids with a compulsory unfolding also 576have a binding, but it does not harm to say they don't here, and its a very 577simple way to fix #14561. 578-} 579 580isDeadBinder :: Id -> Bool 581isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) 582 | otherwise = False -- TyVars count as not dead 583 584{- 585************************************************************************ 586* * 587 Join variables 588* * 589************************************************************************ 590-} 591 592idJoinArity :: JoinId -> JoinArity 593idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id) 594 595asJoinId :: Id -> JoinArity -> JoinId 596asJoinId id arity = WARN(not (isLocalId id), 597 text "global id being marked as join var:" <+> ppr id) 598 WARN(not (is_vanilla_or_join id), 599 ppr id <+> pprIdDetails (idDetails id)) 600 id `setIdDetails` JoinId arity 601 where 602 is_vanilla_or_join id = case Var.idDetails id of 603 VanillaId -> True 604 JoinId {} -> True 605 _ -> False 606 607zapJoinId :: Id -> Id 608-- May be a regular id already 609zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId) 610 -- Core Lint may complain if still marked 611 -- as AlwaysTailCalled 612 | otherwise = jid 613 614asJoinId_maybe :: Id -> Maybe JoinArity -> Id 615asJoinId_maybe id (Just arity) = asJoinId id arity 616asJoinId_maybe id Nothing = zapJoinId id 617 618{- 619************************************************************************ 620* * 621\subsection{IdInfo stuff} 622* * 623************************************************************************ 624-} 625 626 --------------------------------- 627 -- ARITY 628idArity :: Id -> Arity 629idArity id = arityInfo (idInfo id) 630 631setIdArity :: Id -> Arity -> Id 632setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id 633 634idCallArity :: Id -> Arity 635idCallArity id = callArityInfo (idInfo id) 636 637setIdCallArity :: Id -> Arity -> Id 638setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id 639 640idFunRepArity :: Id -> RepArity 641idFunRepArity x = countFunRepArgs (idArity x) (idType x) 642 643-- | Returns true if an application to n args would diverge 644isBottomingId :: Var -> Bool 645isBottomingId v 646 | isId v = isBottomingSig (idStrictness v) 647 | otherwise = False 648 649-- | Accesses the 'Id''s 'strictnessInfo'. 650idStrictness :: Id -> StrictSig 651idStrictness id = strictnessInfo (idInfo id) 652 653setIdStrictness :: Id -> StrictSig -> Id 654setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id 655 656zapIdStrictness :: Id -> Id 657zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id 658 659-- | This predicate says whether the 'Id' has a strict demand placed on it or 660-- has a type such that it can always be evaluated strictly (i.e an 661-- unlifted type, as of GHC 7.6). We need to 662-- check separately whether the 'Id' has a so-called \"strict type\" because if 663-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict 664-- type, we still want @isStrictId id@ to be @True@. 665isStrictId :: Id -> Bool 666isStrictId id 667 = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id ) 668 not (isJoinId id) && ( 669 (isStrictType (idType id)) || 670 -- Take the best of both strictnesses - old and new 671 (isStrictDmd (idDemandInfo id)) 672 ) 673 674 --------------------------------- 675 -- UNFOLDING 676idUnfolding :: Id -> Unfolding 677-- Do not expose the unfolding of a loop breaker! 678idUnfolding id 679 | isStrongLoopBreaker (occInfo info) = NoUnfolding 680 | otherwise = unfoldingInfo info 681 where 682 info = idInfo id 683 684realIdUnfolding :: Id -> Unfolding 685-- Expose the unfolding if there is one, including for loop breakers 686realIdUnfolding id = unfoldingInfo (idInfo id) 687 688setIdUnfolding :: Id -> Unfolding -> Id 689setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id 690 691idDemandInfo :: Id -> Demand 692idDemandInfo id = demandInfo (idInfo id) 693 694setIdDemandInfo :: Id -> Demand -> Id 695setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id 696 697setCaseBndrEvald :: StrictnessMark -> Id -> Id 698-- Used for variables bound by a case expressions, both the case-binder 699-- itself, and any pattern-bound variables that are argument of a 700-- strict constructor. It just marks the variable as already-evaluated, 701-- so that (for example) a subsequent 'seq' can be dropped 702setCaseBndrEvald str id 703 | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding 704 | otherwise = id 705 706 --------------------------------- 707 -- SPECIALISATION 708 709-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs 710 711idSpecialisation :: Id -> RuleInfo 712idSpecialisation id = ruleInfo (idInfo id) 713 714idCoreRules :: Id -> [CoreRule] 715idCoreRules id = ruleInfoRules (idSpecialisation id) 716 717idHasRules :: Id -> Bool 718idHasRules id = not (isEmptyRuleInfo (idSpecialisation id)) 719 720setIdSpecialisation :: Id -> RuleInfo -> Id 721setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id 722 723 --------------------------------- 724 -- CAF INFO 725idCafInfo :: Id -> CafInfo 726idCafInfo id = cafInfo (idInfo id) 727 728setIdCafInfo :: Id -> CafInfo -> Id 729setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id 730 731 --------------------------------- 732 -- Occurrence INFO 733idOccInfo :: Id -> OccInfo 734idOccInfo id = occInfo (idInfo id) 735 736setIdOccInfo :: Id -> OccInfo -> Id 737setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id 738 739zapIdOccInfo :: Id -> Id 740zapIdOccInfo b = b `setIdOccInfo` noOccInfo 741 742{- 743 --------------------------------- 744 -- INLINING 745The inline pragma tells us to be very keen to inline this Id, but it's still 746OK not to if optimisation is switched off. 747-} 748 749idInlinePragma :: Id -> InlinePragma 750idInlinePragma id = inlinePragInfo (idInfo id) 751 752setInlinePragma :: Id -> InlinePragma -> Id 753setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id 754 755modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id 756modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id 757 758idInlineActivation :: Id -> Activation 759idInlineActivation id = inlinePragmaActivation (idInlinePragma id) 760 761setInlineActivation :: Id -> Activation -> Id 762setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act) 763 764idRuleMatchInfo :: Id -> RuleMatchInfo 765idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id) 766 767isConLikeId :: Id -> Bool 768isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id) 769 770{- 771 --------------------------------- 772 -- ONE-SHOT LAMBDAS 773-} 774 775idOneShotInfo :: Id -> OneShotInfo 776idOneShotInfo id = oneShotInfo (idInfo id) 777 778-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account 779-- See Note [The state-transformer hack] in CoreArity 780idStateHackOneShotInfo :: Id -> OneShotInfo 781idStateHackOneShotInfo id 782 | isStateHackType (idType id) = stateHackOneShot 783 | otherwise = idOneShotInfo id 784 785-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once 786-- This one is the "business end", called externally. 787-- It works on type variables as well as Ids, returning True 788-- Its main purpose is to encapsulate the Horrible State Hack 789-- See Note [The state-transformer hack] in CoreArity 790isOneShotBndr :: Var -> Bool 791isOneShotBndr var 792 | isTyVar var = True 793 | OneShotLam <- idStateHackOneShotInfo var = True 794 | otherwise = False 795 796-- | Should we apply the state hack to values of this 'Type'? 797stateHackOneShot :: OneShotInfo 798stateHackOneShot = OneShotLam 799 800typeOneShot :: Type -> OneShotInfo 801typeOneShot ty 802 | isStateHackType ty = stateHackOneShot 803 | otherwise = NoOneShotInfo 804 805isStateHackType :: Type -> Bool 806isStateHackType ty 807 | hasNoStateHack unsafeGlobalDynFlags 808 = False 809 | otherwise 810 = case tyConAppTyCon_maybe ty of 811 Just tycon -> tycon == statePrimTyCon 812 _ -> False 813 -- This is a gross hack. It claims that 814 -- every function over realWorldStatePrimTy is a one-shot 815 -- function. This is pretty true in practice, and makes a big 816 -- difference. For example, consider 817 -- a `thenST` \ r -> ...E... 818 -- The early full laziness pass, if it doesn't know that r is one-shot 819 -- will pull out E (let's say it doesn't mention r) to give 820 -- let lvl = E in a `thenST` \ r -> ...lvl... 821 -- When `thenST` gets inlined, we end up with 822 -- let lvl = E in \s -> case a s of (r, s') -> ...lvl... 823 -- and we don't re-inline E. 824 -- 825 -- It would be better to spot that r was one-shot to start with, but 826 -- I don't want to rely on that. 827 -- 828 -- Another good example is in fill_in in PrelPack.hs. We should be able to 829 -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet. 830 831isProbablyOneShotLambda :: Id -> Bool 832isProbablyOneShotLambda id = case idStateHackOneShotInfo id of 833 OneShotLam -> True 834 NoOneShotInfo -> False 835 836setOneShotLambda :: Id -> Id 837setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id 838 839clearOneShotLambda :: Id -> Id 840clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id 841 842setIdOneShotInfo :: Id -> OneShotInfo -> Id 843setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id 844 845updOneShotInfo :: Id -> OneShotInfo -> Id 846-- Combine the info in the Id with new info 847updOneShotInfo id one_shot 848 | do_upd = setIdOneShotInfo id one_shot 849 | otherwise = id 850 where 851 do_upd = case (idOneShotInfo id, one_shot) of 852 (NoOneShotInfo, _) -> True 853 (OneShotLam, _) -> False 854 855-- The OneShotLambda functions simply fiddle with the IdInfo flag 856-- But watch out: this may change the type of something else 857-- f = \x -> e 858-- If we change the one-shot-ness of x, f's type changes 859 860zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id 861zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id 862 863zapLamIdInfo :: Id -> Id 864zapLamIdInfo = zapInfo zapLamInfo 865 866zapFragileIdInfo :: Id -> Id 867zapFragileIdInfo = zapInfo zapFragileInfo 868 869zapIdDemandInfo :: Id -> Id 870zapIdDemandInfo = zapInfo zapDemandInfo 871 872zapIdUsageInfo :: Id -> Id 873zapIdUsageInfo = zapInfo zapUsageInfo 874 875zapIdUsageEnvInfo :: Id -> Id 876zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo 877 878zapIdUsedOnceInfo :: Id -> Id 879zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo 880 881zapIdTailCallInfo :: Id -> Id 882zapIdTailCallInfo = zapInfo zapTailCallInfo 883 884zapStableUnfolding :: Id -> Id 885zapStableUnfolding id 886 | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding 887 | otherwise = id 888 889{- 890Note [transferPolyIdInfo] 891~~~~~~~~~~~~~~~~~~~~~~~~~ 892This transfer is used in three places: 893 FloatOut (long-distance let-floating) 894 SimplUtils.abstractFloats (short-distance let-floating) 895 StgLiftLams (selectively lambda-lift local functions to top-level) 896 897Consider the short-distance let-floating: 898 899 f = /\a. let g = rhs in ... 900 901Then if we float thus 902 903 g' = /\a. rhs 904 f = /\a. ...[g' a/g].... 905 906we *do not* want to lose g's 907 * strictness information 908 * arity 909 * inline pragma (though that is bit more debatable) 910 * occurrence info 911 912Mostly this is just an optimisation, but it's *vital* to 913transfer the occurrence info. Consider 914 915 NonRec { f = /\a. let Rec { g* = ..g.. } in ... } 916 917where the '*' means 'LoopBreaker'. Then if we float we must get 918 919 Rec { g'* = /\a. ...(g' a)... } 920 NonRec { f = /\a. ...[g' a/g]....} 921 922where g' is also marked as LoopBreaker. If not, terrible things 923can happen if we re-simplify the binding (and the Simplifier does 924sometimes simplify a term twice); see #4345. 925 926It's not so simple to retain 927 * worker info 928 * rules 929so we simply discard those. Sooner or later this may bite us. 930 931If we abstract wrt one or more *value* binders, we must modify the 932arity and strictness info before transferring it. E.g. 933 f = \x. e 934--> 935 g' = \y. \x. e 936 + substitute (g' y) for g 937Notice that g' has an arity one more than the original g 938-} 939 940transferPolyIdInfo :: Id -- Original Id 941 -> [Var] -- Abstract wrt these variables 942 -> Id -- New Id 943 -> Id 944transferPolyIdInfo old_id abstract_wrt new_id 945 = modifyIdInfo transfer new_id 946 where 947 arity_increase = count isId abstract_wrt -- Arity increases by the 948 -- number of value binders 949 950 old_info = idInfo old_id 951 old_arity = arityInfo old_info 952 old_inline_prag = inlinePragInfo old_info 953 old_occ_info = occInfo old_info 954 new_arity = old_arity + arity_increase 955 new_occ_info = zapOccTailCallInfo old_occ_info 956 957 old_strictness = strictnessInfo old_info 958 new_strictness = increaseStrictSigArity arity_increase old_strictness 959 960 transfer new_info = new_info `setArityInfo` new_arity 961 `setInlinePragInfo` old_inline_prag 962 `setOccInfo` new_occ_info 963 `setStrictnessInfo` new_strictness 964 965isNeverLevPolyId :: Id -> Bool 966isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo 967