X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=dc01c7ceb9a893ecce1e424fa14380ba1fb11b54;hb=3a90968fac18bbf931420afff6ef866614ecdd7f;hp=2f0b0d94a4baeaeecc0e4a97ab12ec4dae84f387;hpb=c5dbdf06b92472ef64b66a01f107ba30b65c3708;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 2f0b0d9..dc01c7c 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -1,6 +1,6 @@ module VectBuiltIn ( Builtins(..), sumTyCon, prodTyCon, prodDataCon, - selTy, selReplicate, selPick, selElements, + selTy, selReplicate, selPick, selTags, selElements, combinePDVar, scalarZip, closureCtrFun, initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons, initBuiltinPAs, initBuiltinPRs, @@ -27,11 +27,11 @@ import OccName import TypeRep ( funTyCon ) import Type ( Type, mkTyConApp ) import TysPrim -import TysWiredIn ( unitTyCon, unitDataCon, +import TysWiredIn ( unitDataCon, tupleTyCon, tupleCon, - intTyCon, intTyConName, - doubleTyCon, doubleTyConName, - boolTyCon, boolTyConName, trueDataCon, falseDataCon, + intTyCon, + doubleTyCon, + boolTyCon, trueDataCon, falseDataCon, parrTyConName ) import PrelNames ( word8TyConName, gHC_PARR ) import BasicTypes ( Boxity(..) ) @@ -111,6 +111,7 @@ data Builtins = Builtins { , selTys :: Array Int Type , selReplicates :: Array Int CoreExpr , selPicks :: Array Int CoreExpr + , selTagss :: Array Int CoreExpr , selEls :: Array (Int, Int) CoreExpr , sumTyCons :: Array Int TyCon , closureTyCon :: TyCon @@ -124,7 +125,7 @@ data Builtins = Builtins { , liftedApplyVar :: Var , replicatePDVar :: Var , emptyPDVar :: Var - , packPDVar :: Var + , packByTagPDVar :: Var , combinePDVars :: Array Int Var , scalarClass :: Class , scalarZips :: Array Int Var @@ -149,6 +150,9 @@ selReplicate = indexBuiltin "selReplicate" selReplicates selPick :: Int -> Builtins -> CoreExpr selPick = indexBuiltin "selPick" selPicks +selTags :: Int -> Builtins -> CoreExpr +selTags = indexBuiltin "selTags" selTagss + selElements :: Int -> Int -> Builtins -> CoreExpr selElements i j = indexBuiltin "selElements" selEls (i,j) @@ -156,7 +160,7 @@ sumTyCon :: Int -> Builtins -> TyCon sumTyCon = indexBuiltin "sumTyCon" sumTyCons prodTyCon :: Int -> Builtins -> TyCon -prodTyCon n bi +prodTyCon n _ | n >= 2 && n <= mAX_DPH_PROD = tupleTyCon Boxed n | otherwise = pprPanic "prodTyCon" (ppr n) @@ -196,6 +200,8 @@ initBuiltins pkg (numbered "replicate" 2 mAX_DPH_SUM) sel_picks <- mapM (externalFun dph_Selector) (numbered "pick" 2 mAX_DPH_SUM) + sel_tags <- mapM (externalFun dph_Selector) + (numbered "tagsSel" 2 mAX_DPH_SUM) sel_els <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]] sum_tcs <- mapM (externalTyCon dph_Repr) @@ -204,6 +210,7 @@ initBuiltins pkg let selTys = listArray (2, mAX_DPH_SUM) sel_tys selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates selPicks = listArray (2, mAX_DPH_SUM) sel_picks + selTagss = listArray (2, mAX_DPH_SUM) sel_tags selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs @@ -217,14 +224,14 @@ initBuiltins pkg liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply") replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD") emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD") - packPDVar <- externalVar dph_PArray (fsLit "packPD") + packByTagPDVar <- externalVar dph_PArray (fsLit "packByTagPD") combines <- mapM (externalVar dph_PArray) [mkFastString ("combine" ++ show i ++ "PD") | i <- [2..mAX_DPH_COMBINE]] let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines - scalarClass <- externalClass dph_Scalar (fsLit "Scalar") + scalarClass <- externalClass dph_PArray (fsLit "Scalar") scalar_map <- externalVar dph_Scalar (fsLit "scalar_map") scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith") scalar_zips <- mapM (externalVar dph_Scalar) @@ -253,6 +260,7 @@ initBuiltins pkg , selTys = selTys , selReplicates = selReplicates , selPicks = selPicks + , selTagss = selTagss , selEls = selEls , sumTyCons = sumTyCons , closureTyCon = closureTyCon @@ -266,7 +274,7 @@ initBuiltins pkg , liftedApplyVar = liftedApplyVar , replicatePDVar = replicatePDVar , emptyPDVar = emptyPDVar - , packPDVar = packPDVar + , packByTagPDVar = packByTagPDVar , combinePDVars = combinePDVars , scalarClass = scalarClass , scalarZips = scalarZips @@ -322,6 +330,16 @@ preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple }) where mk_tup n mod name = (tupleCon Boxed n, mod, name) + +-- | Mapping of prelude functions to vectorised versions. +-- Functions like filterP currently have a working but naive version in GHC.PArr +-- During vectorisation we replace these by calls to filterPA, which are +-- defined in dph-common Data.Array.Parallel.Lifted.Combinators +-- +-- As renamer only sees the GHC.PArr functions, if you want to add a new function +-- to the vectoriser there has to be a definition for it in GHC.PArr, even though +-- it will never be used at runtime. +-- preludeVars :: Modules -> [(Module, FastString, Module, FastString)] preludeVars (Modules { dph_Combinators = dph_Combinators , dph_PArray = dph_PArray @@ -340,6 +358,7 @@ preludeVars (Modules { dph_Combinators = dph_Combinators , mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA") , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA") , mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA") + , mk gHC_PARR (fsLit "sliceP") dph_Combinators (fsLit "slicePA") , mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA") , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA") , mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA") @@ -595,10 +614,6 @@ externalClass :: Module -> FastString -> DsM Class externalClass mod fs = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs) -unitTyConName :: Name -unitTyConName = tyConName unitTyCon - - primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var) primMethod tycon method (Builtins { dphModules = mods }) | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)