X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=92a19d562c9c6271cf247e77bf812026e6716280;hb=33770e2e376005ff14a1d16b89f32b0d474425e2;hp=70e69b7e90a0386742baad289a214ccee71ad962;hpb=cc67e20f5c6355919b54f82c2620515fa28269a8;p=ghc-hetmet.git diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 70e69b7..92a19d5 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -10,7 +10,7 @@ import VectCore import DynFlags import HscTypes hiding ( MonadThings(..) ) -import Module ( dphSeqPackageId, dphParPackageId ) +import Module ( PackageId ) import CoreLint ( showPass, endPass ) import CoreSyn import CoreUtils @@ -37,23 +37,19 @@ import FastString import Control.Monad ( liftM, liftM2, zipWithM ) import Data.List ( sortBy, unzip4 ) -vectorise :: DPHBackend -> HscEnv -> UniqSupply -> RuleBase -> ModGuts +vectorise :: PackageId -> HscEnv -> UniqSupply -> RuleBase -> ModGuts -> IO (SimplCount, ModGuts) vectorise 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) + Just (info', guts') <- initV 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 - vectModule :: ModGuts -> VM ModGuts vectModule guts = do @@ -275,7 +271,7 @@ vectExpr e@(fvs, AnnLam bndr _) where (bs,body) = collectAnnValBinders e -vectExpr e = traceNoV "vectExpr: can't vectorise" (ppr $ deAnnotate e) +vectExpr e = cantVectorise "Can't vectorise expression" (ppr $ deAnnotate e) vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr vectLam fvs bs body @@ -298,7 +294,8 @@ vectLam fvs bs body vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys -vectTyAppExpr e _ = traceNoV "vectTyAppExpr: can't vectorise" (ppr $ deAnnotate e) +vectTyAppExpr e tys = cantVectorise "Can't vectorise expression" + (ppr $ deAnnotate e `mkTyApps` tys) -- We convert --