Commit d30352ad authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan
Browse files

Remove StgBinderInfo and related computation in CoreToStg

- The StgBinderInfo type was never used in the code gen, so the type, related
  computation in CoreToStg, and some comments about it are removed. See #15770
  for more details.

- Simplified CoreToStg after removing the StgBinderInfo computation: removed
  StgBinderInfo arguments and mfix stuff.

The StgBinderInfo values were not used in the code gen, but I still run nofib
just to make sure: 0.0% change in allocations and binary sizes.

Test Plan: Validated locally

Reviewers: simonpj, simonmar, bgamari, sgraf

Reviewed By: sgraf

Subscribers: AndreasK, sgraf, rwbarton, carter

Differential Revision: https://phabricator.haskell.org/D5232
parent 13ff0b7c
......@@ -153,9 +153,9 @@ cgTopRhs dflags _rec bndr (StgRhsCon _cc con args)
-- con args are always non-void,
-- see Note [Post-unarisation invariants] in UnariseStg
cgTopRhs dflags rec bndr (StgRhsClosure cc bi fvs upd_flag args body)
cgTopRhs dflags rec bndr (StgRhsClosure cc fvs upd_flag args body)
= ASSERT(null fvs) -- There should be no free variables
cgTopRhsClosure dflags rec bndr cc bi upd_flag args body
cgTopRhsClosure dflags rec bndr cc upd_flag args body
---------------------------------------------------------------
......
......@@ -62,13 +62,12 @@ cgTopRhsClosure :: DynFlags
-> RecFlag -- member of a recursive group?
-> Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
-> UpdateFlag
-> [Id] -- Args
-> StgExpr
-> (CgIdInfo, FCode ())
cgTopRhsClosure dflags rec id ccs _ upd_flag args body =
cgTopRhsClosure dflags rec id ccs upd_flag args body =
let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id)
cg_id_info = litIdInfo dflags id lf_info (CmmLabel closure_label)
lf_info = mkClosureLFInfo dflags id TopLevel [] upd_flag args
......@@ -207,15 +206,15 @@ cgRhs id (StgRhsCon cc con args)
-- see Note [Post-unarisation invariants] in UnariseStg
{- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}
cgRhs id (StgRhsClosure cc bi fvs upd_flag args body)
cgRhs id (StgRhsClosure cc fvs upd_flag args body)
= do dflags <- getDynFlags
mkRhsClosure dflags id cc bi (nonVoidIds fvs) upd_flag args body
mkRhsClosure dflags id cc (nonVoidIds fvs) upd_flag args body
------------------------------------------------------------------------
-- Non-constructor right hand sides
------------------------------------------------------------------------
mkRhsClosure :: DynFlags -> Id -> CostCentreStack -> StgBinderInfo
mkRhsClosure :: DynFlags -> Id -> CostCentreStack
-> [NonVoid Id] -- Free vars
-> UpdateFlag
-> [Id] -- Args
......@@ -258,7 +257,7 @@ for semi-obvious reasons.
-}
---------- Note [Selectors] ------------------
mkRhsClosure dflags bndr _cc _bi
mkRhsClosure dflags bndr _cc
[NonVoid the_fv] -- Just one free var
upd_flag -- Updatable thunk
[] -- A thunk
......@@ -291,7 +290,7 @@ mkRhsClosure dflags bndr _cc _bi
in cgRhsStdThunk bndr lf_info [StgVarArg the_fv]
---------- Note [Ap thunks] ------------------
mkRhsClosure dflags bndr _cc _bi
mkRhsClosure dflags bndr _cc
fvs
upd_flag
[] -- No args; a thunk
......@@ -323,7 +322,7 @@ mkRhsClosure dflags bndr _cc _bi
payload = StgVarArg fun_id : args
---------- Default case ------------------
mkRhsClosure dflags bndr cc _ fvs upd_flag args body
mkRhsClosure dflags bndr cc fvs upd_flag args body
= do { let lf_info = mkClosureLFInfo dflags bndr NotTopLevel fvs upd_flag args
; (id_info, reg) <- rhsIdInfo bndr lf_info
; return (id_info, gen_code lf_info reg) }
......
......@@ -622,92 +622,6 @@ getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method"
-----------------------------------------------------------------------------
-- staticClosureRequired
-----------------------------------------------------------------------------
{- staticClosureRequired is never called (hence commented out)
SimonMar writes (Sept 07) It's an optimisation we used to apply at
one time, I believe, but it got lost probably in the rewrite of
the RTS/code generator. I left that code there to remind me to
look into whether it was worth doing sometime
{- Avoiding generating entries and info tables
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
At present, for every function we generate all of the following,
just in case. But they aren't always all needed, as noted below:
[NB1: all of this applies only to *functions*. Thunks always
have closure, info table, and entry code.]
[NB2: All are needed if the function is *exported*, just to play safe.]
* Fast-entry code ALWAYS NEEDED
* Slow-entry code
Needed iff (a) we have any un-saturated calls to the function
OR (b) the function is passed as an arg
OR (c) we're in the parallel world and the function has free vars
[Reason: in parallel world, we always enter functions
with free vars via the closure.]
* The function closure
Needed iff (a) we have any un-saturated calls to the function
OR (b) the function is passed as an arg
OR (c) if the function has free vars (ie not top level)
Why case (a) here? Because if the arg-satis check fails,
UpdatePAP stuffs a pointer to the function closure in the PAP.
[Could be changed; UpdatePAP could stuff in a code ptr instead,
but doesn't seem worth it.]
[NB: these conditions imply that we might need the closure
without the slow-entry code. Here's how.
f x y = let g w = ...x..y..w...
in
...(g t)...
Here we need a closure for g which contains x and y,
but since the calls are all saturated we just jump to the
fast entry point for g, with R1 pointing to the closure for g.]
* Standard info table
Needed iff (a) we have any un-saturated calls to the function
OR (b) the function is passed as an arg
OR (c) the function has free vars (ie not top level)
NB. In the sequential world, (c) is only required so that the function closure has
an info table to point to, to keep the storage manager happy.
If (c) alone is true we could fake up an info table by choosing
one of a standard family of info tables, whose entry code just
bombs out.
[NB In the parallel world (c) is needed regardless because
we enter functions with free vars via the closure.]
If (c) is retained, then we'll sometimes generate an info table
(for storage mgr purposes) without slow-entry code. Then we need
to use an error label in the info table to substitute for the absent
slow entry code.
-}
staticClosureRequired
:: Name
-> StgBinderInfo
-> LambdaFormInfo
-> Bool
staticClosureRequired binder bndr_info
(LFReEntrant top_level _ _ _ _) -- It's a function
= ASSERT( isTopLevel top_level )
-- Assumption: it's a top-level, no-free-var binding
not (satCallsOnly bndr_info)
staticClosureRequired binder other_binder_info other_lf_info = True
-}
-----------------------------------------------------------------------------
-- Data types for closure information
-----------------------------------------------------------------------------
......
......@@ -151,7 +151,7 @@ cgLetNoEscapeRhsBody
-> Id
-> StgRhs
-> FCode (CgIdInfo, FCode ())
cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _bi _ _upd args body)
cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _ _upd args body)
= cgLetNoEscapeClosure bndr local_cc cc (nonVoidIds args) body
cgLetNoEscapeRhsBody local_cc bndr (StgRhsCon cc con args)
= cgLetNoEscapeClosure bndr local_cc cc []
......
......@@ -284,9 +284,9 @@ stgCseTopLvl in_scope (StgTopLifted (StgRec eqs))
where in_scope' = in_scope `extendInScopeSetList` [ bndr | (bndr, _) <- eqs ]
stgCseTopLvlRhs :: InScopeSet -> InStgRhs -> OutStgRhs
stgCseTopLvlRhs in_scope (StgRhsClosure ccs info occs upd args body)
stgCseTopLvlRhs in_scope (StgRhsClosure ccs occs upd args body)
= let body' = stgCseExpr (initEnv in_scope) body
in StgRhsClosure ccs info occs upd args body'
in StgRhsClosure ccs occs upd args body'
stgCseTopLvlRhs _ (StgRhsCon ccs dataCon args)
= StgRhsCon ccs dataCon args
......@@ -402,11 +402,11 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon args)
pair = (bndr, StgRhsCon ccs dataCon args')
in (Just pair, env')
where args' = substArgs env args
stgCseRhs env bndr (StgRhsClosure ccs info occs upd args body)
stgCseRhs env bndr (StgRhsClosure ccs occs upd args body)
= let (env1, args') = substBndrs env args
env2 = forgetCse env1 -- See note [Free variables of an StgClosure]
body' = stgCseExpr env2 body
in (Just (substVar env bndr, StgRhsClosure ccs info occs' upd args' body'), env)
in (Just (substVar env bndr, StgRhsClosure ccs occs' upd args' body'), env)
where occs' = substVars env occs
......
......@@ -131,7 +131,7 @@ statRhs :: Bool -> (Id, StgRhs) -> StatEnv
statRhs top (_, StgRhsCon _ _ _)
= countOne (ConstructorBinds top)
statRhs top (_, StgRhsClosure _ _ fv u _ body)
statRhs top (_, StgRhsClosure _ fv u _ body)
= statExpr body `combineSE`
countN FreeVariables (length fv) `combineSE`
countOne (
......
......@@ -281,11 +281,11 @@ unariseBinding rho (StgRec xrhss)
= StgRec <$> mapM (\(x, rhs) -> (x,) <$> unariseRhs rho rhs) xrhss
unariseRhs :: UnariseEnv -> StgRhs -> UniqSM StgRhs
unariseRhs rho (StgRhsClosure ccs b_info fvs update_flag args expr)
unariseRhs rho (StgRhsClosure ccs fvs update_flag args expr)
= do (rho', args1) <- unariseFunArgBinders rho args
expr' <- unariseExpr rho' expr
let fvs' = unariseFreeVars rho fvs
return (StgRhsClosure ccs b_info fvs' update_flag args1 expr')
return (StgRhsClosure ccs fvs' update_flag args1 expr')
unariseRhs rho (StgRhsCon ccs con args)
= ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
......
......@@ -118,19 +118,6 @@ import Control.Monad (liftM, ap)
--
-- See also: Commentary/Rts/Storage/GC/CAFs on the GHC Wiki.
-- Note [Collecting live CAF info]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- In this pass we also collect information on which CAFs are live.
--
-- A top-level Id has CafInfo, which is
--
-- - MayHaveCafRefs, if it may refer indirectly to
-- one or more CAFs, or
-- - NoCafRefs if it definitely doesn't
--
-- The CafInfo has already been calculated during the CoreTidy pass.
--
-- Note [What is a non-escaping let]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
......@@ -282,7 +269,7 @@ coreTopBindToStg dflags this_mod env body_fvs ccs (NonRec id rhs)
(stg_rhs, fvs', ccs') =
initCts env $
coreToTopStgRhs dflags ccs this_mod body_fvs (id,rhs)
coreToTopStgRhs dflags ccs this_mod (id,rhs)
bind = StgTopLifted $ StgNonRec id stg_rhs
in
......@@ -308,7 +295,7 @@ coreTopBindToStg dflags this_mod env body_fvs ccs (Rec pairs)
= initCts env' $ do
mapAccumLM (\(fvs, ccs) rhs -> do
(rhs', fvs', ccs') <-
coreToTopStgRhs dflags ccs this_mod body_fvs rhs
coreToTopStgRhs dflags ccs this_mod rhs
return ((fvs' `unionFVInfo` fvs, ccs'), rhs'))
(body_fvs, ccs)
pairs
......@@ -338,15 +325,14 @@ coreToTopStgRhs
:: DynFlags
-> CollectedCCs
-> Module
-> FreeVarsInfo -- Free var info for the scope of the binding
-> (Id,CoreExpr)
-> CtsM (StgRhs, FreeVarsInfo, CollectedCCs)
coreToTopStgRhs dflags ccs this_mod scope_fv_info (bndr, rhs)
coreToTopStgRhs dflags ccs this_mod (bndr, rhs)
= do { (new_rhs, rhs_fvs) <- coreToStgExpr rhs
; let (stg_rhs, ccs') =
mkTopStgRhs dflags this_mod ccs rhs_fvs bndr bndr_info new_rhs
mkTopStgRhs dflags this_mod ccs rhs_fvs bndr new_rhs
stg_arity =
stgRhsArity stg_rhs
......@@ -354,8 +340,6 @@ coreToTopStgRhs dflags ccs this_mod scope_fv_info (bndr, rhs)
rhs_fvs,
ccs') }
where
bndr_info = lookupFVInfo scope_fv_info bndr
-- It's vital that the arity on a top-level Id matches
-- the arity of the generated STG binding, else an importing
-- module will use the wrong calling convention
......@@ -558,8 +542,7 @@ coreToStgApp _ f args ticks = do
let
n_val_args = valArgCount args
not_letrec_bound = not (isLetBound how_bound)
fun_fvs = singletonFVInfo f how_bound fun_occ
fun_fvs = singletonFVInfo f how_bound
-- e.g. (f :: a -> int) (x :: a)
-- Here the free variables are "f", "x" AND the type variable "a"
-- coreToStgArgs will deal with the arguments recursively
......@@ -574,11 +557,6 @@ coreToStgApp _ f args ticks = do
f_arity = stgArity f how_bound
saturated = f_arity <= n_val_args
fun_occ
| not_letrec_bound = noBinderInfo -- Uninteresting variable
| f_arity > 0 && saturated = stgSatOcc -- Saturated or over-saturated function call
| otherwise = stgUnsatOcc -- Unsaturated function or thunk
res_ty = exprType (mkApps (Var f) args)
app = case idDetails f of
DataConWorkId dc
......@@ -612,8 +590,6 @@ coreToStgApp _ f args ticks = do
fvs
)
-- ---------------------------------------------------------------------------
-- Argument lists
-- This is the guy that turns applications into A-normal form
......@@ -686,10 +662,10 @@ coreToStgLet
coreToStgLet bind body = do
(bind2, bind_fvs,
body2, body_fvs)
<- mfix $ \ ~(_, _, _, rec_body_fvs) -> do
<- do
( bind2, bind_fvs, env_ext)
<- vars_bind rec_body_fvs bind
<- vars_bind bind
-- Do the body
extendVarEnvCts env_ext $ do
......@@ -698,7 +674,6 @@ coreToStgLet bind body = do
return (bind2, bind_fvs,
body2, body_fvs)
-- Compute the new let-expression
let
new_let | isJoinBind bind = StgLetNoEscape bind2 body2
......@@ -717,59 +692,51 @@ coreToStgLet bind body = do
mk_binding binder rhs
= (binder, LetBound NestedLet (manifestArity rhs))
vars_bind :: FreeVarsInfo -- Free var info for body of binding
-> CoreBind
vars_bind :: CoreBind
-> CtsM (StgBinding,
FreeVarsInfo,
[(Id, HowBound)]) -- extension to environment
vars_bind body_fvs (NonRec binder rhs) = do
(rhs2, bind_fvs) <- coreToStgRhs body_fvs (binder,rhs)
vars_bind (NonRec binder rhs) = do
(rhs2, bind_fvs) <- coreToStgRhs (binder,rhs)
let
env_ext_item = mk_binding binder rhs
return (StgNonRec binder rhs2,
bind_fvs, [env_ext_item])
vars_bind body_fvs (Rec pairs)
= mfix $ \ ~(_, rec_rhs_fvs, _) ->
let
rec_scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
vars_bind (Rec pairs)
= let
binders = map fst pairs
env_ext = [ mk_binding b rhs
| (b,rhs) <- pairs ]
in
extendVarEnvCts env_ext $ do
(rhss2, fvss)
<- mapAndUnzipM (coreToStgRhs rec_scope_fvs) pairs
<- mapAndUnzipM coreToStgRhs pairs
let
bind_fvs = unionFVInfos fvss
return (StgRec (binders `zip` rhss2),
bind_fvs, env_ext)
coreToStgRhs :: FreeVarsInfo -- Free var info for the scope of the binding
-> (Id,CoreExpr)
coreToStgRhs :: (Id,CoreExpr)
-> CtsM (StgRhs, FreeVarsInfo)
coreToStgRhs scope_fv_info (bndr, rhs) = do
coreToStgRhs (bndr, rhs) = do
(new_rhs, rhs_fvs) <- coreToStgExpr rhs
return (mkStgRhs rhs_fvs bndr bndr_info new_rhs, rhs_fvs)
where
bndr_info = lookupFVInfo scope_fv_info bndr
return (mkStgRhs rhs_fvs bndr new_rhs, rhs_fvs)
-- Generate a top-level RHS. Any new cost centres generated for CAFs will be
-- appended to `CollectedCCs` argument.
mkTopStgRhs :: DynFlags -> Module -> CollectedCCs
-> FreeVarsInfo -> Id -> StgBinderInfo -> StgExpr
-> FreeVarsInfo -> Id -> StgExpr
-> (StgRhs, CollectedCCs)
mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
mkTopStgRhs dflags this_mod ccs rhs_fvs bndr rhs
| StgLam bndrs body <- rhs
= -- StgLam can't have empty arguments, so not CAF
( StgRhsClosure dontCareCCS binder_info
( StgRhsClosure dontCareCCS
(getFVs rhs_fvs)
ReEntrant
(toList bndrs) body
......@@ -785,13 +752,13 @@ mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
-- Otherwise it's a CAF, see Note [Cost-centre initialization plan].
| gopt Opt_AutoSccsOnIndividualCafs dflags
= ( StgRhsClosure caf_ccs binder_info
= ( StgRhsClosure caf_ccs
(getFVs rhs_fvs)
upd_flag [] rhs
, collectCC caf_cc caf_ccs ccs )
| otherwise
= ( StgRhsClosure all_cafs_ccs binder_info
= ( StgRhsClosure all_cafs_ccs
(getFVs rhs_fvs)
upd_flag [] rhs
, ccs )
......@@ -816,17 +783,17 @@ mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
-- Generate a non-top-level RHS. Cost-centre is always currentCCS,
-- see Note [Cost-centre initialzation plan].
mkStgRhs :: FreeVarsInfo -> Id -> StgBinderInfo -> StgExpr -> StgRhs
mkStgRhs rhs_fvs bndr binder_info rhs
mkStgRhs :: FreeVarsInfo -> Id -> StgExpr -> StgRhs
mkStgRhs rhs_fvs bndr rhs
| StgLam bndrs body <- rhs
= StgRhsClosure currentCCS binder_info
= StgRhsClosure currentCCS
(getFVs rhs_fvs)
ReEntrant
(toList bndrs) body
| isJoinId bndr -- must be a nullary join point
= ASSERT(idJoinArity bndr == 0)
StgRhsClosure currentCCS binder_info
StgRhsClosure currentCCS
(getFVs rhs_fvs)
ReEntrant -- ignored for LNE
[] rhs
......@@ -835,7 +802,7 @@ mkStgRhs rhs_fvs bndr binder_info rhs
= StgRhsCon currentCCS con args
| otherwise
= StgRhsClosure currentCCS binder_info
= StgRhsClosure currentCCS
(getFVs rhs_fvs)
upd_flag [] rhs
where
......@@ -924,10 +891,6 @@ data LetInfo
| NestedLet
deriving (Eq)
isLetBound :: HowBound -> Bool
isLetBound (LetBound _ _) = True
isLetBound _ = False
topLevelBound :: HowBound -> Bool
topLevelBound ImportBound = True
topLevelBound (LetBound TopLet _) = True
......@@ -974,11 +937,6 @@ instance Applicative CtsM where
instance Monad CtsM where
(>>=) = thenCts
instance MonadFix CtsM where
mfix expr = CtsM $ \env ->
let result = unCtsM (expr result) env
in result
-- Functions specific to this monad:
extendVarEnvCts :: [(Id, HowBound)] -> CtsM a -> CtsM a
......@@ -1007,7 +965,7 @@ getAllCAFsCC this_mod =
-- Free variable information
-- ---------------------------------------------------------------------------
type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
type FreeVarsInfo = VarEnv (Var, HowBound)
-- The Var is so we can gather up the free variables
-- as a set.
--
......@@ -1017,31 +975,16 @@ type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
-- Imported Ids without CAF refs are simply
-- not put in the FreeVarsInfo for an expression.
-- See singletonFVInfo and freeVarsToLiveVars
--
-- StgBinderInfo records how it occurs; notably, we
-- are interested in whether it only occurs in saturated
-- applications, because then we don't need to build a
-- curried version.
-- If f is mapped to noBinderInfo, that means
-- that f *is* mentioned (else it wouldn't be in the
-- IdEnv at all), but perhaps in an unsaturated applications.
--
-- All case/lambda-bound things are also mapped to
-- noBinderInfo, since we aren't interested in their
-- occurrence info.
--
-- For ILX we track free var info for type variables too;
-- hence VarEnv not IdEnv
emptyFVInfo :: FreeVarsInfo
emptyFVInfo = emptyVarEnv
singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
singletonFVInfo :: Id -> HowBound -> FreeVarsInfo
-- Don't record non-CAF imports at all, to keep free-var sets small
singletonFVInfo id ImportBound info
| mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound, info)
singletonFVInfo id ImportBound
| mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound)
| otherwise = emptyVarEnv
singletonFVInfo id how_bound info = unitVarEnv id (id, how_bound, info)
singletonFVInfo id how_bound = unitVarEnv id (id, how_bound)
unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
......@@ -1060,29 +1003,20 @@ minusFVBinder v fv = fv `delVarEnv` v
elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
elementOfFVInfo id fvs = isJust (lookupVarEnv fvs id)
lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
-- Find how the given Id is used.
-- Externally visible things may be used any old how
lookupFVInfo fvs id
| isExternalName (idName id) = noBinderInfo
| otherwise = case lookupVarEnv fvs id of
Nothing -> noBinderInfo
Just (_,_,info) -> info
-- Non-top-level things only, both type variables and ids
getFVs :: FreeVarsInfo -> [Var]
getFVs fvs = [id | (id, how_bound, _) <- nonDetEltsUFM fvs,
getFVs fvs = [id | (id, how_bound) <- nonDetEltsUFM fvs,
-- It's OK to use nonDetEltsUFM here because we're not aiming for
-- bit-for-bit determinism.
-- See Note [Unique Determinism and code generation]
not (topLevelBound how_bound) ]
plusFVInfo :: (Var, HowBound, StgBinderInfo)
-> (Var, HowBound, StgBinderInfo)
-> (Var, HowBound, StgBinderInfo)
plusFVInfo (id1,hb1,info1) (id2,hb2,info2)
plusFVInfo :: (Var, HowBound)
-> (Var, HowBound)
-> (Var, HowBound)
plusFVInfo (id1,hb1) (id2,hb2)
= ASSERT(id1 == id2 && hb1 == hb2)
(id1, hb1, combineStgBinderInfo info1 info2)
(id1, hb1)
-- Misc.
......
......@@ -116,10 +116,10 @@ lint_binds_help (binder, rhs)
lintStgRhs :: StgRhs -> LintM ()
lintStgRhs (StgRhsClosure _ _ _ _ [] expr)
lintStgRhs (StgRhsClosure _ _ _ [] expr)
= lintStgExpr expr
lintStgRhs (StgRhsClosure _ _ _ _ binders expr)
lintStgRhs (StgRhsClosure _ _ _ binders expr)
= addLoc (LambdaBodyOf binders) $
addInScopeVars binders $
lintStgExpr expr
......
......@@ -19,10 +19,6 @@ module StgSyn (
UpdateFlag(..), isUpdatable,
StgBinderInfo,
noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
combineStgBinderInfo,
-- a set of synonyms for the most common (only :-) parameterisation
StgArg,
StgTopBinding, StgBinding, StgExpr, StgRhs, StgAlt,
......@@ -393,7 +389,6 @@ flavour is for closures:
data GenStgRhs bndr occ
= StgRhsClosure
CostCentreStack -- CCS to be attached (default is CurrentCCS)
StgBinderInfo -- Info about how this binder is used (see below)
[occ] -- non-global free vars; a list, rather than
-- a set, because order is important
!UpdateFlag -- ReEntrant | Updatable | SingleEntry
......@@ -428,7 +423,7 @@ The second flavour of right-hand-side is for constructors (simple but important)
[GenStgArg occ] -- Args
stgRhsArity :: StgRhs -> Int
stgRhsArity (StgRhsClosure _ _ _ _ bndrs _)
stgRhsArity (StgRhsClosure _ _ _ bndrs _)
= ASSERT( all isId bndrs ) length bndrs
-- The arity never includes type parameters, but they should have gone by now
stgRhsArity (StgRhsCon _ _ _) = 0
......@@ -455,7 +450,7 @@ topStgBindHasCafRefs StgTopStringLit{}
= False
topRhsHasCafRefs :: GenStgRhs bndr Id -> Bool
topRhsHasCafRefs (StgRhsClosure _ _ _ upd _ body)
topRhsHasCafRefs (StgRhsClosure _ _ upd _ body)
= -- See Note [CAF consistency]
isUpdatable upd || exprHasCafRefs body
topRhsHasCafRefs (StgRhsCon _ _ args)
......@@ -488,7 +483,7 @@ bindHasCafRefs (StgRec binds)
= any rhsHasCafRefs (map snd binds)
rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
rhsHasCafRefs (StgRhsClosure _ _ _ _ _ body)
rhsHasCafRefs (StgRhsClosure _ _ _ _ body)
= exprHasCafRefs body