diff options
Diffstat (limited to 'compiler/simplStg/StgCse.hs')
| -rw-r--r-- | compiler/simplStg/StgCse.hs | 12 |
1 files changed, 4 insertions, 8 deletions
diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index fe7943c7d8..a22a7c1400 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -227,9 +227,6 @@ substArg :: CseEnv -> InStgArg -> OutStgArg substArg env (StgVarArg from) = StgVarArg (substVar env from) substArg _ (StgLitArg lit) = StgLitArg lit -substVars :: CseEnv -> [InId] -> [OutId] -substVars env = map (substVar env) - substVar :: CseEnv -> InId -> OutId substVar env id = fromMaybe id $ lookupVarEnv (ce_subst env) id @@ -284,9 +281,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 occs upd args body) +stgCseTopLvlRhs in_scope (StgRhsClosure ext ccs upd args body) = let body' = stgCseExpr (initEnv in_scope) body - in StgRhsClosure ccs occs upd args body' + in StgRhsClosure ext ccs upd args body' stgCseTopLvlRhs _ (StgRhsCon ccs dataCon args) = StgRhsCon ccs dataCon args @@ -402,12 +399,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 occs upd args body) +stgCseRhs env bndr (StgRhsClosure ext ccs 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 occs' upd args' body'), env) - where occs' = substVars env occs + in (Just (substVar env bndr, StgRhsClosure ext ccs upd args' body'), env) mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr |