-- | Variation of "Futhark.CodeGen.ImpCode" that contains the notion
-- of a kernel invocation.
module Futhark.CodeGen.ImpCode.GPU
  ( Program,
    HostCode,
    KernelCode,
    KernelConst (..),
    KernelConstExp,
    HostOp (..),
    KernelOp (..),
    Fence (..),
    AtomicOp (..),
    GroupDim,
    Kernel (..),
    KernelUse (..),
    module Futhark.CodeGen.ImpCode,
    module Futhark.IR.GPU.Sizes,
  )
where

import Futhark.CodeGen.ImpCode
import Futhark.IR.GPU.Sizes
import Futhark.IR.Pretty ()
import Futhark.Util.Pretty

-- | A program that calls kernels.
type Program = Definitions HostOp

-- | Host-level code that can call kernels.
type HostCode = Code HostOp

-- | Code inside a kernel.
type KernelCode = Code KernelOp

-- | A run-time constant related to kernels.
data KernelConst
  = SizeConst Name
  | SizeMaxConst SizeClass
  deriving (KernelConst -> KernelConst -> Bool
(KernelConst -> KernelConst -> Bool)
-> (KernelConst -> KernelConst -> Bool) -> Eq KernelConst
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KernelConst -> KernelConst -> Bool
== :: KernelConst -> KernelConst -> Bool
$c/= :: KernelConst -> KernelConst -> Bool
/= :: KernelConst -> KernelConst -> Bool
Eq, Eq KernelConst
Eq KernelConst
-> (KernelConst -> KernelConst -> Ordering)
-> (KernelConst -> KernelConst -> Bool)
-> (KernelConst -> KernelConst -> Bool)
-> (KernelConst -> KernelConst -> Bool)
-> (KernelConst -> KernelConst -> Bool)
-> (KernelConst -> KernelConst -> KernelConst)
-> (KernelConst -> KernelConst -> KernelConst)
-> Ord KernelConst
KernelConst -> KernelConst -> Bool
KernelConst -> KernelConst -> Ordering
KernelConst -> KernelConst -> KernelConst
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KernelConst -> KernelConst -> Ordering
compare :: KernelConst -> KernelConst -> Ordering
$c< :: KernelConst -> KernelConst -> Bool
< :: KernelConst -> KernelConst -> Bool
$c<= :: KernelConst -> KernelConst -> Bool
<= :: KernelConst -> KernelConst -> Bool
$c> :: KernelConst -> KernelConst -> Bool
> :: KernelConst -> KernelConst -> Bool
$c>= :: KernelConst -> KernelConst -> Bool
>= :: KernelConst -> KernelConst -> Bool
$cmax :: KernelConst -> KernelConst -> KernelConst
max :: KernelConst -> KernelConst -> KernelConst
$cmin :: KernelConst -> KernelConst -> KernelConst
min :: KernelConst -> KernelConst -> KernelConst
Ord, Int -> KernelConst -> ShowS
[KernelConst] -> ShowS
KernelConst -> String
(Int -> KernelConst -> ShowS)
-> (KernelConst -> String)
-> ([KernelConst] -> ShowS)
-> Show KernelConst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KernelConst -> ShowS
showsPrec :: Int -> KernelConst -> ShowS
$cshow :: KernelConst -> String
show :: KernelConst -> String
$cshowList :: [KernelConst] -> ShowS
showList :: [KernelConst] -> ShowS
Show)

-- | An expression whose variables are kernel constants.
type KernelConstExp = PrimExp KernelConst

-- | An operation that runs on the host (CPU).
data HostOp
  = CallKernel Kernel
  | GetSize VName Name SizeClass
  | CmpSizeLe VName Name SizeClass Exp
  | GetSizeMax VName SizeClass
  deriving (Int -> HostOp -> ShowS
[HostOp] -> ShowS
HostOp -> String
(Int -> HostOp -> ShowS)
-> (HostOp -> String) -> ([HostOp] -> ShowS) -> Show HostOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HostOp -> ShowS
showsPrec :: Int -> HostOp -> ShowS
$cshow :: HostOp -> String
show :: HostOp -> String
$cshowList :: [HostOp] -> ShowS
showList :: [HostOp] -> ShowS
Show)

