X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=200ebc476de035b2149035c72ef185292988164d;hb=4c7846e8a0336f71d5c16798e103980f83532c30;hp=24c8603a27187240f044d2525b9b7831a5b77e90;hpb=5902b3d706a4892a2e9265f5cc53fe2950bdb27b;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 24c8603..200ebc4 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -126,15 +126,20 @@ doCorePasses :: HscEnv doCorePasses hsc_env rb us stats guts [] = return (stats, guts) +doCorePasses hsc_env rb us stats guts (CoreDoPasses to_dos1 : to_dos2) + = doCorePasses hsc_env rb us stats guts (to_dos1 ++ to_dos2) + doCorePasses hsc_env rb us stats guts (to_do : to_dos) = do let (us1, us2) = splitUniqSupply us (stats1, guts1) <- doCorePass to_do hsc_env us1 rb guts doCorePasses hsc_env rb us2 (stats `plusSimplCount` stats1) guts1 to_dos +doCorePass :: CoreToDo -> HscEnv -> UniqSupply -> RuleBase + -> ModGuts -> IO (SimplCount, ModGuts) doCorePass (CoreDoSimplify mode sws) = _scc_ "Simplify" simplifyPgm mode sws doCorePass CoreCSE = _scc_ "CommonSubExpr" trBinds cseProgram -doCorePass CoreLiberateCase = _scc_ "LiberateCase" trBinds liberateCase +doCorePass CoreLiberateCase = _scc_ "LiberateCase" liberateCase doCorePass CoreDoFloatInwards = _scc_ "FloatInwards" trBinds floatInwards doCorePass (CoreDoFloatOutwards f) = _scc_ "FloatOutwards" trBindsU (floatOutwards f) doCorePass CoreDoStaticArgs = _scc_ "StaticArgs" trBinds doStaticArgs @@ -148,7 +153,10 @@ doCorePass (CoreDoRuleCheck phase pat) = observe (ruleCheck phase pat) doCorePass CoreDoNothing = observe (\ _ _ -> return ()) #ifdef OLD_STRICTNESS doCorePass CoreDoOldStrictness = _scc_ "OldStrictness" trBinds doOldStrictness +#else +doCorePass CoreDoOldStrictness = panic "CoreDoOldStrictness" #endif +doCorePass (CoreDoPasses _) = panic "CoreDoPasses" #ifdef OLD_STRICTNESS doOldStrictness dfs binds @@ -390,7 +398,7 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts text "", pprSimplCount counts_out]); - endPass dflags "Simplify" Opt_D_verbose_core2core binds'; + endPass dflags ("Simplify phase " ++ phase_info ++ " done") Opt_D_verbose_core2core binds'; return (counts_out, guts { mg_binds = binds' }) }