diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-20 10:26:13 +0000 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-20 10:33:22 +0000 |
| commit | 0c578870d5a65b496cb57b260cd83d71db50f3b3 (patch) | |
| tree | 881c3b4d40a690421042106a1e1f1db2f6b0c034 /compiler | |
| parent | 2bb19fad1d809dda37011f442b0fd561aea045b6 (diff) | |
| download | haskell-0c578870d5a65b496cb57b260cd83d71db50f3b3.tar.gz | |
Simplify doCorePass
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/simplCore/SimplCore.lhs | 60 | ||||
| -rw-r--r-- | 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 eb306aea0d..de562d5a97 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 225076e9e3..3191ae946e 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 |