X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=f2fa70573dfda4dd919ec5ba03d5f266b6c33936;hp=032e3b00f1e088a727487fc77d365a2b2813f73a;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=9670d6643e55adeb15f998a0efd5799d499ea2a4 diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 032e3b0..f2fa705 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -4,6 +4,13 @@ \section[SimplCore]{Driver for simplifying @Core@ programs} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- for details + module SimplCore ( core2core, simplifyExpr ) where #include "HsVersions.h" @@ -49,6 +56,7 @@ import WorkWrap ( wwTopBinds ) import StrictAnal ( saBinds ) import CprAnalyse ( cprAnalyse ) #endif +import Vectorise ( vectorise ) import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) import IO ( hPutStr, stderr ) @@ -136,22 +144,23 @@ doCorePasses hsc_env rb us stats guts (to_do : 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" liberateCase -doCorePass CoreDoFloatInwards = _scc_ "FloatInwards" trBinds floatInwards -doCorePass (CoreDoFloatOutwards f) = _scc_ "FloatOutwards" trBindsU (floatOutwards f) -doCorePass CoreDoStaticArgs = _scc_ "StaticArgs" trBinds doStaticArgs -doCorePass CoreDoStrictness = _scc_ "Stranal" trBinds dmdAnalPgm -doCorePass CoreDoWorkerWrapper = _scc_ "WorkWrap" trBindsU wwTopBinds -doCorePass CoreDoSpecialising = _scc_ "Specialise" trBindsU specProgram -doCorePass CoreDoSpecConstr = _scc_ "SpecConstr" trBindsU specConstrProgram +doCorePass (CoreDoSimplify mode sws) = {-# SCC "Simplify" #-} simplifyPgm mode sws +doCorePass CoreCSE = {-# SCC "CommonSubExpr" #-} trBinds cseProgram +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 +doCorePass CoreDoStrictness = {-# SCC "Stranal" #-} trBinds dmdAnalPgm +doCorePass CoreDoWorkerWrapper = {-# SCC "WorkWrap" #-} trBindsU wwTopBinds +doCorePass CoreDoSpecialising = {-# SCC "Specialise" #-} trBindsU specProgram +doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-} trBindsU specConstrProgram doCorePass CoreDoGlomBinds = trBinds glomBinds +doCorePass CoreDoVectorisation = {-# SCC "Vectorise" #-} vectorise doCorePass CoreDoPrintCore = observe printCore doCorePass (CoreDoRuleCheck phase pat) = observe (ruleCheck phase pat) doCorePass CoreDoNothing = observe (\ _ _ -> return ()) #ifdef OLD_STRICTNESS -doCorePass CoreDoOldStrictness = _scc_ "OldStrictness" trBinds doOldStrictness +doCorePass CoreDoOldStrictness = {-# SCC "OldStrictness" #-} trBinds doOldStrictness #else doCorePass CoreDoOldStrictness = panic "CoreDoOldStrictness" #endif @@ -434,7 +443,7 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts | let sz = coreBindsSize binds in sz == sz = do { -- Occurrence analysis - let { tagged_binds = _scc_ "OccAnal" occurAnalysePgm binds } ; + let { tagged_binds = {-# SCC "OccAnal" #-} occurAnalysePgm binds } ; dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis" (pprCoreBindings tagged_binds); @@ -446,7 +455,7 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts eps <- hscEPS hsc_env ; let { rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps) ; simpl_env = mkSimplEnv mode sw_chkr - ; simpl_binds = _scc_ "SimplTopBinds" + ; simpl_binds = {-# SCC "SimplTopBinds" #-} simplTopBinds simpl_env tagged_binds ; fam_envs = (eps_fam_inst_env eps, mg_fam_inst_env guts) } ; @@ -483,7 +492,7 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts -- -- ToDo: alas, this means that indirection-shorting does not happen at all -- if the simplifier does nothing (not common, I know, but unsavoury) - let { binds'' = _scc_ "ZapInd" shortOutIndirections binds' } ; + let { binds'' = {-# SCC "ZapInd" #-} shortOutIndirections binds' } ; -- Dump the result of this iteration dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald