-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Graph.Build
-- Copyright : [2018] Trevor L. McDonell
-- License   : BSD
--
-- Graph construction functions for the low-level driver interface
--
-- Requires CUDA-10
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Graph.Build (

  Graph(..), Node(..), NodeType(..), HostCallback,
  create, destroy, clone, remove,

  -- ** Construction
  addChild,
  addEmpty,
  addHost,
  addKernel,
  addMemcpy,
  addMemset,
  addDependencies,
  removeDependencies,

  -- ** Querying
  getType,
  getChildGraph,
  getEdges,
  getNodes,
  getRootNodes,
  getDependencies,
  getDependents,
  findInClone,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 46 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}


import Foreign.CUDA.Driver.Context.Base                   ( Context(..) )
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Exec                           ( Fun(..), FunParam(..) )
import Foreign.CUDA.Driver.Graph.Base
import Foreign.CUDA.Driver.Marshal                        ( useDeviceHandle )
import Foreign.CUDA.Driver.Stream                         ( Stream(..) )
import Foreign.CUDA.Driver.Unified                        ( MemoryType(..) )
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Ptr                                   ( DevicePtr(..) )

import Control.Monad                                      ( liftM )
import Unsafe.Coerce

import Data.Word
import Foreign
import Foreign.C
import Foreign.Storable