-- | The size of one dimension of a group.
type GroupDim = Either Exp KernelConst

-- | A generic kernel containing arbitrary kernel code.
data Kernel = Kernel
  { Kernel -> Code KernelOp
kernelBody :: Code KernelOp,
    -- | The host variables referenced by the kernel.
    Kernel -> [KernelUse]
kernelUses :: [KernelUse],
    Kernel -> [Exp]
kernelNumGroups :: [Exp],
    Kernel -> [GroupDim]
kernelGroupSize :: [GroupDim],
    -- | A short descriptive and _unique_ name - should be
    -- alphanumeric and without spaces.
    Kernel -> Name
kernelName :: Name,
    -- | If true, this kernel does not need to check
    -- whether we are in a failing state, as it can cope.
    -- Intuitively, it means that the kernel does not
    -- depend on any non-scalar parameters to make control
    -- flow decisions.  Replication, transpose, and copy
    -- kernels are examples of this.
    Kernel -> Bool
kernelFailureTolerant :: Bool,
    -- | If true, multi-versioning branches will consider this kernel
    -- when considering the local memory requirements.  Set this to
    -- false for kernels that do their own checking.
    Kernel -> Bool
kernelCheckLocalMemory :: Bool
  }
  deriving (Int -> Kernel -> ShowS
[Kernel] -> ShowS
Kernel -> String
(Int -> Kernel -> ShowS)
-> (Kernel -> String) -> ([Kernel] -> ShowS) -> Show Kernel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Kernel -> ShowS
showsPrec :: Int -> Kernel -> ShowS
$cshow :: Kernel -> String
show :: Kernel -> String
$cshowList :: [Kernel] -> ShowS
showList :: [Kernel] -> ShowS
Show)

-- | Information about a host-level variable that is used inside this
-- kernel.  When generating the actual kernel code, this is used to
-- deduce which parameters are needed.
data KernelUse
  = ScalarUse VName PrimType
  | MemoryUse VName
  | ConstUse VName KernelConstExp
  deriving (KernelUse -> KernelUse -> Bool
(KernelUse -> KernelUse -> Bool)
-> (KernelUse -> KernelUse -> Bool) -> Eq KernelUse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KernelUse -> KernelUse -> Bool
== :: KernelUse -> KernelUse -> Bool
$c/= :: KernelUse -> KernelUse -> Bool
/= :: KernelUse -> KernelUse -> Bool
Eq, Eq KernelUse
Eq KernelUse
-> (KernelUse -> KernelUse -> Ordering)
-> (KernelUse -> KernelUse -> Bool)
-> (KernelUse -> KernelUse -> Bool)
-> (KernelUse -> KernelUse -> Bool)
-> (KernelUse -> KernelUse -> Bool)
-> (KernelUse -> KernelUse -> KernelUse)
-> (KernelUse -> KernelUse -> KernelUse)
-> Ord KernelUse
KernelUse -> KernelUse -> Bool
KernelUse -> KernelUse -> Ordering
KernelUse -> KernelUse -> KernelUse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KernelUse -> KernelUse -> Ordering
compare :: KernelUse -> KernelUse -> Ordering
$c< :: KernelUse -> KernelUse -> Bool
< :: KernelUse -> KernelUse -> Bool
$c<= :: KernelUse -> KernelUse -> Bool
<= :: KernelUse -> KernelUse -> Bool
$c> :: KernelUse -> KernelUse -> Bool
> :: KernelUse -> KernelUse -> Bool
$c>= :: KernelUse -> KernelUse -> Bool
>= :: KernelUse -> KernelUse -> Bool
$cmax :: KernelUse -> KernelUse -> KernelUse
max :: KernelUse -> KernelUse -> KernelUse
$cmin :: KernelUse -> KernelUse -> KernelUse
min :: KernelUse -> KernelUse -> KernelUse
Ord, Int -> KernelUse -> ShowS
[KernelUse] -> ShowS
KernelUse -> String
(Int -> KernelUse -> ShowS)
-> (KernelUse -> String)
-> ([KernelUse] -> ShowS)
-> Show KernelUse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KernelUse -> ShowS
showsPrec :: Int -> KernelUse -> ShowS
$cshow :: KernelUse -> String
show :: KernelUse -> String
$cshowList :: [KernelUse] -> ShowS
showList :: [KernelUse] -> ShowS
Show)

