X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=ac44ca807cfa92d067eab44627fe44145a13c895;hb=671f6c78fd7b9b6453b4386e5dc64f169f7ed291;hp=fbc29323438730c08d99c4db8c7a6d3c97a26679;hpb=b562edc69ed995644f195943d780b2e650021318;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index fbc2932..ac44ca8 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -18,6 +18,9 @@ module VectBuiltIn ( primMethod, primPArray ) where +import Vectorise.Builtins.Modules +import Vectorise.Builtins.Base + import DsMonad import IfaceEnv ( lookupOrig ) import InstEnv @@ -42,7 +45,7 @@ import TysWiredIn ( unitDataCon, doubleTyCon, boolTyCon, trueDataCon, falseDataCon, parrTyConName ) -import PrelNames ( word8TyConName, gHC_PARR ) +import PrelNames ( word8TyConName, gHC_PARR, gHC_CLASSES ) import BasicTypes ( Boxity(..) ) import FastString @@ -53,175 +56,6 @@ import Control.Monad ( liftM, zipWithM ) 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 ------------------------------------------------------------- @@ -251,17 +85,17 @@ initBuiltins pkg 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 @@ -350,8 +184,8 @@ initBuiltins pkg 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 @@ -364,10 +198,13 @@ initBuiltins 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) @@ -459,6 +296,10 @@ preludeVars (Modules { dph_Combinators = dph_Combinators [ 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") @@ -466,6 +307,7 @@ preludeVars (Modules { dph_Combinators = dph_Combinators , 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 = (,,,)