diff options
Diffstat (limited to 'compiler/vectorise/Vectorise/Builtins/Initialise.hs')
| -rw-r--r-- | compiler/vectorise/Vectorise/Builtins/Initialise.hs | 234 |
1 files changed, 0 insertions, 234 deletions
diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs deleted file mode 100644 index 0772e5be43..0000000000 --- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs +++ /dev/null @@ -1,234 +0,0 @@ --- Set up the data structures provided by 'Vectorise.Builtins'. - -module Vectorise.Builtins.Initialise ( - -- * Initialisation - initBuiltins, initBuiltinVars -) where - -import GhcPrelude - -import Vectorise.Builtins.Base - -import BasicTypes -import TysPrim -import DsMonad -import TysWiredIn -import DataCon -import TyCon -import Class -import CoreSyn -import Type -import NameEnv -import Name -import Id -import FastString -import Outputable - -import Control.Monad -import Data.Array - - --- |Create the initial map of builtin types and functions. --- -initBuiltins :: DsM Builtins -initBuiltins - = do { -- 'PArray: representation type for parallel arrays - ; parrayTyCon <- externalTyCon (fsLit "PArray") - - -- 'PData': type family mapping array element types to array representation types - -- Not all backends use `PDatas`. - ; pdataTyCon <- externalTyCon (fsLit "PData") - ; pdatasTyCon <- externalTyCon (fsLit "PDatas") - - -- 'PR': class of basic array operators operating on 'PData' types - ; prClass <- externalClass (fsLit "PR") - ; let prTyCon = classTyCon prClass - - -- 'PRepr': type family mapping element types to representation types - ; preprTyCon <- externalTyCon (fsLit "PRepr") - - -- 'PA': class of basic operations on arrays (parametrised by the element type) - ; paClass <- externalClass (fsLit "PA") - ; let paTyCon = classTyCon paClass - [paDataCon] = tyConDataCons paTyCon - paPRSel = classSCSelId paClass 0 - - -- Functions on array representations - ; replicatePDVar <- externalVar (fsLit "replicatePD") - ; replicate_vars <- mapM externalVar (suffixed "replicatePA" aLL_DPH_PRIM_TYCONS) - ; emptyPDVar <- externalVar (fsLit "emptyPD") - ; empty_vars <- mapM externalVar (suffixed "emptyPA" aLL_DPH_PRIM_TYCONS) - ; packByTagPDVar <- externalVar (fsLit "packByTagPD") - ; packByTag_vars <- mapM externalVar (suffixed "packByTagPA" aLL_DPH_PRIM_TYCONS) - ; let combineNamesD = [("combine" ++ show i ++ "PD") | i <- [2..mAX_DPH_COMBINE]] - ; let combineNamesA = [("combine" ++ show i ++ "PA") | i <- [2..mAX_DPH_COMBINE]] - ; combines <- mapM externalVar (map mkFastString combineNamesD) - ; combines_vars <- mapM (mapM externalVar) $ - map (\name -> suffixed name aLL_DPH_PRIM_TYCONS) combineNamesA - ; let replicatePD_PrimVars = mkNameEnv (zip aLL_DPH_PRIM_TYCONS replicate_vars) - emptyPD_PrimVars = mkNameEnv (zip aLL_DPH_PRIM_TYCONS empty_vars) - packByTagPD_PrimVars = mkNameEnv (zip aLL_DPH_PRIM_TYCONS packByTag_vars) - combinePDVars = listArray (2, mAX_DPH_COMBINE) combines - combinePD_PrimVarss = listArray (2, mAX_DPH_COMBINE) - [ mkNameEnv (zip aLL_DPH_PRIM_TYCONS vars) - | vars <- combines_vars] - - -- 'Scalar': class moving between plain unboxed arrays and 'PData' representations - ; scalarClass <- externalClass (fsLit "Scalar") - - -- N-ary maps ('zipWith' family) - ; scalar_map <- externalVar (fsLit "scalar_map") - ; scalar_zip2 <- externalVar (fsLit "scalar_zipWith") - ; scalar_zips <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS) - ; let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS) - (scalar_map : scalar_zip2 : scalar_zips) - - -- Types and functions for generic type representations - ; voidTyCon <- externalTyCon (fsLit "Void") - ; voidVar <- externalVar (fsLit "void") - ; fromVoidVar <- externalVar (fsLit "fromVoid") - ; sum_tcs <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM) - ; let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs - ; wrapTyCon <- externalTyCon (fsLit "Wrap") - ; pvoidVar <- externalVar (fsLit "pvoid") - ; pvoidsVar <- externalVar (fsLit "pvoids#") - - -- Types and functions for closure conversion - ; closureTyCon <- externalTyCon (fsLit ":->") - ; closureVar <- externalVar (fsLit "closure") - ; liftedClosureVar <- externalVar (fsLit "liftedClosure") - ; applyVar <- externalVar (fsLit "$:") - ; liftedApplyVar <- externalVar (fsLit "liftedApply") - ; closures <- mapM externalVar (numbered "closure" 1 mAX_DPH_SCALAR_ARGS) - ; let closureCtrFuns = listArray (1, mAX_DPH_SCALAR_ARGS) closures - - -- Types and functions for selectors - ; sel_tys <- mapM externalType (numbered "Sel" 2 mAX_DPH_SUM) - ; sels_tys <- mapM externalType (numbered "Sels" 2 mAX_DPH_SUM) - ; sels_length <- mapM externalFun (numbered_hash "lengthSels" 2 mAX_DPH_SUM) - ; sel_replicates <- mapM externalFun (numbered_hash "replicateSel" 2 mAX_DPH_SUM) - ; sel_tags <- mapM externalFun (numbered "tagsSel" 2 mAX_DPH_SUM) - ; sel_elements <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]] - ; let selTys = listArray (2, mAX_DPH_SUM) sel_tys - selsTys = listArray (2, mAX_DPH_SUM) sels_tys - selsLengths = listArray (2, mAX_DPH_SUM) sels_length - selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates - selTagss = listArray (2, mAX_DPH_SUM) sel_tags - selElementss = array ((2, 0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_elements - - -- Distinct local variable - ; liftingContext <- liftM (\u -> mkSysLocalOrCoVar (fsLit "lc") u intPrimTy) newUnique - - ; return $ Builtins - { parrayTyCon = parrayTyCon - , pdataTyCon = pdataTyCon - , pdatasTyCon = pdatasTyCon - , preprTyCon = preprTyCon - , prClass = prClass - , prTyCon = prTyCon - , paClass = paClass - , paTyCon = paTyCon - , paDataCon = paDataCon - , paPRSel = paPRSel - , replicatePDVar = replicatePDVar - , replicatePD_PrimVars = replicatePD_PrimVars - , emptyPDVar = emptyPDVar - , emptyPD_PrimVars = emptyPD_PrimVars - , packByTagPDVar = packByTagPDVar - , packByTagPD_PrimVars = packByTagPD_PrimVars - , combinePDVars = combinePDVars - , combinePD_PrimVarss = combinePD_PrimVarss - , scalarClass = scalarClass - , scalarZips = scalarZips - , voidTyCon = voidTyCon - , voidVar = voidVar - , fromVoidVar = fromVoidVar - , sumTyCons = sumTyCons - , wrapTyCon = wrapTyCon - , pvoidVar = pvoidVar - , pvoidsVar = pvoidsVar - , closureTyCon = closureTyCon - , closureVar = closureVar - , liftedClosureVar = liftedClosureVar - , applyVar = applyVar - , liftedApplyVar = liftedApplyVar - , closureCtrFuns = closureCtrFuns - , selTys = selTys - , selsTys = selsTys - , selsLengths = selsLengths - , selReplicates = selReplicates - , selTagss = selTagss - , selElementss = selElementss - , liftingContext = liftingContext - } - } - where - suffixed :: String -> [Name] -> [FastString] - suffixed pfx ns = [mkFastString (pfx ++ "_" ++ (occNameString . nameOccName) n) | n <- ns] - - -- Make a list of numbered strings in some range, eg foo3, foo4, foo5 - 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 $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#") - ; return ((i, j), Var v) - } - --- |Get the mapping of names in the Prelude to names in the DPH library. --- -initBuiltinVars :: Builtins -> DsM [(Var, Var)] --- FIXME: must be replaced by VECTORISE pragmas!!! -initBuiltinVars (Builtins { }) - = do - cvars <- mapM externalVar cfs - return $ zip (map dataConWorkId cons) cvars - where - (cons, cfs) = unzip preludeDataCons - - preludeDataCons :: [(DataCon, FastString)] - preludeDataCons - = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]] - where - mk_tup n name = (tupleDataCon Boxed n, name) - - --- Auxiliary look up functions ----------------------------------------------- - --- |Lookup a variable given its name and the module that contains it. -externalVar :: FastString -> DsM Var -externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId - - --- |Like `externalVar` but wrap the `Var` in a `CoreExpr`. -externalFun :: FastString -> DsM CoreExpr -externalFun fs = Var <$> externalVar fs - - --- |Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name. --- Panic if there isn't one. -externalTyCon :: FastString -> DsM TyCon -externalTyCon fs = dsLookupDPHRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon - - --- |Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name. -externalType :: FastString -> DsM Type -externalType fs - = do tycon <- externalTyCon fs - return $ mkTyConApp tycon [] - - --- |Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name. -externalClass :: FastString -> DsM Class -externalClass fs - = do { tycon <- dsLookupDPHRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon - ; case tyConClass_maybe tycon of - Nothing -> pprPanic "Vectorise.Builtins.Initialise" $ - text "Data.Array.Parallel.Prim." <> - ftext fs <+> text "is not a type class" - Just cls -> return cls - } |