X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=cd1f42945474f6b39a4352036519cea14f4532cc;hb=9ffadf219cbc4f8ec57264786df936a3cee88aec;hp=8d8bfef119bfeb9c4e4392f92f147956911ea09c;hpb=9c966bfa8c0328cb4d2e01806a8eca242b9e6f66;p=ghc-hetmet.git diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 8d8bfef..cd1f429 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -7,16 +7,13 @@ import VectUtils import VectType import VectCore -import DynFlags import HscTypes hiding ( MonadThings(..) ) -import Module ( dphSeqPackageId, dphParPackageId ) -import CoreLint ( showPass, endPass ) +import Module ( PackageId ) import CoreSyn import CoreUtils import CoreFVs -import SimplMonad ( SimplCount, zeroSimplCount ) -import Rules ( RuleBase ) +import CoreMonad ( CoreM, getHscEnv, liftIO ) import DataCon import TyCon import Type @@ -37,23 +34,18 @@ import FastString import Control.Monad ( liftM, liftM2, zipWithM ) import Data.List ( sortBy, unzip4 ) -vectorise :: DPHBackend -> HscEnv -> UniqSupply -> RuleBase -> ModGuts - -> IO (SimplCount, ModGuts) -vectorise backend hsc_env _ _ guts +vectorise :: PackageId -> ModGuts -> CoreM ModGuts +vectorise backend guts = do + hsc_env <- getHscEnv + liftIO $ vectoriseIO backend hsc_env guts + +vectoriseIO :: PackageId -> HscEnv -> ModGuts -> IO ModGuts +vectoriseIO backend 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 (backendPackage backend) hsc_env guts info - (vectModule guts) - endPass dflags "Vectorisation" Opt_D_dump_vect (mg_binds guts') - return (zeroSimplCount dflags, guts' { mg_vect_info = info' }) - where - dflags = hsc_dflags hsc_env - - backendPackage DPHSeq = dphSeqPackageId - backendPackage DPHPar = dphParPackageId - backendPackage DPHThis = thisPackage dflags + Just (info', guts') <- initV backend hsc_env guts info (vectModule guts) + return (guts' { mg_vect_info = info' }) vectModule :: ModGuts -> VM ModGuts vectModule guts