diff options
Diffstat (limited to 'compiler/GHC/Stg/CSE.hs')
| -rw-r--r-- | compiler/GHC/Stg/CSE.hs | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs index 73fb7617a0..eb52d6f8d2 100644 --- a/compiler/GHC/Stg/CSE.hs +++ b/compiler/GHC/Stg/CSE.hs @@ -319,11 +319,11 @@ stgCseTopLvl in_scope (StgTopLifted (StgRec eqs)) where in_scope' = in_scope `extendInScopeSetList` [ bndr | (bndr, _) <- eqs ] stgCseTopLvlRhs :: InScopeSet -> InStgRhs -> OutStgRhs -stgCseTopLvlRhs in_scope (StgRhsClosure ext ccs upd args body) +stgCseTopLvlRhs in_scope (StgRhsClosure ext ccs upd args body typ) = let body' = stgCseExpr (initEnv in_scope) body - in StgRhsClosure ext ccs upd args body' -stgCseTopLvlRhs _ (StgRhsCon ccs dataCon mu ticks args) - = StgRhsCon ccs dataCon mu ticks args + in StgRhsClosure ext ccs upd args body' typ +stgCseTopLvlRhs _ (StgRhsCon ccs dataCon mu ticks args typ) + = StgRhsCon ccs dataCon mu ticks args typ ------------------------------ -- The actual AST traversal -- @@ -427,7 +427,7 @@ stgCsePairs env0 ((b,e):pairs) -- The RHS of a binding. -- If it is a constructor application, either short-cut it or extend the environment stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv) -stgCseRhs env bndr (StgRhsCon ccs dataCon mu ticks args) +stgCseRhs env bndr (StgRhsCon ccs dataCon mu ticks args typ) | Just other_bndr <- envLookup dataCon args' env , not (isWeakLoopBreaker (idOccInfo bndr)) -- See Note [Care with loop breakers] = let env' = addSubst bndr other_bndr env @@ -435,15 +435,15 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon mu ticks args) | otherwise = let env' = addDataCon bndr dataCon args' env -- see Note [Case 1: CSEing allocated closures] - pair = (bndr, StgRhsCon ccs dataCon mu ticks args') + pair = (bndr, StgRhsCon ccs dataCon mu ticks args' typ) in (Just pair, env') where args' = substArgs env args -stgCseRhs env bndr (StgRhsClosure ext ccs upd args body) +stgCseRhs env bndr (StgRhsClosure ext ccs upd args body typ) = 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 ext ccs upd args' body'), env) + in (Just (substVar env bndr, StgRhsClosure ext ccs upd args' body' typ), env) mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr |