X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FBuiltins%2FInitialise.hs;h=b37f559f50551fe98651ef36404b35d25e319f2a;hb=31b9ba54b309b7ad8043a7dade7dddb71d184b8b;hp=413980a1c3031602ff6d65d369be8ebe9dbece63;hpb=0e82126ed0bd2d16a1925d8a8a6c5eb6d7762ac5;p=ghc-hetmet.git diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs index 413980a..b37f559 100644 --- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs +++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs @@ -22,10 +22,8 @@ import TyCon import Class import CoreSyn import Type -import OccName import Name import Module -import Var import Id import FastString import Outputable @@ -42,19 +40,50 @@ initBuiltins initBuiltins pkg = do mapM_ load dph_Orphans + -- 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 + + + -- 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 + + 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 + + + -- 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 (fsLit "PArray") let [parrayDataCon] = tyConDataCons parrayTyCon - pdataTyCon <- externalTyCon dph_PArray (fsLit "PData") - paTyCon <- externalClassTyCon dph_PArray (fsLit "PA") - let [paDataCon] = tyConDataCons paTyCon - preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr") - prTyCon <- externalClassTyCon dph_PArray (fsLit "PR") - let [prDataCon] = tyConDataCons prTyCon - - closureTyCon <- externalTyCon dph_Closure (fsLit ":->") + closureTyCon <- externalTyCon dph_Closure (fsLit ":->") -- From dph-common:Data.Array.Parallel.Lifted.Repr voidTyCon <- externalTyCon dph_Repr (fsLit "Void") @@ -95,16 +124,7 @@ initBuiltins pkg 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_zips <- mapM (externalVar dph_Scalar) @@ -126,9 +146,12 @@ initBuiltins pkg , parrayTyCon = parrayTyCon , parrayDataCon = parrayDataCon , pdataTyCon = pdataTyCon + , paClass = paClass , paTyCon = paTyCon , paDataCon = paDataCon + , paPRSel = paPRSel , preprTyCon = preprTyCon + , prClass = prClass , prTyCon = prTyCon , prDataCon = prDataCon , voidTyCon = voidTyCon @@ -158,13 +181,19 @@ 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 = dph_PArray + , dph_PArray_Scalar = dph_PArray_Scalar + , dph_PArray_PRepr = dph_PArray_PRepr + , dph_PArray_PData = dph_PArray_PData + , dph_Repr = dph_Repr + , dph_Closure = dph_Closure + , dph_Scalar = dph_Scalar + , dph_Unboxed = dph_Unboxed + }) = dph_Modules pkg load get_mod = dsLoadModule doc mod @@ -186,10 +215,11 @@ initBuiltins pkg $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#") return ((i,j), Var v) - -- | Get the mapping of names in the Prelude to names in the DPH library. -initBuiltinVars :: Builtins -> DsM [(Var, Var)] -initBuiltinVars (Builtins { dphModules = mods }) +-- +initBuiltinVars :: Bool -- FIXME + -> Builtins -> DsM [(Var, Var)] +initBuiltinVars compilingDPH (Builtins { dphModules = mods }) = do uvars <- zipWithM externalVar umods ufs vvars <- zipWithM externalVar vmods vfs @@ -198,7 +228,7 @@ initBuiltinVars (Builtins { dphModules = mods }) ++ zip (map dataConWorkId cons) cvars ++ zip uvars vvars where - (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods) + (umods, ufs, vmods, vfs) = if compilingDPH then ([], [], [], []) else unzip4 (preludeVars mods) (cons, cmods, cfs) = unzip3 (preludeDataCons mods) defaultDataConWorkers :: [DataCon] @@ -243,13 +273,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. @@ -268,12 +298,12 @@ initBuiltinBoxedTyCons builtinBoxedTyCons _ = [(tyConName intPrimTyCon, intTyCon)] - -- | Get a list of all scalar functions in the mock prelude. -initBuiltinScalars :: Builtins -> DsM [Var] -initBuiltinScalars bi - = mapM (uncurry externalVar) (preludeScalars $ dphModules bi) - +-- +initBuiltinScalars :: Bool + -> Builtins -> DsM [Var] +initBuiltinScalars True _bi = return [] +initBuiltinScalars False bi = mapM (uncurry externalVar) (preludeScalars $ dphModules bi) -- | Lookup some variable given its name and the module that contains it. externalVar :: Module -> FastString -> DsM Var @@ -306,9 +336,3 @@ externalClass :: Module -> FastString -> DsM Class externalClass mod fs = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs) - --- | Like `externalClass`, but get the TyCon of of the class. -externalClassTyCon :: Module -> FastString -> DsM TyCon -externalClassTyCon mod fs = liftM classTyCon (externalClass mod fs) - -