From 671f6c78fd7b9b6453b4386e5dc64f169f7ed291 Mon Sep 17 00:00:00 2001 From: "benl@ouroborus.net" Date: Mon, 30 Aug 2010 07:09:00 +0000 Subject: [PATCH] Break up vectoriser builtins module --- compiler/ghc.cabal.in | 2 + compiler/vectorise/VectBuiltIn.hs | 170 +--------------------- compiler/vectorise/Vectorise/Builtins/Base.hs | 169 +++++++++++++++++++++ compiler/vectorise/Vectorise/Builtins/Modules.hs | 54 +++++++ 4 files changed, 228 insertions(+), 167 deletions(-) create mode 100644 compiler/vectorise/Vectorise/Builtins/Base.hs create mode 100644 compiler/vectorise/Vectorise/Builtins/Modules.hs diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 6251a8e..f8eac7b 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -461,6 +461,8 @@ Library VectVar Vectorise.Env Vectorise.Vect + Vectorise.Builtins.Base + Vectorise.Builtins.Modules Vectorise -- We only need to expose more modules as some of the ncg code is used diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 059b575..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 @@ -53,173 +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_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_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 ------------------------------------------------------------- diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs new file mode 100644 index 0000000..884224e --- /dev/null +++ b/compiler/vectorise/Vectorise/Builtins/Base.hs @@ -0,0 +1,169 @@ + +-- | Builtin types and functions used by the vectoriser. +-- These are all defined in the DPH package. +module Vectorise.Builtins.Base ( + -- * Hard config + mAX_DPH_PROD, + mAX_DPH_SUM, + mAX_DPH_COMBINE, + mAX_DPH_SCALAR_ARGS, + + -- * Builtins + Builtins(..), + indexBuiltin, + + -- * Projections + selTy, + selReplicate, + selPick, + selTags, + selElements, + sumTyCon, + prodTyCon, + prodDataCon, + combinePDVar, + scalarZip, + closureCtrFun +) where +import Vectorise.Builtins.Modules +import BasicTypes +import Class +import CoreSyn +import TysWiredIn +import Type +import TyCon +import DataCon +import Var +import Outputable +import Data.Array + + +-- 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 + + +-- | Holds the names of the builtin types and functions used by the vectoriser. +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 ---------------------------------------------------------------- +-- 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 + +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 + + diff --git a/compiler/vectorise/Vectorise/Builtins/Modules.hs b/compiler/vectorise/Vectorise/Builtins/Modules.hs new file mode 100644 index 0000000..d5b10cb --- /dev/null +++ b/compiler/vectorise/Vectorise/Builtins/Modules.hs @@ -0,0 +1,54 @@ + +-- | Modules that contain builtin functions used by the vectoriser. +module Vectorise.Builtins.Modules + ( Modules(..) + , dph_Modules + , dph_Orphans) +where +import Module +import FastString + +-- | 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_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_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] -- 1.7.10.4