-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/NVVM/Compile.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE UnboxedTuples            #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.NVVM.Compile
-- Copyright : [2016..2023] Trevor L. McDonell
-- License   : BSD
--
-- Program compilation
--
--------------------------------------------------------------------------------

module Foreign.NVVM.Compile (

  Program,
  Result(..),
  CompileOption(..),

  compileModule, compileModules,

  create,
  destroy,
  addModule,     addModuleFromPtr,
  addModuleLazy, addModuleLazyFromPtr,
  compile,
  verify

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign.CUDA.Analysis
import Foreign.NVVM.Error
import Foreign.NVVM.Internal.C2HS

import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable

import Control.Exception
import Data.Word
import Text.Printf
import Data.ByteString                                              ( ByteString )
import Data.ByteString.Short                                        ( ShortByteString )
import qualified Data.ByteString.Char8                              as B
import qualified Data.ByteString.Unsafe                             as B
import qualified Data.ByteString.Internal                           as B
import qualified Data.ByteString.Short                              as BS
import qualified Data.ByteString.Short.Internal                     as BI

import GHC.Exts
import GHC.Base                                                     ( IO(..) )




{-# LINE 61 "./Foreign/NVVM/Compile.chs" #-}



-- | An NVVM program
--
newtype Program = Program { useProgram :: ((C2HSImp.Ptr ())) }
  deriving ( Eq, Show )

-- | The result of compiling an NVVM program.
--
data Result = Result
  { Result -> ByteString
compileResult :: !ByteString  -- ^ The compiled kernel, which can be loaded into the current program using 'Foreign.CUDA.Driver.loadData*'
  , Result -> ByteString
compileLog    :: !ByteString  -- ^ Warning messages generated by the compiler/verifier
  }

-- | Program compilation options
--
data CompileOption
  = OptimisationLevel !Int        -- ^ optimisation level, from 0 (disable optimisations) to 3 (default)
  | Target !Compute               -- ^ target architecture to compile for (default: compute 2.0)
  | FlushToZero                   -- ^ flush denormal values to zero when performing single-precision floating-point operations (default: no)
  | NoFMA                         -- ^ disable fused-multiply-add instructions (default: enabled)
  | FastSqrt                      -- ^ use a fast approximation for single-precision floating-point square root (default: no)
  | FastDiv                       -- ^ use a fast approximation for single-precision floating-point division and reciprocal (default: no)
  | GenerateDebugInfo             -- ^ generate debugging information (-g) (default: no)
  deriving ( CompileOption -> CompileOption -> Bool
(CompileOption -> CompileOption -> Bool)
-> (CompileOption -> CompileOption -> Bool) -> Eq CompileOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompileOption -> CompileOption -> Bool
== :: CompileOption -> CompileOption -> Bool
$c/= :: CompileOption -> CompileOption -> Bool
/= :: CompileOption -> CompileOption -> Bool
Eq, Int -> CompileOption -> ShowS
[CompileOption] -> ShowS
CompileOption -> String
(Int -> CompileOption -> ShowS)
-> (CompileOption -> String)
-> ([CompileOption] -> ShowS)
-> Show CompileOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileOption -> ShowS
showsPrec :: Int -> CompileOption -> ShowS
$cshow :: CompileOption -> String
show :: CompileOption -> String
$cshowList :: [CompileOption] -> ShowS
showList :: [CompileOption] -> ShowS
Show )


-- | Compile an NVVM IR module, in either bitcode or textual representation,
-- into PTX code.
--
{-# INLINEABLE compileModule #-}
compileModule
    :: ShortByteString            -- ^ name of the module
    -> ByteString                 -- ^ NVVM IR in either textual or bitcode representation
    -> [CompileOption]            -- ^ compiler options
    -> IO Result
compileModule :: ShortByteString -> ByteString -> [CompileOption] -> IO Result
compileModule !ShortByteString
name !ByteString
bs ![CompileOption]
opts =
  [(ShortByteString, ByteString)] -> [CompileOption] -> IO Result
compileModules [(ShortByteString
name,ByteString
bs)] [CompileOption]
opts


-- | Compile a collection of NVVM IR modules into PTX code
--
{-# INLINEABLE compileModules #-}
compileModules
    :: [(ShortByteString, ByteString)]  -- ^ (module name, module NVVM IR) pairs to compile
    -> [CompileOption]                  -- ^ compiler options
    -> IO Result
compileModules :: [(ShortByteString, ByteString)] -> [CompileOption] -> IO Result
compileModules ![(ShortByteString, ByteString)]
bss ![CompileOption]
opts =
  IO Program
-> (Program -> IO ()) -> (Program -> IO Result) -> IO Result
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Program
create Program -> IO ()
destroy ((Program -> IO Result) -> IO Result)
-> (Program -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Program
prg -> do
    ((ShortByteString, ByteString) -> IO ())
-> [(ShortByteString, ByteString)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ShortByteString -> ByteString -> IO ())
-> (ShortByteString, ByteString) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Program -> ShortByteString -> ByteString -> IO ()
addModule Program
prg)) [(ShortByteString, ByteString)]
bss
    (ByteString
messages, Maybe ByteString
result) <- Program -> [CompileOption] -> IO (ByteString, Maybe ByteString)
compile Program
prg [CompileOption]
opts
    case Maybe ByteString
result of
      Maybe ByteString
Nothing  -> String -> IO Result
forall a. String -> IO a
nvvmErrorIO (ByteString -> String
B.unpack ByteString
messages)
      Just ByteString
ptx -> Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Result
Result ByteString
ptx ByteString
messages


-- | Create an empty 'Program'
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g46a0ab04a063cba28bfbb41a1939e3f4>
--
{-# INLINEABLE create #-}
create :: IO ((Program))
create :: IO Program
create =
  (Ptr (Ptr ()) -> IO Program) -> IO Program
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO Program) -> IO Program)
-> (Ptr (Ptr ()) -> IO Program) -> IO Program
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' -> 
  Ptr (Ptr ()) -> IO CInt
create'_ Ptr (Ptr ())
a1' IO CInt -> (CInt -> IO Program) -> IO Program
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  CInt -> IO ()
checkStatus CInt
res IO () -> IO Program -> IO Program
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr (Ptr ()) -> IO Program
peekProgram  Ptr (Ptr ())
a1'IO Program -> (Program -> IO Program) -> IO Program
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Program
a1'' -> 
  Program -> IO Program
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program
a1'')

{-# LINE 127 "./Foreign/NVVM/Compile.chs" #-}



-- | Destroy a 'Program'
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1gfba94cab1224c0152841b80690d366aa>
--
{-# INLINEABLE destroy #-}
destroy :: (Program) -> IO ()
destroy :: Program -> IO ()
destroy Program
a1 =
  Program -> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a. Program -> (Ptr (Ptr ()) -> IO a) -> IO a
withProgram Program
a1 ((Ptr (Ptr ()) -> IO ()) -> IO ())
-> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' -> 
  Ptr (Ptr ()) -> IO CInt
destroy'_ Ptr (Ptr ())
a1' IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  CInt -> IO ()
checkStatus CInt
res IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 140 "./Foreign/NVVM/Compile.chs" #-}



-- | Add a module level NVVM IR to a program
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g0c22d2b9be033c165bc37b16f3ed75c6>
--
{-# INLINEABLE addModule #-}
addModule
    :: Program              -- ^ NVVM program to add to
    -> ShortByteString      -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)
    -> ByteString           -- ^ NVVM IR module in either bitcode or textual representation
    -> IO ()
addModule :: Program -> ShortByteString -> ByteString -> IO ()
addModule !Program
prg !ShortByteString
name !ByteString
bs =
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr,Int
len) ->
  Program -> ShortByteString -> Int -> Ptr Word8 -> IO ()
addModuleFromPtr Program
prg ShortByteString
name Int
len (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr)


-- | As with 'addModule', but read the specified number of bytes from the given
-- pointer.
--
{-# INLINEABLE addModuleFromPtr #-}
addModuleFromPtr
    :: Program              -- ^ NVVM program to add to
    -> ShortByteString      -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)
    -> Int                  -- ^ Number of bytes in the module
    -> Ptr Word8            -- ^ NVVM IR module in bitcode or textual representation
    -> IO ()
addModuleFromPtr :: Program -> ShortByteString -> Int -> Ptr Word8 -> IO ()
addModuleFromPtr !Program
prg !ShortByteString
name !Int
size !Ptr Word8
buffer =
  Program -> Ptr Word8 -> Int -> ShortByteString -> IO ()
nvvmAddModuleToProgram Program
prg Ptr Word8
buffer Int
size ShortByteString
name
  where
    nvvmAddModuleToProgram :: (Program) -> (Ptr Word8) -> (Int) -> (ShortByteString) -> IO ()
    nvvmAddModuleToProgram :: Program -> Ptr Word8 -> Int -> ShortByteString -> IO ()
nvvmAddModuleToProgram Program
a1 Ptr Word8
a2 Int
a3 ShortByteString
a4 =
      let {a1' :: Ptr ()
a1' = Program -> Ptr ()
useProgram Program
a1} in 
      let {a2' :: Ptr b
a2' = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
a2} in 
      let {a3' :: CULong
a3' = Int -> CULong
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a3} in 
      ShortByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ShortByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString ShortByteString
a4 ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a4' -> 
      Ptr () -> Ptr CChar -> CULong -> Ptr CChar -> IO CInt
nvvmAddModuleToProgram'_ Ptr ()
a1' Ptr CChar
forall {b}. Ptr b
a2' CULong
a3' Ptr CChar
a4' IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
      CInt -> IO ()
checkStatus CInt
res IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 179 "./Foreign/NVVM/Compile.chs" #-}



-- | Add a module level NVVM IR to a program.
--
-- The module is loaded lazily: only symbols required by modules loaded using
-- 'addModule' or 'addModuleFromPtr' will be loaded.
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g5356ce5063db232cd4330b666c62219b>
--
-- @since 0.9.0.0
--
{-# INLINEABLE addModuleLazy #-}
addModuleLazy
    :: Program              -- ^ NVVM program to add to
    -> ShortByteString      -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)
    -> ByteString           -- ^ NVVM IR module in either bitcode or textual representation
    -> IO ()
addModuleLazy :: Program -> ShortByteString -> ByteString -> IO ()
addModuleLazy !Program
prg !ShortByteString
name !ByteString
bs =
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buffer, Int
size) ->
  Program -> ShortByteString -> Int -> Ptr Word8 -> IO ()
addModuleLazyFromPtr Program
prg ShortByteString
name Int
size (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
buffer)


-- | As with 'addModuleLazy', but read the specified number of bytes from the
-- given pointer (the symbols are loaded lazily, the data in the buffer will be
-- read immediately).
--
-- Requires CUDA-10.0
--
-- @since 0.9.0.0
--
{-# INLINEABLE addModuleLazyFromPtr #-}
addModuleLazyFromPtr
    :: Program              -- ^ NVVM program to add to
    -> ShortByteString      -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)
    -> Int                  -- ^ Number of bytes in the module
    -> Ptr Word8            -- ^ NVVM IR in bitcode or textual representation
    -> IO ()
addModuleLazyFromPtr :: Program -> ShortByteString -> Int -> Ptr Word8 -> IO ()
addModuleLazyFromPtr !Program
prg !ShortByteString
name !Int
size !Ptr Word8
buffer =
  Program -> Ptr Word8 -> Int -> ShortByteString -> IO ()
nvvmLazyAddModuleToProgram Program
prg Ptr Word8
buffer Int
size ShortByteString
name
  where
    nvvmLazyAddModuleToProgram :: (Program) -> (Ptr Word8) -> (Int) -> (ShortByteString) -> IO ()
    nvvmLazyAddModuleToProgram :: Program -> Ptr Word8 -> Int -> ShortByteString -> IO ()
nvvmLazyAddModuleToProgram Program
a1 Ptr Word8
a2 Int
a3 ShortByteString
a4 =
      let {a1' :: Ptr ()
a1' = Program -> Ptr ()
useProgram Program
a1} in 
      let {a2' :: Ptr b
a2' = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
a2} in 
      let {a3' :: CULong
a3' = Int -> CULong
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a3} in 
      ShortByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ShortByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString ShortByteString
a4 ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a4' -> 
      Ptr () -> Ptr CChar -> CULong -> Ptr CChar -> IO CInt
nvvmLazyAddModuleToProgram'_ Ptr ()
a1' Ptr CChar
forall {b}. Ptr b
a2' CULong
a3' Ptr CChar
a4' IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
      CInt -> IO ()
checkStatus CInt
res IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 238 "./Foreign/NVVM/Compile.chs" #-}



-- | Compile the NVVM program. Returns the log from the compiler/verifier and,
-- if successful, the compiled program.
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g76ac1e23f5d0e2240e78be0e63450346>
--
{-# INLINEABLE compile #-}
compile :: Program -> [CompileOption] -> IO (ByteString, Maybe ByteString)
compile :: Program -> [CompileOption] -> IO (ByteString, Maybe ByteString)
compile !Program
prg ![CompileOption]
opts = do
  Status
status    <- [CompileOption]
-> (Int -> Ptr (Ptr CChar) -> IO Status) -> IO Status
forall a.
[CompileOption] -> (Int -> Ptr (Ptr CChar) -> IO a) -> IO a
withCompileOptions [CompileOption]
opts (Program -> Int -> Ptr (Ptr CChar) -> IO Status
nvvmCompileProgram Program
prg)
  ByteString
messages  <- IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
retrieve (Program -> IO Int
nvvmGetProgramLogSize Program
prg) (Program -> ForeignPtr Word8 -> IO ()
nvvmGetProgramLog Program
prg)
  case Status
status of
    Status
Success -> do ByteString
ptx <- IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
retrieve (Program -> IO Int
nvvmGetCompiledResultSize Program
prg) (Program -> ForeignPtr Word8 -> IO ()
nvvmGetCompiledResult Program
prg)
                  (ByteString, Maybe ByteString) -> IO (ByteString, Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
messages, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
ptx)
    Status
_       ->    (ByteString, Maybe ByteString) -> IO (ByteString, Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
messages, Maybe ByteString
forall a. Maybe a
Nothing)
  where
    nvvmCompileProgram :: (Program) -> (Int) -> (Ptr CString) -> IO ((Status))
    nvvmCompileProgram :: Program -> Int -> Ptr (Ptr CChar) -> IO Status
nvvmCompileProgram Program
a1 Int
a2 Ptr (Ptr CChar)
a3 =
      let {a1' :: Ptr ()
a1' = Program -> Ptr ()
useProgram Program
a1} in 
      let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a2} in 
      let {a3' :: Ptr (Ptr CChar)
a3' = Ptr (Ptr CChar) -> Ptr (Ptr CChar)
forall a. a -> a
id Ptr (Ptr CChar)
a3} in 
      Ptr () -> CInt -> Ptr (Ptr CChar) -> IO CInt
nvvmCompileProgram'_ Ptr ()
a1' CInt
a2' Ptr (Ptr CChar)
a3' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
      let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
      Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 262 "./Foreign/NVVM/Compile.chs" #-}


    nvvmGetCompiledResultSize :: (Program) -> IO ((Int))
    nvvmGetCompiledResultSize a1 =
      let {a1' = useProgram a1} in 
      alloca $ \a2' -> 
      nvvmGetCompiledResultSize'_ a1' a2' >>= \res ->
      checkStatus res >> 
      peekIntConv  a2'>>= \a2'' -> 
      return (a2'')

{-# LINE 269 "./Foreign/NVVM/Compile.chs" #-}


    nvvmGetCompiledResult :: (Program) -> (ForeignPtr Word8) -> IO ()
    nvvmGetCompiledResult a1 a2 =
      let {a1' = useProgram a1} in 
      withForeignPtr' a2 $ \a2' -> 
      nvvmGetCompiledResult'_ a1' a2' >>= \res ->
      checkStatus res >> 
      return ()

{-# LINE 276 "./Foreign/NVVM/Compile.chs" #-}



-- | Verify the NVVM program. Returns whether compilation will succeed, together
-- with any error or warning messages.
--
{-# INLINEABLE verify #-}
verify :: Program -> [CompileOption] -> IO (Status, ByteString)
verify :: Program -> [CompileOption] -> IO (Status, ByteString)
verify !Program
prg ![CompileOption]
opts = do
  Status
status   <- [CompileOption]
-> (Int -> Ptr (Ptr CChar) -> IO Status) -> IO Status
forall a.
[CompileOption] -> (Int -> Ptr (Ptr CChar) -> IO a) -> IO a
withCompileOptions [CompileOption]
opts (Program -> Int -> Ptr (Ptr CChar) -> IO Status
nvvmVerifyProgram Program
prg)
  ByteString
messages <- IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
retrieve (Program -> IO Int
nvvmGetProgramLogSize Program
prg) (Program -> ForeignPtr Word8 -> IO ()
nvvmGetProgramLog Program
prg)
  (Status, ByteString) -> IO (Status, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
status, ByteString
messages)
  where
    nvvmVerifyProgram :: (Program) -> (Int) -> (Ptr CString) -> IO ((Status))
    nvvmVerifyProgram :: Program -> Int -> Ptr (Ptr CChar) -> IO Status
nvvmVerifyProgram Program
a1 Int
a2 Ptr (Ptr CChar)
a3 =
      let {a1' :: Ptr ()
a1' = Program -> Ptr ()
useProgram Program
a1} in 
      let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a2} in 
      let {a3' :: Ptr (Ptr CChar)
a3' = Ptr (Ptr CChar) -> Ptr (Ptr CChar)
forall a. a -> a
id Ptr (Ptr CChar)
a3} in 
      Ptr () -> CInt -> Ptr (Ptr CChar) -> IO CInt
nvvmVerifyProgram'_ Ptr ()
a1' CInt
a2' Ptr (Ptr CChar)
a3' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
      let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
      Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 296 "./Foreign/NVVM/Compile.chs" #-}



nvvmGetProgramLogSize :: (Program) -> IO ((Int))
nvvmGetProgramLogSize :: Program -> IO Int
nvvmGetProgramLogSize Program
a1 =
  let {a1' :: Ptr ()
a1' = Program -> Ptr ()
useProgram Program
a1} in 
  (Ptr CULong -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO Int) -> IO Int)
-> (Ptr CULong -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a2' -> 
  Ptr () -> Ptr CULong -> IO CInt
nvvmGetProgramLogSize'_ Ptr ()
a1' Ptr CULong
a2' IO CInt -> (CInt -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  CInt -> IO ()
checkStatus CInt
res IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CULong -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CULong
a2'IO Int -> (Int -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a2'' -> 
  Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a2'')

{-# LINE 304 "./Foreign/NVVM/Compile.chs" #-}


nvvmGetProgramLog :: (Program) -> (ForeignPtr Word8) -> IO ()
nvvmGetProgramLog a1 a2 =
  let {a1' = useProgram a1} in 
  withForeignPtr' a2 $ \a2' -> 
  nvvmGetProgramLog'_ a1' a2' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 311 "./Foreign/NVVM/Compile.chs" #-}



-- Utilities
-- ---------

{-# INLINEABLE withForeignPtr' #-}
withForeignPtr' :: ForeignPtr Word8 -> (Ptr CChar -> IO a) -> IO a
withForeignPtr' :: forall a. ForeignPtr Word8 -> (Ptr CChar -> IO a) -> IO a
withForeignPtr' ForeignPtr Word8
fp Ptr CChar -> IO a
f = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (Ptr CChar -> IO a
f (Ptr CChar -> IO a)
-> (Ptr Word8 -> Ptr CChar) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr)


{-# INLINEABLE withCompileOptions #-}
withCompileOptions :: [CompileOption] -> (Int -> Ptr CString -> IO a) -> IO a
withCompileOptions :: forall a.
[CompileOption] -> (Int -> Ptr (Ptr CChar) -> IO a) -> IO a
withCompileOptions [CompileOption]
opts Int -> Ptr (Ptr CChar) -> IO a
next =
  (String -> (Ptr CChar -> IO a) -> IO a)
-> [String] -> ([Ptr CChar] -> IO a) -> IO a
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (Ptr CChar -> IO a) -> IO a
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString ((CompileOption -> String) -> [CompileOption] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CompileOption -> String
toStr [CompileOption]
opts) (([Ptr CChar] -> IO a) -> IO a) -> ([Ptr CChar] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cs -> [Ptr CChar] -> (Int -> Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Ptr CChar]
cs Int -> Ptr (Ptr CChar) -> IO a
next
  where
    toStr :: CompileOption -> String
    toStr :: CompileOption -> String
toStr (OptimisationLevel Int
n)  = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"-opt=%d" Int
n
    toStr (Target (Compute Int
n Int
m)) = String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"-arch=compute_%d%d" Int
n Int
m
    toStr CompileOption
FlushToZero            = String
"-ftz=1"
    toStr CompileOption
NoFMA                  = String
"-fma=0"
    toStr CompileOption
FastSqrt               = String
"-prec-sqrt=0"
    toStr CompileOption
FastDiv                = String
"-prec-div=0"
    toStr CompileOption
GenerateDebugInfo      = String
"-g"

{-# INLINEABLE retrieve #-}
retrieve :: IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
retrieve :: IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
retrieve IO Int
size ForeignPtr Word8 -> IO ()
fill = do
  Int
bytes <- IO Int
size
  if Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1             -- size includes NULL terminator
    then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
    else do ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
bytes
            ()
_  <- ForeignPtr Word8 -> IO ()
fill ForeignPtr Word8
fp
            ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
fp Int
0 Int
bytes)

{-# INLINEABLE peekProgram #-}
peekProgram :: Ptr ((C2HSImp.Ptr ())) -> IO Program
peekProgram :: Ptr (Ptr ()) -> IO Program
peekProgram Ptr (Ptr ())
p = Ptr () -> Program
Program (Ptr () -> Program) -> IO (Ptr ()) -> IO Program
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
p

{-# INLINEABLE withProgram #-}
withProgram :: Program -> (Ptr ((C2HSImp.Ptr ())) -> IO a) -> IO a
withProgram :: forall a. Program -> (Ptr (Ptr ()) -> IO a) -> IO a
withProgram Program
p = Ptr () -> (Ptr (Ptr ()) -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Program -> Ptr ()
useProgram Program
p)


-- [Short]ByteStrings are not null-terminated, so can't be passed directly to C.
--
-- unsafeUseAsCString :: ShortByteString -> CString
-- unsafeUseAsCString (BI.SBS ba#) = Ptr (byteArrayContents# ba#)

{-# INLINE useAsCString #-}
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString :: forall a. ShortByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (BI.SBS ByteArray#
ba#) Ptr CChar -> IO a
action = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  case ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#                              of { Int#
n# ->
  case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# (Int#
n# Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s0                 of { (# State# RealWorld
s1, MutableByteArray# RealWorld
mba# #) ->
  case ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
mba#)           of { Addr#
addr# ->
  case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# Int#
0# Addr#
addr# Int#
n# State# RealWorld
s1           of { State# RealWorld
s2 ->
  case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
addr# Int#
n# (Word# -> Word8#
wordToWord8# Word#
0##) State# RealWorld
s2 of { State# RealWorld
s3 ->
  case Ptr CChar -> IO a
action (Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
addr#)                                of { IO State# RealWorld -> (# State# RealWorld, a #)
action' ->
  case State# RealWorld -> (# State# RealWorld, a #)
action' State# RealWorld
s3                                        of { (# State# RealWorld
s4, a
r  #) ->
  case MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
mba# State# RealWorld
s4                                    of { State# RealWorld
s5 ->
  (# State# RealWorld
s5, a
r #)
 }}}}}}}}



foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmCreateProgram"
  create'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmDestroyProgram"
  destroy'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmAddModuleToProgram"
  nvvmAddModuleToProgram'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmLazyAddModuleToProgram"
  nvvmLazyAddModuleToProgram'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmCompileProgram"
  nvvmCompileProgram'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetCompiledResultSize"
  nvvmGetCompiledResultSize'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetCompiledResult"
  nvvmGetCompiledResult'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmVerifyProgram"
  nvvmVerifyProgram'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetProgramLogSize"
  nvvmGetProgramLogSize'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetProgramLog"
  nvvmGetProgramLog'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))