summaryrefslogtreecommitdiff
path: root/compiler/GHC/Stg
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2020-02-01 13:29:18 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-02-05 09:22:52 -0500
commit9c89a48dd88b566a23b670ce707208e8c4cf28c1 (patch)
tree7a480acc9a5d3949778ae5869a5e3cc0f2bd526a /compiler/GHC/Stg
parent6d3b5d5706a8fcfe724ee0a042d5f7c18880ccba (diff)
downloadhaskell-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.hs8
-rw-r--r--compiler/GHC/Stg/Lift/Monad.hs30
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