diff options
Diffstat (limited to 'compiler/simplCore')
-rw-r--r-- | compiler/simplCore/CSE.hs | 9 | ||||
-rw-r--r-- | compiler/simplCore/SimplUtils.hs | 8 |
2 files changed, 13 insertions, 4 deletions
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index b8e26b593e..6603abf14a 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -294,11 +294,14 @@ cseProgram binds = snd (mapAccumL (cseBind True) emptyCSEnv binds) cseBind :: Bool -> CSEnv -> CoreBind -> (CSEnv, CoreBind) cseBind toplevel env (NonRec b e) - = (env2, NonRec b2 e1) + = (env2, NonRec b2 e2) where e1 = tryForCSE toplevel env e (env1, b1) = addBinder env b (env2, b2) = addBinding env1 b b1 e1 + e2 -- See Note [Take care with literal strings] + | toplevel && exprIsLiteralString e = e + | otherwise = e1 cseBind _ env (Rec [(in_id, rhs)]) | noCSE in_id @@ -402,9 +405,7 @@ the original RHS unmodified. This produces: -} tryForCSE :: Bool -> CSEnv -> InExpr -> OutExpr -tryForCSE toplevel env expr - | toplevel && exprIsLiteralString expr = expr - -- See Note [Take care with literal strings] +tryForCSE _toplevel env expr | Just e <- lookupCSEnv env expr'' = mkTicks ticks e | otherwise = expr' -- The varToCoreExpr is needed if we have diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 0fe262b2c7..6941f16e15 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1030,6 +1030,12 @@ Note [Do not inline CoVars unconditionally] Coercion variables appear inside coercions, and the RHS of a let-binding is a term (not a coercion) so we can't necessarily inline the latter in the former. + +Note [Do not inline string literals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We float out string literals and then common them up. So we must ensure +that preInlineUnconditionally doesn't undo the work of FloatOut by inlining +them right back. -} preInlineUnconditionally :: DynFlags -> SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool @@ -1055,6 +1061,8 @@ preInlineUnconditionally dflags env top_lvl bndr rhs -- See Note [pre/postInlineUnconditionally in gentle mode] act = idInlineActivation bndr try_once in_lam int_cxt -- There's one textual occurrence + -- See Note [Do not inline string literals] + | exprIsLiteralString rhs = False | not in_lam = isNotTopLevel top_lvl || early_phase | otherwise = int_cxt && canInlineInLam rhs |