-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/MXNet/Core/Base/Internal/Raw.chs" #-}
-----------------------------------------------------------
-- |
-- module:                      MXNet.Core.Base.Internal.Raw
-- copyright:                   (c) 2016 Tao He
-- license:                     MIT
-- maintainer:                  sighingnow@gmail.com
--
-- Direct C FFI bindings for <mxnet/c_api.h>.
--
{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module MXNet.Core.Base.Internal.Raw where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable

import C2HS.C.Extra.Marshal

import MXNet.Core.Internal.Types.Raw
{-# LINE 27 "src/MXNet/Core/Base/Internal/Raw.chs" #-}




-- | Handle size_t type.

{-# LINE 32 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the string message of last error.
mxGetLastError :: IO ((String))
mxGetLastError =
  mxGetLastError'_ >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 37 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

-- | Seed the global random number generators in mxnet.
mxRandomSeed :: (Int) -> IO ((Int))
mxRandomSeed a1 =
  let {a1' = fromIntegral a1} in 
  mxRandomSeed'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 44 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Notify the engine about a shutdown.
mxNotifyShutdown :: IO ((Int))
mxNotifyShutdown =
  mxNotifyShutdown'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 49 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Set up configuration of profiler.
mxSetProfilerConfig :: (Int) -- ^ Mode, indicate the working mode of profiler, record anly symbolic  operator when mode == 0, record all operator when mode == 1.
 -> (String) -- ^ Filename, where to save trace file.
 -> IO ((Int))
mxSetProfilerConfig a1 a2 =
  let {a1' = fromIntegral a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  mxSetProfilerConfig'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 56 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Set up state of profiler.
mxSetProfilerState :: (Int) -- ^ State, indicate the working state of profiler, profiler not running  when state == 0, profiler running when state == 1.
 -> IO ((Int))
mxSetProfilerState a1 =
  let {a1' = fromIntegral a1} in 
  mxSetProfilerState'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 62 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Save profile and stop profiler.
mxDumpProfile :: IO ((Int))
mxDumpProfile =
  mxDumpProfile'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 67 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

-- | Create a NDArray handle that is not initialized.
mxNDArrayCreateNone :: IO ((Int), (NDArrayHandle)) -- ^ The returned NDArrayHandle.

mxNDArrayCreateNone =
  alloca $ \a1' -> 
  mxNDArrayCreateNone'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 75 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a NDArray with specified shape.
mxNDArrayCreate :: ([MXUInt]) -- ^ The shape of NDArray.
 -> (MXUInt) -- ^ The dimension of the shape.
 -> (Int) -- ^ Device type, specify device we want to take.
 -> (Int) -- ^ The device id of the specific device.
 -> (Int) -- ^ Whether to delay allocation until.
 -> IO ((Int), (NDArrayHandle)) -- ^ The returing handle.

mxNDArrayCreate a1 a2 a3 a4 a5 =
  withArray a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  alloca $ \a6' -> 
  mxNDArrayCreate'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a6'>>= \a6'' -> 
  return (res', a6'')

{-# LINE 86 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a NDArray with specified shape and data type.
mxNDArrayCreateEx :: ([MXUInt]) -> (MXUInt) -> (Int) -- ^ Device type, specify device we want to take.
 -> (Int) -- ^ The device id of the specific device.
 -> (Int) -- ^ Whether to delay allocation until.
 -> (Int) -- ^ Data type of created array.
 -> IO ((Int), (NDArrayHandle)) -- ^ The returing handle.

mxNDArrayCreateEx a1 a2 a3 a4 a5 a6 =
  withArray a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  let {a6' = fromIntegral a6} in 
  alloca $ \a7' -> 
  mxNDArrayCreateEx'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a7'>>= \a7'' -> 
  return (res', a7'')

{-# LINE 98 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a NDArray handle that is loaded from raw bytes.
mxNDArrayLoadFromRawBytes :: (Ptr ()) -- ^ The head of the raw bytes.
 -> (CSize) -- ^ Size of the raw bytes.
 -> IO ((Int), (NDArrayHandle))
mxNDArrayLoadFromRawBytes a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  mxNDArrayLoadFromRawBytes'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 105 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Save the NDArray into raw bytes.
mxNDArraySaveRawBytes :: (NDArrayHandle) -- ^ The NDArray handle.
 -> IO ((Int), (CSize), (Ptr CChar))
mxNDArraySaveRawBytes a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxNDArraySaveRawBytes'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 112 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Save list of narray into the file.
mxNDArraySave :: (String) -- ^ Name of the file.
 -> (MXUInt) -- ^ Number of arguments to save.
 -> ([NDArrayHandle]) -- ^ the array of NDArrayHandles to be saved.
 -> ([String]) -- ^ names of the NDArrays to save.
 -> IO ((Int))
mxNDArraySave a1 a2 a3 a4 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = id a2} in 
  withArray a3 $ \a3' -> 
  withStringArray a4 $ \a4' -> 
  mxNDArraySave'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 120 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxNDArrayLoadImpl :: (String) -- ^ Name of the file.
 -> IO ((Int), (MXUInt), (Ptr NDArrayHandle), (MXUInt), (Ptr (Ptr CChar)))
mxNDArrayLoadImpl a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  mxNDArrayLoadImpl'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peek  a5'>>= \a5'' -> 
  return (res', a2'', a3'', a4'', a5'')

{-# LINE 128 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Load list of narray from the file.
mxNDArrayLoad :: String                         -- ^ Name of the file.
              -> IO (Int,
                     MXUInt, [NDArrayHandle],
                     MXUInt, [String])          -- ^ The size of ndarray handles, ndarray
                                                -- handles the number of names and the
                                                -- returned names.
mxNDArrayLoad fname = do
    (res, c1, p1, c2, p2) <- mxNDArrayLoadImpl fname
    handles <- peekArray (fromIntegral c1) p1
    names <- peekStringArray c2 p2
    return (res, c1, handles, c2, names)

-- | Perform a synchronize copy from a continugous CPU memory region.
-- This is useful to copy data from existing memory region that are
-- not wrapped by NDArray (thus dependency not being tracked).
mxNDArraySyncCopyFromCPU :: (NDArrayHandle) -- ^ The NDArrayHandle.
 -> (Ptr ()) -- ^ The raw data source to copy from.
 -> (CSize) -- ^ The memory size want to copy from.
 -> IO ((Int))
mxNDArraySyncCopyFromCPU a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  mxNDArraySyncCopyFromCPU'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 150 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Perform a synchronize copy to a continugous CPU memory region.
mxNDArraySyncCopyToCPU :: (NDArrayHandle) -- ^ The NDArrayHandle.
 -> (Ptr ()) -- ^ The raw data source to copy into.
 -> (CSize) -- ^ The memory size want to copy into.
 -> IO ((Int))
mxNDArraySyncCopyToCPU a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  mxNDArraySyncCopyToCPU'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 157 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Wait until all the pending writes with respect NDArray are finished.
mxNDArrayWaitToRead :: (NDArrayHandle) -> IO ((Int))
mxNDArrayWaitToRead a1 =
  let {a1' = id a1} in 
  mxNDArrayWaitToRead'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 162 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Wait until all the pending read/write with respect NDArray are finished.
mxNDArrayWaitToWrite :: (NDArrayHandle) -> IO ((Int))
mxNDArrayWaitToWrite a1 =
  let {a1' = id a1} in 
  mxNDArrayWaitToWrite'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 167 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Wait until all delayed operations in the system is completed.
mxNDArrayWaitAll :: IO ((Int))
mxNDArrayWaitAll =
  mxNDArrayWaitAll'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 172 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Free the narray handle.
mxNDArrayFree :: (NDArrayHandle) -> IO ((Int))
mxNDArrayFree a1 =
  let {a1' = id a1} in 
  mxNDArrayFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 177 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Slice the NDArray along axis 0.
mxNDArraySlice :: (NDArrayHandle) -- ^ The handle to the NDArray.
 -> (MXUInt) -- ^ The beginning index of slice.
 -> (MXUInt) -- ^ The ending index of slice.
 -> IO ((Int), (NDArrayHandle)) -- ^ The NDArrayHandle of sliced NDArray.

mxNDArraySlice a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  alloca $ \a4' -> 
  mxNDArraySlice'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a4'>>= \a4'' -> 
  return (res', a4'')

{-# LINE 186 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Index the NDArray along axis 0.
mxNDArrayAt :: (NDArrayHandle) -- ^ The handle to the NDArray.
 -> (MXUInt) -- ^ The index.
 -> IO ((Int), (NDArrayHandle)) -- ^ The NDArrayHandle of output NDArray.

mxNDArrayAt a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  mxNDArrayAt'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 194 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Reshape the NDArray.
mxNDArrayReshape :: (NDArrayHandle) -- ^ The handle to the NDArray.
 -> (Int) -- ^ Number of dimensions of new shape.
 -> ([Int]) -- ^ New sizes of every dimension.
 -> IO ((Int), (NDArrayHandle)) -- ^ The new shape data and the NDArrayHandle of reshaped NDArray.

mxNDArrayReshape a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  withIntegralArray a3 $ \a3' -> 
  alloca $ \a4' -> 
  mxNDArrayReshape'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a4'>>= \a4'' -> 
  return (res', a4'')

{-# LINE 203 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxNDArrayGetShapeImpl :: (NDArrayHandle) -> IO ((Int), (MXUInt), (Ptr MXUInt))
mxNDArrayGetShapeImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxNDArrayGetShapeImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 209 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- Get the shape of the array.
mxNDArrayGetShape :: NDArrayHandle
                  -> IO (Int, MXUInt, [MXUInt]) -- ^ The output dimension and it's shape.
mxNDArrayGetShape handle = do
    (res, d, p) <- mxNDArrayGetShapeImpl handle
    shapes <- peekArray (fromIntegral d) p
    return (res, d, shapes)

-- | Get the content of the data in NDArray.
mxNDArrayGetData :: (NDArrayHandle) -- ^ The NDArray handle.
 -> IO ((Int), (Ptr MXFloat)) -- ^ Pointer holder to get pointer of data.

mxNDArrayGetData a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxNDArrayGetData'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 224 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the type of the data in NDArray
mxNDArrayGetDType :: (NDArrayHandle) -- ^ The NDArray handle.
 -> IO ((Int), (Int)) -- ^ The type of data in this NDArray handle.

mxNDArrayGetDType a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxNDArrayGetDType'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 231 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the context of the NDArray.
mxNDArrayGetContext :: (NDArrayHandle) -- ^ The NDArray handle.
 -> IO ((Int), (Int), (Int)) -- ^ The device type and device id.

mxNDArrayGetContext a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxNDArrayGetContext'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 239 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

mxListFunctionsImpl :: IO ((Int), (MXUInt), (Ptr FunctionHandle))
mxListFunctionsImpl =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  mxListFunctionsImpl'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a1'>>= \a1'' -> 
  peek  a2'>>= \a2'' -> 
  return (res', a1'', a2'')

{-# LINE 246 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List all the available functions handles.
mxListFunctions :: IO (Int, MXUInt, [FunctionHandle]) -- ^ The output function handle array.
mxListFunctions = do
    (res, c, p) <- mxListFunctionsImpl
    fs <- peekArray (fromIntegral c) p
    return (res, c, fs)

-- | Get the function handle by name.
mxGetFunction :: (String) -- ^ The name of the function.
 -> IO ((Int), (FunctionHandle)) -- ^ The corresponding function handle.

mxGetFunction a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxGetFunction'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 260 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxFuncGetInfoImpl :: (FunctionHandle) -> IO ((Int), (String), (String), (MXUInt), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (String))
mxFuncGetInfoImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \a8' -> 
  mxFuncGetInfoImpl'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  peekString  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peek  a5'>>= \a5'' -> 
  peek  a6'>>= \a6'' -> 
  peek  a7'>>= \a7'' -> 
  peekString  a8'>>= \a8'' -> 
  return (res', a2'', a3'', a4'', a5'', a6'', a7'', a8'')

{-# LINE 271 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the information of the function handle.
mxFuncGetInfo :: FunctionHandle                     -- ^ The target function handle.
              -> IO (Int,
                     String, String,
                     MXUInt,
                     [String], [String], [String],
                     String)                        -- ^ The name of returned function,
                                                    -- it's description, the number of it's
                                                    -- arguments, argument name, type and
                                                    -- descriptions, as well as the return
                                                    -- type of this function.
mxFuncGetInfo handle = do
    (res, name, desc, argc, argv, argtype, argdesc, rettype) <- mxFuncGetInfoImpl handle
    argv' <- peekStringArray argc argv
    argtype' <- peekStringArray argc argtype
    argdesc' <- peekStringArray argc argdesc
    return (res, name, desc, argc, argv', argtype', argdesc', rettype)

-- | Get the argument requirements of the function.
mxFuncDescribe :: (FunctionHandle) -> IO ((Int), (MXUInt), (MXUInt), (MXUInt), (Int)) -- ^ The number of NDArrays, scalar variables and mutable NDArrays to be  passed in, and the type mask of this function.

mxFuncDescribe a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  mxFuncDescribe'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peekIntegral  a5'>>= \a5'' -> 
  return (res', a2'', a3'', a4'', a5'')

{-# LINE 300 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Invoke a function, the array size of passed in arguments must match the values in the
-- @fun@ function.
mxFuncInvoke :: (FunctionHandle) -- ^ The function to invoke.
 -> ([NDArrayHandle]) -- ^ The normal NDArrays arguments.
 -> ([MXFloat]) -- ^ The scalar arguments.
 -> ([NDArrayHandle]) -- ^ The mutable NDArrays arguments.
 -> IO ((Int))
mxFuncInvoke a1 a2 a3 a4 =
  let {a1' = id a1} in 
  withArray a2 $ \a2' -> 
  withArray a3 $ \a3' -> 
  withArray a4 $ \a4' -> 
  mxFuncInvoke'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 309 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Invoke a function, the array size of passed in arguments must match the values in the
-- @fun@ function.
mxFuncInvokeEx :: (FunctionHandle) -- ^ The function to invoke.
 -> ([NDArrayHandle]) -- ^ The normal NDArrays arguments.
 -> ([MXFloat]) -- ^ The scalar arguments.
 -> ([NDArrayHandle]) -- ^ The mutable NDArrays arguments.
 -> (Int) -- ^ Number of keyword parameters.
 -> ([String]) -- ^ Keys for keyword parameters.
 -> ([String]) -- ^ Values for keyword parameters.
 -> IO ((Int))
mxFuncInvokeEx a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in 
  withArray a2 $ \a2' -> 
  withArray a3 $ \a3' -> 
  withArray a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  withStringArray a6 $ \a6' -> 
  withStringArray a7 $ \a7' -> 
  mxFuncInvokeEx'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 321 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Invoke a nnvm op and imperative function. FIXME
mxImperativeInvoke = undefined

-------------------------------------------------------------------------------

mxSymbolListAtomicSymbolCreatorsImpl :: IO ((Int), (MXUInt), (Ptr AtomicSymbolCreator))
mxSymbolListAtomicSymbolCreatorsImpl =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  mxSymbolListAtomicSymbolCreatorsImpl'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a1'>>= \a1'' -> 
  peek  a2'>>= \a2'' -> 
  return (res', a1'', a2'')

{-# LINE 331 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List all the available @AtomicSymbolCreator@.
mxSymbolListAtomicSymbolCreators
    :: IO (Int, MXUInt, [AtomicSymbolCreator])  -- ^ The number of atomic symbol creators and
                                                -- the atomic symbol creators list.
mxSymbolListAtomicSymbolCreators = do
    (res, n, p) <- mxSymbolListAtomicSymbolCreatorsImpl
    ss <- peekArray (fromIntegral n) p
    return (res, n, ss)

-- | Get the name of an atomic symbol.
mxSymbolGetAtomicSymbolName :: (AtomicSymbolCreator) -> IO ((Int), (String)) -- ^ Name of the target atomic symbol.

mxSymbolGetAtomicSymbolName a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxSymbolGetAtomicSymbolName'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 347 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolGetAtomicSymbolInfoImpl :: (AtomicSymbolCreator) -> ([String]) -> IO ((Int), (String), (String), (MXUInt), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (String))
mxSymbolGetAtomicSymbolInfoImpl a1 a8 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  withStringArray a8 $ \a8' -> 
  alloca $ \a9' -> 
  mxSymbolGetAtomicSymbolInfoImpl'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  peekString  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peek  a5'>>= \a5'' -> 
  peek  a6'>>= \a6'' -> 
  peek  a7'>>= \a7'' -> 
  peekString  a9'>>= \a9'' -> 
  return (res', a2'', a3'', a4'', a5'', a6'', a7'', a9'')

{-# LINE 359 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the detailed information about atomic symbol.
mxSymbolGetAtomicSymbolInfo
    :: AtomicSymbolCreator
    -> [String]                             -- ^ TODO document for this argument.
                                            -- The keyword arguments for specifying variable
                                            -- number of arguments.
    -> IO (Int, String, String, MXUInt,
           [String], [String], [String],
           String)                          -- ^ Return the name and description of the symbol,
                                            -- the name, type and description of it's arguments,
                                            -- as well as the return type of this symbol.
mxSymbolGetAtomicSymbolInfo creator kargs = do
    (res, name, desc, argc, argv, argtype, argdesc, rettype) <- mxSymbolGetAtomicSymbolInfoImpl creator kargs
    argv' <- peekStringArray argc argv
    argtype' <- peekStringArray argc argtype
    argdesc' <- peekStringArray argc argdesc
    return (res, name, desc, argc, argv', argtype', argdesc', rettype)

-- | Create an AtomicSymbol.
mxSymbolCreateAtomicSymbol :: (AtomicSymbolCreator) -- ^ The atomic symbol creator.
 -> (MXUInt) -- ^ The number of parameters.
 -> ([String]) -- ^ The keys of the parameters.
 -> ([String]) -- ^ The values of the parameters.
 -> IO ((Int), (SymbolHandle)) -- ^ The created symbol.

mxSymbolCreateAtomicSymbol a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  withStringArray a4 $ \a4' -> 
  alloca $ \a5' -> 
  mxSymbolCreateAtomicSymbol'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a5'>>= \a5'' -> 
  return (res', a5'')

{-# LINE 387 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a Variable Symbol.
mxSymbolCreateVariable :: (String) -- ^ Name of the variable.
 -> IO ((Int), (SymbolHandle)) -- ^ The created variable symbol.

mxSymbolCreateVariable a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxSymbolCreateVariable'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 394 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a Symbol by grouping list of symbols together.
mxSymbolCreateGroup :: (MXUInt) -- ^ Number of symbols to be grouped.
 -> ([SymbolHandle]) -> IO ((Int), (SymbolHandle)) -- ^ The created symbol group.

mxSymbolCreateGroup a1 a2 =
  let {a1' = id a1} in 
  withArray a2 $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolCreateGroup'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 402 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Load a symbol from a json file.
mxSymbolCreateFromFile :: (String) -- ^ The file name
 -> IO ((Int), (SymbolHandle))
mxSymbolCreateFromFile a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxSymbolCreateFromFile'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 408 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Load a symbol from a json string.
mxSymbolCreateFromJSON :: (String) -- ^ The json string.
 -> IO ((Int), (SymbolHandle))
mxSymbolCreateFromJSON a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxSymbolCreateFromJSON'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 414 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Save a symbol into a json file.
mxSymbolSaveToFile :: (SymbolHandle) -- ^ The symbol to save.
 -> (String) -- ^ The target file name.
 -> IO ((Int))
mxSymbolSaveToFile a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  mxSymbolSaveToFile'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 420 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Save a symbol into a json string.
mxSymbolSaveToJSON :: (SymbolHandle) -- ^ The symbol to save.
 -> IO ((Int), (String)) -- ^ The result json string.

mxSymbolSaveToJSON a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxSymbolSaveToJSON'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 427 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Free the symbol handle.
mxSymbolFree :: (SymbolHandle) -> IO ((Int))
mxSymbolFree a1 =
  let {a1' = id a1} in 
  mxSymbolFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 432 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Copy the symbol to another handle.
mxSymbolCopy :: (SymbolHandle) -> IO ((Int), (SymbolHandle))
mxSymbolCopy a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxSymbolCopy'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 438 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Print the content of symbol, used for debug.
mxSymbolPrint :: (SymbolHandle) -- ^ The symbol handle to print.
 -> IO ((Int), (String))
mxSymbolPrint a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxSymbolPrint'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 444 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get string name from symbol
mxSymbolGetName :: (SymbolHandle) -> IO ((Int), (String), (Int)) -- ^ The name of the symbol and whether the call is successful.

mxSymbolGetName a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolGetName'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 452 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get string attribute from symbol.
mxSymbolGetAttr :: (SymbolHandle) -- ^ The source symbol.
 -> (String) -- ^ The key of this attribute.
 -> IO ((Int), (String), (Int)) -- ^ The value of this attribute and whether the call is successful.

mxSymbolGetAttr a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  mxSymbolGetAttr'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a3'>>= \a3'' -> 
  peekIntegral  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 461 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Set string attribute from symbol. Setting attribute to a symbol can affect the semantics
-- (mutable/immutable) of symbolic graph.
mxSymbolSetAttr :: (SymbolHandle) -- ^ The source symbol.
 -> (String) -- ^ The name of the attribute.
 -> (String) -- ^ The value of the attribute.
 -> IO ((Int))
mxSymbolSetAttr a1 a2 a3 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  C2HSImp.withCString a3 $ \a3' -> 
  mxSymbolSetAttr'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 469 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolListAttrImpl :: (SymbolHandle) -> IO ((Int), (MXUInt), (Ptr (Ptr CChar)))
mxSymbolListAttrImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolListAttrImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 475 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get all attributes from symbol, including all descendents.
mxSymbolListAttr :: SymbolHandle
                 -> IO (Int, MXUInt, [String])  -- ^ The number of attributes and
                                                -- attributes list.
mxSymbolListAttr symbol = do
    (res, n, p) <- mxSymbolListAttrImpl symbol
    ss <- peekStringArray n p
    return (res, n, ss)

mxSymbolListAttrShallowImpl :: (SymbolHandle) -> IO ((Int), (MXUInt), (Ptr (Ptr CChar)))
mxSymbolListAttrShallowImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolListAttrShallowImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 490 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get all attributes from symbol, excluding descendents.
mxSymbolListAttrShallow :: SymbolHandle
                        -> IO (Int, MXUInt, [String])   -- ^ The number of attributes and
                                                        -- attributes list.
mxSymbolListAttrShallow symbol = do
    (res, n, p) <- mxSymbolListAttrShallowImpl symbol
    ss <- peekStringArray n p
    return (res, n, ss)

mxSymbolListArgumentsImpl :: (SymbolHandle) -> IO ((Int), (MXUInt), (Ptr (Ptr CChar)))
mxSymbolListArgumentsImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolListArgumentsImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 505 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List arguments in the symbol.
mxSymbolListArguments :: SymbolHandle
                      -> IO (Int, MXUInt, [String]) -- ^ The number of arguments and list of
                                                    -- arguments' names.
mxSymbolListArguments symbol = do
    (res, n, p) <- mxSymbolListArgumentsImpl symbol
    ss <- peekStringArray n p
    return (res, n, ss)

mxSymbolListOutputsImpl :: (SymbolHandle) -> IO ((Int), (MXUInt), (Ptr (Ptr CChar)))
mxSymbolListOutputsImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolListOutputsImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 520 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List returns in the symbol.
mxSymbolListOutputs :: SymbolHandle
                    -> IO (Int, MXUInt, [String])   -- ^ The number of outputs and list of
                                                    -- outputs' names.
mxSymbolListOutputs symbol = do
    (res, n, p) <- mxSymbolListOutputsImpl symbol
    ss <- peekStringArray n p
    return (res, n, ss)

-- | Get a symbol that contains all the internals.
mxSymbolGetInternals :: (SymbolHandle) -> IO ((Int), (SymbolHandle)) -- ^ The output symbol whose outputs are all the internals.

mxSymbolGetInternals a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxSymbolGetInternals'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 536 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get index-th outputs of the symbol.
mxSymbolGetOutput :: (SymbolHandle) -- ^ The symbol.
 -> (MXUInt) -- ^ Index of the output.
 -> IO ((Int), (SymbolHandle)) -- ^ The output symbol whose outputs are the index-th symbol.

mxSymbolGetOutput a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  mxSymbolGetOutput'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 544 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolListAuxiliaryStatesImpl :: (SymbolHandle) -> IO ((Int), (MXUInt), (Ptr (Ptr CChar)))
mxSymbolListAuxiliaryStatesImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxSymbolListAuxiliaryStatesImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 550 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List auxiliary states in the symbol.
mxSymbolListAuxiliaryStates
    :: SymbolHandle
    -> IO (Int, MXUInt, [String])   -- ^ The output size and the output string array.
mxSymbolListAuxiliaryStates symbol = do
    (res, n, p) <- mxSymbolListAuxiliaryStatesImpl symbol
    ss <- peekStringArray n p
    return (res, n, ss)

-- | Compose the symbol on other symbols.
mxSymbolCompose :: (SymbolHandle) -- ^ The symbol to apply.
 -> (String) -- ^ Name of the symbol.
 -> (MXUInt) -- ^ Number of arguments.
 -> ([String]) -- ^ Key of keyword arguments, optional.
 -> ([SymbolHandle]) -- ^ Arguments.
 -> IO ((Int))
mxSymbolCompose a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  withStringArray a4 $ \a4' -> 
  withArray a5 $ \a5' -> 
  mxSymbolCompose'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 568 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the gradient graph of the symbol.
mxSymbolGrad :: (SymbolHandle) -- ^ The symbol to get gradient.
 -> (MXUInt) -- ^ Number of arguments to get gradient.
 -> ([String]) -- ^ Names of the arguments to get gradient.
 -> IO ((Int), (SymbolHandle)) -- ^ Return the symbol that has gradient.

mxSymbolGrad a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  alloca $ \a4' -> 
  mxSymbolGrad'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a4'>>= \a4'' -> 
  return (res', a4'')

{-# LINE 577 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolInferShapeImpl :: (SymbolHandle) -> (MXUInt) -> ([String]) -> (Ptr MXUInt) -> (Ptr MXUInt) -> IO ((Int), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (Int))
mxSymbolInferShapeImpl a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \a8' -> 
  alloca $ \a9' -> 
  alloca $ \a10' -> 
  alloca $ \a11' -> 
  alloca $ \a12' -> 
  alloca $ \a13' -> 
  alloca $ \a14' -> 
  alloca $ \a15' -> 
  mxSymbolInferShapeImpl'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a6'>>= \a6'' -> 
  peek  a7'>>= \a7'' -> 
  peek  a8'>>= \a8'' -> 
  peek  a9'>>= \a9'' -> 
  peek  a10'>>= \a10'' -> 
  peek  a11'>>= \a11'' -> 
  peek  a12'>>= \a12'' -> 
  peek  a13'>>= \a13'' -> 
  peek  a14'>>= \a14'' -> 
  peekIntegral  a15'>>= \a15'' -> 
  return (res', a6'', a7'', a8'', a9'', a10'', a11'', a12'', a13'', a14'', a15'')

{-# LINE 595 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Infer shape of unknown input shapes given the known one.
mxSymbolInferShape :: SymbolHandle                          -- ^ Symbol handle.
                   -> MXUInt                                -- ^ Number of input arguments.
                   -> [String]                              -- ^ Number of input arguments.
                   -> Ptr MXUInt                            -- ^ Keys of keyword arguments, optional.
                   -> Ptr MXUInt                            -- ^ The head pointer of the rows in CSR
                   -> IO (Int,
                          (MXUInt, [MXUInt], [Ptr MXUInt]),
                          (MXUInt, [MXUInt], [Ptr MXUInt]),
                          (MXUInt, [MXUInt], [Ptr MXUInt]),
                          Int)                              -- ^ Return the in, out and auxiliary
                                                            -- shape size, ndim and data (array
                                                            -- of pointers to head of the input
                                                            -- shape), and whether infer shape
                                                            -- completes or more information is
                                                            -- needed.
mxSymbolInferShape sym argc keys indptr shapedata = do
    (res, in_size, in_ndim, in_data, out_size, out_ndim, out_data, aux_size, aux_ndim, aux_data, success) <- mxSymbolInferShapeImpl sym argc keys indptr shapedata
    in_ndim' <- peekArray (fromIntegral in_size) in_ndim
    in_data' <- peekArray (fromIntegral in_size) in_data
    out_ndim' <- peekArray (fromIntegral out_size) out_ndim
    out_data' <- peekArray (fromIntegral out_size) out_data
    aux_ndim' <- peekArray (fromIntegral aux_size) aux_ndim
    aux_data' <- peekArray (fromIntegral aux_size) aux_data
    return (res, (in_size, in_ndim', in_data'), (out_size, out_ndim', out_data'), (aux_size, aux_ndim', aux_data'), success)

mxSymbolInferShapePartialImpl :: (SymbolHandle) -> (MXUInt) -> ([String]) -> (Ptr MXUInt) -> (Ptr MXUInt) -> IO ((Int), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (MXUInt), (Ptr MXUInt), (Ptr (Ptr MXUInt)), (Int))
mxSymbolInferShapePartialImpl a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \a8' -> 
  alloca $ \a9' -> 
  alloca $ \a10' -> 
  alloca $ \a11' -> 
  alloca $ \a12' -> 
  alloca $ \a13' -> 
  alloca $ \a14' -> 
  alloca $ \a15' -> 
  mxSymbolInferShapePartialImpl'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a6'>>= \a6'' -> 
  peek  a7'>>= \a7'' -> 
  peek  a8'>>= \a8'' -> 
  peek  a9'>>= \a9'' -> 
  peek  a10'>>= \a10'' -> 
  peek  a11'>>= \a11'' -> 
  peek  a12'>>= \a12'' -> 
  peek  a13'>>= \a13'' -> 
  peek  a14'>>= \a14'' -> 
  peekIntegral  a15'>>= \a15'' -> 
  return (res', a6'', a7'', a8'', a9'', a10'', a11'', a12'', a13'', a14'', a15'')

{-# LINE 639 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Partially infer shape of unknown input shapes given the known one.
mxSymbolInferShapePartial
    :: SymbolHandle                             -- ^ Symbol handle.
    -> MXUInt                                   -- ^ Number of input arguments.
    -> [String]                                 -- ^ Number of input arguments.
    -> Ptr MXUInt                               -- ^ Keys of keyword arguments, optional.
    -> Ptr MXUInt                               -- ^ The head pointer of the rows in CSR
    -> IO (Int,
           (MXUInt, [MXUInt], [Ptr MXUInt]),
           (MXUInt, [MXUInt], [Ptr MXUInt]),
           (MXUInt, [MXUInt], [Ptr MXUInt]),
           Int)                                 -- ^ Return the in, out and auxiliary array's
                                                -- shape size, ndim and data (array of pointers
                                                -- to head of the input shape), and whether
                                                -- infer shape completes or more information is
                                                -- needed.
mxSymbolInferShapePartial sym argc keys indptr shapedata = do
    (res, in_size, in_ndim, in_data, out_size, out_ndim, out_data, aux_size, aux_ndim, aux_data, success) <- mxSymbolInferShapePartialImpl sym argc keys indptr shapedata
    in_ndim' <- peekArray (fromIntegral in_size) in_ndim
    in_data' <- peekArray (fromIntegral in_size) in_data
    out_ndim' <- peekArray (fromIntegral out_size) out_ndim
    out_data' <- peekArray (fromIntegral out_size) out_data
    aux_ndim' <- peekArray (fromIntegral aux_size) aux_ndim
    aux_data' <- peekArray (fromIntegral aux_size) aux_data
    return (res, (in_size, in_ndim', in_data'), (out_size, out_ndim', out_data'), (aux_size, aux_ndim', aux_data'), success)

-- | Infer type of unknown input types given the known one.
mxSymbolInferType :: (SymbolHandle) -- ^ Symbol handle.
 -> (MXUInt) -- ^ Number of input arguments.
 -> ([String]) -- ^ Key of keyword arguments, optional.
 -> (Ptr CInt) -- ^ The content of the CSR.
 -> IO ((Int), (MXUInt), (MXUInt), (MXUInt), (Int)) -- ^ Return the size and an array of pointers to head the input, output and  auxiliary type, as well as whether infer type completes or more information  is needed.

mxSymbolInferType a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  let {a4' = id a4} in 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \a8' -> 
  alloca $ \a9' -> 
  alloca $ \a10' -> 
  alloca $ \a11' -> 
  mxSymbolInferType'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a5'>>= \a5'' -> 
  peek  a7'>>= \a7'' -> 
  peek  a9'>>= \a9'' -> 
  peekIntegral  a11'>>= \a11'' -> 
  return (res', a5'', a7'', a9'', a11'')

{-# LINE 683 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

-- | Delete the executor.
mxExecutorFree :: (ExecutorHandle) -- ^ The executor handle.
 -> IO ((Int))
mxExecutorFree a1 =
  let {a1' = id a1} in 
  mxExecutorFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 690 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Print the content of execution plan, used for debug.
mxExecutorPrint :: (ExecutorHandle) -- ^ The executor handle.
 -> IO ((Int), (String))
mxExecutorPrint a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxExecutorPrint'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 696 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Executor forward method.
mxExecutorForward :: (ExecutorHandle) -- ^ The executor handle.
 -> (Int) -- ^ int value to indicate whether the forward pass is for  evaluation.
 -> IO ((Int))
mxExecutorForward a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  mxExecutorForward'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 703 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Excecutor run backward.
mxExecutorBackward :: (ExecutorHandle) -- ^ The executor handle.
 -> (MXUInt) -- ^ Length.
 -> ([NDArrayHandle]) -- ^ NDArray handle for heads' gradient.
 -> IO ((Int))
mxExecutorBackward a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withArray a3 $ \a3' -> 
  mxExecutorBackward'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 710 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxExecutorOutputsImpl :: (ExecutorHandle) -- ^ The executor handle.
 -> IO ((Int), (MXUInt), (Ptr NDArrayHandle))
mxExecutorOutputsImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxExecutorOutputsImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 716 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get executor's head NDArray.
mxExecutorOutputs :: ExecutorHandle             -- ^ The executor handle.
                  -> IO (Int, [NDArrayHandle])  -- ^ The handles for outputs.
mxExecutorOutputs handle = do
    (r, c, p) <- mxExecutorOutputsImpl handle
    handles <- peekArray (fromIntegral c) p
    return (r, handles)

-- | Generate Executor from symbol.
mxExecutorBind :: (SymbolHandle) -- ^ The symbol handle.
 -> (Int) -- ^ Device type.
 -> (Int) -- ^ Device id.
 -> (MXUInt) -- ^ Length of arrays in arguments.
 -> ([NDArrayHandle]) -- ^ In array.
 -> ([NDArrayHandle]) -- ^ Grads handle array.
 -> ([MXUInt]) -- ^ Grad req array.
 -> (MXUInt) -- ^ Length of auxiliary states.
 -> ([NDArrayHandle]) -- ^ Auxiliary states array.
 -> IO ((Int), (ExecutorHandle))
mxExecutorBind a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  withArray a5 $ \a5' -> 
  withArray a6 $ \a6' -> 
  withArray a7 $ \a7' -> 
  let {a8' = id a8} in 
  withArray a9 $ \a9' -> 
  alloca $ \a10' -> 
  mxExecutorBind'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a10'>>= \a10'' -> 
  return (res', a10'')

{-# LINE 738 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Generate Executor from symbol. This is advanced function, allow specify group2ctx map.
-- The user can annotate "ctx_group" attribute to name each group.
mxExecutorBindX :: (SymbolHandle) -- ^ The symbol handle.
 -> (Int) -- ^ Device type of default context.
 -> (Int) -- ^ Device id of default context.
 -> (MXUInt) -- ^ Size of group2ctx map.
 -> ([String]) -- ^ Keys of group2ctx map.
 -> ([Int]) -- ^ Device type of group2ctx map.
 -> ([Int]) -- ^ Device id of group2ctx map.
 -> (MXUInt) -- ^ Length of arrays in arguments.
 -> ([NDArrayHandle]) -- ^ In array.
 -> ([NDArrayHandle]) -- ^ Grads handle array.
 -> ([MXUInt]) -- ^ Grad req array.
 -> (MXUInt) -- ^ Length of auxiliary states.
 -> ([NDArrayHandle]) -- ^ Auxiliary states array.
 -> IO ((Int), (ExecutorHandle))
mxExecutorBindX a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  withStringArray a5 $ \a5' -> 
  withIntegralArray a6 $ \a6' -> 
  withIntegralArray a7 $ \a7' -> 
  let {a8' = id a8} in 
  withArray a9 $ \a9' -> 
  withArray a10 $ \a10' -> 
  withArray a11 $ \a11' -> 
  let {a12' = id a12} in 
  withArray a13 $ \a13' -> 
  alloca $ \a14' -> 
  mxExecutorBindX'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a14'>>= \a14'' -> 
  return (res', a14'')

{-# LINE 757 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Generate Executor from symbol. This is advanced function, allow specify group2ctx map.
-- The user can annotate "ctx_group" attribute to name each group.
mxExecutorBindEX :: (SymbolHandle) -- ^ The symbol handle.
 -> (Int) -- ^ Device type of default context.
 -> (Int) -- ^ Device id of default context.
 -> (MXUInt) -- ^ Size of group2ctx map.
 -> ([String]) -- ^ Keys of group2ctx map.
 -> ([Int]) -- ^ Device type of group2ctx map.
 -> ([Int]) -- ^ Device id of group2ctx map.
 -> (MXUInt) -- ^ Length of arrays in arguments.
 -> ([NDArrayHandle]) -- ^ In array.
 -> ([NDArrayHandle]) -- ^ Grads handle array.
 -> ([MXUInt]) -- ^ Grad req array.
 -> (MXUInt) -- ^ Length of auxiliary states.
 -> ([NDArrayHandle]) -- ^ Auxiliary states array.
 -> (ExecutorHandle) -- ^ Input executor handle for memory sharing.
 -> IO ((Int), (ExecutorHandle))
mxExecutorBindEX a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  withStringArray a5 $ \a5' -> 
  withIntegralArray a6 $ \a6' -> 
  withIntegralArray a7 $ \a7' -> 
  let {a8' = id a8} in 
  withArray a9 $ \a9' -> 
  withArray a10 $ \a10' -> 
  withArray a11 $ \a11' -> 
  let {a12' = id a12} in 
  withArray a13 $ \a13' -> 
  let {a14' = id a14} in 
  alloca $ \a15' -> 
  mxExecutorBindEX'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a15'>>= \a15'' -> 
  return (res', a15'')

{-# LINE 777 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Set a call back to notify the completion of operation.
mxExecutorSetMonitorCallback :: (ExecutorHandle) -- ^ The executor handle.
 -> (ExecutorMonitorCallback) -> (Ptr ()) -> IO ((Int))
mxExecutorSetMonitorCallback a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  mxExecutorSetMonitorCallback'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 784 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

mxListDataItersImpl :: IO ((Int), (MXUInt), (Ptr DataIterCreator))
mxListDataItersImpl =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  mxListDataItersImpl'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a1'>>= \a1'' -> 
  peek  a2'>>= \a2'' -> 
  return (res', a1'', a2'')

{-# LINE 791 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List all the available iterator entries.
mxListDataIters :: IO (Int, [DataIterCreator]) -- ^ The output iterator entries.
mxListDataIters = do
    (res, c, p) <- mxListDataItersImpl
    creators <- peekArray (fromIntegral c) p
    return (res, creators)

-- | Init an iterator, init with parameters the array size of passed in arguments.
mxDataIterCreateIter :: (DataIterCreator) -- ^ The handle pointer to the data iterator.
 -> (MXUInt) -- ^ Size of arrays in arguments.
 -> ([String]) -- ^ Parameter keys.
 -> ([String]) -- ^ Parameter values.
 -> IO ((Int), (DataIterHandle))
mxDataIterCreateIter a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  withStringArray a4 $ \a4' -> 
  alloca $ \a5' -> 
  mxDataIterCreateIter'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a5'>>= \a5'' -> 
  return (res', a5'')

{-# LINE 807 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxDataIterGetIterInfoImpl :: (DataIterCreator) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (String), (String), (MXUInt), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)))
mxDataIterGetIterInfoImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  mxDataIterGetIterInfoImpl'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  peekString  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  peek  a5'>>= \a5'' -> 
  peek  a6'>>= \a6'' -> 
  peek  a7'>>= \a7'' -> 
  return (res', a2'', a3'', a4'', a5'', a6'', a7'')

{-# LINE 817 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the detailed information about data iterator.
mxDataIterGetIterInfo :: DataIterCreator                    -- ^ The handle pointer to the
                                                            -- data iterator.
                      -> IO (Int, String, String,
                             MXUInt,
                             [String], [String], [String])  -- ^ Return the name and description
                                                            -- of the data iter creator,
                                                            -- the name, type and description of
                                                            -- it's arguments, as well as the
                                                            -- return type of this symbol.
mxDataIterGetIterInfo creator = do
    (res, name, desc, argc, argv, argtype, argdesc) <- mxDataIterGetIterInfoImpl creator
    argv' <- peekStringArray argc argv
    argtype' <- peekStringArray argc argtype
    argdesc' <- peekStringArray argc argdesc
    return (res, name, desc, argc, argv', argtype', argdesc')

-- | Get the detailed information about data iterator.

-- | Free the handle to the IO module.
mxDataIterFree :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int))
mxDataIterFree a1 =
  let {a1' = id a1} in 
  mxDataIterFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 841 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Move iterator to next position.
mxDataIterNext :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (Int))
mxDataIterNext a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxDataIterNext'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 847 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Call iterator.Reset.
mxDataIterBeforeFirst :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int))
mxDataIterBeforeFirst a1 =
  let {a1' = id a1} in 
  mxDataIterBeforeFirst'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 852 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the handle to the NDArray of underlying data.
mxDataIterGetData :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (NDArrayHandle))
mxDataIterGetData a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxDataIterGetData'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 858 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxDataIterGetIndexImpl :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (Ptr CULong), (CULong))
mxDataIterGetIndexImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  mxDataIterGetIndexImpl'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 872 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the image index by array.
mxDataIterGetIndex :: DataIterHandle        -- ^ The handle pointer to the data iterator.
                   -> IO (Int, [CULong])    -- ^ Output indices of the array.
mxDataIterGetIndex creator = do
    (res, p, c) <- mxDataIterGetIndexImpl creator
    indices <- peekArray (fromIntegral c) p
    return (res, indices)

-- | Get the padding number in current data batch.
mxDataIterGetPadNum :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (Int))
mxDataIterGetPadNum a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxDataIterGetPadNum'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 890 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the handle to the NDArray of underlying label.
mxDataIterGetLabel :: (DataIterHandle) -- ^ The handle pointer to the data iterator.
 -> IO ((Int), (NDArrayHandle))
mxDataIterGetLabel a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxDataIterGetLabel'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 896 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

-- | Initialized ps-lite environment variables.
mxInitPSEnv :: (MXUInt) -- ^ Number of variables to initialize.
 -> ([String]) -- ^ Environment keys.
 -> ([String]) -- ^ Environment values.
 -> IO ((Int))
mxInitPSEnv a1 a2 a3 =
  let {a1' = id a1} in 
  withStringArray a2 $ \a2' -> 
  withStringArray a3 $ \a3' -> 
  mxInitPSEnv'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 905 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a kvstore.
mxKVStoreCreate :: (String) -- ^ The type of KVStore.
 -> IO ((Int), (KVStoreHandle))
mxKVStoreCreate a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxKVStoreCreate'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 911 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Delete a KVStore handle.
mxKVStoreFree :: (KVStoreHandle) -- ^ Handle to the kvstore.
 -> IO ((Int))
mxKVStoreFree a1 =
  let {a1' = id a1} in 
  mxKVStoreFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 916 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Init a list of (key,value) pairs in kvstore.
mxKVStoreInit :: (KVStoreHandle) -- ^ Handle to the kvstore.
 -> (MXUInt) -- ^ The number of key-value pairs.
 -> ([Int]) -- ^ The list of keys.
 -> ([NDArrayHandle]) -- ^ The list of values.
 -> IO ((Int))
mxKVStoreInit a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntegralArray a3 $ \a3' -> 
  withArray a4 $ \a4' -> 
  mxKVStoreInit'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 924 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Push a list of (key,value) pairs to kvstore.
mxKVStorePush :: (KVStoreHandle) -- ^ Handle to the kvstore.
 -> (MXUInt) -- ^ The number of key-value pairs.
 -> ([Int]) -- ^ The list of keys.
 -> ([NDArrayHandle]) -- ^ The list of values.
 -> (Int) -- ^ The priority of the action.
 -> IO ((Int))
mxKVStorePush a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntegralArray a3 $ \a3' -> 
  withArray a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  mxKVStorePush'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 933 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | FIXME Pull a list of (key, value) pairs from the kvstore.
mxKVStorePull :: (KVStoreHandle) -- ^ Handle to the kvstore.
 -> (MXUInt) -- ^ The number of key-value pairs.
 -> ([Int]) -- ^ The list of keys.
 -> ([NDArrayHandle]) -- ^ The list of values.
 -> (Int) -- ^ The priority of the action.
 -> IO ((Int))
mxKVStorePull a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntegralArray a3 $ \a3' -> 
  withArray a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  mxKVStorePull'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 942 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | FIXME Register an push updater.
mxKVStoreSetUpdater = undefined
{-
{#fun  as
    { id `KVStoreHandle'
    , id `MXUInt'
    } -> `Int' #}
-}

-- | Get the type of the kvstore.
mxKVStoreGetType :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> IO ((Int), (String))
mxKVStoreGetType a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxKVStoreGetType'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 957 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-------------------------------------------------------------------------------

-- | The rank of this node in its group, which is in [0, GroupSize).
mxKVStoreGetRank :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> IO ((Int), (Int))
mxKVStoreGetRank a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxKVStoreGetRank'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 965 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | The number of nodes in this group, which is
--
--      * number of workers if if `IsWorkerNode() == true`,
--      * number of servers if if `IsServerNode() == true`,
--      * 1 if `IsSchedulerNode() == true`.
mxKVStoreGetGroupSize :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> IO ((Int), (Int))
mxKVStoreGetGroupSize a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  mxKVStoreGetGroupSize'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 975 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Return whether or not this process is a worker node.
mxKVStoreIsWorkerNode :: IO ((Int), (Int))
mxKVStoreIsWorkerNode =
  alloca $ \a1' -> 
  mxKVStoreIsWorkerNode'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 980 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Return whether or not this process is a server node.
mxKVStoreIsServerNode :: IO ((Int), (Int))
mxKVStoreIsServerNode =
  alloca $ \a1' -> 
  mxKVStoreIsServerNode'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 985 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Return whether or not this process is a scheduler node.
mxKVStoreIsSchedulerNode :: IO ((Int), (Int))
mxKVStoreIsSchedulerNode =
  alloca $ \a1' -> 
  mxKVStoreIsSchedulerNode'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 990 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Global barrier among all worker machines.
mxKVStoreBarrier :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> IO ((Int))
mxKVStoreBarrier a1 =
  let {a1' = id a1} in 
  mxKVStoreBarrier'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 995 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Whether to do barrier when finalize.
mxKVStoreSetBarrierBeforeExit :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> (Int) -- ^ Whether to do barrier when kvstore finalize
 -> IO ((Int))
mxKVStoreSetBarrierBeforeExit a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  mxKVStoreSetBarrierBeforeExit'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1001 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | FIXME  Run as server (or scheduler).
mxKVStoreRunServer = undefined
{-
{#fun MXKVStoreRunServer as mxKVStoreRunServer
    { id `KVStoreHandle'
    , id `MXUInt'
    } -> `Int' #}
-}

-- | Send a command to all server nodes.
mxKVStoreSendCommmandToServers :: (KVStoreHandle) -- ^ Handle to the KVStore.
 -> (Int) -- ^ The head of the command.
 -> (String) -- ^ The body of the command.
 -> IO ((Int))
mxKVStoreSendCommmandToServers a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  C2HSImp.withCString a3 $ \a3' -> 
  mxKVStoreSendCommmandToServers'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1017 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the number of ps dead node(s) specified by {node_id}.
mxKVStoreGetNumDeadNode :: (KVStoreHandle) -- ^ Handle to the kvstore.
 -> (Int) -- ^ node id, can be a node group or a single node.  kScheduler = 1, kServerGroup = 2, kWorkerGroup = 4
 -> (Int) -- ^ A node fails to send heartbeart in {timeout_sec}  seconds will be presumed as 'dead'
 -> IO ((Int), (Int))
mxKVStoreGetNumDeadNode a1 a2 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  let {a4' = fromIntegral a4} in 
  mxKVStoreGetNumDeadNode'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 1027 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a RecordIO writer object.
mxRecordIOWriterCreate :: (String) -- ^ Path to file.
 -> IO ((Int), (RecordIOHandle))
mxRecordIOWriterCreate a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxRecordIOWriterCreate'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 1033 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Delete a RecordIO writer object.
mxRecordIOWriterFree :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> IO ((Int))
mxRecordIOWriterFree a1 =
  let {a1' = id a1} in 
  mxRecordIOWriterFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1038 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Write a record to a RecordIO object.
mxRecordIOWriterWriteRecord :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> (Ptr CChar) -- ^ Buffer to write.
 -> (CSize) -- ^ Size of buffer.
 -> IO ((Int))
mxRecordIOWriterWriteRecord a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  mxRecordIOWriterWriteRecord'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1045 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get the current writer pointer position.
mxRecordIOWriterTell :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> (Ptr CSize) -- ^ Handle to output position.
 -> IO ((Int))
mxRecordIOWriterTell a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  mxRecordIOWriterTell'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1051 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a RecordIO reader object.
mxRecordIOReaderCreate :: (String) -- ^ Path to file.
 -> IO ((Int), (RecordIOHandle))
mxRecordIOReaderCreate a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  mxRecordIOReaderCreate'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 1057 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Delete a RecordIO reader object.
mxRecordIOReaderFree :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> IO ((Int))
mxRecordIOReaderFree a1 =
  let {a1' = id a1} in 
  mxRecordIOReaderFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1062 "src/MXNet/Core/Base/Internal/Raw.chs" #-}



-- | Write a record to a RecordIO object.
mxRecordIOReaderReadRecord :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> (Ptr (Ptr CChar)) -- ^ Pointer to return buffer.
 -> IO ((Int), (CSize))
mxRecordIOReaderReadRecord a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  mxRecordIOReaderReadRecord'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 1070 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Set the current reader pointer position.
mxRecordIOReaderSeek :: (RecordIOHandle) -- ^ Handle to RecordIO object.
 -> (CSize) -- ^ Target position.
 -> IO ((Int))
mxRecordIOReaderSeek a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  mxRecordIOReaderSeek'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1076 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Create a MXRtc object.
mxRtcCreate :: (String) -- ^ Name.
 -> (MXUInt) -- ^ Number of inputs.
 -> (MXUInt) -- ^ Number of outputs.
 -> ([String]) -- ^ Input names.
 -> ([String]) -- ^ Output names.
 -> ([NDArrayHandle]) -- ^ Inputs.
 -> ([NDArrayHandle]) -- ^ Outputs.
 -> (Ptr CChar) -- ^ Kernel.
 -> IO ((Int), (RtcHandle))
mxRtcCreate a1 a2 a3 a4 a5 a6 a7 a8 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  withStringArray a4 $ \a4' -> 
  withStringArray a5 $ \a5' -> 
  withArray a6 $ \a6' -> 
  withArray a7 $ \a7' -> 
  let {a8' = id a8} in 
  alloca $ \a9' -> 
  mxRtcCreate'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a9'>>= \a9'' -> 
  return (res', a9'')

{-# LINE 1089 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Run cuda kernel.
mxRtcPush :: (RtcHandle) -- ^ Handle.
 -> (MXUInt) -- ^ Number of inputs.
 -> (MXUInt) -- ^ Number of outputs.
 -> ([NDArrayHandle]) -- ^ Inputs.
 -> ([NDArrayHandle]) -- ^ Outputs.
 -> (MXUInt) -- ^ Grid dim x
 -> (MXUInt) -- ^ Grid dim y
 -> (MXUInt) -- ^ Grid dim z
 -> (MXUInt) -- ^ Block dim x
 -> (MXUInt) -- ^ Block dim y
 -> (MXUInt) -- ^ Block dim z
 -> IO ((Int))
mxRtcPush a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  withArray a4 $ \a4' -> 
  withArray a5 $ \a5' -> 
  let {a6' = id a6} in 
  let {a7' = id a7} in 
  let {a8' = id a8} in 
  let {a9' = id a9} in 
  let {a10' = id a10} in 
  let {a11' = id a11} in 
  mxRtcPush'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1104 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Delete a MXRtc object.
mxRtcFree :: (RtcHandle) -> IO ((Int))
mxRtcFree a1 =
  let {a1' = id a1} in 
  mxRtcFree'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1109 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- |
mxCustomOpRegister :: (String) -- ^ op type.
 -> (CustomOpPropCreator) -> IO ((Int))
mxCustomOpRegister a1 a2 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = id a2} in 
  mxCustomOpRegister'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1115 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXGetLastError"
  mxGetLastError'_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRandomSeed"
  mxRandomSeed'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNotifyShutdown"
  mxNotifyShutdown'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSetProfilerConfig"
  mxSetProfilerConfig'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSetProfilerState"
  mxSetProfilerState'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDumpProfile"
  mxDumpProfile'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayCreateNone"
  mxNDArrayCreateNone'_ :: ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayCreate"
  mxNDArrayCreate'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayCreateEx"
  mxNDArrayCreateEx'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayLoadFromRawBytes"
  mxNDArrayLoadFromRawBytes'_ :: ((C2HSImp.Ptr ()) -> (CSize -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArraySaveRawBytes"
  mxNDArraySaveRawBytes'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr CSize) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArraySave"
  mxNDArraySave'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayLoad"
  mxNDArrayLoadImpl'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (NDArrayHandle))) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArraySyncCopyFromCPU"
  mxNDArraySyncCopyFromCPU'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr ()) -> (CSize -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArraySyncCopyToCPU"
  mxNDArraySyncCopyToCPU'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr ()) -> (CSize -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayWaitToRead"
  mxNDArrayWaitToRead'_ :: ((NDArrayHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayWaitToWrite"
  mxNDArrayWaitToWrite'_ :: ((NDArrayHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayWaitAll"
  mxNDArrayWaitAll'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayFree"
  mxNDArrayFree'_ :: ((NDArrayHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArraySlice"
  mxNDArraySlice'_ :: ((NDArrayHandle) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayAt"
  mxNDArrayAt'_ :: ((NDArrayHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayReshape"
  mxNDArrayReshape'_ :: ((NDArrayHandle) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayGetShape"
  mxNDArrayGetShapeImpl'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayGetData"
  mxNDArrayGetData'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CFloat)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayGetDType"
  mxNDArrayGetDType'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXNDArrayGetContext"
  mxNDArrayGetContext'_ :: ((NDArrayHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXListFunctions"
  mxListFunctionsImpl'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (FunctionHandle))) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXGetFunction"
  mxGetFunction'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (FunctionHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXFuncGetInfo"
  mxFuncGetInfoImpl'_ :: ((FunctionHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXFuncDescribe"
  mxFuncDescribe'_ :: ((FunctionHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXFuncInvoke"
  mxFuncInvoke'_ :: ((FunctionHandle) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXFuncInvokeEx"
  mxFuncInvokeEx'_ :: ((FunctionHandle) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListAtomicSymbolCreators"
  mxSymbolListAtomicSymbolCreatorsImpl'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (AtomicSymbolCreator))) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetAtomicSymbolName"
  mxSymbolGetAtomicSymbolName'_ :: ((AtomicSymbolCreator) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetAtomicSymbolInfo"
  mxSymbolGetAtomicSymbolInfoImpl'_ :: ((AtomicSymbolCreator) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCreateAtomicSymbol"
  mxSymbolCreateAtomicSymbol'_ :: ((AtomicSymbolCreator) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCreateVariable"
  mxSymbolCreateVariable'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCreateGroup"
  mxSymbolCreateGroup'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr (SymbolHandle)) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCreateFromFile"
  mxSymbolCreateFromFile'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCreateFromJSON"
  mxSymbolCreateFromJSON'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolSaveToFile"
  mxSymbolSaveToFile'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolSaveToJSON"
  mxSymbolSaveToJSON'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolFree"
  mxSymbolFree'_ :: ((SymbolHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCopy"
  mxSymbolCopy'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolPrint"
  mxSymbolPrint'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetName"
  mxSymbolGetName'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetAttr"
  mxSymbolGetAttr'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolSetAttr"
  mxSymbolSetAttr'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListAttr"
  mxSymbolListAttrImpl'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListAttrShallow"
  mxSymbolListAttrShallowImpl'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListArguments"
  mxSymbolListArgumentsImpl'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListOutputs"
  mxSymbolListOutputsImpl'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetInternals"
  mxSymbolGetInternals'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetOutput"
  mxSymbolGetOutput'_ :: ((SymbolHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolListAuxiliaryStates"
  mxSymbolListAuxiliaryStatesImpl'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolCompose"
  mxSymbolCompose'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGrad"
  mxSymbolGrad'_ :: ((SymbolHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolInferShape"
  mxSymbolInferShapeImpl'_ :: ((SymbolHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolInferShapePartial"
  mxSymbolInferShapePartialImpl'_ :: ((SymbolHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt)) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CUInt))) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolInferType"
  mxSymbolInferType'_ :: ((SymbolHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorFree"
  mxExecutorFree'_ :: ((ExecutorHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorPrint"
  mxExecutorPrint'_ :: ((ExecutorHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorForward"
  mxExecutorForward'_ :: ((ExecutorHandle) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorBackward"
  mxExecutorBackward'_ :: ((ExecutorHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorOutputs"
  mxExecutorOutputsImpl'_ :: ((ExecutorHandle) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (NDArrayHandle))) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorBind"
  mxExecutorBind'_ :: ((SymbolHandle) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (ExecutorHandle)) -> (IO C2HSImp.CInt)))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorBindX"
  mxExecutorBindX'_ :: ((SymbolHandle) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (ExecutorHandle)) -> (IO C2HSImp.CInt)))))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorBindEX"
  mxExecutorBindEX'_ :: ((SymbolHandle) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((ExecutorHandle) -> ((C2HSImp.Ptr (ExecutorHandle)) -> (IO C2HSImp.CInt))))))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXExecutorSetMonitorCallback"
  mxExecutorSetMonitorCallback'_ :: ((ExecutorHandle) -> ((ExecutorMonitorCallback) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXListDataIters"
  mxListDataItersImpl'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (DataIterCreator))) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterCreateIter"
  mxDataIterCreateIter'_ :: ((DataIterCreator) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (DataIterHandle)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterGetIterInfo"
  mxDataIterGetIterInfoImpl'_ :: ((DataIterCreator) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterFree"
  mxDataIterFree'_ :: ((DataIterHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterNext"
  mxDataIterNext'_ :: ((DataIterHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterBeforeFirst"
  mxDataIterBeforeFirst'_ :: ((DataIterHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterGetData"
  mxDataIterGetData'_ :: ((DataIterHandle) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterGetIndex"
  mxDataIterGetIndexImpl'_ :: ((DataIterHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CULong)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterGetPadNum"
  mxDataIterGetPadNum'_ :: ((DataIterHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXDataIterGetLabel"
  mxDataIterGetLabel'_ :: ((DataIterHandle) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXInitPSEnv"
  mxInitPSEnv'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreCreate"
  mxKVStoreCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (KVStoreHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreFree"
  mxKVStoreFree'_ :: ((KVStoreHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreInit"
  mxKVStoreInit'_ :: ((KVStoreHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStorePush"
  mxKVStorePush'_ :: ((KVStoreHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStorePull"
  mxKVStorePull'_ :: ((KVStoreHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreGetType"
  mxKVStoreGetType'_ :: ((KVStoreHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreGetRank"
  mxKVStoreGetRank'_ :: ((KVStoreHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreGetGroupSize"
  mxKVStoreGetGroupSize'_ :: ((KVStoreHandle) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreIsWorkerNode"
  mxKVStoreIsWorkerNode'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreIsServerNode"
  mxKVStoreIsServerNode'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreIsSchedulerNode"
  mxKVStoreIsSchedulerNode'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreBarrier"
  mxKVStoreBarrier'_ :: ((KVStoreHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreSetBarrierBeforeExit"
  mxKVStoreSetBarrierBeforeExit'_ :: ((KVStoreHandle) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreSendCommmandToServers"
  mxKVStoreSendCommmandToServers'_ :: ((KVStoreHandle) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXKVStoreGetNumDeadNode"
  mxKVStoreGetNumDeadNode'_ :: ((KVStoreHandle) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOWriterCreate"
  mxRecordIOWriterCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (RecordIOHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOWriterFree"
  mxRecordIOWriterFree'_ :: ((RecordIOHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOWriterWriteRecord"
  mxRecordIOWriterWriteRecord'_ :: ((RecordIOHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (CSize -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOWriterTell"
  mxRecordIOWriterTell'_ :: ((RecordIOHandle) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOReaderCreate"
  mxRecordIOReaderCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (RecordIOHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOReaderFree"
  mxRecordIOReaderFree'_ :: ((RecordIOHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOReaderReadRecord"
  mxRecordIOReaderReadRecord'_ :: ((RecordIOHandle) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRecordIOReaderSeek"
  mxRecordIOReaderSeek'_ :: ((RecordIOHandle) -> (CSize -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRtcCreate"
  mxRtcCreate'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (RtcHandle)) -> (IO C2HSImp.CInt))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRtcPush"
  mxRtcPush'_ :: ((RtcHandle) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr (NDArrayHandle)) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))))))))))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXRtcFree"
  mxRtcFree'_ :: ((RtcHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXCustomOpRegister"
  mxCustomOpRegister'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((CustomOpPropCreator) -> (IO C2HSImp.CInt)))