instance Pretty KernelConst where
  pretty :: forall ann. KernelConst -> Doc ann
pretty (SizeConst Name
key) = Doc ann
"get_size" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
key)
  pretty (SizeMaxConst SizeClass
size_class) = Doc ann
"get_max_size" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (SizeClass -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeClass -> Doc ann
pretty SizeClass
size_class)

instance FreeIn KernelConst where
  freeIn' :: KernelConst -> FV
freeIn' (SizeConst Name
_) = FV
forall a. Monoid a => a
mempty
  freeIn' (SizeMaxConst SizeClass
_) = FV
forall a. Monoid a => a
mempty

instance Pretty KernelUse where
  pretty :: forall ann. KernelUse -> Doc ann
pretty (ScalarUse VName
name PrimType
t) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
oneLine (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"scalar_copy" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name, PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t])
  pretty (MemoryUse VName
name) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
oneLine (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"mem_copy" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name])
  pretty (ConstUse VName
name KernelConstExp
e) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
oneLine (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"const" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name, KernelConstExp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. KernelConstExp -> Doc ann
pretty KernelConstExp
e])

instance Pretty HostOp where
  pretty :: forall ann. HostOp -> Doc ann
pretty (GetSize VName
dest Name
key SizeClass
size_class) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_size" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
key, SizeClass -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeClass -> Doc ann
pretty SizeClass
size_class])
  pretty (GetSizeMax VName
dest SizeClass
size_class) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_size_max" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (SizeClass -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeClass -> Doc ann
pretty SizeClass
size_class)
  pretty (CmpSizeLe VName
dest Name
name SizeClass
size_class Exp
x) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_size" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
name, SizeClass -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeClass -> Doc ann
pretty SizeClass
size_class])
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x
  pretty (CallKernel Kernel
c) =
    Kernel -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Kernel -> Doc ann
pretty Kernel
c

instance FreeIn HostOp where
  freeIn' :: HostOp -> FV
freeIn' (CallKernel Kernel
c) =
    Kernel -> FV
forall a. FreeIn a => a -> FV
freeIn' Kernel
c
  freeIn' (CmpSizeLe VName
dest Name
_ SizeClass
_ Exp
x) =
    VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
dest FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (GetSizeMax VName
dest SizeClass
_) =
    VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
dest
  freeIn' (GetSize VName
dest Name
_ SizeClass
_) =
    VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
dest

instance FreeIn Kernel where
  freeIn' :: Kernel -> FV
freeIn' Kernel
kernel =
    (Code KernelOp, [Exp], [GroupDim]) -> FV
forall a. FreeIn a => a -> FV
freeIn'
      ( Kernel -> Code KernelOp
kernelBody Kernel
kernel,
        Kernel -> [Exp]
kernelNumGroups Kernel
kernel,
        Kernel -> [GroupDim]
kernelGroupSize Kernel
kernel
      )

instance Pretty Kernel where
  pretty :: forall ann. Kernel -> Doc ann
pretty Kernel
kernel =
    Doc ann
