Commit 671f6c78 authored by benl@ouroborus.net's avatar benl@ouroborus.net
Browse files

Break up vectoriser builtins module

parent 02c988e5
......@@ -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
......
......@@ -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 -------------------------------------------------------------
......
-- | 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
-- | 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]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment