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


{-# LINE 1 "src/MXNet/NNVM/Internal/Types/Raw.chs" #-}
-----------------------------------------------------------
-- |
-- module:                      MXNet.NNVM.Internal.Types.Raw
-- copyright:                   (c) 2016 Tao He
-- license:                     MIT
-- maintainer:                  sighingnow@gmail.com
--
-- Collect data type defintions of NNVM into a single raw binding module to
-- avoid redefinitions.
--
{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}

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



import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr
import Foreign.Storable



{---------------------------------------------------------------------
- <nnvm/c_api.h>
---------------------------------------------------------------------}

-- | MXUint type alias.
type NNUInt = CUInt

-- | Handle to a function that takes param and creates symbol.
newtype OpHandle = OpHandle (C2HSImp.Ptr (OpHandle))
{-# LINE 37 "src/MXNet/NNVM/Internal/Types/Raw.chs" #-}


instance Storable OpHandle where
    sizeOf (OpHandle t) = sizeOf t
    alignment (OpHandle t) = alignment t
    peek p = fmap OpHandle (peek (castPtr p))
    poke p (OpHandle t) = poke (castPtr p) t

-- | Handle to a symbol that can be bind as operator.
newtype SymbolHandle = SymbolHandle (C2HSImp.Ptr (SymbolHandle))
{-# LINE 46 "src/MXNet/NNVM/Internal/Types/Raw.chs" #-}


instance Storable SymbolHandle where
    sizeOf (SymbolHandle t) = sizeOf t
    alignment (SymbolHandle t) = alignment t
    peek p = fmap SymbolHandle (peek (castPtr p))
    poke p (SymbolHandle t) = poke (castPtr p) t

-- | Handle to Graph.
newtype GraphHandle = GraphHandle (C2HSImp.Ptr (GraphHandle))
{-# LINE 55 "src/MXNet/NNVM/Internal/Types/Raw.chs" #-}


instance Storable GraphHandle where
    sizeOf (GraphHandle t) = sizeOf t
    alignment (GraphHandle t) = alignment t
    peek p = fmap GraphHandle (peek (castPtr p))
    poke p (GraphHandle t) = poke (castPtr p) t