-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/Cublas/Types.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.Cublas.Types (

  -- * Types
  Handle(..), Status(..),
  Operation(..),
  SideMode(..),FillMode(..), DiagType(..), PointerMode(..), AtomicsMode(..),

) where

import Foreign (Ptr)



{-# LINE 16 "./Foreign/CUDA/Cublas/Types.chs" #-}



-- | Types

newtype Handle = Handle { useHandle :: ((Ptr ()))}

data Status = Success
            | NotInitialized
            | AllocFailed
            | InvalidValue
            | ArchMismatch
            | MappingError
            | ExecutionFailed
            | InternalError
            | NotSupported
            deriving (Eq,Show)
instance Enum Status where
  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

  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 unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 25 "./Foreign/CUDA/Cublas/Types.chs" #-}


data Operation = N
               | T
               | C
               deriving (Eq,Show)
instance Enum Operation where
  fromEnum N = 0
  fromEnum T = 1
  fromEnum C = 2

  toEnum 0 = N
  toEnum 1 = T
  toEnum 2 = C
  toEnum unmatched = error ("Operation.toEnum: Cannot match " ++ show unmatched)

{-# LINE 29 "./Foreign/CUDA/Cublas/Types.chs" #-}


data SideMode = SideLeft
              | SideRight
              deriving (Eq,Show)
instance Enum SideMode where
  fromEnum SideLeft = 0
  fromEnum SideRight = 1

  toEnum 0 = SideLeft
  toEnum 1 = SideRight
  toEnum unmatched = error ("SideMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 33 "./Foreign/CUDA/Cublas/Types.chs" #-}


data FillMode = Lower
              | Upper
              deriving (Eq,Show)
instance Enum FillMode where
  fromEnum Lower = 0
  fromEnum Upper = 1

  toEnum 0 = Lower
  toEnum 1 = Upper
  toEnum unmatched = error ("FillMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 37 "./Foreign/CUDA/Cublas/Types.chs" #-}


data DiagType = NonUnit
              | Unit
              deriving (Eq,Show)
instance Enum DiagType where
  fromEnum NonUnit = 0
  fromEnum Unit = 1

  toEnum 0 = NonUnit
  toEnum 1 = Unit
  toEnum unmatched = error ("DiagType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 41 "./Foreign/CUDA/Cublas/Types.chs" #-}


data PointerMode = Host
                 | Device
                 deriving (Eq,Show)
instance Enum PointerMode where
  fromEnum Host = 0
  fromEnum Device = 1

  toEnum 0 = Host
  toEnum 1 = Device
  toEnum unmatched = error ("PointerMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 45 "./Foreign/CUDA/Cublas/Types.chs" #-}


data AtomicsMode = NotAllowed
                 | Allowed
                 deriving (Eq,Show)
instance Enum AtomicsMode where
  fromEnum NotAllowed = 0
  fromEnum Allowed = 1

  toEnum 0 = NotAllowed
  toEnum 1 = Allowed
  toEnum unmatched = error ("AtomicsMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 49 "./Foreign/CUDA/Cublas/Types.chs" #-}