diff options
Diffstat (limited to 'compiler/vectorise/Vectorise/Builtins/Base.hs')
| -rw-r--r-- | compiler/vectorise/Vectorise/Builtins/Base.hs | 217 |
1 files changed, 0 insertions, 217 deletions
diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs deleted file mode 100644 index 4837bde208..0000000000 --- a/compiler/vectorise/Vectorise/Builtins/Base.hs +++ /dev/null @@ -1,217 +0,0 @@ --- |Builtin types and functions used by the vectoriser. These are all defined in --- 'Data.Array.Parallel.Prim'. - -module Vectorise.Builtins.Base ( - -- * Hard config - mAX_DPH_PROD, - mAX_DPH_SUM, - mAX_DPH_COMBINE, - mAX_DPH_SCALAR_ARGS, - aLL_DPH_PRIM_TYCONS, - - -- * Builtins - Builtins(..), - - -- * Projections - selTy, selsTy, - selReplicate, - selTags, - selElements, - selsLength, - sumTyCon, - prodTyCon, - prodDataCon, - replicatePD_PrimVar, - emptyPD_PrimVar, - packByTagPD_PrimVar, - combinePDVar, - combinePD_PrimVar, - scalarZip, - closureCtrFun -) where - -import TysPrim -import BasicTypes -import Class -import CoreSyn -import TysWiredIn hiding (sumTyCon) -import Type -import TyCon -import DataCon -import NameEnv -import Name -import Outputable - -import Data.Array - - --- Cardinality of the various families of types and functions 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 = 8 - --- Types from 'GHC.Prim' supported by DPH --- -aLL_DPH_PRIM_TYCONS :: [Name] -aLL_DPH_PRIM_TYCONS = map tyConName [intPrimTyCon, {- floatPrimTyCon, -} doublePrimTyCon] - - --- |Holds the names of the types and functions from 'Data.Array.Parallel.Prim' that are used by the --- vectoriser. --- -data Builtins - = Builtins - { parrayTyCon :: TyCon -- ^ PArray - , pdataTyCon :: TyCon -- ^ PData - , pdatasTyCon :: TyCon -- ^ PDatas - , prClass :: Class -- ^ PR - , prTyCon :: TyCon -- ^ PR - , preprTyCon :: TyCon -- ^ PRepr - , paClass :: Class -- ^ PA - , paTyCon :: TyCon -- ^ PA - , paDataCon :: DataCon -- ^ PA - , paPRSel :: Var -- ^ PA - , replicatePDVar :: Var -- ^ replicatePD - , replicatePD_PrimVars :: NameEnv Var -- ^ replicatePD_Int# etc. - , emptyPDVar :: Var -- ^ emptyPD - , emptyPD_PrimVars :: NameEnv Var -- ^ emptyPD_Int# etc. - , packByTagPDVar :: Var -- ^ packByTagPD - , packByTagPD_PrimVars :: NameEnv Var -- ^ packByTagPD_Int# etc. - , combinePDVars :: Array Int Var -- ^ combinePD - , combinePD_PrimVarss :: Array Int (NameEnv Var) -- ^ combine2PD_Int# etc. - , scalarClass :: Class -- ^ Scalar - , scalarZips :: Array Int Var -- ^ map, zipWith, zipWith3 - , voidTyCon :: TyCon -- ^ Void - , voidVar :: Var -- ^ void - , fromVoidVar :: Var -- ^ fromVoid - , sumTyCons :: Array Int TyCon -- ^ Sum2 .. Sum3 - , wrapTyCon :: TyCon -- ^ Wrap - , pvoidVar :: Var -- ^ pvoid - , pvoidsVar :: Var -- ^ pvoids - , closureTyCon :: TyCon -- ^ :-> - , closureVar :: Var -- ^ closure - , liftedClosureVar :: Var -- ^ liftedClosure - , applyVar :: Var -- ^ $: - , liftedApplyVar :: Var -- ^ liftedApply - , closureCtrFuns :: Array Int Var -- ^ closure1 .. closure3 - , selTys :: Array Int Type -- ^ Sel2 - , selsTys :: Array Int Type -- ^ Sels2 - , selsLengths :: Array Int CoreExpr -- ^ lengthSels2 - , selReplicates :: Array Int CoreExpr -- ^ replicate2 - , selTagss :: Array Int CoreExpr -- ^ tagsSel2 - , selElementss :: Array (Int, Int) CoreExpr -- ^ elementsSel2_0 .. elementsSel_2_1 - , liftingContext :: Var -- ^ lc - } - - --- Projections ---------------------------------------------------------------- --- We use these wrappers instead of indexing the `Builtin` structure directly --- because they give nicer panic messages if the indexed thing cannot be found. - -selTy :: Int -> Builtins -> Type -selTy = indexBuiltin "selTy" selTys - -selsTy :: Int -> Builtins -> Type -selsTy = indexBuiltin "selsTy" selsTys - -selsLength :: Int -> Builtins -> CoreExpr -selsLength = indexBuiltin "selLength" selsLengths - -selReplicate :: Int -> Builtins -> CoreExpr -selReplicate = indexBuiltin "selReplicate" selReplicates - -selTags :: Int -> Builtins -> CoreExpr -selTags = indexBuiltin "selTags" selTagss - -selElements :: Int -> Int -> Builtins -> CoreExpr -selElements i j = indexBuiltin "selElements" selElementss (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) - -replicatePD_PrimVar :: TyCon -> Builtins -> Var -replicatePD_PrimVar tc bi - = lookupEnvBuiltin "replicatePD_PrimVar" (replicatePD_PrimVars bi) (tyConName tc) - -emptyPD_PrimVar :: TyCon -> Builtins -> Var -emptyPD_PrimVar tc bi - = lookupEnvBuiltin "emptyPD_PrimVar" (emptyPD_PrimVars bi) (tyConName tc) - -packByTagPD_PrimVar :: TyCon -> Builtins -> Var -packByTagPD_PrimVar tc bi - = lookupEnvBuiltin "packByTagPD_PrimVar" (packByTagPD_PrimVars bi) (tyConName tc) - -combinePDVar :: Int -> Builtins -> Var -combinePDVar = indexBuiltin "combinePDVar" combinePDVars - -combinePD_PrimVar :: Int -> TyCon -> Builtins -> Var -combinePD_PrimVar i tc bi - = lookupEnvBuiltin "combinePD_PrimVar" - (indexBuiltin "combinePD_PrimVar" combinePD_PrimVarss i bi) (tyConName tc) - -scalarZip :: Int -> Builtins -> Var -scalarZip = indexBuiltin "scalarZip" scalarZips - -closureCtrFun :: Int -> Builtins -> Var -closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns - --- | Get an element from one of the arrays of `Builtins`. --- Panic if the indexed thing is not in the array. -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 - = pprSorry "Vectorise.Builtins.indexBuiltin" - (vcat [ text "" - , text "DPH builtin function '" <> text fn <> text "' of size '" <> ppr i <> - text "' is not yet implemented." - , text "This function does not appear in your source program, but it is needed" - , text "to compile your code in the backend. This is a known, current limitation" - , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org" - , text "and ask what you can do to help (it might involve some GHC hacking)."]) - where xs = f bi - - --- | Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array. -lookupEnvBuiltin :: String -- Function name for error messages - -> NameEnv a -- Name environment - -> Name -- Index into the name environment - -> a -lookupEnvBuiltin fn env n - | Just r <- lookupNameEnv env n = r - | otherwise - = pprSorry "Vectorise.Builtins.lookupEnvBuiltin" - (vcat [ text "" - , text "DPH builtin function '" <> text fn <> text "_" <> ppr n <> - text "' is not yet implemented." - , text "This function does not appear in your source program, but it is needed" - , text "to compile your code in the backend. This is a known, current limitation" - , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org" - , text "and ask what you can do to help (it might involve some GHC hacking)."]) |