{-# LINE 1 "./Foreign/NVVM/Error.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Foreign.NVVM.Error (
Status(..),
describe,
resultIfOk, nothingIfOk, checkStatus,
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 (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq,Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
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 :: Status -> Status -> [Status]
enumFromTo Status
from Status
to = Status -> [Status]
forall {t}. Enum t => t -> [t]
go Status
from
where
end :: Int
end = Status -> Int
forall a. Enum a => a -> Int
fromEnum Status
to
go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
EQ -> [v]
Ordering
GT -> []
enumFrom :: Status -> [Status]
enumFrom Status
from = Status -> Status -> [Status]
forall a. Enum a => a -> a -> [a]
enumFromTo Status
from Status
CompilationFailure
fromEnum :: Status -> Int
fromEnum Status
Success = Int
0
fromEnum OutOfMemory = 1
fromEnum ProgramCreationFailure = 2
fromEnum Status
IRVersionMismatch = Int
3
fromEnum InvalidInput = 4
fromEnum InvalidProgram = 5
fromEnum Status
InvalidIR = Int
6
fromEnum InvalidOption = 7
fromEnum NoModuleInProgram = 8
fromEnum Status
CompilationFailure = Int
9
toEnum :: Int -> Status
toEnum Int
0 = Status
Success
toEnum Int
1 = Status
OutOfMemory
toEnum Int
2 = Status
ProgramCreationFailure
toEnum 3 = IRVersionMismatch
toEnum 4 = InvalidInput
toEnum Int
5 = Status
InvalidProgram
toEnum 6 = InvalidIR
toEnum 7 = InvalidOption
toEnum Int
8 = Status
NoModuleInProgram
toEnum Int
9 = Status
CompilationFailure
toEnum Int
unmatched = String -> Status
forall a. HasCallStack => String -> a
error (String
"Status.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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 -> IO ()
nothingIfOk Status
status =
case Status
status of
Status
Success -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Status
_ -> NVVMException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Status -> NVVMException
ExitCode Status
status)
{-# INLINE checkStatus #-}
checkStatus :: CInt -> IO ()
checkStatus :: CInt -> IO ()
checkStatus = Status -> IO ()
nothingIfOk (Status -> IO ()) -> (CInt -> Status) -> CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum
foreign import ccall unsafe "Foreign/NVVM/Error.chs.h nvvmGetErrorString"
describe'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))