ghc-8.2.1: vectorise/Vectorise/Builtins/Base.hs
-- |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)."])