primMethod, primPArray
) where
+import Vectorise.Builtins.Modules
+import Vectorise.Builtins.Base
+
import DsMonad
import IfaceEnv ( lookupOrig )
import InstEnv
doubleTyCon,
boolTyCon, trueDataCon, falseDataCon,
parrTyConName )
-import PrelNames ( word8TyConName, gHC_PARR )
+import PrelNames ( word8TyConName, gHC_PARR, gHC_CLASSES )
import BasicTypes ( Boxity(..) )
import FastString
import Data.List ( unzip4 )
--- Numbers of things exported by the DPH library.
-mAX_DPH_PROD :: Int
-mAX_DPH_PROD = 5
-
-mAX_DPH_SUM :: Int
-mAX_DPH_SUM = 2
-
-mAX_DPH_COMBINE :: Int
-mAX_DPH_COMBINE = 2
-
-mAX_DPH_SCALAR_ARGS :: Int
-mAX_DPH_SCALAR_ARGS = 3
-
-
--- | 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_Selector :: 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
- }
-
-
--- | 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")
- , dph_Selector = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
-
- , 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
-
-
--- | Project out ids of modules that contain orphan instances that we need to load.
-dph_Orphans :: [Modules -> Module]
-dph_Orphans = [dph_Repr, dph_Instances]
-
-
--- | Information about what builtin stuff to use from the DPH base libraries.
-data Builtins
- = Builtins
- { dphModules :: Modules
-
- -- From dph-common:Data.Array.Parallel.Lifted.PArray
- , parrayTyCon :: TyCon -- ^ PArray
- , parrayDataCon :: DataCon -- ^ PArray
- , pdataTyCon :: TyCon -- ^ PData
- , paTyCon :: TyCon -- ^ PA
- , paDataCon :: DataCon -- ^ PA
- , preprTyCon :: TyCon -- ^ PRepr
- , prTyCon :: TyCon -- ^ PR
- , prDataCon :: DataCon -- ^ PR
- , replicatePDVar :: Var -- ^ replicatePD
- , emptyPDVar :: Var -- ^ emptyPD
- , packByTagPDVar :: Var -- ^ packByTagPD
- , combinePDVars :: Array Int Var -- ^ combinePD
- , scalarClass :: Class -- ^ Scalar
-
- -- From dph-common:Data.Array.Parallel.Lifted.Closure
- , closureTyCon :: TyCon -- ^ :->
- , closureVar :: Var -- ^ closure
- , applyVar :: Var -- ^ $:
- , liftedClosureVar :: Var -- ^ liftedClosure
- , liftedApplyVar :: Var -- ^ liftedApply
- , closureCtrFuns :: Array Int Var -- ^ closure1 .. closure2
-
- -- From dph-common:Data.Array.Parallel.Lifted.Repr
- , voidTyCon :: TyCon -- ^ Void
- , wrapTyCon :: TyCon -- ^ Wrap
- , sumTyCons :: Array Int TyCon -- ^ Sum2 .. Sum3
- , voidVar :: Var -- ^ void
- , pvoidVar :: Var -- ^ pvoid
- , fromVoidVar :: Var -- ^ fromVoid
- , punitVar :: Var -- ^ punit
-
- -- From dph-common:Data.Array.Parallel.Lifted.Selector
- , selTys :: Array Int Type -- ^ Sel2
- , selReplicates :: Array Int CoreExpr -- ^ replicate2
- , selPicks :: Array Int CoreExpr -- ^ pick2
- , selTagss :: Array Int CoreExpr -- ^ tagsSel2
- , selEls :: Array (Int, Int) CoreExpr -- ^ elementsSel2_0 .. elementsSel_2_1
-
- -- From dph-common:Data.Array.Parallel.Lifted.Scalar
- -- NOTE: map is counted as a zipWith fn with one argument array.
- , scalarZips :: Array Int Var -- ^ map, zipWith, zipWith3
-
- -- A Fresh variable
- , liftingContext :: Var -- ^ lc
- }
-
-
--- | Get an element from one of the arrays of contained by a `Builtins`.
--- If the indexed thing is not in the array then panic.
-indexBuiltin
- :: (Ix i, Outputable i)
- => String -- ^ Name of the selector we've used, for panic messages.
- -> (Builtins -> Array i a) -- ^ Field selector for the `Builtins`.
- -> i -- ^ Index into the array.
- -> Builtins
- -> a
-
-indexBuiltin fn f i bi
- | inRange (bounds xs) i = xs ! i
- | otherwise = pprPanic fn (ppr i)
- where
- xs = f bi
-
-
--- Projections ----------------------------------------------------------------
-selTy :: Int -> Builtins -> Type
-selTy = indexBuiltin "selTy" selTys
-
-selReplicate :: Int -> Builtins -> CoreExpr
-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)
-
-sumTyCon :: Int -> Builtins -> TyCon
-sumTyCon = indexBuiltin "sumTyCon" sumTyCons
-
-prodTyCon :: Int -> Builtins -> TyCon
-prodTyCon n _
- | n >= 2 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
- | otherwise = pprPanic "prodTyCon" (ppr n)
-
-prodDataCon :: Int -> Builtins -> DataCon
-prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
- [con] -> con
- _ -> pprPanic "prodDataCon" (ppr n)
-
-combinePDVar :: Int -> Builtins -> Var
-combinePDVar = indexBuiltin "combinePDVar" combinePDVars
-
-scalarZip :: Int -> Builtins -> Var
-scalarZip = indexBuiltin "scalarZip" scalarZips
-
-closureCtrFun :: Int -> Builtins -> Var
-closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
-- Initialisation -------------------------------------------------------------
voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
- -- From dph-common:Data.Array.Parallel.Lifted.Selector
- sel_tys <- mapM (externalType dph_Selector)
+ -- From dph-common:Data.Array.Parallel.Lifted.Unboxed
+ sel_tys <- mapM (externalType dph_Unboxed)
(numbered "Sel" 2 mAX_DPH_SUM)
- sel_replicates <- mapM (externalFun dph_Selector)
- (numbered "replicate" 2 mAX_DPH_SUM)
+ sel_replicates <- mapM (externalFun dph_Unboxed)
+ (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
- sel_picks <- mapM (externalFun dph_Selector)
- (numbered "pick" 2 mAX_DPH_SUM)
+ sel_picks <- mapM (externalFun dph_Unboxed)
+ (numbered_hash "pickSel" 2 mAX_DPH_SUM)
- sel_tags <- mapM (externalFun dph_Selector)
+ sel_tags <- mapM (externalFun dph_Unboxed)
(numbered "tagsSel" 2 mAX_DPH_SUM)
sel_els <- mapM mk_elements
dph_PArray = dph_PArray
, dph_Repr = dph_Repr
, dph_Closure = dph_Closure
- , dph_Selector = dph_Selector
, dph_Scalar = dph_Scalar
+ , dph_Unboxed = dph_Unboxed
})
= dph_Modules pkg
numbered :: String -> Int -> Int -> [FastString]
numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
+ numbered_hash :: String -> Int -> Int -> [FastString]
+ numbered_hash pfx m n = [mkFastString (pfx ++ show i ++ "#") | i <- [m..n]]
+
mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
mk_elements (i,j)
= do
- v <- externalVar dph_Selector
+ v <- externalVar dph_Unboxed
$ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
return ((i,j), Var v)
[ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
, mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
+ , 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 "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 = (,,,)