-- 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/NNVM/Internal/Raw.chs" #-}
-----------------------------------------------------------
-- |
-- module:                      MXNet.Core.NNVM.Internal.Raw
-- copyright:                   (c) 2016-2017 Tao He
-- license:                     MIT
-- maintainer:                  sighingnow@gmail.com
--
-- Direct C FFI bindings for <nnvm/c_api.h>.
--
{-# LANGUAGE Safe #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ForeignFunctionInterface #-}

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



import Control.Exception (throwIO)
import Foreign.C.String
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 32 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}




-- | Set the last error message needed by C API.
nnAPISetLastError :: (String) -> IO ()
nnAPISetLastError a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  nnAPISetLastError'_ a1' >>
  return ()

{-# LINE 39 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Return str message of the last error.
nnGetLastError :: IO ((String))
nnGetLastError =
  nnGetLastError'_ >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

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


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

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


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

-- | Get operator handle given name.
nnGetOpHandle :: (String) -- ^ The name of the operator.
 -> IO ((Int), (OpHandle))
nnGetOpHandle a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  nnGetOpHandle'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

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


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

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


-- | List all the available operators.
nnListUniqueOps :: IO (Int, [OpHandle])
nnListUniqueOps = do
    (res, n, p) <- nnListUniqueOpsImpl
    ops <- peekArray (fromIntegral n) p
    return (res, ops)

nnGetOpInfoImpl :: (OpHandle) -> IO ((Int), (String), (String), (NNUInt), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (Ptr (Ptr CChar)), (String))
nnGetOpInfoImpl a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  alloca $ \a6' -> 
  alloca $ \a7' -> 
  alloca $ \a8' -> 
  nnGetOpInfoImpl'_ 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 85 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get the detailed information about atomic symbol.
nnGetOpInfo :: OpHandle
            -> IO (Int, String, String, NNUInt, [String], [String], [String], String)
nnGetOpInfo handle = do
    (res, name, desc, argc, pargv, pargt, pargdesc, rettype) <- nnGetOpInfoImpl handle
    argv <- peekStringArray argc pargv
    argt <- peekStringArray argc pargt
    argdesc <- peekStringArray argc pargdesc
    return (res, name, desc, argc, argv, argt, argdesc, rettype)

-- | Create an AtomicSymbol functor.
nnSymbolCreateAtomicSymbol :: (OpHandle) -- ^ The operator handle.
 -> (NNUInt) -- ^ The number of parameters.
 -> ([String]) -- ^ The keys to the params.
 -> ([String]) -- ^ The values to the params.
 -> IO ((Int), (SymbolHandle))
nnSymbolCreateAtomicSymbol a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  withStringArray a4 $ \a4' -> 
  alloca $ \a5' -> 
  nnSymbolCreateAtomicSymbol'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a5'>>= \a5'' -> 
  return (res', a5'')

{-# LINE 104 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Create a Variable Symbol.
nnSymbolCreateVariable :: (String) -- ^ The name of the variable.
 -> IO ((Int), (SymbolHandle))
nnSymbolCreateVariable a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  alloca $ \a2' -> 
  nnSymbolCreateVariable'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 110 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Create a Symbol by grouping list of symbols together.
nnSymbolCreateGroup :: (NNUInt) -- ^ Number of symbols to be grouped.
 -> ([SymbolHandle]) -- ^ Array of symbol handles.
 -> IO ((Int), (SymbolHandle))
nnSymbolCreateGroup a1 a2 =
  let {a1' = id a1} in 
  withArray a2 $ \a2' -> 
  alloca $ \a3' -> 
  nnSymbolCreateGroup'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 117 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Add src_dep to the handle as control dep.
nnAddControlDeps :: (SymbolHandle) -- ^ The symbol to add dependency edges on.
 -> (SymbolHandle) -- ^ The source handles.
 -> IO ((Int))
nnAddControlDeps a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  nnAddControlDeps'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 123 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


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

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


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

{-# LINE 134 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


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

{-# LINE 140 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get string attribute from symbol.
nnSymbolGetAttr :: (SymbolHandle) -- ^ symbol handle
 -> (String) -- ^ key
 -> IO ((Int), (String), (Int))
nnSymbolGetAttr a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  nnSymbolGetAttr'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a3'>>= \a3'' -> 
  peekIntegral  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 148 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Set string attribute from symbol.
nnSymbolSetAttrs :: (SymbolHandle) -> (NNUInt) -> ([String]) -- ^ attribute keys
 -> ([String]) -- ^ attribute values
 -> IO ((Int))
nnSymbolSetAttrs a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  withStringArray a4 $ \a4' -> 
  nnSymbolSetAttrs'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 156 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


nnSymbolListAttrsImpl :: (SymbolHandle) -> (Int) -- ^ 0 for recursive, 1 for shallow
 -> IO ((Int), (NNUInt), (Ptr (Ptr CChar)))
nnSymbolListAttrsImpl a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  nnSymbolListAttrsImpl'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 163 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get all attributes from symbol, including all descendents.
nnSymbolListAttrs :: SymbolHandle -> Int -> IO (Int, [String])
nnSymbolListAttrs sym recursive = do
    (res, n, p) <- nnSymbolListAttrsImpl sym recursive
    ss <- peekStringArray n p
    return (res, ss)

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

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


-- | List inputs variables in the symbol.
nnSymbolListInputVariables :: SymbolHandle -> Int -> IO (Int, [SymbolHandle])
nnSymbolListInputVariables sym opt = do
    (res, n, p) <- nnSymbolListInputVariablesImpl sym opt
    vs <- peekArray (fromIntegral n) p
    return (res, vs)

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

{-# LINE 191 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | List input names in the symbol.
nnSymbolListInputNames :: SymbolHandle -> Int -> IO (Int, [String])
nnSymbolListInputNames sym opt = do
    (res, n, p) <- nnSymbolListInputNamesImpl sym opt
    ss <- peekStringArray n p
    return (res, ss)

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

{-# LINE 204 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | List returns names in the symbol.
nnSymbolListOutputNames :: SymbolHandle -> IO (Int, [String])
nnSymbolListOutputNames sym = do
    (res, n, p) <- nnSymbolListOutputNamesImpl sym
    ss <- peekStringArray n p
    return (res, ss)

-- | Get a symbol that contains all the internals.
nnSymbolGetInternals :: (SymbolHandle) -> IO ((Int), (SymbolHandle))
nnSymbolGetInternals a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  nnSymbolGetInternals'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 217 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get index-th outputs of the symbol.
nnSymbolGetOutput :: (SymbolHandle) -> (NNUInt) -> IO ((Int), (SymbolHandle))
nnSymbolGetOutput a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  alloca $ \a3' -> 
  nnSymbolGetOutput'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

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


-- | Compose the symbol on other symbols.
nnSymbolComposeImpl :: (SymbolHandle) -> (Ptr CChar) -> (NNUInt) -> ([String]) -> ([SymbolHandle]) -> IO ((Int))
nnSymbolComposeImpl a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  withStringArray a4 $ \a4' -> 
  withArray a5 $ \a5' -> 
  nnSymbolComposeImpl'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 233 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}



-- | Invoke a nnvm op and imperative function.
nnSymbolCompose :: SymbolHandle       -- ^ Creator/Handler of the OP.
                -> String
                -> [String]
                -> [SymbolHandle]
                -> IO Int
nnSymbolCompose sym name keys args = do
    if null keys || length keys == length args
        then return ()
        else throwIO $ userError "nnSymbolCompose: keyword arguments mismatch."
    let nargs = fromIntegral $ length args
    if null name
        then nnSymbolComposeImpl sym nullPtr nargs keys args
        else withCString name $ \p -> nnSymbolComposeImpl sym p nargs keys args

-- | Create a graph handle from symbol.
nnGraphCreate :: (SymbolHandle) -> IO ((Int), (GraphHandle))
nnGraphCreate a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  nnGraphCreate'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 255 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


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

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


-- | Get a new symbol from the graph.
nnGraphGetSymbol :: (GraphHandle) -- ^ the graph handle.
 -> IO ((Int), (SymbolHandle))
nnGraphGetSymbol a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  nnGraphGetSymbol'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 266 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get Set a attribute in json format.
nnGraphSetJSONAttr :: (GraphHandle) -> (String) -> (String) -> IO ((Int))
nnGraphSetJSONAttr a1 a2 a3 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  C2HSImp.withCString a3 $ \a3' -> 
  nnGraphSetJSONAttr'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 273 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Get a serialized attrirbute from graph.
nnGraphGetJSONAttr :: (SymbolHandle) -> (String) -> IO ((Int), (String), (Int))
nnGraphGetJSONAttr a1 a2 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  nnGraphGetJSONAttr'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekString  a3'>>= \a3'' -> 
  peekIntegral  a4'>>= \a4'' -> 
  return (res', a3'', a4'')

{-# LINE 281 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Set a attribute whose type is std::vector<NodeEntry> in c++.
nnGraphSetNodeEntryListAttr_ :: (GraphHandle) -> (String) -> (SymbolHandle) -> IO ((Int))
nnGraphSetNodeEntryListAttr_ a1 a2 a3 =
  let {a1' = id a1} in 
  C2HSImp.withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  nnGraphSetNodeEntryListAttr_'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 288 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


-- | Apply passes on the src graph.
nnGraphApplyPasses :: (GraphHandle) -> (NNUInt) -> ([String]) -> IO ((Int), (GraphHandle))
nnGraphApplyPasses a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withStringArray a3 $ \a3' -> 
  alloca $ \a4' -> 
  nnGraphApplyPasses'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a4'>>= \a4'' -> 
  return (res', a4'')

{-# LINE 296 "src/MXNet/Core/NNVM/Internal/Raw.chs" #-}


foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNAPISetLastError"
  nnAPISetLastError'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGetLastError"
  nnGetLastError'_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

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

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGetOpHandle"
  nnGetOpHandle'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (OpHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNListUniqueOps"
  nnListUniqueOpsImpl'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (OpHandle))) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGetOpInfo"
  nnGetOpInfoImpl'_ :: ((OpHandle) -> ((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/NNVM/Internal/Raw.chs.h NNSymbolCreateAtomicSymbol"
  nnSymbolCreateAtomicSymbol'_ :: ((OpHandle) -> (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/NNVM/Internal/Raw.chs.h NNSymbolCreateVariable"
  nnSymbolCreateVariable'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNSymbolCompose"
  nnSymbolComposeImpl'_ :: ((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/NNVM/Internal/Raw.chs.h NNGraphCreate"
  nnGraphCreate'_ :: ((SymbolHandle) -> ((C2HSImp.Ptr (GraphHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGraphFree"
  nnGraphFree'_ :: ((GraphHandle) -> (IO C2HSImp.CInt))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGraphGetSymbol"
  nnGraphGetSymbol'_ :: ((GraphHandle) -> ((C2HSImp.Ptr (SymbolHandle)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGraphSetJSONAttr"
  nnGraphSetJSONAttr'_ :: ((GraphHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

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

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGraphSetNodeEntryListAttr_"
  nnGraphSetNodeEntryListAttr_'_ :: ((GraphHandle) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((SymbolHandle) -> (IO C2HSImp.CInt))))

foreign import ccall safe "MXNet/Core/NNVM/Internal/Raw.chs.h NNGraphApplyPasses"
  nnGraphApplyPasses'_ :: ((GraphHandle) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr (GraphHandle)) -> (IO C2HSImp.CInt)))))