diff options
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/CSE.hs | 14 | ||||
| -rw-r--r-- | compiler/simplCore/FloatIn.hs | 4 |
2 files changed, 11 insertions, 7 deletions
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index 95df5f8b09..83f5ee6a3b 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -352,15 +352,19 @@ cse_bind toplevel env (in_id, in_rhs) out_id (env', out_id') = addBinding env in_id out_id out_rhs addBinding :: CSEnv -- Includes InId->OutId cloning - -> InId + -> InVar -- Could be a let-bound type -> OutId -> OutExpr -- Processed binding -> (CSEnv, OutId) -- Final env, final bndr -- Extend the CSE env with a mapping [rhs -> out-id] -- unless we can instead just substitute [in-id -> rhs] +-- +-- It's possible for the binder to be a type variable (see +-- Note [Type-let] in CoreSyn), in which case we can just substitute. addBinding env in_id out_id rhs' - | noCSE in_id = (env, out_id) - | use_subst = (extendCSSubst env in_id rhs', out_id) - | otherwise = (extendCSEnv env rhs' id_expr', zapped_id) + | not (isId in_id) = (extendCSSubst env in_id rhs', out_id) + | noCSE in_id = (env, out_id) + | use_subst = (extendCSSubst env in_id rhs', out_id) + | otherwise = (extendCSEnv env rhs' id_expr', zapped_id) where id_expr' = varToCoreExpr out_id zapped_id = zapIdUsageInfo out_id @@ -381,7 +385,7 @@ addBinding env in_id out_id rhs' _ -> False noCSE :: InId -> Bool -noCSE id = not (isAlwaysActive (idInlineActivation id)) +noCSE id = not (isAlwaysActive (idInlineActivation id)) -- See Note [CSE for INLINE and NOINLINE] || isAnyInlinePragma (idInlinePragma id) -- See Note [CSE for stable unfoldings] diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs index e765455dfc..02a7f741c5 100644 --- a/compiler/simplCore/FloatIn.hs +++ b/compiler/simplCore/FloatIn.hs @@ -485,7 +485,7 @@ fiBind dflags to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs where body_fvs2 = body_fvs `delDVarSet` id - rule_fvs = idRuleAndUnfoldingVarsDSet id -- See Note [extra_fvs (2): free variables of rules] + rule_fvs = bndrRuleAndUnfoldingVarsDSet id -- See Note [extra_fvs (2): free variables of rules] extra_fvs | noFloatIntoRhs NonRecursive id rhs = rule_fvs `unionDVarSet` rhs_fvs | otherwise @@ -515,7 +515,7 @@ fiBind dflags to_drop (AnnRec bindings) body_fvs rhss_fvs = map freeVarsOf rhss -- See Note [extra_fvs (1,2)] - rule_fvs = mapUnionDVarSet idRuleAndUnfoldingVarsDSet ids + rule_fvs = mapUnionDVarSet bndrRuleAndUnfoldingVarsDSet ids extra_fvs = rule_fvs `unionDVarSet` unionDVarSets [ rhs_fvs | (bndr, (rhs_fvs, rhs)) <- bindings , noFloatIntoRhs Recursive bndr rhs ] |