{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
-- | A representation with flat parallelism via GPU-oriented kernels.
module Futhark.Representation.Kernels
       ( -- * The Lore definition
         Kernels
         -- * Module re-exports
       , module Futhark.Representation.AST.Attributes
       , module Futhark.Representation.AST.Traversals
       , module Futhark.Representation.AST.Pretty
       , module Futhark.Representation.AST.Syntax
       , module Futhark.Representation.Kernels.Kernel
       , module Futhark.Representation.Kernels.Sizes
       , module Futhark.Representation.SOACS.SOAC
       )
where

import Futhark.Representation.AST.Syntax
import Futhark.Representation.Kernels.Kernel
import Futhark.Representation.Kernels.Sizes
import Futhark.Representation.AST.Attributes
import Futhark.Representation.AST.Traversals
import Futhark.Representation.AST.Pretty
import Futhark.Representation.SOACS.SOAC hiding (HistOp(..))
import Futhark.Binder
import Futhark.Construct
import qualified Futhark.TypeCheck as TypeCheck

-- This module could be written much nicer if Haskell had functors
-- like Standard ML.  Instead, we have to abuse the namespace/module
-- system.

data Kernels

instance Annotations Kernels where
  type Op Kernels = HostOp Kernels (SOAC Kernels)
instance Attributes Kernels where
  expTypesFromPattern :: Pattern Kernels -> m [BranchType Kernels]
expTypesFromPattern = [ExtType] -> m [ExtType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtType] -> m [ExtType])
-> (PatternT Type -> [ExtType]) -> PatternT Type -> m [ExtType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT Type -> [ExtType]
forall attr. Typed attr => PatternT attr -> [ExtType]
expExtTypesFromPattern

instance TypeCheck.CheckableOp Kernels where
  checkOp :: OpWithAliases (Op Kernels) -> TypeM Kernels ()
checkOp = Maybe SegLevel
-> HostOp (Aliases Kernels) (SOAC (Aliases Kernels))
-> TypeM Kernels ()
forall lore.
(Checkable lore,
 OpWithAliases (Op lore)
 ~ HostOp (Aliases lore) (SOAC (Aliases lore))) =>
Maybe SegLevel
-> HostOp (Aliases lore) (SOAC (Aliases lore)) -> TypeM lore ()
typeCheckKernelsOp Maybe SegLevel
forall a. Maybe a
Nothing
    where typeCheckKernelsOp :: Maybe SegLevel
-> HostOp (Aliases lore) (SOAC (Aliases lore)) -> TypeM lore ()
typeCheckKernelsOp Maybe SegLevel
lvl =
            (SegLevel -> OpWithAliases (Op lore) -> TypeM lore ())
-> Maybe SegLevel
-> (SOAC (Aliases lore) -> TypeM lore ())
-> HostOp (Aliases lore) (SOAC (Aliases lore))
-> TypeM lore ()
forall lore op.
Checkable lore =>
(SegLevel -> OpWithAliases (Op lore) -> TypeM lore ())
-> Maybe SegLevel
-> (op -> TypeM lore ())
-> HostOp (Aliases lore) op
-> TypeM lore ()
typeCheckHostOp (Maybe SegLevel
-> HostOp (Aliases lore) (SOAC (Aliases lore)) -> TypeM lore ()
typeCheckKernelsOp (Maybe SegLevel
 -> HostOp (Aliases lore) (SOAC (Aliases lore)) -> TypeM lore ())
-> (SegLevel -> Maybe SegLevel)
-> SegLevel
-> HostOp (Aliases lore) (SOAC (Aliases lore))
-> TypeM lore ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegLevel -> Maybe SegLevel
forall a. a -> Maybe a
Just) Maybe SegLevel
lvl SOAC (Aliases lore) -> TypeM lore ()
forall lore. Checkable lore => SOAC (Aliases lore) -> TypeM lore ()
typeCheckSOAC

instance TypeCheck.Checkable Kernels where

instance Bindable Kernels where
  mkBody :: Stms Kernels -> Result -> Body Kernels
mkBody = BodyAttr Kernels -> Stms Kernels -> Result -> Body Kernels
forall lore. BodyAttr lore -> Stms lore -> Result -> BodyT lore
Body ()
  mkExpPat :: [Ident] -> [Ident] -> Exp Kernels -> Pattern Kernels
mkExpPat [Ident]
ctx [Ident]
val Exp Kernels
_ = [Ident] -> [Ident] -> PatternT Type
basicPattern [Ident]
ctx [Ident]
val
  mkExpAttr :: Pattern Kernels -> Exp Kernels -> ExpAttr Kernels
mkExpAttr Pattern Kernels
_ Exp Kernels
_ = ()
  mkLetNames :: [VName] -> Exp Kernels -> m (Stm Kernels)
mkLetNames = [VName] -> Exp Kernels -> m (Stm Kernels)
forall lore (m :: * -> *).
(ExpAttr lore ~ (), LetAttr lore ~ Type, MonadFreshNames m,
 TypedOp (Op lore), HasScope lore m) =>
[VName] -> Exp lore -> m (Stm lore)
simpleMkLetNames

instance BinderOps Kernels where
  mkExpAttrB :: Pattern Kernels -> Exp Kernels -> m (ExpAttr Kernels)
mkExpAttrB = Pattern Kernels -> Exp Kernels -> m (ExpAttr Kernels)
forall (m :: * -> *).
(MonadBinder m, Bindable (Lore m)) =>
Pattern (Lore m) -> Exp (Lore m) -> m (ExpAttr (Lore m))
bindableMkExpAttrB
  mkBodyB :: Stms Kernels -> Result -> m (Body Kernels)
mkBodyB = Stms Kernels -> Result -> m (Body Kernels)
forall (m :: * -> *).
(MonadBinder m, Bindable (Lore m)) =>
Stms (Lore m) -> Result -> m (Body (Lore m))
bindableMkBodyB
  mkLetNamesB :: [VName] -> Exp Kernels -> m (Stm Kernels)
mkLetNamesB = [VName] -> Exp Kernels -> m (Stm Kernels)
forall (m :: * -> *).
(MonadBinder m, Bindable (Lore m)) =>
[VName] -> Exp (Lore m) -> m (Stm (Lore m))
bindableMkLetNamesB

instance PrettyLore Kernels where