{-# LINE 1 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module MXNet.Core.Types.Internal.Raw where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
{-# LINE 28 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
type NNUInt = CUInt
type MXUInt = CUInt
type MXFloat = CFloat
type OpHandle = C2HSImp.Ptr (())
{-# LINE 49 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
newtype SymbolHandle = SymbolHandle (C2HSImp.Ptr (SymbolHandle))
{-# LINE 65 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable SymbolHandle where
sizeOf (SymbolHandle t) = sizeOf t
alignment (SymbolHandle t) = alignment t
peek p = fmap SymbolHandle (peek (castPtr p))
poke p (SymbolHandle t) = poke (castPtr p) t
newtype GraphHandle = GraphHandle (C2HSImp.Ptr (GraphHandle))
{-# LINE 74 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable GraphHandle where
sizeOf (GraphHandle t) = sizeOf t
alignment (GraphHandle t) = alignment t
peek p = fmap GraphHandle (peek (castPtr p))
poke p (GraphHandle t) = poke (castPtr p) t
newtype NDArrayHandle = NDArrayHandle (C2HSImp.Ptr (NDArrayHandle))
{-# LINE 87 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable NDArrayHandle where
sizeOf (NDArrayHandle t) = sizeOf t
alignment (NDArrayHandle t) = alignment t
peek p = fmap NDArrayHandle (peek (castPtr p))
poke p (NDArrayHandle t) = poke (castPtr p) t
newtype FunctionHandle = FunctionHandle (C2HSImp.Ptr (FunctionHandle))
{-# LINE 96 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable FunctionHandle where
sizeOf (FunctionHandle t) = sizeOf t
alignment (FunctionHandle t) = alignment t
peek p = fmap FunctionHandle (peek (castPtr p))
poke p (FunctionHandle t) = poke (castPtr p) t
type AtomicSymbolCreator = OpHandle
newtype AtomicSymbolHandle = AtomicSymbolHandle (C2HSImp.Ptr (AtomicSymbolHandle))
{-# LINE 108 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable AtomicSymbolHandle where
sizeOf (AtomicSymbolHandle t) = sizeOf t
alignment (AtomicSymbolHandle t) = alignment t
peek p = fmap AtomicSymbolHandle (peek (castPtr p))
poke p (AtomicSymbolHandle t) = poke (castPtr p) t
newtype ExecutorHandle = ExecutorHandle (C2HSImp.Ptr (ExecutorHandle))
{-# LINE 116 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable ExecutorHandle where
sizeOf (ExecutorHandle t) = sizeOf t
alignment (ExecutorHandle t) = alignment t
peek p = fmap ExecutorHandle (peek (castPtr p))
poke p (ExecutorHandle t) = poke (castPtr p) t
newtype DataIterCreator = DataIterCreator (C2HSImp.Ptr (DataIterCreator))
{-# LINE 126 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable DataIterCreator where
sizeOf (DataIterCreator t) = sizeOf t
alignment (DataIterCreator t) = alignment t
peek p = fmap DataIterCreator (peek (castPtr p))
poke p (DataIterCreator t) = poke (castPtr p) t
newtype DataIterHandle = DataIterHandle (C2HSImp.Ptr (DataIterHandle))
{-# LINE 135 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable DataIterHandle where
sizeOf (DataIterHandle t) = sizeOf t
alignment (DataIterHandle t) = alignment t
peek p = fmap DataIterHandle (peek (castPtr p))
poke p (DataIterHandle t) = poke (castPtr p) t
newtype KVStoreHandle = KVStoreHandle (C2HSImp.Ptr (KVStoreHandle))
{-# LINE 144 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable KVStoreHandle where
sizeOf (KVStoreHandle t) = sizeOf t
alignment (KVStoreHandle t) = alignment t
peek p = fmap KVStoreHandle (peek (castPtr p))
poke p (KVStoreHandle t) = poke (castPtr p) t
newtype RecordIOHandle = RecordIOHandle (C2HSImp.Ptr (RecordIOHandle))
{-# LINE 153 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable RecordIOHandle where
sizeOf (RecordIOHandle t) = sizeOf t
alignment (RecordIOHandle t) = alignment t
peek p = fmap RecordIOHandle (peek (castPtr p))
poke p (RecordIOHandle t) = poke (castPtr p) t
newtype RtcHandle = RtcHandle (C2HSImp.Ptr (RtcHandle))
{-# LINE 162 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable RtcHandle where
sizeOf (RtcHandle t) = sizeOf t
alignment (RtcHandle t) = alignment t
peek p = fmap RtcHandle (peek (castPtr p))
poke p (RtcHandle t) = poke (castPtr p) t
newtype ExecutorMonitorCallback = ExecutorMonitorCallback (C2HSImp.FunPtr (ExecutorMonitorCallback))
{-# LINE 171 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
newtype CustomOpPropCreator = CustomOpPropCreator (C2HSImp.FunPtr (CustomOpPropCreator))
{-# LINE 174 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
type MXKVStoreUpdater = Int
-> NDArrayHandle
-> NDArrayHandle
-> Ptr ()
-> IO Int
foreign import ccall "wrapper"
makeMXKVStoreUpdater :: MXKVStoreUpdater -> IO (FunPtr MXKVStoreUpdater)
type MXKVStoreServerController = Int
-> Ptr CChar
-> Ptr ()
-> IO Int
foreign import ccall "wrapper"
makeMXKVStoreServerController :: MXKVStoreServerController -> IO (FunPtr MXKVStoreServerController)
newtype PredictorHandle = PredictorHandle (C2HSImp.Ptr (PredictorHandle))
{-# LINE 200 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable PredictorHandle where
sizeOf (PredictorHandle t) = sizeOf t
alignment (PredictorHandle t) = alignment t
peek p = fmap PredictorHandle (peek (castPtr p))
poke p (PredictorHandle t) = poke (castPtr p) t
newtype NDListHandle = NDListHandle (C2HSImp.Ptr (NDListHandle))
{-# LINE 209 "src/MXNet/Core/Types/Internal/Raw.chs" #-}
instance Storable NDListHandle where
sizeOf (NDListHandle t) = sizeOf t
alignment (NDListHandle t) = alignment t
peek p = fmap NDListHandle (peek (castPtr p))
poke p (NDListHandle t) = poke (castPtr p) t