"kernel"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace
        ( Doc ann
"groups"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace ([Exp] -> Doc ann
forall ann. [Exp] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Exp] -> Doc ann) -> [Exp] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Kernel -> [Exp]
kernelNumGroups Kernel
kernel)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"group_size"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
list ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (GroupDim -> Doc ann) -> [GroupDim] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp -> Doc ann) -> (KernelConst -> Doc ann) -> GroupDim -> Doc ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty KernelConst -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. KernelConst -> Doc ann
pretty) ([GroupDim] -> [Doc ann]) -> [GroupDim] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Kernel -> [GroupDim]
kernelGroupSize Kernel
kernel)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"uses"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (KernelUse -> Doc ann) -> [KernelUse] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map KernelUse -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. KernelUse -> Doc ann
pretty ([KernelUse] -> [Doc ann]) -> [KernelUse] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Kernel -> [KernelUse]
kernelUses Kernel
kernel)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"failure_tolerant"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace (Bool -> Doc ann
forall ann. Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Bool -> Doc ann) -> Bool -> Doc ann
forall a b. (a -> b) -> a -> b
$ Kernel -> Bool
kernelFailureTolerant Kernel
kernel)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"check_local_memory"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace (Bool -> Doc ann
forall ann. Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Bool -> Doc ann) -> Bool -> Doc ann
forall a b. (a -> b) -> a -> b
$ Kernel -> Bool
kernelCheckLocalMemory Kernel
kernel)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"body"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brace (Code KernelOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code KernelOp -> Doc ann
pretty (Code KernelOp -> Doc ann) -> Code KernelOp -> Doc ann
forall a b. (a -> b) -> a -> b
$ Kernel -> Code KernelOp
kernelBody Kernel
kernel)
        )

-- | When we do a barrier or fence, is it at the local or global
-- level?  By the 'Ord' instance, global is greater than local.
data Fence = FenceLocal | FenceGlobal
  deriving (Int -> Fence -> ShowS
[Fence] -> ShowS
Fence -> String
(Int -> Fence -> ShowS)
-> (Fence -> String) -> ([Fence] -> ShowS) -> Show Fence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fence -> ShowS
showsPrec :: Int -> Fence -> ShowS
$cshow :: Fence -> String
show :: Fence -> String
$cshowList :: [Fence] -> ShowS
showList :: [Fence] -> ShowS
Show, Fence -> Fence -> Bool
(Fence -> Fence -> Bool) -> (Fence -> Fence -> Bool) -> Eq Fence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fence -> Fence -> Bool
== :: Fence -> Fence -> Bool
$c/= :: Fence -> Fence -> Bool
/= :: Fence -> Fence -> Bool
Eq, Eq Fence
Eq Fence
-> (Fence -> Fence -> Ordering)
-> (Fence -> Fence -> Bool)
-> (Fence -> Fence -> Bool)
-> (Fence -> Fence -> Bool)
-> (Fence -> Fence -> Bool)
-> (Fence -> Fence -> Fence)
-> (Fence -> Fence -> Fence)
-> Ord Fence
Fence -> Fence -> Bool
Fence -> Fence -> Ordering
Fence -> Fence -> Fence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Fence -> Fence -> Ordering
compare :: Fence -> Fence -> Ordering
$c< :: Fence -> Fence -> Bool
< :: Fence -> Fence -> Bool
$c<= :: Fence -> Fence -> Bool
<= :: Fence -> Fence -> Bool
$c> :: Fence -> Fence -> Bool
> :: Fence -> Fence -> Bool
$c>= :: Fence -> Fence -> Bool
>= :: Fence -> Fence -> Bool
$cmax :: Fence -> Fence -> Fence
max :: Fence -> Fence -> Fence
$cmin :: Fence -> Fence -> Fence
min :: Fence -> Fence -> Fence
Ord)

-- | An operation that occurs within a kernel body.
data KernelOp
  = GetGroupId VName Int
  | GetLocalId VName Int
  | GetLocalSize VName Int
  | GetLockstepWidth VName
  | Atomic Space AtomicOp
  | Barrier Fence
  | MemFence Fence
  | LocalAlloc VName (Count Bytes (TExp Int64))
  | -- | Perform a barrier and also check whether any
    -- threads have failed an assertion.  Make sure all
    -- threads would reach all 'ErrorSync's if any of them
    -- do.  A failing assertion will jump to the next
    -- following 'ErrorSync', so make sure it's not inside
    -- control flow or similar.
    ErrorSync Fence
  deriving (Int -> KernelOp -> ShowS
[KernelOp] -> ShowS
KernelOp -> String
(Int -> KernelOp -> ShowS)
-> (KernelOp -> String) -> ([KernelOp] -> ShowS) -> Show KernelOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KernelOp -> ShowS
showsPrec :: Int -> KernelOp -> ShowS
$cshow :: KernelOp -> String
show :: KernelOp -> String
$cshowList :: [KernelOp] -> ShowS
showList :: [KernelOp] -> ShowS
Show)

