{-# LINE 1 "./Foreign/NVVM/Error.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Foreign.NVVM.Error (
Status(..),
describe,
resultIfOk, nothingIfOk,
nvvmError, nvvmErrorIO, requireSDK,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
import Foreign.NVVM.Internal.C2HS
import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe
import Control.Exception
import Data.Typeable
import Language.Haskell.TH
import Text.Printf
{-# LINE 32 "./Foreign/NVVM/Error.chs" #-}
data Status = Success
| OutOfMemory
| ProgramCreationFailure
| IRVersionMismatch
| InvalidInput
| InvalidProgram
| InvalidIR
| InvalidOption
| NoModuleInProgram
| CompilationFailure
deriving (Eq,Show)
instance Enum Status where
succ Success = OutOfMemory
succ OutOfMemory = ProgramCreationFailure
succ ProgramCreationFailure = IRVersionMismatch
succ IRVersionMismatch = InvalidInput
succ InvalidInput = InvalidProgram
succ InvalidProgram = InvalidIR
succ InvalidIR = InvalidOption
succ InvalidOption = NoModuleInProgram
succ NoModuleInProgram = CompilationFailure
succ CompilationFailure = error "Status.succ: CompilationFailure has no successor"
pred OutOfMemory = Success
pred ProgramCreationFailure = OutOfMemory
pred IRVersionMismatch = ProgramCreationFailure
pred InvalidInput = IRVersionMismatch
pred InvalidProgram = InvalidInput
pred InvalidIR = InvalidProgram
pred InvalidOption = InvalidIR
pred NoModuleInProgram = InvalidOption
pred CompilationFailure = NoModuleInProgram
pred Success = error "Status.pred: Success has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CompilationFailure
fromEnum Success = 0
fromEnum OutOfMemory = 1
fromEnum ProgramCreationFailure = 2
fromEnum IRVersionMismatch = 3
fromEnum InvalidInput = 4
fromEnum InvalidProgram = 5
fromEnum InvalidIR = 6
fromEnum InvalidOption = 7
fromEnum NoModuleInProgram = 8
fromEnum CompilationFailure = 9
toEnum 0 = Success
toEnum 1 = OutOfMemory
toEnum 2 = ProgramCreationFailure
toEnum 3 = IRVersionMismatch
toEnum 4 = InvalidInput
toEnum 5 = InvalidProgram
toEnum 6 = InvalidIR
toEnum 7 = InvalidOption
toEnum 8 = NoModuleInProgram
toEnum 9 = CompilationFailure
toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)
{-# LINE 47 "./Foreign/NVVM/Error.chs" #-}
describe :: (Status) -> (String)
describe a1 =
C2HSImp.unsafePerformIO $
let {a1' = cFromEnum a1} in
describe'_ a1' >>= \res ->
peekCString res >>= \res' ->
return (res')
{-# LINE 57 "./Foreign/NVVM/Error.chs" #-}
data NVVMException
= ExitCode Status
| UserError String
deriving Typeable
instance Exception NVVMException
instance Show NVVMException where
showsPrec _ (ExitCode s) = showString ("NVVM Exception: " ++ describe s)
showsPrec _ (UserError s) = showString ("NVVM Exception: " ++ s)
{-# RULES "nvvmError/IO" nvvmError = nvvmErrorIO #-}
{-# NOINLINE [1] nvvmError #-}
nvvmError :: String -> a
nvvmError s = throw (UserError s)
nvvmErrorIO :: String -> IO a
nvvmErrorIO s = throwIO (UserError s)
requireSDK :: Name -> Double -> a
requireSDK n v = nvvmError $ printf "'%s' requires at least cuda-%3.1f\n" (show n) v
{-# INLINE resultIfOk #-}
resultIfOk :: (Status, a) -> IO a
resultIfOk (status, result) =
case status of
Success -> return $! result
_ -> throwIO (ExitCode status)
{-# INLINE nothingIfOk #-}
nothingIfOk :: Status -> IO ()
nothingIfOk status =
case status of
Success -> return ()
_ -> throwIO (ExitCode status)
foreign import ccall unsafe "Foreign/NVVM/Error.chs.h nvvmGetErrorString"
describe'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))