Make vectorisation part of the optimiser pipeline

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 896f136..d62013a 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 59039e9..96fe9d2 100644 (file)
--- 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