From 913c612f25e118f06a2c21617fbccf34b80f1146 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 16 Jul 2007 06:19:00 +0000 Subject: [PATCH] Make vectorisation part of the optimiser pipeline --- compiler/main/DynFlags.hs | 11 +++++++++++ compiler/main/HscMain.lhs | 6 +----- compiler/simplCore/SimplCore.lhs | 2 ++ compiler/vectorise/Vectorise.hs | 11 ++++++----- 4 files changed, 20 insertions(+), 10 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 896f136..d62013a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -676,6 +676,7 @@ data CoreToDo -- These are diff core-to-core passes, | CoreCSE | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules -- matching this string + | CoreDoVectorisation | CoreDoNothing -- Useful when building up | CoreDoPasses [CoreToDo] -- lists of these things @@ -711,6 +712,7 @@ getCoreToDo dflags spec_constr = dopt Opt_SpecConstr dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags + vectorisation = dopt Opt_Vectorise dflags core_todo = if opt_level == 0 then @@ -738,6 +740,15 @@ getCoreToDo dflags MaxSimplifierIterations max_iter ], + + -- We run vectorisation here for now, but we might also try to run + -- it later + runWhen vectorisation (CoreDoPasses [ + CoreDoVectorisation, + CoreDoSimplify SimplGently + [NoCaseOfCase, + MaxSimplifierIterations max_iter]]), + -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 092d163..2d1f71e 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -33,7 +33,6 @@ import CoreSyn ( CoreExpr ) import CoreTidy ( tidyExpr ) import CorePrep ( corePrepExpr ) import Flattening ( flattenExpr ) -import Vectorise ( vectorise ) import Desugar ( deSugarExpr ) import SimplCore ( simplifyExpr ) import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType ) @@ -67,7 +66,6 @@ import PrelInfo ( wiredInThings, basicKnownKeyNames ) import MkIface ( checkOldIface, mkIface, writeIfaceFile ) import Desugar ( deSugar ) import Flattening ( flatten ) -import Vectorise ( vectorise ) import SimplCore ( core2core ) import TidyPgm ( tidyProgram, mkBootModDetails ) import CorePrep ( corePrepPgm ) @@ -478,13 +476,11 @@ hscSimplify :: ModGuts -> Comp ModGuts hscSimplify ds_result = do hsc_env <- gets compHscEnv liftIO $ do - vect_result <- {-# SCC "Vectorisation" #-} - vectorise hsc_env ds_result ------------------- -- SIMPLIFY ------------------- simpl_result <- {-# SCC "Core2Core" #-} - core2core hsc_env vect_result + core2core hsc_env ds_result return simpl_result -------------------------------------------------------------- diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 032e3b0..8c98492 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -49,6 +49,7 @@ import WorkWrap ( wwTopBinds ) import StrictAnal ( saBinds ) import CprAnalyse ( cprAnalyse ) #endif +import Vectorise ( vectorise ) import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) import IO ( hPutStr, stderr ) @@ -147,6 +148,7 @@ doCorePass CoreDoWorkerWrapper = _scc_ "WorkWrap" trBindsU wwTopBin 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 ()) diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 59039e93..96fe9d2 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -13,6 +13,8 @@ import CoreLint ( showPass, endPass ) import CoreSyn import CoreUtils import CoreFVs +import SimplMonad ( SimplCount, zeroSimplCount ) +import Rules ( RuleBase ) import DataCon import TyCon import Type @@ -38,17 +40,16 @@ import FastString import Control.Monad ( liftM, liftM2, mapAndUnzipM, zipWithM_ ) import Data.Maybe ( maybeToList ) -vectorise :: HscEnv -> ModGuts -> IO ModGuts -vectorise hsc_env guts - | not (Opt_Vectorise `dopt` dflags) = return guts - | otherwise +vectorise :: HscEnv -> UniqSupply -> RuleBase -> ModGuts + -> IO (SimplCount, ModGuts) +vectorise hsc_env _ _ guts = do showPass dflags "Vectorisation" eps <- hscEPS hsc_env let info = hptVectInfo hsc_env `plusVectInfo` eps_vect_info eps Just (info', guts') <- initV hsc_env guts info (vectModule guts) endPass dflags "Vectorisation" Opt_D_dump_vect (mg_binds guts') - return $ guts' { mg_vect_info = info' } + return (zeroSimplCount dflags, guts' { mg_vect_info = info' }) where dflags = hsc_dflags hsc_env -- 1.7.10.4