-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/NVVM/Info.chs" #-}
{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.NVVM.Info
-- Copyright : [2016] Trevor L. McDonell
-- License   : BSD
--
-- General information query
--
--------------------------------------------------------------------------------

module Foreign.NVVM.Info (

  nvvmVersion,
  nvvmIRVersion,

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



import Foreign.NVVM.Error
import Foreign.NVVM.Internal.C2HS
import Foreign.Marshal

import Data.Version
import System.IO.Unsafe




{-# LINE 29 "./Foreign/NVVM/Info.chs" #-}



-- | Get the version of NVVM IR supported by this library. The first component
-- is the NVVM IR version, and the second the version of the debug metadata.
--
-- Requires: CUDA-7.0
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__query.html#group__query_1g0894677934db095b3c40d4f8e2578cc5>
--
nvvmIRVersion :: (Version, Version)
nvvmIRVersion = unsafePerformIO $ do
  (status, r1, r2, d1, d2) <- c_nvvmIRVersion
  resultIfOk (status, (makeVersion [r1,r2], makeVersion [d1,d2]))

c_nvvmIRVersion :: IO ((Status), (Int), (Int), (Int), (Int))
c_nvvmIRVersion =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  c_nvvmIRVersion'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  peekIntConv  a1'>>= \a1'' -> 
  peekIntConv  a2'>>= \a2'' -> 
  peekIntConv  a3'>>= \a3'' -> 
  peekIntConv  a4'>>= \a4'' -> 
  return (res', a1'', a2'', a3'', a4'')

{-# LINE 56 "./Foreign/NVVM/Info.chs" #-}



-- | Get the version of the NVVM library
--
-- <http://docs.nvidia.com/cuda/libnvvm-api/group__query.html#group__query_1gcdd062f26078d20ded68f1017e999246>
--
nvvmVersion :: Version
nvvmVersion = unsafePerformIO $ do
  (status, v1, v2) <- c_nvvmVersion
  resultIfOk (status, makeVersion [v1,v2])

c_nvvmVersion :: IO ((Status), (Int), (Int))
c_nvvmVersion =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  c_nvvmVersion'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekIntConv  a1'>>= \a1'' -> 
  peekIntConv  a2'>>= \a2'' -> 
  return (res', a1'', a2'')

{-# LINE 74 "./Foreign/NVVM/Info.chs" #-}




foreign import ccall unsafe "Foreign/NVVM/Info.chs.h nvvmIRVersion"
  c_nvvmIRVersion'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/NVVM/Info.chs.h nvvmVersion"
  c_nvvmVersion'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))