From e009b4f1676c3ae080b59cb1e0914409e0c4660c Mon Sep 17 00:00:00 2001
From: Joachim Breitner <mail@joachim-breitner.de>
Date: Wed, 18 Dec 2013 00:11:25 +0100
Subject: [PATCH] Move Common Context after CSE
We had something like
let $j = ...
in case foo of ... -> case $j a b c of ... -> case foo of
and moving the inner "case foo" into $j prevented CSE from happening
here.
(Although presumably the "let $j" could be moved inside the outer case
before CSE, to give CSE a greater scope here.)
---
compiler/simplCore/CommonContext.lhs | 2 ++
compiler/simplCore/SimplCore.lhs | 5 +++--
2 files changed, 5 insertions(+), 2 deletions(-)
diff --git a/compiler/simplCore/CommonContext.lhs b/compiler/simplCore/CommonContext.lhs
index 9199e70154a..1cfcbe99128 100644
--- a/compiler/simplCore/CommonContext.lhs
+++ b/compiler/simplCore/CommonContext.lhs
@@ -52,6 +52,8 @@ findInterestingLet (Let (Rec pairs) body) =
process :: Var -> CoreExpr -> CoreExpr -> (Var, CoreExpr, CoreExpr)
process v e body
| idArity v <= 0 = (v, e, body)
+ -- TODO: check for non value args here. For now, ignore this let then
+ -- Possibly later: Check if all uses have the same type argument
| otherwise
= case contextOf v body of
OneUse cts | not (null cts) ->
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 92784d33b37..110c461d392 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -190,8 +190,6 @@ getCoreToDo dflags
demand_analyser = (CoreDoPasses ([
CoreDoStrictness,
CoreDoWorkerWrapper,
- simpl_phase 0 ["post-worker-wrapper"] max_iter,
- CoreCommonContext,
simpl_phase 0 ["post-worker-wrapper"] max_iter
]))
@@ -293,6 +291,9 @@ getCoreToDo dflags
-- reduce the possiblility of shadowing
-- Reason: see Note [Shadowing] in SpecConstr.lhs
+ CoreCommonContext,
+ simpl_phase 0 ["post-common-context"] max_iter,
+
runWhen spec_constr CoreDoSpecConstr,
maybe_rule_check (Phase 0),
--
GitLab