halide-haskell-0.0.1.0: Haskell bindings to Halide
Copyright(c) Tom Westerhout 2023
Safe HaskellSafe-Inferred
LanguageGHC2021

Language.Halide

Description

This package provides Haskell bindings that allow to write Halide embedded in Haskell without C++.

This module contains the reference documentation for Halide. If you're new, the best way to learn Halide is to have a look at the tutorials.

Synopsis

Scalar expressions

The basic building block of Halide pipelines is Expr. Expr a represents a scalar expression of type a, where a must be an instance of IsHalideType.

data Expr a Source #

A scalar expression in Halide.

To have a nice experience writing arithmetic expressions in terms of Exprs, we want to derive Num, Floating etc. instances for Expr. Unfortunately, that means that we encode Expr, Var, RVar, and ScalarParam by the same type, and passing an Expr to a function that expects a Var will produce a runtime error.

Constructors

Expr (ForeignPtr CxxExpr)

Scalar expression.

Var (ForeignPtr CxxVar)

Index variable.

RVar (ForeignPtr CxxRVar)

Reduction variable.

ScalarParam (IORef (Maybe (ForeignPtr CxxParameter)))

Scalar parameter.

The IORef is initialized with Nothing and filled in on the first call to asExpr.

Instances

Instances details
HasField "extent" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "max" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "min" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "stride" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "var" (LoopLevel 'LockedTy) (Expr Int32) Source # 
Instance details

Defined in Language.Halide.LoopLevel

(IsHalideType a, Floating a) => Floating (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

Methods

pi :: Expr a #

exp :: Expr a -> Expr a #

log :: Expr a -> Expr a #

sqrt :: Expr a -> Expr a #

(**) :: Expr a -> Expr a -> Expr a #

logBase :: Expr a -> Expr a -> Expr a #

sin :: Expr a -> Expr a #

cos :: Expr a -> Expr a #

tan :: Expr a -> Expr a #

asin :: Expr a -> Expr a #

acos :: Expr a -> Expr a #

atan :: Expr a -> Expr a #

sinh :: Expr a -> Expr a #

cosh :: Expr a -> Expr a #

tanh :: Expr a -> Expr a #

asinh :: Expr a -> Expr a #

acosh :: Expr a -> Expr a #

atanh :: Expr a -> Expr a #

log1p :: Expr a -> Expr a #

expm1 :: Expr a -> Expr a #

log1pexp :: Expr a -> Expr a #

log1mexp :: Expr a -> Expr a #

(IsHalideType a, Num a) => Num (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

Methods

(+) :: Expr a -> Expr a -> Expr a #

(-) :: Expr a -> Expr a -> Expr a #

(*) :: Expr a -> Expr a -> Expr a #

negate :: Expr a -> Expr a #

abs :: Expr a -> Expr a #

signum :: Expr a -> Expr a #

fromInteger :: Integer -> Expr a #

(IsHalideType a, Fractional a) => Fractional (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

Methods

(/) :: Expr a -> Expr a -> Expr a #

recip :: Expr a -> Expr a #

fromRational :: Rational -> Expr a #

IsHalideType a => Show (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

Methods

showsPrec :: Int -> Expr a -> ShowS #

show :: Expr a -> String #

showList :: [Expr a] -> ShowS #

type FromTuple (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

type FromTuple (Expr a)

type VarOrRVar = Expr Int32 Source #

Either Var or RVar.

class Storable a => IsHalideType a Source #

Specifies that a type is supported by Halide.

Minimal complete definition

halideTypeFor, toCxxExpr

Instances

Instances details
IsHalideType CDouble Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy CDouble -> HalideType

toCxxExpr :: CDouble -> IO (ForeignPtr CxxExpr)

IsHalideType CFloat Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy CFloat -> HalideType

toCxxExpr :: CFloat -> IO (ForeignPtr CxxExpr)

IsHalideType Int16 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Int16 -> HalideType

toCxxExpr :: Int16 -> IO (ForeignPtr CxxExpr)

IsHalideType Int32 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Int32 -> HalideType

toCxxExpr :: Int32 -> IO (ForeignPtr CxxExpr)

IsHalideType Int64 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Int64 -> HalideType

toCxxExpr :: Int64 -> IO (ForeignPtr CxxExpr)

IsHalideType Int8 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Int8 -> HalideType

toCxxExpr :: Int8 -> IO (ForeignPtr CxxExpr)

IsHalideType Word16 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Word16 -> HalideType

toCxxExpr :: Word16 -> IO (ForeignPtr CxxExpr)

IsHalideType Word32 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Word32 -> HalideType

toCxxExpr :: Word32 -> IO (ForeignPtr CxxExpr)

IsHalideType Word64 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Word64 -> HalideType

toCxxExpr :: Word64 -> IO (ForeignPtr CxxExpr)

IsHalideType Word8 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Word8 -> HalideType

toCxxExpr :: Word8 -> IO (ForeignPtr CxxExpr)

IsHalideType Bool Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Bool -> HalideType

toCxxExpr :: Bool -> IO (ForeignPtr CxxExpr)

IsHalideType Double Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Double -> HalideType

toCxxExpr :: Double -> IO (ForeignPtr CxxExpr)

IsHalideType Float Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Float -> HalideType

toCxxExpr :: Float -> IO (ForeignPtr CxxExpr)

Creating

mkExpr :: IsHalideType a => a -> Expr a Source #

Create a scalar expression from a Haskell value.

mkVar :: Text -> IO (Expr Int32) Source #

Create a named index variable.

mkRVar Source #

Arguments

:: Text

name

-> Expr Int32

min index

-> Expr Int32

extent

-> IO (Expr Int32) 

Create a named reduction variable.

For more information about reduction variables, see Halide::RDom.

undef :: forall a. IsHalideType a => Expr a Source #

Return an undef value of the given type.

For more information, see Halide::undef.

cast :: forall to from. (IsHalideType to, IsHalideType from) => Expr from -> Expr to Source #

Cast a scalar expression to a different type.

Use TypeApplications with this function, e.g. cast @Float x.

bool :: IsHalideType a => Expr Bool -> Expr a -> Expr a -> Expr a Source #

Similar to the standard bool function from Prelude except that it's lifted to work with Expr types.

Inspecting

toIntImm :: IsHalideType a => Expr a -> Maybe Int Source #

Convert expression to integer immediate.

Tries to extract the value of an expression if it is a compile-time constant. If the expression isn't known at compile-time of the Halide pipeline, returns Nothing.

printed :: IsHalideType a => Expr a -> Expr a Source #

Print the expression to stdout when it's evaluated.

This is useful for debugging Halide pipelines.

evaluate :: forall a. IsHalideType a => Expr a -> IO a Source #

Evaluate a scalar expression.

It should contain no parameters. If it does contain parameters, an exception will be thrown.

Comparisons

We can't use Eq and Ord instances here, because we want the comparison to happen when the pipeline is run rather than when it's built. Hence, we define lifted version of various comparison operators. Note, that infix versions of the these functions have the same precedence as the normal comparison operators.

eq :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

== but lifted to return an Expr.

neq :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

/= but lifted to return an Expr.

lt :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

< but lifted to return an Expr.

lte :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

<= but lifted to return an Expr.

gt :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

> but lifted to return an Expr.

gte :: IsHalideType a => Expr a -> Expr a -> Expr Bool infix 4 Source #

>= but lifted to return an Expr.

Functions

data Func (t :: FuncTy) (n :: Nat) (a :: Type) where Source #

A function in Halide. Conceptually, it can be thought of as a lazy n-dimensional buffer of type a.

This is a wrapper around the Halide::Func C++ type.

Constructors

Func :: !(ForeignPtr CxxFunc) -> Func 'FuncTy n a 
Param :: !(IORef (Maybe (ForeignPtr CxxImageParam))) -> Func 'ParamTy n a 

Instances

Instances details
(KnownNat n, IsHalideType a) => Schedulable (Func t) n a Source # 
Instance details

Defined in Language.Halide.Func

Methods

vectorize :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

unroll :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

reorder :: [VarOrRVar] -> Func t n a -> IO (Func t n a) Source #

split :: TailStrategy -> VarOrRVar -> (VarOrRVar, VarOrRVar) -> Expr Int32 -> Func t n a -> IO (Func t n a) Source #

fuse :: (VarOrRVar, VarOrRVar) -> VarOrRVar -> Func t n a -> IO (Func t n a) Source #

serial :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

parallel :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

specialize :: Expr Bool -> Func t n a -> IO (Stage n a) Source #

specializeFail :: Text -> Func t n a -> IO () Source #

gpuBlocks :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Func t n a -> IO (Func t n a) Source #

gpuThreads :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Func t n a -> IO (Func t n a) Source #

gpuLanes :: DeviceAPI -> VarOrRVar -> Func t n a -> IO (Func t n a) Source #

computeWith :: forall (t0 :: LoopLevelTy). LoopAlignStrategy -> Func t n a -> LoopLevel t0 -> IO () Source #

data FuncTy Source #

Function type. It can either be FuncTy which means that we have defined the function ourselves, or ParamTy which means that it's a parameter to our pipeline.

Constructors

FuncTy 
ParamTy 

Instances

Instances details
Show FuncTy Source # 
Instance details

Defined in Language.Halide.Func

Eq FuncTy Source # 
Instance details

Defined in Language.Halide.Func

Methods

(==) :: FuncTy -> FuncTy -> Bool #

(/=) :: FuncTy -> FuncTy -> Bool #

Ord FuncTy Source # 
Instance details

Defined in Language.Halide.Func

newtype Stage (n :: Nat) (a :: Type) Source #

A single definition of a Func.

Constructors

Stage (ForeignPtr CxxStage) 

Instances

Instances details
(KnownNat n, IsHalideType a) => Schedulable Stage n a Source # 
Instance details

Defined in Language.Halide.Func

Methods

vectorize :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

unroll :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

reorder :: [VarOrRVar] -> Stage n a -> IO (Stage n a) Source #

split :: TailStrategy -> VarOrRVar -> (VarOrRVar, VarOrRVar) -> Expr Int32 -> Stage n a -> IO (Stage n a) Source #

fuse :: (VarOrRVar, VarOrRVar) -> VarOrRVar -> Stage n a -> IO (Stage n a) Source #

serial :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

parallel :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

specialize :: Expr Bool -> Stage n a -> IO (Stage n a) Source #

specializeFail :: Text -> Stage n a -> IO () Source #

gpuBlocks :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Stage n a -> IO (Stage n a) Source #

gpuThreads :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Stage n a -> IO (Stage n a) Source #

gpuLanes :: DeviceAPI -> VarOrRVar -> Stage n a -> IO (Stage n a) Source #

computeWith :: forall (t :: LoopLevelTy). LoopAlignStrategy -> Stage n a -> LoopLevel t -> IO () Source #

Creating

define :: (IsTuple (Arguments ts) i, All ((~) Var) ts, Length ts ~ n, KnownNat n, IsHalideType a) => Text -> i -> Expr a -> IO (Func 'FuncTy n a) Source #

Define a Halide function.

define "f" i e defines a Halide function called "f" such that f[i] = e.

Here, i is an n-element tuple of Var, i.e. the following are all valid:

>>> [x, y, z] <- mapM mkVar ["x", "y", "z"]
>>> f1 <- define "f1" x (0 :: Expr Float)
>>> f2 <- define "f2" (x, y) (0 :: Expr Float)
>>> f3 <- define "f3" (x, y, z) (0 :: Expr Float)

update :: (IsTuple (Arguments ts) i, All ((~) (Expr Int32)) ts, Length ts ~ n, KnownNat n, IsHalideType a) => Func 'FuncTy n a -> i -> Expr a -> IO () Source #

Create an update definition for a Halide function.

update f i e creates an update definition for f that performs f[i] = e.

(!) :: (IsTuple (Arguments ts) i, All ((~) (Expr Int32)) ts, Length ts ~ n, KnownNat n, IsHalideType a) => Func t n a -> i -> Expr a infix 9 Source #

Apply a Halide function. Conceptually, f ! i is equivalent to f[i], i.e. indexing into a lazy array.

Inspecting

getArgs :: (KnownNat n, IsHalideType a) => Func t n a -> IO [Var] Source #

Get the index arguments of the function.

The returned list contains exactly n elements.

hasUpdateDefinitions :: (KnownNat n, IsHalideType a) => Func t n a -> IO Bool Source #

Return True when the function has update definitions, False otherwise.

getUpdateStage :: (KnownNat n, IsHalideType a) => Int -> Func 'FuncTy n a -> IO (Stage n a) Source #

Get a handle to an update step for the purposes of scheduling it.

Buffers

In the C interface of Halide, buffers are described by the C struct halide_buffer_t. On the Haskell side, we have HalideBuffer.

newtype HalideBuffer (n :: Nat) (a :: Type) Source #

An n-dimensional buffer of elements of type a.

Most pipelines use Ptr (HalideBuffer n a) for input and output array arguments.

Instances

Instances details
Show (HalideBuffer n a) Source # 
Instance details

Defined in Language.Halide.Buffer

Eq (HalideBuffer n a) Source # 
Instance details

Defined in Language.Halide.Buffer

Methods

(==) :: HalideBuffer n a -> HalideBuffer n a -> Bool #

(/=) :: HalideBuffer n a -> HalideBuffer n a -> Bool #

IsHalideType a => IsListPeek (HalideBuffer 0 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 0 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 1 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 1 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 2 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 2 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 3 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 3 a) Source #

type ListPeekElem (HalideBuffer 0 a) Source # 
Instance details

Defined in Language.Halide.Buffer

type ListPeekElem (HalideBuffer 0 a) = a
type ListPeekElem (HalideBuffer 1 a) Source # 
Instance details

Defined in Language.Halide.Buffer

type ListPeekElem (HalideBuffer 1 a) = a
type ListPeekElem (HalideBuffer 2 a) Source # 
Instance details

Defined in Language.Halide.Buffer

type ListPeekElem (HalideBuffer 2 a) = [a]
type ListPeekElem (HalideBuffer 3 a) Source # 
Instance details

Defined in Language.Halide.Buffer

type ListPeekElem (HalideBuffer 3 a) = [[a]]

To easily test out your pipeline, there are helper functions to create HalideBuffers without worrying about the low-level representation.

allocaCpuBuffer :: forall n a b. (HasCallStack, KnownNat n, IsHalideType a) => [Int] -> (Ptr (HalideBuffer n a) -> IO b) -> IO b Source #

Temporary allocate a CPU buffer.

This is useful for testing and debugging when you need to allocate an output buffer for your pipeline. E.g.

allocaCpuBuffer [3, 3] $ out -> do
  myKernel out                -- fill the buffer
  print =<< peekToList out  -- print it for debugging

Buffers can also be converted to lists to easily print them for debugging.

class IsListPeek a where Source #

Specifies that a can be converted to a list. This is very similar to IsList except that we read the list from a Ptr rather than converting directly.

Associated Types

type ListPeekElem a :: Type Source #

Instances

Instances details
IsHalideType a => IsListPeek (HalideBuffer 0 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 0 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 1 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 1 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 2 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 2 a) Source #

IsHalideType a => IsListPeek (HalideBuffer 3 a) Source # 
Instance details

Defined in Language.Halide.Buffer

Associated Types

type ListPeekElem (HalideBuffer 3 a) Source #

For production usage however, you don't want to work with lists. Instead, you probably want Halide to work with your existing array data types. For this, we define IsHalideBuffer typeclass that teaches Halide how to convert your data into a HalideBuffer. Depending on how you implement the instance, this can be very efficient, because it need not involve any memory copying.

class (KnownNat n, IsHalideType a) => IsHalideBuffer t n a where Source #

Specifies that a type t can be used as an n-dimensional Halide buffer with elements of type a.

Methods

withHalideBufferImpl :: t -> (Ptr (HalideBuffer n a) -> IO b) -> IO b Source #

Instances

Instances details
IsHalideType a => IsHalideBuffer (Vector a) 1 a Source #

Storable vectors are one-dimensional buffers. This involves no copying.

Instance details

Defined in Language.Halide.Buffer

Methods

withHalideBufferImpl :: Vector a -> (Ptr (HalideBuffer 1 a) -> IO b) -> IO b Source #

IsHalideType a => IsHalideBuffer [[[a]]] 3 a Source #

Lists can also act as Halide buffers. Use for testing only.

Instance details

Defined in Language.Halide.Buffer

Methods

withHalideBufferImpl :: [[[a]]] -> (Ptr (HalideBuffer 3 a) -> IO b) -> IO b Source #

IsHalideType a => IsHalideBuffer [[a]] 2 a Source #

Lists can also act as Halide buffers. Use for testing only.

Instance details

Defined in Language.Halide.Buffer

Methods

withHalideBufferImpl :: [[a]] -> (Ptr (HalideBuffer 2 a) -> IO b) -> IO b Source #

IsHalideType a => IsHalideBuffer [a] 1 a Source #

Lists can also act as Halide buffers. Use for testing only.

Instance details

Defined in Language.Halide.Buffer

Methods

withHalideBufferImpl :: [a] -> (Ptr (HalideBuffer 1 a) -> IO b) -> IO b Source #

IsHalideType a => IsHalideBuffer (MVector RealWorld a) 1 a Source #

Storable vectors are one-dimensional buffers. This involves no copying.

Instance details

Defined in Language.Halide.Buffer

withHalideBuffer :: forall n a t b. IsHalideBuffer t n a => t -> (Ptr (HalideBuffer n a) -> IO b) -> IO b Source #

Treat a type t as a HalideBuffer and use it in an IO action.

This function is a simple wrapper around withHalideBufferImpl, except that the order of type parameters is reversed. If you have TypeApplications extension enabled, this allows you to write withHalideBuffer 3 Float yourBuffer to specify that you want a 3-dimensional buffer of Float.

There are also helper functions to simplify writing instances of IsHalideBuffer.

bufferFromPtrShapeStrides Source #

Arguments

:: forall n a b. (HasCallStack, KnownNat n, IsHalideType a) 
=> Ptr a

CPU pointer to the data

-> [Int]

Extents (in number of elements, not in bytes)

-> [Int]

Strides (in number of elements, not in bytes)

-> (Ptr (HalideBuffer n a) -> IO b)

Action to run

-> IO b 

Construct a HalideBuffer from a pointer to the data, a list of extents, and a list of strides, and use it in an IO action.

This function throws a runtime error if the number of dimensions does not match n.

bufferFromPtrShape Source #

Arguments

:: (HasCallStack, KnownNat n, IsHalideType a) 
=> Ptr a

CPU pointer to the data

-> [Int]

Extents (in number of elements, not in bytes)

-> (Ptr (HalideBuffer n a) -> IO b) 
-> IO b 

Similar to bufferFromPtrShapeStrides, but assumes column-major ordering of data.

Running the pipelines

There are a few ways how one can run a Halide pipeline.

The simplest way to build a Func and then call realize to evaluate it over a rectangular domain.

realize Source #

Arguments

:: forall n a t b. (KnownNat n, IsHalideType a) 
=> Func t n a

Function to evaluate

-> [Int]

Domain over which to evaluate

-> (Ptr (HalideBuffer n a) -> IO b)

What to do with the buffer afterwards. Note that the buffer is allocated only temporary, so do not return it directly.

-> IO b 

Evaluate this function over a rectangular domain.

asBufferParam Source #

Arguments

:: forall n a t b. IsHalideBuffer t n a 
=> t

Object to treat as a buffer

-> (Func 'ParamTy n a -> IO b)

What to do with the temporary buffer

-> IO b 

Wrap a buffer into a Func.

Suppose, we are defining a pipeline that adds together two vectors, and we'd like to call realize to evaluate it directly, how do we pass the vectors to the Func? asBufferParam allows to do exactly this.

asBuffer [1, 2, 3] $ \a ->
  asBuffer [4, 5, 6] $ \b -> do
    i <- mkVar "i"
    f <- define "vectorAdd" i $ a ! i + b ! i
    realize f [3] $ \result ->
      print =<< peekToList f

The drawback of calling realize all the time is that it's impossible to pass parameters to pipelines. We can define pipelines that operate on buffers using asBufferParam, but we have to recompile the pipeline for every new buffer.

A better way to handle pipeline parameters is to define a Haskell function that accepts Exprs and Funcs as arguments and returns a Func. We can then pass this function to compile (or compileForTarget), and it compile it into a Haskell function that can now be invoked with normal scalars instead of Exprs and Ptr HalideBuffers instead of Funcs.

compile Source #

Arguments

:: forall n a t f kernel. (IsFuncBuilder f t n a, Curry (Lowered (FunctionArguments f)) (Ptr (HalideBuffer n a) -> IO ()) kernel) 
=> f

Function to compile

-> IO kernel

Compiled kernel

Convert a function that builds a Halide Func into a normal Haskell function acccepting scalars and HalideBuffers.

For example:

builder :: Expr Float -> Func 'ParamTy 1 Float -> IO (Func 'FuncTy 1 Float)
builder scale inputVector = do
  i <- mkVar "i"
  scaledVector <- define "scaledVector" i $ scale * inputVector ! i
  pure scaledVector

The builder function accepts a scalar parameter and a vector and scales the vector by the given factor. We can now pass builder to compile:

scaler <- compile builder
withHalideBuffer 1 Float [1, 1, 1] $ inputVector ->
  allocaCpuBuffer [3] $ outputVector -> do
    -- invoke the kernel
    scaler 2.0 inputVector outputVector
    -- print the result
    print =<< peekToList outputVector

Parameters

Similar to how we can specify the name of a variable in mkVar (or mkRVar) or function in define, one can also specify the name of a pipeline parameter. This is achieved by using the ViewPatterns extension together with the scalar and buffer helper functions.

buffer :: forall n a. (KnownNat n, IsHalideType a) => Text -> Func 'ParamTy n a -> Func 'ParamTy n a Source #

A view pattern to specify the name of a buffer argument.

Example usage:

>>> :{
_ <- compile $ \(buffer "src" -> src) -> do
  i <- mkVar "i"
  define "dest" i $ (src ! i :: Expr Float)
:}

or if we want to specify the dimension and type, we can use type applications:

>>> :{
_ <- compile $ \(buffer @1 @Float "src" -> src) -> do
  i <- mkVar "i"
  define "dest" i $ src ! i
:}

scalar :: forall a. IsHalideType a => Text -> Expr a -> Expr a Source #

Similar to buffer, but for scalar parameters.

Example usage:

>>> :{
_ <- compile $ \(scalar @Float "a" -> a) -> do
  i <- mkVar "i"
  define "dest" i $ a
:}

Another common thing to do with the parameters is to explicitly specify their shapes. For this, we expose the Dimension type:

newtype Dimension Source #

Information about a buffer's dimension, such as the min, extent, and stride.

Instances

Instances details
Show Dimension Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "extent" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "max" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "min" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "stride" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

dim :: forall n a. (HasCallStack, KnownNat n, IsHalideType a) => Int -> Func 'ParamTy n a -> IO Dimension Source #

Get a particular dimension of a pipeline parameter.

setMin :: Expr Int32 -> Dimension -> IO Dimension Source #

Set the min in a given dimension to equal the given expression. Setting the mins to zero may simplify some addressing math.

For more info, see Halide::Internal::Dimension::set_min.

setExtent :: Expr Int32 -> Dimension -> IO Dimension Source #

Set the extent in a given dimension to equal the given expression.

Halide will generate runtime errors for Buffers that fail this check.

For more info, see Halide::Internal::Dimension::set_extent.

setStride :: Expr Int32 -> Dimension -> IO Dimension Source #

Set the stride in a given dimension to equal the given expression.

This is particularly useful to set when vectorizing. Known strides for the vectorized dimensions generate better code.

For more info, see Halide::Internal::Dimension::set_stride.

setEstimate Source #

Arguments

:: Expr Int32

min estimate

-> Expr Int32

extent estimate

-> Dimension 
-> IO Dimension 

Set estimates for autoschedulers.

Targets

newtype Target Source #

The compilation target.

This is the Haskell counterpart of Halide::Target.

Constructors

Target (ForeignPtr CxxTarget) 

Instances

Instances details
Show Target Source # 
Instance details

Defined in Language.Halide.Target

Eq Target Source # 
Instance details

Defined in Language.Halide.Target

Methods

(==) :: Target -> Target -> Bool #

(/=) :: Target -> Target -> Bool #

hostTarget :: Target Source #

Return the target that Halide will use by default.

If the HL_TARGET environment variable is set, it uses that. Otherwise, it returns the target corresponding to the host machine.

gpuTarget :: Maybe Target Source #

Get the default GPU target. We first check for CUDA and then for OpenCL. If neither of the two is usable, Nothing is returned.

compileForTarget :: forall n a t f kernel. (IsFuncBuilder f t n a, Curry (Lowered (FunctionArguments f)) (Ptr (HalideBuffer n a) -> IO ()) kernel) => Target -> f -> IO kernel Source #

Similar to compile, but the first argument lets you explicitly specify the compilation target.

data TargetFeature Source #

Note: generated automatically using

cat $HALIDE_PATH/include/Halide.h | \
  grep -E '.* = halide_target_feature_.*' | \
  sed -E 's/^\s*(.*) = .*$/  | \1/g' | \
  grep -v FeatureEnd

setFeature Source #

Arguments

:: TargetFeature

Feature to add

-> Target

Initial target

-> Target

New target

Add a feature to target.

hasGpuFeature :: Target -> Bool Source #

Return whether a GPU compute runtime is enabled.

Checks whether gpuBlocks and similar are going to work.

For more info, see Target::has_gpu_feature.

hostSupportsTargetDevice Source #

Arguments

:: Target 
-> Bool

Whether the target appears to be usable

Attempt to sniff whether a given Target (and its implied DeviceAPI) is usable on the current host.

Note that a return value of True does not guarantee that future usage of that device will succeed; it is intended mainly as a simple diagnostic to allow early-exit when a desired device is definitely not usable.

Also note that this call is NOT threadsafe, as it temporarily redirects various global error-handling hooks in Halide.

Scheduling

class (KnownNat n, IsHalideType a) => Schedulable f n a where Source #

Common scheduling functions

Methods

vectorize :: VarOrRVar -> f n a -> IO (f n a) Source #

Vectorize the dimension.

unroll :: VarOrRVar -> f n a -> IO (f n a) Source #

Unroll the dimension.

reorder :: [VarOrRVar] -> f n a -> IO (f n a) Source #

Reorder variables to have the given nesting order, from innermost out.

split :: TailStrategy -> VarOrRVar -> (VarOrRVar, VarOrRVar) -> Expr Int32 -> f n a -> IO (f n a) Source #

Split a dimension into inner and outer subdimensions with the given names, where the inner dimension iterates from 0 to factor-1.

The inner and outer subdimensions can then be dealt with using the other scheduling calls. It's okay to reuse the old variable name as either the inner or outer variable. The first argument specifies how the tail should be handled if the split factor does not provably divide the extent.

fuse :: (VarOrRVar, VarOrRVar) -> VarOrRVar -> f n a -> IO (f n a) Source #

Join two dimensions into a single fused dimenion.

The fused dimension covers the product of the extents of the inner and outer dimensions given.

serial :: VarOrRVar -> f n a -> IO (f n a) Source #

Mark the dimension to be traversed serially

parallel :: VarOrRVar -> f n a -> IO (f n a) Source #

Mark the dimension to be traversed in parallel

specialize :: Expr Bool -> f n a -> IO (Stage n a) Source #

specializeFail :: Text -> f n a -> IO () Source #

gpuBlocks :: (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> f n a -> IO (f n a) Source #

gpuThreads :: (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> f n a -> IO (f n a) Source #

gpuLanes :: DeviceAPI -> VarOrRVar -> f n a -> IO (f n a) Source #

computeWith :: LoopAlignStrategy -> f n a -> LoopLevel t -> IO () Source #

Schedule the iteration over this stage to be fused with another stage from outermost loop to a given LoopLevel.

For more info, see Halide::Stage::compute_with.

Instances

Instances details
(KnownNat n, IsHalideType a) => Schedulable Stage n a Source # 
Instance details

Defined in Language.Halide.Func

Methods

vectorize :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

unroll :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

reorder :: [VarOrRVar] -> Stage n a -> IO (Stage n a) Source #

split :: TailStrategy -> VarOrRVar -> (VarOrRVar, VarOrRVar) -> Expr Int32 -> Stage n a -> IO (Stage n a) Source #

fuse :: (VarOrRVar, VarOrRVar) -> VarOrRVar -> Stage n a -> IO (Stage n a) Source #

serial :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

parallel :: VarOrRVar -> Stage n a -> IO (Stage n a) Source #

specialize :: Expr Bool -> Stage n a -> IO (Stage n a) Source #

specializeFail :: Text -> Stage n a -> IO () Source #

gpuBlocks :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Stage n a -> IO (Stage n a) Source #

gpuThreads :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Stage n a -> IO (Stage n a) Source #

gpuLanes :: DeviceAPI -> VarOrRVar -> Stage n a -> IO (Stage n a) Source #

computeWith :: forall (t :: LoopLevelTy). LoopAlignStrategy -> Stage n a -> LoopLevel t -> IO () Source #

(KnownNat n, IsHalideType a) => Schedulable (Func t) n a Source # 
Instance details

Defined in Language.Halide.Func

Methods

vectorize :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

unroll :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

reorder :: [VarOrRVar] -> Func t n a -> IO (Func t n a) Source #

split :: TailStrategy -> VarOrRVar -> (VarOrRVar, VarOrRVar) -> Expr Int32 -> Func t n a -> IO (Func t n a) Source #

fuse :: (VarOrRVar, VarOrRVar) -> VarOrRVar -> Func t n a -> IO (Func t n a) Source #

serial :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

parallel :: VarOrRVar -> Func t n a -> IO (Func t n a) Source #

specialize :: Expr Bool -> Func t n a -> IO (Stage n a) Source #

specializeFail :: Text -> Func t n a -> IO () Source #

gpuBlocks :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Func t n a -> IO (Func t n a) Source #

gpuThreads :: forall i (ts :: [Type]). (IndexTuple i ts, 1 <= Length ts, Length ts <= 3) => DeviceAPI -> i -> Func t n a -> IO (Func t n a) Source #

gpuLanes :: DeviceAPI -> VarOrRVar -> Func t n a -> IO (Func t n a) Source #

computeWith :: forall (t0 :: LoopLevelTy). LoopAlignStrategy -> Func t n a -> LoopLevel t0 -> IO () Source #

data TailStrategy Source #

Different ways to handle a tail case in a split when the split factor does not provably divide the extent.

This is the Haskell counterpart of Halide::TailStrategy.

Constructors

TailRoundUp

Round up the extent to be a multiple of the split factor.

Not legal for RVars, as it would change the meaning of the algorithm.

  • Pros: generates the simplest, fastest code.
  • Cons: if used on a stage that reads from the input or writes to the output, constrains the input or output size to be a multiple of the split factor.
TailGuardWithIf

Guard the inner loop with an if statement that prevents evaluation beyond the original extent.

Always legal. The if statement is treated like a boundary condition, and factored out into a loop epilogue if possible.

  • Pros: no redundant re-evaluation; does not constrain input our output sizes.
  • Cons: increases code size due to separate tail-case handling; vectorization will scalarize in the tail case to handle the if statement.
TailPredicate

Guard the loads and stores in the loop with an if statement that prevents evaluation beyond the original extent.

Always legal. The if statement is treated like a boundary condition, and factored out into a loop epilogue if possible. * Pros: no redundant re-evaluation; does not constrain input or output sizes. * Cons: increases code size due to separate tail-case handling.

TailPredicateLoads

Guard the loads in the loop with an if statement that prevents evaluation beyond the original extent.

Only legal for innermost splits. Not legal for RVars, as it would change the meaning of the algorithm. The if statement is treated like a boundary condition, and factored out into a loop epilogue if possible. * Pros: does not constrain input sizes, output size constraints are simpler than full predication. * Cons: increases code size due to separate tail-case handling, constrains the output size to be a multiple of the split factor.

TailPredicateStores

Guard the stores in the loop with an if statement that prevents evaluation beyond the original extent.

Only legal for innermost splits. Not legal for RVars, as it would change the meaning of the algorithm. The if statement is treated like a boundary condition, and factored out into a loop epilogue if possible. * Pros: does not constrain output sizes, input size constraints are simpler than full predication. * Cons: increases code size due to separate tail-case handling, constraints the input size to be a multiple of the split factor.

TailShiftInwards

Prevent evaluation beyond the original extent by shifting the tail case inwards, re-evaluating some points near the end.

Only legal for pure variables in pure definitions. If the inner loop is very simple, the tail case is treated like a boundary condition and factored out into an epilogue.

This is a good trade-off between several factors. Like TailRoundUp, it supports vectorization well, because the inner loop is always a fixed size with no data-dependent branching. It increases code size slightly for inner loops due to the epilogue handling, but not for outer loops (e.g. loops over tiles). If used on a stage that reads from an input or writes to an output, this stategy only requires that the input/output extent be at least the split factor, instead of a multiple of the split factor as with TailRoundUp.

TailAuto

For pure definitions use TailShiftInwards.

For pure vars in update definitions use TailRoundUp. For RVars in update definitions use TailGuardWithIf.

data LoopLevel (t :: LoopLevelTy) where Source #

A reference to a site in a Halide statement at the top of the body of a particular for loop.

Instances

Instances details
HasField "func" (LoopLevel 'LockedTy) Text Source # 
Instance details

Defined in Language.Halide.LoopLevel

HasField "var" (LoopLevel 'LockedTy) (Expr Int32) Source # 
Instance details

Defined in Language.Halide.LoopLevel

Show (LoopLevel t) Source # 
Instance details

Defined in Language.Halide.LoopLevel

Eq (LoopLevel t) Source # 
Instance details

Defined in Language.Halide.LoopLevel

Methods

(==) :: LoopLevel t -> LoopLevel t -> Bool #

(/=) :: LoopLevel t -> LoopLevel t -> Bool #

data LoopAlignStrategy Source #

Different ways to handle the case when the start/end of the loops of stages computed with (fused) are not aligned.

Constructors

LoopAlignStart

Shift the start of the fused loops to align.

LoopAlignEnd

Shift the end of the fused loops to align.

LoopNoAlign

computeWith will make no attempt to align the start/end of the fused loops.

LoopAlignAuto

By default, LoopAlignStrategy is set to LoopNoAlign.

Instances

Instances details
Enum LoopAlignStrategy Source # 
Instance details

Defined in Language.Halide.LoopLevel

Show LoopAlignStrategy Source # 
Instance details

Defined in Language.Halide.LoopLevel

Eq LoopAlignStrategy Source # 
Instance details

Defined in Language.Halide.LoopLevel

Ord LoopAlignStrategy Source # 
Instance details

Defined in Language.Halide.LoopLevel

computeRoot :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Func t n a) Source #

Compute all of this function once ahead of time.

See Halide::Func::compute_root for more info.

getStage :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Stage n a) Source #

Get the pure stage of a Func for the purposes of scheduling it.

getLoopLevel :: (KnownNat n, IsHalideType a) => Func t n a -> Expr Int32 -> IO (LoopLevel 'LockedTy) Source #

Same as getLoopLevelAtStage except that the stage is -1.

getLoopLevelAtStage Source #

Arguments

:: (KnownNat n, IsHalideType a) 
=> Func t n a 
-> Expr Int32 
-> Int

update index

-> IO (LoopLevel 'LockedTy) 

Identify the loop nest corresponding to some dimension of some function.

asUsed :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Func 'FuncTy n a) Source #

Create and return a global identity wrapper, which wraps all calls to this Func by any other Func.

If a global wrapper already exists, returns it. The global identity wrapper is only used by callers for which no custom wrapper has been specified.

asUsedBy :: (KnownNat n, KnownNat m, IsHalideType a, IsHalideType b) => Func t1 n a -> Func 'FuncTy m b -> IO (Func 'FuncTy n a) Source #

Creates and returns a new identity Func that wraps this Func.

During compilation, Halide replaces all calls to this Func done by f with calls to the wrapper. If this Func is already wrapped for use in f, will return the existing wrapper.

For more info, see Halide::Func::in.

copyToDevice :: (KnownNat n, IsHalideType a) => DeviceAPI -> Func t n a -> IO (Func t n a) Source #

Declare that this function should be implemented by a call to halide_buffer_copy with the given target device API.

Asserts that the Func has a pure definition which is a simple call to a single input, and no update definitions. The wrapper Funcs returned by asUsed are suitable candidates. Consumes all pure variables, and rewrites the Func to have an extern definition that calls halide_buffer_copy.

copyToHost :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Func t n a) Source #

storeAt :: (KnownNat n, IsHalideType a) => Func 'FuncTy n a -> LoopLevel t -> IO (Func 'FuncTy n a) Source #

Allocate storage for this function within a particular loop level.

Scheduling storage is optional, and can be used to separate the loop level at which storage is allocated from the loop level at which computation occurs to trade off between locality and redundant work.

For more info, see Halide::Func::store_at.

computeAt :: (KnownNat n, IsHalideType a) => Func 'FuncTy n a -> LoopLevel t -> IO (Func 'FuncTy n a) Source #

Schedule a function to be computed within the iteration over a given loop level.

For more info, see Halide::Func::compute_at.

estimate Source #

Arguments

:: (KnownNat n, IsHalideType a) 
=> Expr Int32

index variable

-> Expr Int32

min estimate

-> Expr Int32

extent estimate

-> Func t n a 
-> IO () 

Split a dimension by the given factor, then unroll the inner dimension.

This is how you unroll a loop of unknown size by some constant factor. After this call, var refers to the outer dimension of the split. unroll :: (KnownNat n, IsHalideType a) => TailStrategy -> Func t n a -> Expr Int32 -- ^ Variable var to vectorize -> Expr Int32 -- ^ Split factor -> IO () unroll strategy func var factor = withFunc func $ f -> asVarOrRVar var $ x -> asExpr factor $ n -> [C.throwBlock| void { $(Halide::Func* f)->unroll(*$(Halide::VarOrRVar* x), *$(Halide::Expr* n), static_castHalide::TailStrategy($(int tail))); } |] where tail = fromIntegral (fromEnum strategy)

Reorder variables to have the given nesting order, from innermost out. reorder :: forall t n a i ts . ( IsTuple (Arguments ts) i , All ((~) (Expr Int32)) ts , Length ts ~ n , KnownNat n , IsHalideType a ) => Func t n a -> i -> IO () reorder func args = asVectorOf @((~) (Expr Int32)) asVarOrRVar (fromTuple args) $ v -> do withFunc func $ f -> [C.throwBlock| void { $(Halide::Func* f)->reorder(*$(std::vectorHalide::VarOrRVar* v)); } |]

Statically declare the range over which the function will be evaluated in the general case.

This provides a basis for the auto scheduler to make trade-offs and scheduling decisions. The auto generated schedules might break when the sizes of the dimensions are very different from the estimates specified. These estimates are used only by the auto scheduler if the function is a pipeline output.

bound Source #

Arguments

:: (KnownNat n, IsHalideType a) 
=> Expr Int32

index variable

-> Expr Int32

min estimate

-> Expr Int32

extent estimate

-> Func t n a 
-> IO () 

Statically declare the range over which a function should be evaluated.

This can let Halide perform some optimizations. E.g. if you know there are going to be 4 color channels, you can completely vectorize the color channel dimension without the overhead of splitting it up. If bounds inference decides that it requires more of this function than the bounds you have stated, a runtime error will occur when you try to run your pipeline.

Debugging / Tracing

For debugging, it's often useful to observe the value of an expression when it's evaluated. If you have a complex expression that does not depend on any buffers or indices, you can evaluate it. | However, often an expression is only used within a definition of a pipeline, and it's impossible to call evaluate on it. In such cases, it can be wrapped with printed to indicate to Halide that the value of the expression should be dumped to screen when it's computed.

prettyLoopNest :: (KnownNat n, IsHalideType r) => Func t n r -> IO Text Source #

Write out the loop nests specified by the schedule for this function.

Helpful for understanding what a schedule is doing.

For more info, see Halide::Func::print_loop_nest printLoopNest :: (KnownNat n, IsHalideType r) => Func n r -> IO () printLoopNest func = withFunc func $ f -> [C.exp| void { $(Halide::Func* f)->print_loop_nest() } |]

Get the loop nests specified by the schedule for this function.

Helpful for understanding what a schedule is doing.

For more info, see Halide::Func::print_loop_nest

compileToLoweredStmt :: forall n a t f. IsFuncBuilder f t n a => StmtOutputFormat -> Target -> f -> IO Text Source #

Get the internal representation of lowered code.

Useful for analyzing and debugging scheduling. Can emit HTML or plain text.

data TraceEvent Source #

Instances

Instances details
Show TraceEvent Source # 
Instance details

Defined in Language.Halide.Trace

data TraceEventCode Source #

Haskell counterpart of halide_trace_event_code_t.

setCustomTrace Source #

Arguments

:: (KnownNat n, IsHalideType a) 
=> (TraceEvent -> IO ())

Custom trace function

-> Func t n a

For which func to enable it

-> IO b

For the duration of which computation to enable it

-> IO b 

traceStores :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Func t n a) Source #

traceLoads :: (KnownNat n, IsHalideType a) => Func t n a -> IO (Func t n a) Source #

collectIterationOrder :: (KnownNat n, IsHalideType a) => (TraceEventCode -> Bool) -> Func t n a -> IO b -> IO ([[Int]], b) Source #

Type helpers

class (ToTuple a ~ t, FromTuple t ~ a) => IsTuple a t | a -> t, t -> a where Source #

Specifies that there is an isomorphism between a type a and a tuple t.

We use this class to convert between Arguments and normal tuples.

Methods

toTuple :: a -> t Source #

fromTuple :: t -> a Source #

type family ToTuple t where ... Source #

Type family that maps Arguments ts to the corresponding tuple type.

Equations

ToTuple (Arguments '[]) = () 
ToTuple (Arguments '[a1]) = a1 
ToTuple (Arguments '[a1, a2]) = (a1, a2) 
ToTuple (Arguments '[a1, a2, a3]) = (a1, a2, a3) 
ToTuple (Arguments '[a1, a2, a3, a4]) = (a1, a2, a3, a4) 
ToTuple (Arguments '[a1, a2, a3, a4, a5]) = (a1, a2, a3, a4, a5) 

type family FromTuple t Source #

Type family that maps tuples to the corresponding Arguments ts type. This is essentially the inverse of ToTuple.

Instances

Instances details
type FromTuple () Source # 
Instance details

Defined in Language.Halide.Type

type FromTuple ()
type FromTuple (Expr a) Source # 
Instance details

Defined in Language.Halide.Expr

type FromTuple (Expr a)
type FromTuple (a1, a2) Source # 
Instance details

Defined in Language.Halide.Type

type FromTuple (a1, a2)
type FromTuple (a1, a2, a3) Source # 
Instance details

Defined in Language.Halide.Type

type FromTuple (a1, a2, a3)
type FromTuple (a1, a2, a3, a4) Source # 
Instance details

Defined in Language.Halide.Type

type FromTuple (a1, a2, a3, a4)
type FromTuple (a1, a2, a3, a4, a5) Source # 
Instance details

Defined in Language.Halide.Type

type FromTuple (a1, a2, a3, a4, a5)

type IndexTuple i ts = (IsTuple (Arguments ts) i, All ((~) (Expr Int32)) ts) Source #

Specifies that i is a tuple of Expr Int32.

ts are deduced from i, so you don't have to specify them explicitly.

type family Length (xs :: [k]) :: Nat where ... Source #

A type family that returns the length of a type-level list.

Equations

Length '[] = 0 
Length (x ': xs) = 1 + Length xs 

type family All (c :: Type -> Constraint) (ts :: [Type]) :: Constraint where ... Source #

Apply constraint to all types in a list.

Equations

All c '[] = () 
All c (t ': ts) = (c t, All c ts) 

Internal

compileToCallable :: forall n a t f inputs output. (IsFuncBuilder f t n a, Lowered (FunctionArguments f) ~ inputs, Ptr (HalideBuffer n a) ~ output) => Target -> f -> IO (Callable inputs output) Source #

testCUDA :: IO () Source #

A test that tries to compile and run a Halide pipeline using FeatureCUDA.

This is implemented fully in C++ to make sure that we test the installation rather than our Haskell code.

On non-NixOS systems one should do the following:

nixGLNvidia cabal repl --ghc-options='-fobject-code -O0'
ghci> testCUDA

testOpenCL :: IO () Source #

Similar to testCUDA but for FeatureOpenCL.

data SomeLoopLevel where Source #

Constructors

SomeLoopLevel :: LoopLevel t -> SomeLoopLevel 

Instances

Instances details
Show SomeLoopLevel Source # 
Instance details

Defined in Language.Halide.LoopLevel

Eq SomeLoopLevel Source # 
Instance details

Defined in Language.Halide.LoopLevel

data RawHalideBuffer Source #

The low-level untyped Haskell analogue of halide_buffer_t.

It's quite difficult to use RawHalideBuffer correctly, and misusage can result in crashes and segmentation faults. Hence, prefer the higher-level HalideBuffer wrapper for all your code

data HalideDimension Source #

Information about a dimension in a buffer.

It is the Haskell analogue of halide_dimension_t.

Constructors

HalideDimension 

Fields

rowMajorStrides Source #

Arguments

:: Integral a 
=> [a]

Extents

-> [a] 

Get strides corresponding to row-major ordering

colMajorStrides Source #

Arguments

:: Integral a 
=> [a]

Extents

-> [a] 

Get strides corresponding to column-major ordering.

isDeviceDirty :: Ptr RawHalideBuffer -> IO Bool Source #

Do we have changes on the device the have not been copied to the host?

isHostDirty :: Ptr RawHalideBuffer -> IO Bool Source #

Do we have changes on the device the have not been copied to the host?

bufferCopyToHost :: Ptr RawHalideBuffer -> IO () Source #

Copy the underlying memory from device to host.

data Dim Source #

Constructors

Dim 

Instances

Instances details
Storable Dim Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

sizeOf :: Dim -> Int #

alignment :: Dim -> Int #

peekElemOff :: Ptr Dim -> Int -> IO Dim #

pokeElemOff :: Ptr Dim -> Int -> Dim -> IO () #

peekByteOff :: Ptr b -> Int -> IO Dim #

pokeByteOff :: Ptr b -> Int -> Dim -> IO () #

peek :: Ptr Dim -> IO Dim #

poke :: Ptr Dim -> Dim -> IO () #

Show Dim Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

showsPrec :: Int -> Dim -> ShowS #

show :: Dim -> String #

showList :: [Dim] -> ShowS #

Eq Dim Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

(==) :: Dim -> Dim -> Bool #

(/=) :: Dim -> Dim -> Bool #

data DimType Source #

Type of dimension that tells which transformations are legal on it.

Instances

Instances details
Enum DimType Source # 
Instance details

Defined in Language.Halide.Schedule

Show DimType Source # 
Instance details

Defined in Language.Halide.Schedule

Eq DimType Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

(==) :: DimType -> DimType -> Bool #

(/=) :: DimType -> DimType -> Bool #

data ForType Source #

Specifies how loop values are traversed.

Instances

Instances details
Enum ForType Source # 
Instance details

Defined in Language.Halide.Schedule

Show ForType Source # 
Instance details

Defined in Language.Halide.Schedule

Eq ForType Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

(==) :: ForType -> ForType -> Bool #

(/=) :: ForType -> ForType -> Bool #

data SplitContents Source #

Instances

Instances details
Show SplitContents Source # 
Instance details

Defined in Language.Halide.Schedule

data FuseContents Source #

Constructors

FuseContents 

Fields

Instances

Instances details
Show FuseContents Source # 
Instance details

Defined in Language.Halide.Schedule

Eq FuseContents Source # 
Instance details

Defined in Language.Halide.Schedule

data Split Source #

Instances

Instances details
Storable Split Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

sizeOf :: Split -> Int #

alignment :: Split -> Int #

peekElemOff :: Ptr Split -> Int -> IO Split #

pokeElemOff :: Ptr Split -> Int -> Split -> IO () #

peekByteOff :: Ptr b -> Int -> IO Split #

pokeByteOff :: Ptr b -> Int -> Split -> IO () #

peek :: Ptr Split -> IO Split #

poke :: Ptr Split -> Split -> IO () #

Show Split Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

showsPrec :: Int -> Split -> ShowS #

show :: Split -> String #

showList :: [Split] -> ShowS #

data Bound Source #

Constructors

Bound 

Instances

Instances details
Show Bound Source # 
Instance details

Defined in Language.Halide.Schedule

Methods

showsPrec :: Int -> Bound -> ShowS #

show :: Bound -> String #

showList :: [Bound] -> ShowS #

data StorageDim Source #

Instances

Instances details
Show StorageDim Source # 
Instance details

Defined in Language.Halide.Schedule

data FusedPair Source #

Constructors

FusedPair !Text !(Text, Int) !(Text, Int) 

Instances

Instances details
Storable FusedPair Source # 
Instance details

Defined in Language.Halide.Schedule

Show FusedPair Source # 
Instance details

Defined in Language.Halide.Schedule

Eq FusedPair Source # 
Instance details

Defined in Language.Halide.Schedule

applySplits :: (KnownNat n, IsHalideType a) => [Split] -> Stage n a -> IO () Source #

applyDims :: (KnownNat n, IsHalideType a) => [Dim] -> Stage n a -> IO () Source #

type IsFuncBuilder f t n a = (All ValidParameter (FunctionArguments f), All ValidArgument (Lowered (FunctionArguments f)), UnCurry f (FunctionArguments f) (FunctionReturn f), PrepareParameters (FunctionArguments f), ReturnsFunc f t n a, KnownNat (Length (FunctionArguments f)), KnownNat (Length (Lowered (FunctionArguments f)))) Source #

class (FunctionReturn f ~ IO (Func t n a), IsHalideType a, KnownNat n) => ReturnsFunc f t n a | f -> t n a Source #

A constraint that specifies that the function f returns IO (Func t n a).

Instances

Instances details
(FunctionReturn f ~ IO (Func t n a), IsHalideType a, KnownNat n) => ReturnsFunc f t n a Source # 
Instance details

Defined in Language.Halide.Kernel

type family FunctionArguments (f :: Type) :: [Type] where ... Source #

Return the list of arguments to of a function type.

Equations

FunctionArguments (a -> b) = a ': FunctionArguments b 
FunctionArguments a = '[] 

type family FunctionReturn (f :: Type) :: Type where ... Source #

Get the return type of a function.

Equations

FunctionReturn (a -> b) = FunctionReturn b 
FunctionReturn a = a 

class Curry (args :: [Type]) (r :: Type) (f :: Type) | args r -> f where Source #

A helper typeclass to convert a function that takes Arguments as input into a normal curried function. This is the inverse of UnCurry.

For instance, if we have a function f :: Arguments '[Int, Float] -> Double, then it will be converted to f' :: Int -> Float -> Double.

Methods

curryG :: (Arguments args -> r) -> f Source #

Instances

Instances details
Curry ('[] :: [Type]) r r Source # 
Instance details

Defined in Language.Halide.Type

Methods

curryG :: (Arguments '[] -> r) -> r Source #

Curry args r f => Curry (a ': args) r (a -> f) Source # 
Instance details

Defined in Language.Halide.Type

Methods

curryG :: (Arguments (a ': args) -> r) -> a -> f Source #

class UnCurry (f :: Type) (args :: [Type]) (r :: Type) | args r -> f where Source #

A helper typeclass to convert a normal curried function to a function that takes Arguments as input.

For instance, if we have a function f :: Int -> Float -> Double, then it will be converted to f' :: Arguments '[Int, Float] -> Double.

Methods

uncurryG :: f -> Arguments args -> r Source #

Instances

Instances details
(FunctionArguments f ~ ('[] :: [Type]), FunctionReturn f ~ r, f ~ r) => UnCurry f ('[] :: [Type]) r Source # 
Instance details

Defined in Language.Halide.Type

Methods

uncurryG :: f -> Arguments '[] -> r Source #

UnCurry f args r => UnCurry (a -> f) (a ': args) r Source # 
Instance details

Defined in Language.Halide.Type

Methods

uncurryG :: (a -> f) -> Arguments (a ': args) -> r Source #

type family Lowered (t :: k) :: k where ... Source #

Specifies how Expr and Func parameters become scalar and buffer arguments in compiled kernels.

Equations

Lowered (Expr a) = a 
Lowered (Func t n a) = Ptr (HalideBuffer n a) 
Lowered '[] = '[] 
Lowered (Expr a ': ts) = a ': Lowered ts 
Lowered (Func t n a ': ts) = Ptr (HalideBuffer n a) ': Lowered ts 

inline-c helpers

importHalide :: DecsQ Source #

One stop function to include all the neccessary machinery to call Halide functions via inline-c.

Put importHalide somewhere at the beginning of the file and enjoy using the C++ interface of Halide via inline-c quasiquotes.

data CxxExpr Source #

Haskell counterpart of Halide::Expr.

data CxxVar Source #

Haskell counterpart of Halide::Var.

data CxxRVar Source #

Haskell counterpart of Halide::RVar.

data CxxParameter Source #

Haskell counterpart of Halide::Internal::Parameter.

data CxxFunc Source #

Haskell counterpart of Halide::Func.

data CxxImageParam Source #

Haskell counterpart of Halide::ImageParam.

data CxxStage Source #

Haskell counterpart of Halide::Stage.

data CxxDimension Source #

Haskell counterpart of Halide::Internal::Dimension.

data CxxTarget Source #

Haskell counterpart of Halide::Target.

data CxxLoopLevel Source #

Haskell counterpart of Halide::LoopLevel

Convenience re-exports

data Int32 #

32-bit signed integer type

Instances

Instances details
Storable Int32

Since: base-2.1

Instance details

Defined in Foreign.Storable

Methods

sizeOf :: Int32 -> Int #

alignment :: Int32 -> Int #

peekElemOff :: Ptr Int32 -> Int -> IO Int32 #

pokeElemOff :: Ptr Int32 -> Int -> Int32 -> IO () #

peekByteOff :: Ptr b -> Int -> IO Int32 #

pokeByteOff :: Ptr b -> Int -> Int32 -> IO () #

peek :: Ptr Int32 -> IO Int32 #

poke :: Ptr Int32 -> Int32 -> IO () #

Bits Int32

Since: base-2.1

Instance details

Defined in GHC.Int

FiniteBits Int32

Since: base-4.6.0.0

Instance details

Defined in GHC.Int

Bounded Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Enum Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Ix Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Num Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Read Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Integral Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Real Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Methods

toRational :: Int32 -> Rational #

Show Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Methods

showsPrec :: Int -> Int32 -> ShowS #

show :: Int32 -> String #

showList :: [Int32] -> ShowS #

Eq Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Methods

(==) :: Int32 -> Int32 -> Bool #

(/=) :: Int32 -> Int32 -> Bool #

Ord Int32

Since: base-2.1

Instance details

Defined in GHC.Int

Methods

compare :: Int32 -> Int32 -> Ordering #

(<) :: Int32 -> Int32 -> Bool #

(<=) :: Int32 -> Int32 -> Bool #

(>) :: Int32 -> Int32 -> Bool #

(>=) :: Int32 -> Int32 -> Bool #

max :: Int32 -> Int32 -> Int32 #

min :: Int32 -> Int32 -> Int32 #

IsHalideType Int32 Source # 
Instance details

Defined in Language.Halide.Expr

Methods

halideTypeFor :: proxy Int32 -> HalideType

toCxxExpr :: Int32 -> IO (ForeignPtr CxxExpr)

Hashable Int32 
Instance details

Defined in Data.Hashable.Class

Methods

hashWithSalt :: Int -> Int32 -> Int #

hash :: Int32 -> Int #

Prim Int32 
Instance details

Defined in Data.Primitive.Types

Uniform Int32 
Instance details

Defined in System.Random.Internal

Methods

uniformM :: StatefulGen g m => g -> m Int32 #

UniformRange Int32 
Instance details

Defined in System.Random.Internal

Methods

uniformRM :: StatefulGen g m => (Int32, Int32) -> g -> m Int32 #

Lift Int32 
Instance details

Defined in Language.Haskell.TH.Syntax

Methods

lift :: Quote m => Int32 -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Int32 -> Code m Int32 #

HasField "extent" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "max" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "min" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "stride" Dimension (Expr Int32) Source # 
Instance details

Defined in Language.Halide.Dimension

HasField "var" (LoopLevel 'LockedTy) (Expr Int32) Source # 
Instance details

Defined in Language.Halide.LoopLevel

data Ptr a #

A value of type Ptr a represents a pointer to an object, or an array of objects, which may be marshalled to or from Haskell values of type a.

The type a will often be an instance of class Storable which provides the marshalling operations. However this is not essential, and you can provide your own operations to access the pointer. For example you might write small foreign functions to get or set the fields of a C struct.

Instances

Instances details
Generic1 (URec (Ptr ()) :: k -> Type) 
Instance details

Defined in GHC.Generics

Associated Types

type Rep1 (URec (Ptr ())) :: k -> Type #

Methods

from1 :: forall (a :: k0). URec (Ptr ()) a -> Rep1 (URec (Ptr ())) a #

to1 :: forall (a :: k0). Rep1 (URec (Ptr ())) a -> URec (Ptr ()) a #

Foldable (UAddr :: TYPE LiftedRep -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Foldable

Methods

fold :: Monoid m => UAddr m -> m #

foldMap :: Monoid m => (a -> m) -> UAddr a -> m #

foldMap' :: Monoid m => (a -> m) -> UAddr a -> m #

foldr :: (a -> b -> b) -> b -> UAddr a -> b #

foldr' :: (a -> b -> b) -> b -> UAddr a -> b #

foldl :: (b -> a -> b) -> b -> UAddr a -> b #

foldl' :: (b -> a -> b) -> b -> UAddr a -> b #

foldr1 :: (a -> a -> a) -> UAddr a -> a #

foldl1 :: (a -> a -> a) -> UAddr a -> a #

toList :: UAddr a -> [a] #

null :: UAddr a -> Bool #

length :: UAddr a -> Int #

elem :: Eq a => a -> UAddr a -> Bool #

maximum :: Ord a => UAddr a -> a #

minimum :: Ord a => UAddr a -> a #

sum :: Num a => UAddr a -> a #

product :: Num a => UAddr a -> a #

Traversable (UAddr :: Type -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Traversable

Methods

traverse :: Applicative f => (a -> f b) -> UAddr a -> f (UAddr b) #

sequenceA :: Applicative f => UAddr (f a) -> f (UAddr a) #

mapM :: Monad m => (a -> m b) -> UAddr a -> m (UAddr b) #

sequence :: Monad m => UAddr (m a) -> m (UAddr a) #

Storable (Ptr a)

Since: base-2.1

Instance details

Defined in Foreign.Storable

Methods

sizeOf :: Ptr a -> Int #

alignment :: Ptr a -> Int #

peekElemOff :: Ptr (Ptr a) -> Int -> IO (Ptr a) #

pokeElemOff :: Ptr (Ptr a) -> Int -> Ptr a -> IO () #

peekByteOff :: Ptr b -> Int -> IO (Ptr a) #

pokeByteOff :: Ptr b -> Int -> Ptr a -> IO () #

peek :: Ptr (Ptr a) -> IO (Ptr a) #

poke :: Ptr (Ptr a) -> Ptr a -> IO () #

Show (Ptr a)

Since: base-2.1

Instance details

Defined in GHC.Ptr

Methods

showsPrec :: Int -> Ptr a -> ShowS #

show :: Ptr a -> String #

showList :: [Ptr a] -> ShowS #

Eq (Ptr a)

Since: base-2.1

Instance details

Defined in GHC.Ptr

Methods

(==) :: Ptr a -> Ptr a -> Bool #

(/=) :: Ptr a -> Ptr a -> Bool #

Ord (Ptr a)

Since: base-2.1

Instance details

Defined in GHC.Ptr

Methods

compare :: Ptr a -> Ptr a -> Ordering #

(<) :: Ptr a -> Ptr a -> Bool #

(<=) :: Ptr a -> Ptr a -> Bool #

(>) :: Ptr a -> Ptr a -> Bool #

(>=) :: Ptr a -> Ptr a -> Bool #

max :: Ptr a -> Ptr a -> Ptr a #

min :: Ptr a -> Ptr a -> Ptr a #

Hashable (Ptr a) 
Instance details

Defined in Data.Hashable.Class

Methods

hashWithSalt :: Int -> Ptr a -> Int #

hash :: Ptr a -> Int #

Prim (Ptr a) 
Instance details

Defined in Data.Primitive.Types

Methods

sizeOf# :: Ptr a -> Int# #

alignment# :: Ptr a -> Int# #

indexByteArray# :: ByteArray# -> Int# -> Ptr a #

readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #) #

writeByteArray# :: MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s #

setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Ptr a -> State# s -> State# s #

indexOffAddr# :: Addr# -> Int# -> Ptr a #

readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, Ptr a #) #

writeOffAddr# :: Addr# -> Int# -> Ptr a -> State# s -> State# s #

setOffAddr# :: Addr# -> Int# -> Int# -> Ptr a -> State# s -> State# s #

Functor (URec (Ptr ()) :: TYPE LiftedRep -> Type)

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

Methods

fmap :: (a -> b) -> URec (Ptr ()) a -> URec (Ptr ()) b #

(<$) :: a -> URec (Ptr ()) b -> URec (Ptr ()) a #

Generic (URec (Ptr ()) p) 
Instance details

Defined in GHC.Generics

Associated Types

type Rep (URec (Ptr ()) p) :: Type -> Type #

Methods

from :: URec (Ptr ()) p -> Rep (URec (Ptr ()) p) x #

to :: Rep (URec (Ptr ()) p) x -> URec (Ptr ()) p #

Eq (URec (Ptr ()) p)

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

Methods

(==) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

(/=) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

Ord (URec (Ptr ()) p)

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

Methods

compare :: URec (Ptr ()) p -> URec (Ptr ()) p -> Ordering #

(<) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

(<=) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

(>) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

(>=) :: URec (Ptr ()) p -> URec (Ptr ()) p -> Bool #

max :: URec (Ptr ()) p -> URec (Ptr ()) p -> URec (Ptr ()) p #

min :: URec (Ptr ()) p -> URec (Ptr ()) p -> URec (Ptr ()) p #

data URec (Ptr ()) (p :: k)

Used for marking occurrences of Addr#

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

data URec (Ptr ()) (p :: k) = UAddr {}
type Rep1 (URec (Ptr ()) :: k -> Type)

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

type Rep1 (URec (Ptr ()) :: k -> Type) = D1 ('MetaData "URec" "GHC.Generics" "base" 'False) (C1 ('MetaCons "UAddr" 'PrefixI 'True) (S1 ('MetaSel ('Just "uAddr#") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (UAddr :: k -> Type)))
type Rep (URec (Ptr ()) p)

Since: base-4.9.0.0

Instance details

Defined in GHC.Generics

type Rep (URec (Ptr ()) p) = D1 ('MetaData "URec" "GHC.Generics" "base" 'False) (C1 ('MetaCons "UAddr" 'PrefixI 'True) (S1 ('MetaSel ('Just "uAddr#") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (UAddr :: Type -> Type)))

class KnownNat (n :: Nat) #

This class gives the integer associated with a type-level natural. There are instances of the class for every concrete literal: 0, 1, 2, etc.

Since: base-4.7.0.0

Minimal complete definition

natSing