X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=200ebc476de035b2149035c72ef185292988164d;hb=4c7846e8a0336f71d5c16798e103980f83532c30;hp=2fd10268a368ea7ba75f296356cb8ecd87ae7ab4;hpb=647546977c3b6869c027b33c3de841ff13afc912;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 2fd1026..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