-- |
-- Module      : Data.Array.Accelerate.LLVM.PTX.Link.Object
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.PTX.Link.Object
  where

import Data.Array.Accelerate.Lifetime
import Data.ByteString.Short.Char8                                  ( ShortByteString, unpack )
import Data.List
import qualified Foreign.CUDA.Driver                                as CUDA


-- | The kernel function table is a list of the kernels implemented by a given
-- CUDA device module
--
data FunctionTable  = FunctionTable { FunctionTable -> [Kernel]
functionTable :: [Kernel] }
data Kernel         = Kernel
  { Kernel -> ShortByteString
kernelName                  :: {-# UNPACK #-} !ShortByteString
  , Kernel -> Fun
kernelFun                   :: {-# UNPACK #-} !CUDA.Fun
  , Kernel -> Int
kernelSharedMemBytes        :: {-# UNPACK #-} !Int
  , Kernel -> Int
kernelThreadBlockSize       :: {-# UNPACK #-} !Int
  , Kernel -> Int -> Int
kernelThreadBlocks          :: (Int -> Int)
  }

instance Show FunctionTable where
  showsPrec :: Int -> FunctionTable -> ShowS
showsPrec Int
_ FunctionTable
f
    = String -> ShowS
showString String
"<<"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [ ShortByteString -> String
unpack (Kernel -> ShortByteString
kernelName Kernel
k) | Kernel
k <- FunctionTable -> [Kernel]
functionTable FunctionTable
f ])
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">>"

-- | Object code consists of executable code in the device address space
--
type ObjectCode = Lifetime CUDA.Module