From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Wed, 9 Jan 2008 01:43:59 +0000 (+0000)
Subject: Refactor getCoreToDo slightly
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=356ca3e99e13450f9c2d9c8cdf5e4177c2321bb0

Refactor getCoreToDo slightly
---

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 91c7f43..9ba7529 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -787,17 +787,19 @@ getCoreToDo dflags
     rule_check    = ruleCheck dflags
     vectorisation = dopt Opt_Vectorise dflags
 
-    core_todo = 
-     if opt_level == 0 then
-      [
-	CoreDoSimplify (SimplPhase 0) [
-	    MaxSimplifierIterations max_iter
-	]
-      ]
-     else {- opt_level >= 1 -} [ 
+    maybe_rule_check phase | Just s <- rule_check = CoreDoRuleCheck phase s
+                           | otherwise            = CoreDoNothing
+
+    simpl_phase phase iter = CoreDoPasses
+                               [ CoreDoSimplify (SimplPhase phase) [
+                                   MaxSimplifierIterations iter
+                                 ],
+                                 maybe_rule_check phase
+                               ]
+
 
 	-- initial simplify: mk specialiser happy: minimum effort please
-	CoreDoSimplify SimplGently [
+    simpl_gently = CoreDoSimplify SimplGently [
 			-- 	Simplify "gently"
 			-- Don't inline anything till full laziness has bitten
 			-- In particular, inlining wrappers inhibits floating
@@ -811,16 +813,19 @@ getCoreToDo dflags
             NoCaseOfCase,	-- Don't do case-of-case transformations.
 				-- This makes full laziness work better
 	    MaxSimplifierIterations max_iter
-	],
+	]
+
+    core_todo = 
+     if opt_level == 0 then
+       [simpl_phase 0 max_iter]
+     else {- opt_level >= 1 -} [ 
 
+	-- initial simplify: mk specialiser happy: minimum effort please
+        simpl_gently,
 
         -- We run vectorisation here for now, but we might also try to run
         -- it later
-        runWhen vectorisation (CoreDoPasses [
-                  CoreDoVectorisation,
-                  CoreDoSimplify SimplGently
-                                  [NoCaseOfCase,
-                                   MaxSimplifierIterations max_iter]]),
+        runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently]),
 
 	-- Specialisation is best done before full laziness
 	-- so that overloaded functions have all their dictionary lambdas manifest
@@ -830,29 +835,21 @@ getCoreToDo dflags
 
 	CoreDoFloatInwards,
 
-	CoreDoSimplify (SimplPhase 2) [
 		-- Want to run with inline phase 2 after the specialiser to give
 		-- maximum chance for fusion to work before we inline build/augment
 		-- in phase 1.  This made a difference in 'ansi' where an 
 		-- overloaded function wasn't inlined till too late.
-	   MaxSimplifierIterations max_iter
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
+        simpl_phase 2 max_iter,
 
-	CoreDoSimplify (SimplPhase 1) [
 		-- Need inline-phase2 here so that build/augment get 
 		-- inlined.  I found that spectral/hartel/genfft lost some useful
 		-- strictness in the function sumcode' if augment is not inlined
 		-- before strictness analysis runs
-	   MaxSimplifierIterations max_iter
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
+	simpl_phase 1 max_iter,
 
-	CoreDoSimplify (SimplPhase 0) [
 		-- Phase 0: allow all Ids to be inlined now
 		-- This gets foldr inlined before strictness analysis
 
-	   MaxSimplifierIterations (max max_iter 3)
 		-- At least 3 iterations because otherwise we land up with
 		-- huge dead expressions because of an infelicity in the 
 		-- simpifier.   
@@ -860,9 +857,8 @@ getCoreToDo dflags
 		-- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 		-- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 		-- Don't stop now!
+	simpl_phase 0 (max max_iter 3),
 
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 
 #ifdef OLD_STRICTNESS
 	CoreDoOldStrictness,
@@ -871,9 +867,8 @@ getCoreToDo dflags
 		CoreDoStrictness,
 		CoreDoWorkerWrapper,
 		CoreDoGlomBinds,
-		CoreDoSimplify (SimplPhase 0) [
-		   MaxSimplifierIterations max_iter
-		]]),
+                simpl_phase 0 max_iter
+                ]),
 
 	runWhen full_laziness 
 	  (CoreDoFloatOutwards (FloatOutSw False    -- Not lambdas
@@ -892,29 +887,23 @@ getCoreToDo dflags
 
 	CoreDoFloatInwards,
 
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+	maybe_rule_check 0,
 
 		-- Case-liberation for -O2.  This should be after
 		-- strictness analysis and the simplification which follows it.
 	runWhen liberate_case (CoreDoPasses [
 	    CoreLiberateCase,
-	    CoreDoSimplify (SimplPhase 0) [
-		  MaxSimplifierIterations max_iter
-	    ] ]),	-- Run the simplifier after LiberateCase to vastly 
+            simpl_phase 0 max_iter
+            ]),         -- Run the simplifier after LiberateCase to vastly 
 			-- reduce the possiblility of shadowing
 			-- Reason: see Note [Shadowing] in SpecConstr.lhs
 
 	runWhen spec_constr CoreDoSpecConstr,
 
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+        maybe_rule_check 0,
 
 	-- Final clean-up simplification:
-     	CoreDoSimplify (SimplPhase 0) [
-	  MaxSimplifierIterations max_iter
-	],
-
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }
-
+        simpl_phase 0 max_iter
      ]
 
 -- -----------------------------------------------------------------------------