Safe Haskell | None |
---|---|
Language | Haskell2010 |
Segmented operations. These correspond to perfect map
nests on
top of something, except that the map
s are conceptually only
over iota
s (so there will be explicit indexing inside them).
Synopsis
- data SegOp lvl lore
- = SegMap lvl SegSpace [Type] (KernelBody lore)
- | SegRed lvl SegSpace [SegBinOp lore] [Type] (KernelBody lore)
- | SegScan lvl SegSpace [SegBinOp lore] [Type] (KernelBody lore)
- | SegHist lvl SegSpace [HistOp lore] [Type] (KernelBody lore)
- data SegVirt
- segLevel :: SegOp lvl lore -> lvl
- segSpace :: SegOp lvl lore -> SegSpace
- typeCheckSegOp :: Checkable lore => (lvl -> TypeM lore ()) -> SegOp lvl (Aliases lore) -> TypeM lore ()
- data SegSpace = SegSpace {
- segFlat :: VName
- unSegSpace :: [(VName, SubExp)]
- scopeOfSegSpace :: SegSpace -> Scope lore
- segSpaceDims :: SegSpace -> [SubExp]
- data HistOp lore = HistOp {}
- histType :: HistOp lore -> [Type]
- data SegBinOp lore = SegBinOp {
- segBinOpComm :: Commutativity
- segBinOpLambda :: Lambda lore
- segBinOpNeutral :: [SubExp]
- segBinOpShape :: Shape
- segBinOpResults :: [SegBinOp lore] -> Int
- segBinOpChunks :: [SegBinOp lore] -> [a] -> [[a]]
- data KernelBody lore = KernelBody {
- kernelBodyLore :: BodyDec lore
- kernelBodyStms :: Stms lore
- kernelBodyResult :: [KernelResult]
- aliasAnalyseKernelBody :: (ASTLore lore, CanBeAliased (Op lore)) => AliasTable -> KernelBody lore -> KernelBody (Aliases lore)
- consumedInKernelBody :: Aliased lore => KernelBody lore -> Names
- data ResultManifest
- data KernelResult
- = Returns ResultManifest SubExp
- | WriteReturns Shape VName [(Slice SubExp, SubExp)]
- | ConcatReturns SplitOrdering SubExp SubExp VName
- | TileReturns [(SubExp, SubExp)] VName
- | RegTileReturns [(SubExp, SubExp, SubExp)] VName
- kernelResultSubExp :: KernelResult -> SubExp
- data SplitOrdering
- data SegOpMapper lvl flore tlore m = SegOpMapper {
- mapOnSegOpSubExp :: SubExp -> m SubExp
- mapOnSegOpLambda :: Lambda flore -> m (Lambda tlore)
- mapOnSegOpBody :: KernelBody flore -> m (KernelBody tlore)
- mapOnSegOpVName :: VName -> m VName
- mapOnSegOpLevel :: lvl -> m lvl
- identitySegOpMapper :: Monad m => SegOpMapper lvl lore lore m
- mapSegOpM :: (Applicative m, Monad m) => SegOpMapper lvl flore tlore m -> SegOp lvl flore -> m (SegOp lvl tlore)
- simplifySegOp :: (SimplifiableLore lore, BodyDec lore ~ (), Simplifiable lvl) => SegOp lvl lore -> SimpleM lore (SegOp lvl (Wise lore), Stms (Wise lore))
- class HasSegOp lore where
- type SegOpLevel lore
- asSegOp :: Op lore -> Maybe (SegOp (SegOpLevel lore) lore)
- segOp :: SegOp (SegOpLevel lore) lore -> Op lore
- segOpRules :: (HasSegOp lore, BinderOps lore, Bindable lore) => RuleBook lore
- segOpReturns :: (Mem lore, Monad m, HasScope lore m) => SegOp lvl lore -> m [ExpReturns]
Documentation
A SegOp
is semantically a perfectly nested stack of maps, on
top of some bottommost computation (scalar computation, reduction,
scan, or histogram). The SegSpace
encodes the original map
structure.
All SegOp
s are parameterised by the representation of their body,
as well as a *level*. The *level* is a representation-specific bit
of information. For example, in GPU backends, it is used to
indicate whether the SegOp
is expected to run at the thread-level
or the group-level.
SegMap lvl SegSpace [Type] (KernelBody lore) | |
SegRed lvl SegSpace [SegBinOp lore] [Type] (KernelBody lore) | The KernelSpace must always have at least two dimensions, implying that the result of a SegRed is always an array. |
SegScan lvl SegSpace [SegBinOp lore] [Type] (KernelBody lore) | |
SegHist lvl SegSpace [HistOp lore] [Type] (KernelBody lore) |
Instances
Do we need group-virtualisation when generating code for the
segmented operation? In most cases, we do, but for some simple
kernels, we compute the full number of groups in advance, and then
virtualisation is an unnecessary (but generally very small)
overhead. This only really matters for fairly trivial but very
wide map
kernels where each thread performs constant-time work on
scalars.
SegVirt | |
SegNoVirt | |
SegNoVirtFull | Not only do we not need virtualisation, but we _guarantee_ that all physical threads participate in the work. This can save some checks in code generation. |
typeCheckSegOp :: Checkable lore => (lvl -> TypeM lore ()) -> SegOp lvl (Aliases lore) -> TypeM lore () Source #
Type check a SegOp
, given a checker for its level.
Index space of a SegOp
.
SegSpace | |
|
scopeOfSegSpace :: SegSpace -> Scope lore Source #
Details
An operator for SegHist
.
HistOp | |
|
Instances
Decorations lore => Eq (HistOp lore) Source # | |
Decorations lore => Ord (HistOp lore) Source # | |
Defined in Futhark.IR.SegOp | |
Decorations lore => Show (HistOp lore) Source # | |
SegBinOp | |
|
Instances
Decorations lore => Eq (SegBinOp lore) Source # | |
Decorations lore => Ord (SegBinOp lore) Source # | |
Defined in Futhark.IR.SegOp compare :: SegBinOp lore -> SegBinOp lore -> Ordering # (<) :: SegBinOp lore -> SegBinOp lore -> Bool # (<=) :: SegBinOp lore -> SegBinOp lore -> Bool # (>) :: SegBinOp lore -> SegBinOp lore -> Bool # (>=) :: SegBinOp lore -> SegBinOp lore -> Bool # | |
Decorations lore => Show (SegBinOp lore) Source # | |
PrettyLore lore => Pretty (SegBinOp lore) Source # | |
segBinOpResults :: [SegBinOp lore] -> Int Source #
How many reduction results are produced by these SegBinOp
s?
segBinOpChunks :: [SegBinOp lore] -> [a] -> [[a]] Source #
Split some list into chunks equal to the number of values
returned by each SegBinOp
data KernelBody lore Source #
The body of a SegOp
.
KernelBody | |
|
Instances
aliasAnalyseKernelBody :: (ASTLore lore, CanBeAliased (Op lore)) => AliasTable -> KernelBody lore -> KernelBody (Aliases lore) Source #
Perform alias analysis on a KernelBody
.
consumedInKernelBody :: Aliased lore => KernelBody lore -> Names Source #
The variables consumed in the kernel body.
data ResultManifest Source #
Metadata about whether there is a subtle point to this
KernelResult
. This is used to protect things like tiling, which
might otherwise be removed by the simplifier because they're
semantically redundant. This has no semantic effect and can be
ignored at code generation.
ResultNoSimplify | Don't simplify this one! |
ResultMaySimplify | Go nuts. |
ResultPrivate | The results produced are only used within the same physical thread later on, and can thus be kept in registers. |
Instances
Eq ResultManifest Source # | |
Defined in Futhark.IR.SegOp (==) :: ResultManifest -> ResultManifest -> Bool # (/=) :: ResultManifest -> ResultManifest -> Bool # | |
Ord ResultManifest Source # | |
Defined in Futhark.IR.SegOp compare :: ResultManifest -> ResultManifest -> Ordering # (<) :: ResultManifest -> ResultManifest -> Bool # (<=) :: ResultManifest -> ResultManifest -> Bool # (>) :: ResultManifest -> ResultManifest -> Bool # (>=) :: ResultManifest -> ResultManifest -> Bool # max :: ResultManifest -> ResultManifest -> ResultManifest # min :: ResultManifest -> ResultManifest -> ResultManifest # | |
Show ResultManifest Source # | |
Defined in Futhark.IR.SegOp showsPrec :: Int -> ResultManifest -> ShowS # show :: ResultManifest -> String # showList :: [ResultManifest] -> ShowS # |
data KernelResult Source #
A KernelBody
does not return an ordinary Result
. Instead, it
returns a list of these.
Returns ResultManifest SubExp | Each "worker" in the kernel returns this.
Whether this is a result-per-thread or a
result-per-group depends on where the |
WriteReturns Shape VName [(Slice SubExp, SubExp)] | |
ConcatReturns SplitOrdering SubExp SubExp VName | |
TileReturns [(SubExp, SubExp)] VName | |
RegTileReturns [(SubExp, SubExp, SubExp)] VName |
Instances
kernelResultSubExp :: KernelResult -> SubExp Source #
Get the root SubExp
corresponding values for a KernelResult
.
data SplitOrdering Source #
How an array is split into chunks.
Instances
Generic traversal
data SegOpMapper lvl flore tlore m Source #
SegOpMapper | |
|
identitySegOpMapper :: Monad m => SegOpMapper lvl lore lore m Source #
A mapper that simply returns the SegOp
verbatim.
mapSegOpM :: (Applicative m, Monad m) => SegOpMapper lvl flore tlore m -> SegOp lvl flore -> m (SegOp lvl tlore) Source #
Apply a SegOpMapper
to the given SegOp
.
Simplification
simplifySegOp :: (SimplifiableLore lore, BodyDec lore ~ (), Simplifiable lvl) => SegOp lvl lore -> SimpleM lore (SegOp lvl (Wise lore), Stms (Wise lore)) Source #
Simplify the given SegOp
.
class HasSegOp lore where Source #
Does this lore contain SegOp
s in its Op
s? A lore must be an
instance of this class for the simplification rules to work.
type SegOpLevel lore Source #
segOpRules :: (HasSegOp lore, BinderOps lore, Bindable lore) => RuleBook lore Source #
Simplification rules for simplifying SegOp
s.
Memory
segOpReturns :: (Mem lore, Monad m, HasScope lore m) => SegOp lvl lore -> m [ExpReturns] Source #
Like segOpType
, but for memory representations.