-- | Atomic operations return the value stored before the update.
-- This old value is stored in the first 'VName'.  The second 'VName'
-- is the memory block to update.  The 'Exp' is the new value.
data AtomicOp
  = AtomicAdd IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicFAdd FloatType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicSMax IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicSMin IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicUMax IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicUMin IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicAnd IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicOr IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicXor IntType VName VName (Count Elements (TExp Int64)) Exp
  | AtomicCmpXchg PrimType VName VName (Count Elements (TExp Int64)) Exp Exp
  | AtomicXchg PrimType VName VName (Count Elements (TExp Int64)) Exp
  deriving (Int -> AtomicOp -> ShowS
[AtomicOp] -> ShowS
AtomicOp -> String
(Int -> AtomicOp -> ShowS)
-> (AtomicOp -> String) -> ([AtomicOp] -> ShowS) -> Show AtomicOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AtomicOp -> ShowS
showsPrec :: Int -> AtomicOp -> ShowS
$cshow :: AtomicOp -> String
show :: AtomicOp -> String
$cshowList :: [AtomicOp] -> ShowS
showList :: [AtomicOp] -> ShowS
Show)

instance FreeIn AtomicOp where
  freeIn' :: AtomicOp -> FV
freeIn' (AtomicAdd IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicFAdd FloatType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicSMax IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicSMin IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicUMax IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicUMin IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicAnd IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicOr IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicXor IntType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x
  freeIn' (AtomicCmpXchg PrimType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x Exp
y) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
y
  freeIn' (AtomicXchg PrimType
_ VName
_ VName
arr Count Elements (TExp Int64)
i Exp
x) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
arr FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
x

instance Pretty KernelOp where
  pretty :: forall ann. KernelOp -> Doc ann
pretty (GetGroupId VName
dest Int
i) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_group_id" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
  pretty (GetLocalId VName
dest Int
i) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_local_id" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
  pretty (GetLocalSize VName
dest Int
i) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_local_size" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
  pretty (GetLockstepWidth VName
dest) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"get_lockstep_width()"
  pretty (Barrier Fence
FenceLocal) =
    Doc ann
"local_barrier()"
  pretty (Barrier Fence
FenceGlobal) =
    Doc ann
"global_barrier()"
  pretty (MemFence Fence
FenceLocal) =
    Doc ann
"mem_fence_local()"
  pretty (MemFence Fence
FenceGlobal) =
    Doc ann
"mem_fence_global()"
  pretty (LocalAlloc VName
name Count Bytes (TExp Int64)
size) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"local_alloc" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Count Bytes (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Bytes (TExp Int64) -> Doc ann
pretty Count Bytes (TExp Int64)
size)
  pretty (ErrorSync Fence
FenceLocal) =
    Doc ann
"error_sync_local()"
  pretty (ErrorSync Fence
FenceGlobal) =
    Doc ann
"error_sync_global()"
  pretty (Atomic Space
_ (AtomicAdd IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_add_"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicFAdd FloatType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_fadd_"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FloatType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FloatType -> Doc ann
pretty FloatType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicSMax IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_smax"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicSMin IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_smin"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicUMax IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_umax"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicUMin IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_umin"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicAnd IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_and"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicOr IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_or"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicXor IntType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_xor"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntType -> Doc ann
pretty IntType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])
  pretty (Atomic Space
_ (AtomicCmpXchg PrimType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x Exp
y)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_cmp_xchg"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x, Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
y])
  pretty (Atomic Space
_ (AtomicXchg PrimType
t VName
old VName
arr Count Elements (TExp Int64)
ind Exp
x)) =
    VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
old
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"atomic_xchg"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
arr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
ind), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
x])

instance FreeIn KernelOp where
  freeIn' :: KernelOp -> FV
freeIn' (Atomic Space
_ AtomicOp
op) = AtomicOp -> FV
forall a. FreeIn a => a -> FV
freeIn' AtomicOp
op
  freeIn' KernelOp
_ = FV
forall a. Monoid a => a
mempty

brace :: Doc a -> Doc a
brace :: forall ann. Doc ann -> Doc ann
brace Doc a
body = Doc a
" {" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc a
body Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"}"