{-# LINE 1 "./Foreign/CUDA/BLAS/Error.chs" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Foreign.CUDA.BLAS.Error
where
import Foreign.CUDA.BLAS.Internal.C2HS
import Control.Exception
import Data.Typeable
import Foreign.C.Types
import Language.Haskell.TH
import Text.Printf
{-# LINE 28 "./Foreign/CUDA/BLAS/Error.chs" #-}
data Status = Success
| NotInitialized
| AllocFailed
| InvalidValue
| ArchMismatch
| MappingError
| ExecutionFailed
| InternalError
| NotSupported
| LicenseError
deriving (Eq,Show)
instance Enum Status where
succ Success = NotInitialized
succ NotInitialized = AllocFailed
succ AllocFailed = InvalidValue
succ InvalidValue = ArchMismatch
succ ArchMismatch = MappingError
succ MappingError = ExecutionFailed
succ ExecutionFailed = InternalError
succ InternalError = NotSupported
succ NotSupported = LicenseError
succ LicenseError = error "Status.succ: LicenseError has no successor"
pred NotInitialized = Success
pred AllocFailed = NotInitialized
pred InvalidValue = AllocFailed
pred ArchMismatch = InvalidValue
pred MappingError = ArchMismatch
pred ExecutionFailed = MappingError
pred InternalError = ExecutionFailed
pred NotSupported = InternalError
pred LicenseError = NotSupported
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 LicenseError
fromEnum Success = 0
fromEnum NotInitialized = 1
fromEnum AllocFailed = 3
fromEnum InvalidValue = 7
fromEnum ArchMismatch = 8
fromEnum MappingError = 11
fromEnum ExecutionFailed = 13
fromEnum InternalError = 14
fromEnum NotSupported = 15
fromEnum LicenseError = 16
toEnum 0 = Success
toEnum 1 = NotInitialized
toEnum 3 = AllocFailed
toEnum 7 = InvalidValue
toEnum 8 = ArchMismatch
toEnum 11 = MappingError
toEnum 13 = ExecutionFailed
toEnum 14 = InternalError
toEnum 15 = NotSupported
toEnum 16 = LicenseError
toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)
{-# LINE 37 "./Foreign/CUDA/BLAS/Error.chs" #-}
describe :: Status -> String
describe Success = "success"
describe NotInitialized = "library not initialised"
describe AllocFailed = "resource allocation failed"
describe InvalidValue = "unsupported value or parameter passed to a function"
describe ArchMismatch = "unsupported on current architecture"
describe MappingError = "access to GPU memory failed"
describe ExecutionFailed = "execution failed"
describe InternalError = "internal error"
describe NotSupported = "not supported"
describe LicenseError = "license error"
data CUBLASException
= ExitCode Status
| UserError String
deriving Typeable
instance Exception CUBLASException
instance Show CUBLASException where
showsPrec _ (ExitCode s) = showString ("CUBLAS Exception: " ++ describe s)
showsPrec _ (UserError s) = showString ("CUBLAS Exception: " ++ s)
cublasError :: String -> IO a
cublasError s = throwIO (UserError s)
requireSDK :: Name -> Double -> IO a
requireSDK n v = cublasError $ 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)
{-# INLINE checkStatus #-}
checkStatus :: CInt -> IO ()
checkStatus = nothingIfOk . cToEnum