import DynFlags
import StaticFlags
import Util
-import Config
import Digraph
import qualified Pretty
indexBuiltin,
-- * Projections
- selTy,
+ selTy,
selReplicate,
selPick,
selTags,
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)
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
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)
, 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
-- | 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.
-- | Ids of the modules that contain our DPH builtins.
data Modules
- = Modules
- { dph_PArray :: Module
- , dph_Repr :: Module
- , dph_Closure :: Module
- , dph_Unboxed :: Module
- , dph_Instances :: Module
- , dph_Combinators :: Module
- , dph_Scalar :: Module
- , dph_Prelude_PArr :: Module
- , dph_Prelude_Int :: Module
- , dph_Prelude_Word8 :: Module
- , dph_Prelude_Double :: Module
- , dph_Prelude_Bool :: Module
- , dph_Prelude_Tuple :: Module
- }
+ = Modules
+ { dph_PArray_Base :: Module
+ , dph_PArray_Scalar :: Module
+ , dph_PArray_ScalarInstances :: Module
+ , dph_PArray_PRepr :: Module
+ , dph_PArray_PReprInstances :: Module
+ , dph_PArray_PData :: Module
+ , dph_PArray_PDataInstances :: Module
+ , dph_PArray_Types :: Module
+
+ , dph_Closure :: Module
+ , dph_Unboxed :: Module
+ , dph_Combinators :: Module
+ , dph_Scalar :: Module
+
+ , dph_Prelude_Int :: Module
+ , dph_Prelude_Word8 :: Module
+ , dph_Prelude_Double :: Module
+ , dph_Prelude_Bool :: Module
+ , dph_Prelude_Tuple :: Module
+ }
-- | The locations of builtins in the current DPH library.
dph_Modules :: PackageId -> Modules
dph_Modules pkg
- = Modules
- { dph_PArray = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
- , dph_Repr = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
- , dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
- , dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
- , dph_Instances = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
- , dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
- , dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
+ = Modules
+ { dph_PArray_Base = mk (fsLit "Data.Array.Parallel.PArray.Base")
+ , dph_PArray_Scalar = mk (fsLit "Data.Array.Parallel.PArray.Scalar")
+ , dph_PArray_ScalarInstances = mk (fsLit "Data.Array.Parallel.PArray.ScalarInstances")
+ , dph_PArray_PRepr = mk (fsLit "Data.Array.Parallel.PArray.PRepr")
+ , dph_PArray_PReprInstances = mk (fsLit "Data.Array.Parallel.PArray.PReprInstances")
+ , dph_PArray_PData = mk (fsLit "Data.Array.Parallel.PArray.PData")
+ , dph_PArray_PDataInstances = mk (fsLit "Data.Array.Parallel.PArray.PDataInstances")
+ , dph_PArray_Types = mk (fsLit "Data.Array.Parallel.PArray.Types")
+
+ , dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
+ , dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
+ , dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
+ , dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
- , dph_Prelude_PArr = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
- , dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
- , dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
- , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
- , dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
- , dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
- }
- where mk = mkModule pkg . mkModuleNameFS
+ , dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
+ , dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
+ , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
+ , dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
+ , dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
+ }
+ where mk = mkModule pkg . mkModuleNameFS
--- | Project out ids of modules that contain orphan instances that we need to load.
dph_Orphans :: [Modules -> Module]
-dph_Orphans = [dph_Repr, dph_Instances]
+dph_Orphans
+ = [ dph_PArray_Scalar
+ , dph_PArray_ScalarInstances
+ , dph_PArray_PReprInstances
+ , dph_PArray_PDataInstances
+ , dph_Scalar
+ ]
-> [( Module, FastString -- Maps the original variable to the one in the DPH
, Module, FastString)] -- packages that it should be rewritten to.
preludeVars (Modules { dph_Combinators = _dph_Combinators
- , dph_PArray = _dph_PArray
, dph_Prelude_Int = dph_Prelude_Int
, dph_Prelude_Word8 = dph_Prelude_Word8
, dph_Prelude_Double = dph_Prelude_Double
, dph_Prelude_Bool = dph_Prelude_Bool
- , dph_Prelude_PArr = _dph_Prelude_PArr
})
- -- Functions that work on whole PArrays, defined in GHC.PArr
- = [ {- mk gHC_PARR' (fsLit "mapP") dph_Combinators (fsLit "mapPA")
- , mk gHC_PARR' (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
- , mk gHC_PARR' (fsLit "zipP") dph_Combinators (fsLit "zipPA")
- , mk gHC_PARR' (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
- , mk gHC_PARR' (fsLit "filterP") dph_Combinators (fsLit "filterPA")
- , 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")
- , mk gHC_PARR' (fsLit "+:+") dph_Combinators (fsLit "appPA")
- , mk gHC_PARR' (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
-
+ = [
-- Map scalar functions to versions using closures.
- , -} mk' dph_Prelude_Int "div" "divV"
+ mk' dph_Prelude_Int "div" "divV"
, mk' dph_Prelude_Int "mod" "modV"
, mk' dph_Prelude_Int "sqrt" "sqrtV"
, mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
- -- , mk' dph_Prelude_Int "upToP" "upToPA"
]
++ vars_Ord dph_Prelude_Int
++ vars_Num dph_Prelude_Int
, mk gHC_CLASSES (fsLit "not") dph_Prelude_Bool (fsLit "notV")
, mk gHC_CLASSES (fsLit "&&") dph_Prelude_Bool (fsLit "andV")
, mk gHC_CLASSES (fsLit "||") dph_Prelude_Bool (fsLit "orV")
-
-{-
- -- FIXME: temporary
- , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
- , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
- , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
- , mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
- , mk dph_Prelude_PArr (fsLit "updateP") dph_Combinators (fsLit "updatePA")
- , mk dph_Prelude_PArr (fsLit "bpermuteP") dph_Combinators (fsLit "bpermutePA")
- , mk dph_Prelude_PArr (fsLit "indexedP") dph_Combinators (fsLit "indexedPA")
--} ]
+ ]
where
mk = (,,,)
mk' mod v v' = mk mod (fsLit v) mod (fsLit v')