diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2020-02-01 13:29:18 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-05 09:22:52 -0500 |
commit | 9c89a48dd88b566a23b670ce707208e8c4cf28c1 (patch) | |
tree | 7a480acc9a5d3949778ae5869a5e3cc0f2bd526a /compiler/GHC/Stg | |
parent | 6d3b5d5706a8fcfe724ee0a042d5f7c18880ccba (diff) | |
download | haskell-9c89a48dd88b566a23b670ce707208e8c4cf28c1.tar.gz |
Remove CafInfo-related code from STG lambda lift pass
After c846618ae0 we don't have accurate CafInfos for Ids in the current
module and we're free to introduce new CAFFY or non-CAFFY bindings or
change CafInfos of existing binders; so no we no longer need to
maintain CafInfos in Core or STG passes.
Diffstat (limited to 'compiler/GHC/Stg')
-rw-r--r-- | compiler/GHC/Stg/Lift.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Stg/Lift/Monad.hs | 30 |
2 files changed, 5 insertions, 33 deletions
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs index cafcafbd42..0f1a4ccbcb 100644 --- a/compiler/GHC/Stg/Lift.hs +++ b/compiler/GHC/Stg/Lift.hs @@ -22,7 +22,6 @@ import GhcPrelude import BasicTypes import DynFlags import Id -import IdInfo import GHC.Stg.FVs ( annBindingFreeVars ) import GHC.Stg.Lift.Analysis import GHC.Stg.Lift.Monad @@ -155,14 +154,9 @@ withLiftedBind -> (Maybe OutStgBinding -> LiftM a) -> LiftM a withLiftedBind top_lvl bind scope k - | isTopLevel top_lvl - = withCaffyness (is_caffy pairs) go - | otherwise - = go + = withLiftedBindPairs top_lvl rec pairs scope (k . fmap (mkStgBinding rec)) where (rec, pairs) = decomposeStgBinding bind - is_caffy = any (mayHaveCafRefs . idCafInfo . binderInfoBndr . fst) - go = withLiftedBindPairs top_lvl rec pairs scope (k . fmap (mkStgBinding rec)) withLiftedBindPairs :: TopLevelFlag diff --git a/compiler/GHC/Stg/Lift/Monad.hs b/compiler/GHC/Stg/Lift/Monad.hs index 7d17e53cd9..5dd7ab8d65 100644 --- a/compiler/GHC/Stg/Lift/Monad.hs +++ b/compiler/GHC/Stg/Lift/Monad.hs @@ -11,7 +11,7 @@ module GHC.Stg.Lift.Monad ( -- $floats FloatLang (..), collectFloats, -- Exported just for the docs -- * Transformation monad - LiftM, runLiftM, withCaffyness, + LiftM, runLiftM, -- ** Adding bindings startBindingGroup, endBindingGroup, addTopStringLit, addLiftedBinding, -- ** Substitution and binders @@ -29,7 +29,6 @@ import CostCentre ( isCurrentCCS, dontCareCCS ) import DynFlags import FastString import Id -import IdInfo import Name import Outputable import OrdList @@ -81,14 +80,10 @@ data Env -- 'InId's to 'OutId's. -- -- Invariant: 'Id's not present in this map won't be substituted. - , e_in_caffy_context :: !Bool - -- ^ Are we currently analysing within a caffy context (e.g. the containing - -- top-level binder's 'idCafInfo' is 'MayHaveCafRefs')? If not, we can safely - -- assume that functions we lift out aren't caffy either. } emptyEnv :: DynFlags -> Env -emptyEnv dflags = Env dflags emptySubst emptyVarEnv False +emptyEnv dflags = Env dflags emptySubst emptyVarEnv -- Note [Handling floats] @@ -206,8 +201,7 @@ removeRhsCCCS rhs = rhs -- -- * 'Env': Reader-like context. Contains a substitution, info about how -- how lifted identifiers are to be expanded into applications and details --- such as 'DynFlags' and a flag helping with determining if a lifted --- binding is caffy. +-- such as 'DynFlags'. -- -- * @'OrdList' 'FloatLang'@: Writer output for the resulting STG program. -- @@ -233,12 +227,6 @@ runLiftM dflags us (LiftM m) = collectFloats (fromOL floats) where (_, _, floats) = initUs_ us (runRWST m (emptyEnv dflags) ()) --- | Assumes a given caffyness for the execution of the passed action, which --- influences the 'cafInfo' of lifted bindings. -withCaffyness :: Bool -> LiftM a -> LiftM a -withCaffyness caffy action - = LiftM (RWS.local (\e -> e { e_in_caffy_context = caffy }) (unwrapLiftM action)) - -- | Writes a plain 'StgTopStringLit' to the output. addTopStringLit :: OutId -> ByteString -> LiftM () addTopStringLit id = LiftM . RWS.tell . unitOL . PlainTopBinding . StgTopStringLit id @@ -276,26 +264,16 @@ withSubstBndrs = runContT . traverse (ContT . withSubstBndr) -- for) and a continuation in which that fresh, lifted binder is in scope. -- -- It takes care of all the details involved with copying and adjusting the --- binder, fresh name generation and caffyness. +-- binder and fresh name generation. withLiftedBndr :: DIdSet -> Id -> (Id -> LiftM a) -> LiftM a withLiftedBndr abs_ids bndr inner = do uniq <- getUniqueM let str = "$l" ++ occNameString (getOccName bndr) let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr) - -- When the enclosing top-level binding is not caffy, then the lifted - -- binding will not be caffy either. If we don't recognize this, non-caffy - -- things call caffy things and then codegen screws up. - in_caffy_ctxt <- LiftM (RWS.asks e_in_caffy_context) - let caf_info = if in_caffy_ctxt then MayHaveCafRefs else NoCafRefs let bndr' -- See Note [transferPolyIdInfo] in Id.hs. We need to do this at least -- for arity information. = transferPolyIdInfo bndr (dVarSetElems abs_ids) - -- Otherwise we confuse code gen if bndr was not caffy: the new bndr is - -- assumed to be caffy and will need an SRT. Transitive call sites might - -- not be caffy themselves and subsequently will miss a static link - -- field in their closure. Chaos ensues. - . flip setIdCafInfo caf_info . mkSysLocal (mkFastString str) uniq $ ty LiftM $ RWS.local |