import VectCore
import DynFlags
-import HscTypes
+import HscTypes hiding ( MonadThings(..) )
-import Module ( dphSeqPackageId, dphParPackageId )
+import Module ( PackageId )
import CoreLint ( showPass, endPass )
import CoreSyn
import CoreUtils
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
where
scrut_ty = exprType (deAnnotate scrut)
-vectExpr (_, AnnCase _ _ _ _)
- = panic "vectExpr: case"
-
vectExpr (_, AnnLet (AnnNonRec bndr rhs) body)
= do
vrhs <- localV . inBind bndr $ vectPolyExpr rhs
$ vectExpr rhs
vectExpr e@(fvs, AnnLam bndr _)
- | not (isId bndr) = pprPanic "vectExpr" (ppr $ deAnnotate e)
- | otherwise = vectLam fvs bs body
+ | isId bndr = vectLam fvs bs body
where
(bs,body) = collectAnnValBinders e
-vectExpr e = pprPanic "vectExpr" (ppr $ deAnnotate e)
+vectExpr e = cantVectorise "Can't vectorise expression" (ppr $ deAnnotate e)
vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr
vectLam fvs bs body
vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr
vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys
-vectTyAppExpr e _ = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e)
+vectTyAppExpr e tys = cantVectorise "Can't vectorise expression"
+ (ppr $ deAnnotate e `mkTyApps` tys)
-- We convert
--
let (vect_scrut, lift_scrut) = vscrut
(vect_bodies, lift_bodies) = unzip vbodies
- let vect_case = Case vect_scrut (mkWildId (exprType vect_scrut)) vty
+ vdummy <- newDummyVar (exprType vect_scrut)
+ ldummy <- newDummyVar (exprType lift_scrut)
+ let vect_case = Case vect_scrut vdummy vty
(zipWith3 mk_vect_alt vect_dcs vect_bndrss vect_bodies)
lbody <- combinePA vty len sel indices lift_bodies
- let lift_case = Case lift_scrut (mkWildId (exprType lift_scrut)) lty
+ let lift_case = Case lift_scrut ldummy lty
[(DataAlt arr_dc, shape_bndrs ++ concat lift_bndrss,
lbody)]