-- GENERATED by C->Haskell Compiler, version 0.28.2 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 Strict #-}
{-# 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.Types.Internal.Raw
{-# LINE 30 "src/MXNet/Core/Base/Internal/Raw.chs" #-}




-- | Handle size_t type.

{-# LINE 35 "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 40 "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 47 "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 52 "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 59 "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 65 "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 70 "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 78 "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 89 "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 101 "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 108 "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 115 "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 123 "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 131 "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 153 "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 160 "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 165 "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 170 "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 175 "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 180 "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 189 "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 197 "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 206 "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 212 "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 ())) -- ^ 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 227 "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 234 "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 242 "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 249 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List all the available functions handles.
mxListFunctions :: IO (Int, [FunctionHandle]) -- ^ The output function handle array.
mxListFunctions = do
    (res, c, p) <- mxListFunctionsImpl
    fs <- peekArray (fromIntegral c) p
    return (res, 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 263 "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 274 "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 303 "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 312 "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 324 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxImperativeInvokeImpl :: (AtomicSymbolCreator) -- ^ Creator of the OP.
 -> (Int) -> ([NDArrayHandle]) -> (Ptr CInt) -> (Ptr (Ptr NDArrayHandle)) -> (Int) -> ([String]) -> ([String]) -> IO ((Int))
mxImperativeInvokeImpl a1 a2 a3 a4 a5 a6 a7 a8 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  withArray a3 $ \a3' -> 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  let {a6' = fromIntegral a6} in 
  withStringArray a7 $ \a7' -> 
  withStringArray a8 $ \a8' -> 
  mxImperativeInvokeImpl'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


-- | Invoke a nnvm op and imperative function.
mxImperativeInvoke :: AtomicSymbolCreator       -- ^ Creator/Handler of the OP.
                   -> [NDArrayHandle]           -- ^ Input NDArrays.
                   -> [(String, String)]        -- ^ Keywords parameters.
                   -> Maybe [NDArrayHandle]     -- ^ Original given output handles array.
                   -> IO (Int, [NDArrayHandle]) -- ^ Return NDArrays as result.
mxImperativeInvoke creator inputs params outputs = do
    let (keys, values) = unzip params
        ninput = length inputs
        nparam = length params
    (res, n, p) <- case outputs of
        Nothing -> alloca $ \pn ->
            alloca $ \pp -> do
                poke pn 0
                poke pp nullPtr
                res' <- mxImperativeInvokeImpl creator ninput inputs pn pp nparam keys values
                n' <- fromIntegral <$> peek pn
                p' <- peek pp
                return (res', n', p')
        Just out -> alloca $ \pn ->
            alloca $ \pp -> do
                withArray out $ \p' -> do
                    poke pn (fromIntegral $ length out)
                    poke pp p'
                    res' <- mxImperativeInvokeImpl creator ninput inputs pn pp nparam keys values
                    n' <- fromIntegral <$> peek pn
                    return (res', n', p')
    arrays <- if n == 0 then return [] else peekArray n p
    return (res, arrays)

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

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

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


-- | List all the available operator names, include entries.
mxListAllOpNames :: IO (Int, [String])
mxListAllOpNames = do
    (res, n, p) <- mxListAllOpNamesImpl
    names <- peekStringArray (fromIntegral n :: Int) p
    return (res, names)

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 384 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List all the available @AtomicSymbolCreator@.
mxSymbolListAtomicSymbolCreators
    :: IO (Int, [AtomicSymbolCreator])  -- ^ The atomic symbol creators list.
mxSymbolListAtomicSymbolCreators = do
    (res, n, p) <- mxSymbolListAtomicSymbolCreatorsImpl
    ss <- peekArray (fromIntegral n) p
    return (res, 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 399 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolGetAtomicSymbolInfoImpl :: (AtomicSymbolCreator) -> IO ((Int), (String), (String), (MXUInt), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (String), (String))
mxSymbolGetAtomicSymbolInfoImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \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  a8'>>= \a8'' -> 
  peekString  a9'>>= \a9'' -> 
  return (res', a2'', a3'', a4'', a5'', a6'', a7'', a8'', a9'')

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


-- | Get the detailed information about atomic symbol.
mxSymbolGetAtomicSymbolInfo
    :: AtomicSymbolCreator
    -> IO (Int, String, String, MXUInt,
           [String], [String], [String],
           String, String)                  -- ^ Return the name and description of the symbol,
                                            -- the name, type and description of it's arguments,
                                            -- the keyword argument for specifying variable number
                                            -- of arguments, as well as the return type of this
                                            -- symbol.
mxSymbolGetAtomicSymbolInfo creator = do
    -- Documentation for kargs: https://github.com/dmlc/mxnet/blob/master/include/mxnet/c_api.h#L555
    (res, name, desc, argc, argv, argtype, argdesc, kargs, rettype) <- mxSymbolGetAtomicSymbolInfoImpl creator
    argv' <- peekStringArray argc argv
    argtype' <- peekStringArray argc argtype
    argdesc' <- peekStringArray argc argdesc
    return (res, name, desc, argc, argv', argtype', argdesc', kargs, 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 439 "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 446 "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 454 "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 460 "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 466 "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 472 "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 479 "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 484 "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 490 "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 496 "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 504 "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 513 "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 521 "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 527 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get all attributes from symbol, including all descendents.
mxSymbolListAttr :: SymbolHandle
                 -> IO (Int, [String])  -- ^ The attributes list.
mxSymbolListAttr symbol = do
    (res, n, p) <- mxSymbolListAttrImpl symbol
    ss <- peekStringArray n p
    return (res, 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 541 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Get all attributes from symbol, excluding descendents.
mxSymbolListAttrShallow :: SymbolHandle
                        -> IO (Int, [String])   -- ^ The attributes list.
mxSymbolListAttrShallow symbol = do
    (res, n, p) <- mxSymbolListAttrShallowImpl symbol
    ss <- peekStringArray n p
    return (res, 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 555 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List arguments in the symbol.
mxSymbolListArguments :: SymbolHandle
                      -> IO (Int, [String]) -- ^ List of arguments' names.
mxSymbolListArguments symbol = do
    (res, n, p) <- mxSymbolListArgumentsImpl symbol
    ss <- peekStringArray n p
    return (res, 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 569 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List returns in the symbol.
mxSymbolListOutputs :: SymbolHandle
                    -> IO (Int, [String])   -- ^ The outputs' names.
mxSymbolListOutputs symbol = do
    (res, n, p) <- mxSymbolListOutputsImpl symbol
    ss <- peekStringArray n p
    return (res, 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 584 "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 592 "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 598 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | List auxiliary states in the symbol.
mxSymbolListAuxiliaryStates
    :: SymbolHandle
    -> IO (Int, [String])   -- ^ The output string array.
mxSymbolListAuxiliaryStates symbol = do
    (res, n, p) <- mxSymbolListAuxiliaryStatesImpl symbol
    ss <- peekStringArray n p
    return (res, 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 616 "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 625 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


mxSymbolInferShapeImpl :: (SymbolHandle) -> (MXUInt) -> ([String]) -> ([Int]) -> ([Int]) -> 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' -> 
  withIntegralArray a4 $ \a4' -> 
  withIntegralArray a5 $ \a5' -> 
  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 643 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Infer shape of unknown input shapes given the known one.
mxSymbolInferShape
    :: SymbolHandle                          -- ^ Symbol handle.
    -> [String]                              -- ^ Keys of keyword arguments, optional.
    -> [Int]                                 -- ^ The head pointer of the rows in CSR.
    -> [Int]                                 -- ^ The content of the CSR.
    -> IO (Int, [[Int]], [[Int]], [[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 keys ind shapedata = do
    let argc = fromIntegral (length keys)   -- Number of input arguments.
    -- Notice: the complete result are ignored for simplification.
    (res, in_size, in_ndim, in_data, out_size, out_ndim, out_data, aux_size, aux_ndim, aux_data, _) <- mxSymbolInferShapeImpl sym argc keys ind shapedata
    in_ndim' <- peekIntegralArray (fromIntegral in_size) in_ndim
    in_data' <- peekArray (fromIntegral in_size) in_data
    in_data'' <- mapM (uncurry peekIntegralArray) (zip in_ndim' in_data')
    out_ndim' <- peekIntegralArray (fromIntegral out_size) out_ndim
    out_data' <- peekArray (fromIntegral out_size) out_data
    out_data'' <- mapM (uncurry peekIntegralArray) (zip out_ndim' out_data')
    aux_ndim' <- peekIntegralArray (fromIntegral aux_size) aux_ndim
    aux_data' <- peekArray (fromIntegral aux_size) aux_data
    aux_data'' <- mapM (uncurry peekIntegralArray) (zip aux_ndim' aux_data')
    return (res, in_data'', out_data'', aux_data'')

mxSymbolInferShapePartialImpl :: (SymbolHandle) -> (MXUInt) -> ([String]) -> ([Int]) -> ([Int]) -> 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' -> 
  withIntegralArray a4 $ \a4' -> 
  withIntegralArray a5 $ \a5' -> 
  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 688 "src/MXNet/Core/Base/Internal/Raw.chs" #-}


-- | Partially infer shape of unknown input shapes given the known one.
mxSymbolInferShapePartial
    :: SymbolHandle                         -- ^ Symbol handle.
    -> [String]                              -- ^ Keys of keyword arguments, optional.
    -> [Int]                             -- ^ The head pointer of the rows in CSR.
    -> [Int]                             -- ^ The content of the CSR.
    -> IO (Int, [[Int]], [[Int]], [[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 keys ind shapedata = do
    let argc = fromIntegral (length keys)   -- Number of input arguments.
    -- Notice: the complete result are ignored for simplification.
    (res, in_size, in_ndim, in_data, out_size, out_ndim, out_data, aux_size, aux_ndim, aux_data, _) <- mxSymbolInferShapePartialImpl sym argc keys ind shapedata
    in_ndim' <- peekIntegralArray (fromIntegral in_size) in_ndim
    in_data' <- peekArray (fromIntegral in_size) in_data
    in_data'' <- mapM (uncurry peekIntegralArray) (zip in_ndim' in_data')
    out_ndim' <- peekIntegralArray (fromIntegral out_size) out_ndim
    out_data' <- peekArray (fromIntegral out_size) out_data
    out_data'' <- mapM (uncurry peekIntegralArray) (zip out_ndim' out_data')
    aux_ndim' <- peekIntegralArray (fromIntegral aux_size) aux_ndim
    aux_data' <- peekArray (fromIntegral aux_size) aux_data
    aux_data'' <- mapM (uncurry peekIntegralArray) (zip aux_ndim' aux_data')
    return (res, in_data'', out_data'', aux_data'')

mxSymbolInferTypeImpl :: (SymbolHandle) -- ^ Symbol handle.
 -> (MXUInt) -- ^ Number of input arguments.
 -> ([String]) -- ^ Key of keyword arguments, optional.
 -> ([Int]) -- ^ The content of the CSR.
 -> IO ((Int), (MXUInt), (Ptr CInt), (MXUInt), (Ptr CInt), (MXUInt), (Ptr CInt), (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.

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

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


-- | Infer type of unknown input types given the known one.
mxSymbolInferType :: SymbolHandle                   -- ^ Symbol handle.
                  -> [String]                       -- ^ Input arguments.
                  -> IO (Int, [Int], [Int], [Int])  -- ^ Return arg_types, out_types and aux_types.
mxSymbolInferType handle args = do
    let nargs = fromIntegral (length args)
        csr = []
    -- Notice: the complete result are ignored for simplification.
    (res, narg, parg, nout, pout, naux, paux, _) <- mxSymbolInferTypeImpl handle nargs args csr
    args <- peekIntegralArray (fromIntegral narg) parg
    outs <- peekIntegralArray (fromIntegral nout) pout
    auxs <- peekIntegralArray (fromIntegral naux) paux
    return (res, args, outs, auxs)

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

-- | 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 752 "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 758 "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 765 "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 772 "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 778 "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 800 "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 819 "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 839 "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 846 "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 853 "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 869 "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 879 "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 903 "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 909 "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 914 "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 920 "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 934 "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 952 "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 958 "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 967 "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 973 "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 978 "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 986 "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 995 "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 1004 "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 1019 "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 1027 "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 1037 "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 1042 "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 1047 "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 1052 "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 1057 "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 1063 "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 1079 "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 1089 "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 1095 "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 1100 "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 1107 "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 1113 "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 1119 "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 1124 "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 1132 "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 1138 "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 1151 "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 1166 "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 1171 "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 1177 "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 ())) -> (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 MXImperativeInvoke"
  mxImperativeInvokeImpl'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (NDArrayHandle)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (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 MXListAllOpNames"
  mxListAllOpNamesImpl'_ :: ((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 MXSymbolListAtomicSymbolCreators"
  mxSymbolListAtomicSymbolCreatorsImpl'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr ()))) -> (IO C2HSImp.CInt)))

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

foreign import ccall safe "MXNet/Core/Base/Internal/Raw.chs.h MXSymbolGetAtomicSymbolInfo"
  mxSymbolGetAtomicSymbolInfoImpl'_ :: ((C2HSImp.Ptr ()) -> ((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'_ :: ((C2HSImp.Ptr ()) -> (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"
  mxSymbolInferTypeImpl'_ :: ((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)))