[commit: ghc] master: Simplify doCorePass (0c57887)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0c578870d5a65b496cb57b260cd83d71db50f3b3/ghc

>---------------------------------------------------------------

commit 0c578870d5a65b496cb57b260cd83d71db50f3b3
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Jan 20 10:26:13 2014 +0000

    Simplify doCorePass


>---------------------------------------------------------------

0c578870d5a65b496cb57b260cd83d71db50f3b3
 compiler/simplCore/SimplCore.lhs   |   60 ++++++++++++++++++------------------
 compiler/specialise/Specialise.lhs |    5 +--
 2 files changed, 33 insertions(+), 32 deletions(-)

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index eb306ae..de562d5 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -373,54 +373,54 @@ runCorePasses passes guts
        = do { hsc_env <- getHscEnv
             ; let dflags = hsc_dflags hsc_env
             ; liftIO $ showPass dflags pass
-            ; guts' <- doCorePass dflags pass guts
+            ; guts' <- doCorePass pass guts
             ; liftIO $ endPass hsc_env pass (mg_binds guts') (mg_rules guts')
             ; return guts' }
 
-doCorePass :: DynFlags -> CoreToDo -> ModGuts -> CoreM ModGuts
-doCorePass _      pass@(CoreDoSimplify {})  = {-# SCC "Simplify" #-}
-                                              simplifyPgm pass
+doCorePass :: CoreToDo -> ModGuts -> CoreM ModGuts
+doCorePass pass@(CoreDoSimplify {})  = {-# SCC "Simplify" #-}
+                                       simplifyPgm pass
 
-doCorePass _      CoreCSE                   = {-# SCC "CommonSubExpr" #-}
-                                              doPass cseProgram
+doCorePass CoreCSE                   = {-# SCC "CommonSubExpr" #-}
+                                       doPass cseProgram
 
-doCorePass _      CoreLiberateCase          = {-# SCC "LiberateCase" #-}
-                                              doPassD liberateCase
+doCorePass CoreLiberateCase          = {-# SCC "LiberateCase" #-}
+                                       doPassD liberateCase
 
-doCorePass _      CoreDoFloatInwards        = {-# SCC "FloatInwards" #-}
-                                              doPassD floatInwards
+doCorePass CoreDoFloatInwards        = {-# SCC "FloatInwards" #-}
+                                       doPassD floatInwards
 
-doCorePass _      (CoreDoFloatOutwards f)   = {-# SCC "FloatOutwards" #-}
-                                              doPassDUM (floatOutwards f)
+doCorePass (CoreDoFloatOutwards f)   = {-# SCC "FloatOutwards" #-}
+                                       doPassDUM (floatOutwards f)
 
-doCorePass _      CoreDoStaticArgs          = {-# SCC "StaticArgs" #-}
-                                              doPassU doStaticArgs
+doCorePass CoreDoStaticArgs          = {-# SCC "StaticArgs" #-}
+                                       doPassU doStaticArgs
 
-doCorePass _      CoreDoStrictness          = {-# SCC "NewStranal" #-}
-                                              doPassDFM dmdAnalProgram
+doCorePass CoreDoStrictness          = {-# SCC "NewStranal" #-}
+                                       doPassDFM dmdAnalProgram
 
-doCorePass _      CoreDoWorkerWrapper       = {-# SCC "WorkWrap" #-}
-                                              doPassDFU wwTopBinds
+doCorePass CoreDoWorkerWrapper       = {-# SCC "WorkWrap" #-}
+                                       doPassDFU wwTopBinds
 
-doCorePass dflags CoreDoSpecialising        = {-# SCC "Specialise" #-}
-                                              specProgram dflags
+doCorePass CoreDoSpecialising        = {-# SCC "Specialise" #-}
+                                       specProgram
 
-doCorePass _      CoreDoSpecConstr          = {-# SCC "SpecConstr" #-}
-                                              specConstrProgram
+doCorePass CoreDoSpecConstr          = {-# SCC "SpecConstr" #-}
+                                       specConstrProgram
 
-doCorePass _      CoreDoVectorisation       = {-# SCC "Vectorise" #-}
-                                              vectorise
+doCorePass CoreDoVectorisation       = {-# SCC "Vectorise" #-}
+                                       vectorise
 
-doCorePass _      CoreDoPrintCore              = observe   printCore
-doCorePass _      (CoreDoRuleCheck phase pat)  = ruleCheckPass phase pat
-doCorePass _      CoreDoNothing                = return
-doCorePass _      (CoreDoPasses passes)        = runCorePasses passes
+doCorePass CoreDoPrintCore              = observe   printCore
+doCorePass (CoreDoRuleCheck phase pat)  = ruleCheckPass phase pat
+doCorePass CoreDoNothing                = return
+doCorePass (CoreDoPasses passes)        = runCorePasses passes
 
 #ifdef GHCI
-doCorePass _      (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-} pass
+doCorePass (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-} pass
 #endif
 
-doCorePass _      pass = pprPanic "doCorePass" (ppr pass)
+doCorePass pass = pprPanic "doCorePass" (ppr pass)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 225076e..3191ae9 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -566,9 +566,10 @@ Hence, the invariant is this:
 %************************************************************************
 
 \begin{code}
-specProgram :: DynFlags -> ModGuts -> CoreM ModGuts
-specProgram dflags guts@(ModGuts { mg_rules = rules, mg_binds = binds })
+specProgram :: ModGuts -> CoreM ModGuts
+specProgram guts@(ModGuts { mg_rules = rules, mg_binds = binds })
   = do { hpt_rules <- getRuleBase
+       ; dflags <- getDynFlags
        ; let local_rules = mg_rules guts
              rule_base = extendRuleBaseList hpt_rules rules