-- | Callback function executed on the host
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TYPES.html#group__CUDA__TYPES_1g262cd3570ff5d396db4e3dabede3c355>
--
-- @since 0.10.0.0
--
type HostCallback = ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))))
{-# LINE 77 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



--------------------------------------------------------------------------------
-- Graph creation
--------------------------------------------------------------------------------

-- | Create an empty task graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gd885f719186010727b75c3315f865fdf>
--
-- @since 0.10.0.0
--
{-# INLINEABLE create #-}
create :: ([GraphFlag]) -> IO ((Graph))
create a2 =
  alloca $ \a1' ->
  let {a2' = combineBitMasks a2} in
  create'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekGraph  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 102 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Destroy a graph, as well as all of its nodes
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g718cfd9681f078693d4be2426fd689c8>
--
-- @since 0.10.0.0
{-# INLINEABLE destroy #-}
destroy :: (Graph) -> IO ()
destroy a1 =
  let {a1' = useGraph a1} in
  destroy'_ a1' >>= \res ->
  checkStatus res >>
  return ()

{-# LINE 121 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Clone a graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g3603974654e463f2231c71d9b9d1517e>
--
-- @since 0.10.0.0
--
{-# INLINEABLE clone #-}
clone :: (Graph) -> IO ((Graph))
clone a2 =
  alloca $ \a1' ->
  let {a2' = useGraph a2} in
  clone'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekGraph  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 142 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Remove a node from the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g00ed16434d983d8f0011683eacaf19b9>
--
-- @since 0.10.0.0
--
{-# INLINEABLE remove #-}
remove :: (Node) -> IO ()
remove a1 =
  let {a1' = useNode a1} in
  remove'_ a1' >>= \res ->
  checkStatus res >>
  return ()

{-# LINE 162 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Create a child graph node and add it to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g3f27c2e56e3d568b09f00d438e61ceb1>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addChild #-}
addChild :: Graph -> Graph -> [Node] -> IO Node
addChild parent child dependencies = cuGraphAddChildGraphNode parent dependencies child
  where
    cuGraphAddChildGraphNode :: (Graph) -> ([Node]) -> (Graph) -> IO ((Node))
    cuGraphAddChildGraphNode a2 a3 a4 =
      alloca $ \a1' ->
      let {a2' = useGraph a2} in
      withNodeArrayLen a3 $ \(a3'1, a3'2) ->
      let {a4' = useGraph a4} in
      cuGraphAddChildGraphNode'_ a1' a2' a3'1  a3'2 a4' >>= \res ->
      checkStatus res >>
      peekNode  a1'>>= \a1'' ->
      return (a1'')

{-# LINE 187 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Add dependency edges to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g81bf1a6965f881be6ad8d21cfe0ee44f>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addDependencies #-}
addDependencies :: Graph -> [(Node,Node)] -> IO ()
addDependencies !g !deps = cuGraphAddDependencies g from to
  where
    (from, to) = unzip deps

    cuGraphAddDependencies :: (Graph) -> ([Node]) -> ([Node]) -> IO ()
    cuGraphAddDependencies a1 a2 a3 =
      let {a1' = useGraph a1} in
      withNodeArray a2 $ \a2' ->
      withNodeArrayLen a3 $ \(a3'1, a3'2) ->
      cuGraphAddDependencies'_ a1' a2' a3'1  a3'2 >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 213 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Remove dependency edges from the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g8ab696a6b3ccd99db47feba7e97fb579>
--
-- @since 0.10.0.0
--
{-# INLINE removeDependencies #-}
removeDependencies :: Graph -> [(Node,Node)] -> IO ()
removeDependencies !g !deps = cuGraphRemoveDependencies g from to
  where
    (from, to) = unzip deps

    cuGraphRemoveDependencies :: (Graph) -> ([Node]) -> ([Node]) -> IO ()
    cuGraphRemoveDependencies a1 a2 a3 =
      let {a1' = useGraph a1} in
      withNodeArray a2 $ \a2' ->
      withNodeArrayLen a3 $ \(a3'1, a3'2) ->
      cuGraphRemoveDependencies'_ a1' a2' a3'1  a3'2 >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 239 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Create an empty node and add it to the graph.
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g8a8681dbe97dbbb236ea5ebf3abe2ada>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addEmpty #-}
addEmpty :: (Graph) -> ([Node]) -> IO ((Node))
addEmpty a2 a3 =
  alloca $ \a1' ->
  let {a2' = useGraph a2} in
  withNodeArrayLen a3 $ \(a3'1, a3'2) ->
  addEmpty'_ a1' a2' a3'1  a3'2 >>= \res ->
  checkStatus res >>
  peekNode  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 261 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Creates a host execution node and adds it to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g1ba15c2fe1afb8897091ecec4202b597>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addHost #-}
addHost :: (Graph) -> ([Node]) -> (HostCallback) -> (Ptr ()) -> IO ((Node))
addHost a2 a3 a4 a5 =
  alloca $ \a1' ->
  let {a2' = useGraph a2} in
  withNodeArrayLen a3 $ \(a3'1, a3'2) ->
  let {a4' = id a4} in
  let {a5' = id a5} in
  addHost'_ a1' a2' a3'1  a3'2 a4' a5' >>= \res ->
  checkStatus res >>
  peekNode  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 285 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Create a kernel execution node and adds it to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g886a9096293238937f2f3bc7f2d57635>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addKernel #-}
addKernel
    :: Graph
    -> [Node]
    -> Fun
    -> (Int, Int, Int)  -- ^ grid dimension
    -> (Int, Int, Int)  -- ^ thread block dimensions
    -> Int              -- ^ shared memory (bytes)
    -> [FunParam]
    -> IO Node
addKernel !g !ns !fun (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !args
  = withMany withFP args
  $ \pa -> withArray pa
  $ \pp -> cuGraphAddKernelNode_simple g ns fun gx gy gz tx ty tz sm pp
  where
    withFP :: FunParam -> (Ptr () -> IO b) -> IO b
    withFP !p !f = case p of
      IArg v -> with' v (f . castPtr)
      FArg v -> with' v (f . castPtr)
      VArg v -> with' v (f . castPtr)

    -- can't use the standard 'with' because 'alloca' will pass an undefined
    -- dummy argument when determining 'sizeOf' and 'alignment', but sometimes
    -- instances in Accelerate need to evaluate this argument.
    --
    with' :: Storable a => a -> (Ptr a -> IO b) -> IO b
    with' !val !f =
      allocaBytes (sizeOf val) $ \ptr -> do
        poke ptr val
        f ptr

    cuGraphAddKernelNode_simple :: (Graph) -> ([Node]) -> (Fun) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr (Ptr ())) -> IO ((Node))
    cuGraphAddKernelNode_simple a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =
      alloca $ \a1' ->
      let {a2' = useGraph a2} in
      withNodeArrayLen a3 $ \(a3'1, a3'2) ->
      let {a4' = useFun a4} in
      let {a5' = fromIntegral a5} in
      let {a6' = fromIntegral a6} in
      let {a7' = fromIntegral a7} in
      let {a8' = fromIntegral a8} in
      let {a9' = fromIntegral a9} in
      let {a10' = fromIntegral a10} in
      let {a11' = fromIntegral a11} in
      let {a12' = id a12} in
      cuGraphAddKernelNode_simple'_ a1' a2' a3'1  a3'2 a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
      checkStatus res >>
      peekNode  a1'>>= \a1'' ->
      return (a1'')

{-# LINE 345 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Create a memcpy node and add it to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gdd521e1437c1c3ea8822f66a32ff1f94>
--
-- @since 0.10.0.0
--
addMemcpy :: (Graph) -> ([Node]) -> (Context) -> (Int) -- ^ srcXInBytes
 -> (Int) -- ^ srcY
 -> (Int) -- ^ srcZ
 -> (Int) -- ^ srcLOD
 -> (MemoryType) -- ^ source memory type
 -> (Ptr a) -- ^ source ptr
 -> (Int) -- ^ srcPitch
 -> (Int) -- ^ srcHeight
 -> (Int) -- ^ dstXInBytes
 -> (Int) -- ^ dstY
 -> (Int) -- ^ dstZ
 -> (Int) -- ^ dstLOD
 -> (MemoryType) -- ^ destination memory type
 -> (Ptr a) -- ^ destination ptr
 -> (Int) -- ^ dstPitch
 -> (Int) -- ^ dstHeight
 -> (Int) -- ^ widthInBytes
 -> (Int) -- ^ height
 -> (Int) -- ^ depth
 -> IO ((Node))
addMemcpy a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 =
  alloca $ \a1' ->
  let {a2' = useGraph a2} in
  withNodeArrayLen a3 $ \(a3'1, a3'2) ->
  let {a4' = useContext a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  let {a8' = fromIntegral a8} in
  let {a9' = cFromEnum a9} in
  let {a10' = castPtr a10} in
  let {a11' = fromIntegral a11} in
  let {a12' = fromIntegral a12} in
  let {a13' = fromIntegral a13} in
  let {a14' = fromIntegral a14} in
  let {a15' = fromIntegral a15} in
  let {a16' = fromIntegral a16} in
  let {a17' = cFromEnum a17} in
  let {a18' = castPtr a18} in
  let {a19' = fromIntegral a19} in
  let {a20' = fromIntegral a20} in
  let {a21' = fromIntegral a21} in
  let {a22' = fromIntegral a22} in
  let {a23' = fromIntegral a23} in
  addMemcpy'_ a1' a2' a3'1  a3'2 a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' a16' a17' a18' a19' a20' a21' a22' a23' >>= \res ->
  checkStatus res >>
  peekNode  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 386 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Create a memset node and add it to the graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gac7f59961798f14a9f94f9f6b53cc3b7>
--
-- @since 0.10.0.0
--
{-# INLINEABLE addMemset #-}
addMemset
    :: Storable a
    => Graph
    -> [Node]
    -> Context
    -> DevicePtr a
    -> a
    -> Int      -- ^ height
    -> Int      -- ^ pitch
    -> Int      -- ^ width
    -> IO Node
addMemset !g !ns !ctx !dptr !val !h !p !w =
  cuGraphAddMemsetNode_simple g ns ctx dptr bytes h p val' w
  where
    bytes = sizeOf val

    val' :: Word32
    val' = case bytes of
             1 -> fromIntegral (unsafeCoerce val :: Word8)
             2 -> fromIntegral (unsafeCoerce val :: Word16)
             4 -> fromIntegral (unsafeCoerce val :: Word32)
             _ -> cudaError "can only memset 8-, 16-, and 32-bit values"

    cuGraphAddMemsetNode_simple :: (Graph) -> ([Node]) -> (Context) -> (DevicePtr a) -> (Int) -> (Int) -> (Int) -> (Word32) -> (Int) -> IO ((Node))
    cuGraphAddMemsetNode_simple a2 a3 a4 a5 a6 a7 a8 a9 a10 =
      alloca $ \a1' ->
      let {a2' = useGraph a2} in
      withNodeArrayLen a3 $ \(a3'1, a3'2) ->
      let {a4' = useContext a4} in
      let {a5' = useDeviceHandle a5} in
      let {a6' = fromIntegral a6} in
      let {a7' = fromIntegral a7} in
      let {a8' = fromIntegral a8} in
      let {a9' = fromIntegral a9} in
      let {a10' = fromIntegral a10} in
      cuGraphAddMemsetNode_simple'_ a1' a2' a3'1  a3'2 a4' a5' a6' a7' a8' a9' a10' >>= \res ->
      checkStatus res >>
      peekNode  a1'>>= \a1'' ->
      return (a1'')

{-# LINE 437 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



--------------------------------------------------------------------------------
-- Query
--------------------------------------------------------------------------------

-- | Return the type of a node
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gdb1776d97aa1c9d5144774b29e4b8c3e>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getType #-}
getType :: (Node) -> IO ((NodeType))
getType a1 =
  let {a1' = useNode a1} in
  alloca $ \a2' ->
  getType'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekEnum  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 462 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Retrieve the embedded graph of a child sub-graph node
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gbe9fc9267316b3778ef0db507917b4fd>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getChildGraph #-}
getChildGraph :: (Node) -> IO ((Graph))
getChildGraph a1 =
  let {a1' = useNode a1} in
  alloca $ \a2' ->
  getChildGraph'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekGraph  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 483 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Return a graph's dependency edges
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g2b7bd71b0b2b8521f141996e0975a0d7>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getEdges #-}
getEdges :: Graph -> IO [(Node, Node)]
getEdges !g =
  alloca $ \p_count -> do
    cuGraphGetEdges g nullPtr nullPtr p_count
    count <- peekIntConv p_count
    allocaArray  count $ \p_from -> do
     allocaArray count $ \p_to   -> do
       cuGraphGetEdges g p_from p_to p_count
       from <- peekArray count p_from
       to   <- peekArray count p_to
       return $ zip from to
  where
    cuGraphGetEdges :: (Graph) -> (Ptr Node) -> (Ptr Node) -> (Ptr CULong) -> IO ()
    cuGraphGetEdges a1 a2 a3 a4 =
      let {a1' = useGraph a1} in
      let {a2' = castPtr a2} in
      let {a3' = castPtr a3} in
      let {a4' = id a4} in
      cuGraphGetEdges'_ a1' a2' a3' a4' >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 517 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Return a graph's nodes
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gfa35a8e2d2fc32f48dbd67ba27cf27e5>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getNodes #-}
getNodes :: Graph -> IO [Node]
getNodes !g =
  alloca $ \p_count -> do
    cuGraphGetNodes g nullPtr p_count
    count <- peekIntConv p_count
    allocaArray count $ \p_nodes -> do
      cuGraphGetNodes g p_nodes p_count
      peekArray count p_nodes
  where
    cuGraphGetNodes :: (Graph) -> (Ptr Node) -> (Ptr CULong) -> IO ()
    cuGraphGetNodes a1 a2 a3 =
      let {a1' = useGraph a1} in
      let {a2' = castPtr a2} in
      let {a3' = id a3} in
      cuGraphGetNodes'_ a1' a2' a3' >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 547 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Returns the root nodes of a graph
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gf8517646bd8b39ab6359f8e7f0edffbd>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getRootNodes #-}
getRootNodes :: Graph -> IO [Node]
getRootNodes g =
  alloca $ \p_count -> do
    cuGraphGetRootNodes g nullPtr p_count
    count <- peekIntConv p_count
    allocaArray count $ \p_nodes -> do
      cuGraphGetRootNodes g p_nodes p_count
      peekArray count p_nodes
  where
    cuGraphGetRootNodes :: (Graph) -> (Ptr Node) -> (Ptr CULong) -> IO ()
    cuGraphGetRootNodes a1 a2 a3 =
      let {a1' = useGraph a1} in
      let {a2' = castPtr a2} in
      let {a3' = id a3} in
      cuGraphGetRootNodes'_ a1' a2' a3' >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 577 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Return the dependencies of a node
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g048f4c0babcbba64a933fc277cd45083>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getDependencies #-}
getDependencies :: Node -> IO [Node]
getDependencies !n =
  alloca $ \p_count -> do
    cuGraphNodeGetDependencies n nullPtr p_count
    count <- peekIntConv p_count
    allocaArray count $ \p_deps -> do
      cuGraphNodeGetDependencies n p_deps p_count
      peekArray count p_deps
  where
    cuGraphNodeGetDependencies :: (Node) -> (Ptr Node) -> (Ptr CULong) -> IO ()
    cuGraphNodeGetDependencies a1 a2 a3 =
      let {a1' = useNode a1} in
      let {a2' = castPtr a2} in
      let {a3' = id a3} in
      cuGraphNodeGetDependencies'_ a1' a2' a3' >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 607 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Return a node's dependent nodes
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g4b73d9e3b386a9c0b094a452b8431f59>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getDependents #-}
getDependents :: Node -> IO [Node]
getDependents n =
  alloca $ \p_count -> do
    cuGraphNodeGetDependentNodes n nullPtr p_count
    count <- peekIntConv p_count
    allocaArray count $ \p_deps -> do
      cuGraphNodeGetDependentNodes n p_deps p_count
      peekArray count p_deps
  where
    cuGraphNodeGetDependentNodes :: (Node) -> (Ptr Node) -> (Ptr CULong) -> IO ()
    cuGraphNodeGetDependentNodes a1 a2 a3 =
      let {a1' = useNode a1} in
      let {a2' = castPtr a2} in
      let {a3' = id a3} in
      cuGraphNodeGetDependentNodes'_ a1' a2' a3' >>= \res ->
      checkStatus res >>
      return ()

{-# LINE 637 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- | Find a cloned version of a node
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gf21f6c968e346f028737c1118bfd41c2>
--
-- @since 0.10.0.0
--
{-# INLINEABLE findInClone #-}
findInClone :: (Node) -> (Graph) -> IO ((Node))
findInClone a2 a3 =
  alloca $ \a1' ->
  let {a2' = useNode a2} in
  let {a3' = useGraph a3} in
  findInClone'_ a1' a2' a3' >>= \res ->
  checkStatus res >>
  peekNode  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 659 "src/Foreign/CUDA/Driver/Graph/Build.chs" #-}



-- TODO: since CUDA-10.0
--  * cuGraphHostNode[Get/Set]Params
--  * cuGraphKernelNode[Get/Set]Params
--  * cuGraphMemcpyNode[Get/Set]Params
--  * cuGraphMemsetNode[Get/Set]Params

--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE peekGraph #-}
peekGraph :: Ptr ((C2HSImp.Ptr ())) -> IO Graph
peekGraph = liftM Graph . peek

{-# INLINE peekNode #-}
peekNode :: Ptr ((C2HSImp.Ptr ())) -> IO Node
peekNode = liftM Node . peek

{-# INLINE withNodeArray #-}
withNodeArray :: [Node] -> (Ptr ((C2HSImp.Ptr ())) -> IO a) -> IO a
withNodeArray ns f = withArray ns (f . castPtr)

{-# INLINE withNodeArrayLen #-}
withNodeArrayLen :: [Node] -> ((Ptr ((C2HSImp.Ptr ())), CULong) -> IO a) -> IO a
withNodeArrayLen ns f = withArrayLen ns $ \i p -> f (castPtr p, cIntConv i)


foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphCreate"
  create'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphDestroy"
  destroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphClone"
  clone'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphDestroyNode"
  remove'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddChildGraphNode"
  cuGraphAddChildGraphNode'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddDependencies"
  cuGraphAddDependencies'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphRemoveDependencies"
  cuGraphRemoveDependencies'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddEmptyNode"
  addEmpty'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddHostNode_simple"
  addHost'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddKernelNode_simple"
  cuGraphAddKernelNode_simple'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))))))))))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddMemcpyNode_simple"
  addMemcpy'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))))))))))))))))))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphAddMemsetNode_simple"
  cuGraphAddMemsetNode_simple'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CUInt -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))))))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphNodeGetType"
  getType'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphChildGraphNodeGetGraph"
  getChildGraph'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphGetEdges"
  cuGraphGetEdges'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphGetNodes"
  cuGraphGetNodes'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphGetRootNodes"
  cuGraphGetRootNodes'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphNodeGetDependencies"
  cuGraphNodeGetDependencies'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphNodeGetDependentNodes"
  cuGraphNodeGetDependentNodes'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Build.chs.h cuGraphNodeFindInClone"
  findInClone'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))