X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FBuiltins%2FInitialise.hs;fp=compiler%2Fvectorise%2FVectorise%2FBuiltins%2FInitialise.hs;h=5a6cf88272ad1d6ef433d07f6764bfb93c21016e;hp=ecb8a98afa47345d14670f6811ab147981acab8f;hb=2d4d636af091b8da27466b5cf90011395a9c2f66;hpb=d872133bb986dbd15959cbb14504bf9a863e3e4a diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs index ecb8a98..5a6cf88 100644 --- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs +++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs @@ -40,26 +40,62 @@ initBuiltins initBuiltins pkg = do mapM_ load dph_Orphans - -- From dph-common:Data.Array.Parallel.Lifted.PArray - parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray") - let [parrayDataCon] = tyConDataCons parrayTyCon + -- From dph-common:Data.Array.Parallel.PArray.PData + -- PData is a type family that maps an element type onto the type + -- we use to hold an array of those elements. + pdataTyCon <- externalTyCon dph_PArray_PData (fsLit "PData") + + -- PR is a type class that holds the primitive operators we can + -- apply to array data. Its functions take arrays in terms of PData types. + prClass <- externalClass dph_PArray_PData (fsLit "PR") + let prTyCon = classTyCon prClass + [prDataCon] = tyConDataCons prTyCon - pdataTyCon <- externalTyCon dph_PArray (fsLit "PData") - paClass <- externalClass dph_PArray (fsLit "PA") + + -- From dph-common:Data.Array.Parallel.PArray.PRepr + preprTyCon <- externalTyCon dph_PArray_PRepr (fsLit "PRepr") + paClass <- externalClass dph_PArray_PRepr (fsLit "PA") let paTyCon = classTyCon paClass [paDataCon] = tyConDataCons paTyCon paPRSel = classSCSelId paClass 0 - preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr") - prClass <- externalClass dph_PArray (fsLit "PR") - let prTyCon = classTyCon prClass - [prDataCon] = tyConDataCons prTyCon + replicatePDVar <- externalVar dph_PArray_PRepr (fsLit "replicatePD") + emptyPDVar <- externalVar dph_PArray_PRepr (fsLit "emptyPD") + packByTagPDVar <- externalVar dph_PArray_PRepr (fsLit "packByTagPD") + combines <- mapM (externalVar dph_PArray_PRepr) + [mkFastString ("combine" ++ show i ++ "PD") + | i <- [2..mAX_DPH_COMBINE]] + + let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines + - closureTyCon <- externalTyCon dph_Closure (fsLit ":->") + -- From dph-common:Data.Array.Parallel.PArray.Scalar + -- Scalar is the class of scalar values. + -- The dictionary contains functions to coerce U.Arrays of scalars + -- to and from the PData representation. + scalarClass <- externalClass dph_PArray_Scalar (fsLit "Scalar") + + + -- From dph-common:Data.Array.Parallel.Lifted.PArray + -- A PArray (Parallel Array) holds the array length and some array elements + -- represented by the PData type family. + parrayTyCon <- externalTyCon dph_PArray_Base (fsLit "PArray") + let [parrayDataCon] = tyConDataCons parrayTyCon + + -- From dph-common:Data.Array.Parallel.PArray.Types + voidTyCon <- externalTyCon dph_PArray_Types (fsLit "Void") + voidVar <- externalVar dph_PArray_Types (fsLit "void") + fromVoidVar <- externalVar dph_PArray_Types (fsLit "fromVoid") + wrapTyCon <- externalTyCon dph_PArray_Types (fsLit "Wrap") + sum_tcs <- mapM (externalTyCon dph_PArray_Types) (numbered "Sum" 2 mAX_DPH_SUM) + + -- from dph-common:Data.Array.Parallel.PArray.PDataInstances + pvoidVar <- externalVar dph_PArray_PDataInstances (fsLit "pvoid") + punitVar <- externalVar dph_PArray_PDataInstances (fsLit "punit") + + + closureTyCon <- externalTyCon dph_Closure (fsLit ":->") - -- From dph-common:Data.Array.Parallel.Lifted.Repr - voidTyCon <- externalTyCon dph_Repr (fsLit "Void") - wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap") -- From dph-common:Data.Array.Parallel.Lifted.Unboxed sel_tys <- mapM (externalType dph_Unboxed) @@ -77,8 +113,6 @@ initBuiltins pkg sel_els <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]] - sum_tcs <- mapM (externalTyCon dph_Repr) - (numbered "Sum" 2 mAX_DPH_SUM) let selTys = listArray (2, mAX_DPH_SUM) sel_tys selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates @@ -88,26 +122,14 @@ initBuiltins pkg sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs - voidVar <- externalVar dph_Repr (fsLit "void") - pvoidVar <- externalVar dph_Repr (fsLit "pvoid") - fromVoidVar <- externalVar dph_Repr (fsLit "fromVoid") - punitVar <- externalVar dph_Repr (fsLit "punit") + closureVar <- externalVar dph_Closure (fsLit "closure") applyVar <- externalVar dph_Closure (fsLit "$:") liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure") liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply") - replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD") - emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD") - 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_PArray (fsLit "Scalar") scalar_map <- externalVar dph_Scalar (fsLit "scalar_map") - scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith") + scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith") scalar_zips <- mapM (externalVar dph_Scalar) (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS) @@ -162,13 +184,20 @@ initBuiltins pkg , liftingContext = liftingContext } where - mods@(Modules { - dph_PArray = dph_PArray - , dph_Repr = dph_Repr - , dph_Closure = dph_Closure - , dph_Scalar = dph_Scalar - , dph_Unboxed = dph_Unboxed - }) + -- Extract out all the modules we'll use. + -- These are the modules from the DPH base library that contain + -- the primitive array types and functions that vectorised code uses. + mods@(Modules + { dph_PArray_Base = dph_PArray_Base + , dph_PArray_Scalar = dph_PArray_Scalar + , dph_PArray_PRepr = dph_PArray_PRepr + , dph_PArray_PData = dph_PArray_PData + , dph_PArray_PDataInstances = dph_PArray_PDataInstances + , dph_PArray_Types = dph_PArray_Types + , dph_Closure = dph_Closure + , dph_Scalar = dph_Scalar + , dph_Unboxed = dph_Unboxed + }) = dph_Modules pkg load get_mod = dsLoadModule doc mod @@ -248,13 +277,13 @@ initBuiltinDataCons _ -- | Get the names of all buildin instance functions for the PA class. initBuiltinPAs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)] initBuiltinPAs (Builtins { dphModules = mods }) insts - = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PA")) + = liftM (initBuiltinDicts insts) (externalClass (dph_PArray_PRepr mods) (fsLit "PA")) -- | Get the names of all builtin instance functions for the PR class. initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)] initBuiltinPRs (Builtins { dphModules = mods }) insts - = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PR")) + = liftM (initBuiltinDicts insts) (externalClass (dph_PArray_PData mods) (fsLit "PR")) -- | Get the names of all DPH instance functions for this class.