-- 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/Base.chs" #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell            #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Graph.Base
-- Copyright : [2018] Trevor L. McDonell
-- License   : BSD
--
-- Graph execution functions for the low-level driver interface
--
-- Requires CUDA-10
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Graph.Base
  where
import qualified Foreign.Ptr as C2HSImp





{-# LINE 26 "src/Foreign/CUDA/Driver/Graph/Base.chs" #-}


import Foreign.Storable
import Foreign.Ptr


--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

newtype Graph = Graph { Graph -> Ptr ()
useGraph :: ((C2HSImp.Ptr ()))}
  deriving (Graph -> Graph -> Bool
(Graph -> Graph -> Bool) -> (Graph -> Graph -> Bool) -> Eq Graph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graph -> Graph -> Bool
$c/= :: Graph -> Graph -> Bool
== :: Graph -> Graph -> Bool
$c== :: Graph -> Graph -> Bool
Eq, Int -> Graph -> ShowS
[Graph] -> ShowS
Graph -> String
(Int -> Graph -> ShowS)
-> (Graph -> String) -> ([Graph] -> ShowS) -> Show Graph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graph] -> ShowS
$cshowList :: [Graph] -> ShowS
show :: Graph -> String
$cshow :: Graph -> String
showsPrec :: Int -> Graph -> ShowS
$cshowsPrec :: Int -> Graph -> ShowS
Show)

data GraphFlag
instance Enum GraphFlag where

newtype Node = Node { Node -> Ptr ()
useNode :: ((C2HSImp.Ptr ()))}
  deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Ptr b -> Int -> IO Node
Ptr b -> Int -> Node -> IO ()
Ptr Node -> IO Node
Ptr Node -> Int -> IO Node
Ptr Node -> Int -> Node -> IO ()
Ptr Node -> Node -> IO ()
Node -> Int
(Node -> Int)
-> (Node -> Int)
-> (Ptr Node -> Int -> IO Node)
-> (Ptr Node -> Int -> Node -> IO ())
-> (forall b. Ptr b -> Int -> IO Node)
-> (forall b. Ptr b -> Int -> Node -> IO ())
-> (Ptr Node -> IO Node)
-> (Ptr Node -> Node -> IO ())
-> Storable Node
forall b. Ptr b -> Int -> IO Node
forall b. Ptr b -> Int -> Node -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Node -> Node -> IO ()
$cpoke :: Ptr Node -> Node -> IO ()
peek :: Ptr Node -> IO Node
$cpeek :: Ptr Node -> IO Node
pokeByteOff :: Ptr b -> Int -> Node -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Node -> IO ()
peekByteOff :: Ptr b -> Int -> IO Node
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Node
pokeElemOff :: Ptr Node -> Int -> Node -> IO ()
$cpokeElemOff :: Ptr Node -> Int -> Node -> IO ()
peekElemOff :: Ptr Node -> Int -> IO Node
$cpeekElemOff :: Ptr Node -> Int -> IO Node
alignment :: Node -> Int
$calignment :: Node -> Int
sizeOf :: Node -> Int
$csizeOf :: Node -> Int
Storable)

data NodeType = Kernel
              | Memcpy
              | Memset
              | Host
              | Subgraph
              | Empty
              | Count
  deriving (NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c== :: NodeType -> NodeType -> Bool
Eq,Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> String
(Int -> NodeType -> ShowS)
-> (NodeType -> String) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeType] -> ShowS
$cshowList :: [NodeType] -> ShowS
show :: NodeType -> String
$cshow :: NodeType -> String
showsPrec :: Int -> NodeType -> ShowS
$cshowsPrec :: Int -> NodeType -> ShowS
Show,NodeType
NodeType -> NodeType -> Bounded NodeType
forall a. a -> a -> Bounded a
maxBound :: NodeType
$cmaxBound :: NodeType
minBound :: NodeType
$cminBound :: NodeType
Bounded)
instance Enum NodeType where
  succ :: NodeType -> NodeType
succ NodeType
Kernel = NodeType
Memcpy
  succ NodeType
Memcpy = NodeType
Memset
  succ NodeType
Memset = NodeType
Host
  succ NodeType
Host = NodeType
Subgraph
  succ NodeType
Subgraph = NodeType
Empty
  succ NodeType
Empty = NodeType
Count
  succ NodeType
Count = String -> NodeType
forall a. HasCallStack => String -> a
error String
"NodeType.succ: Count has no successor"

  pred :: NodeType -> NodeType
pred NodeType
Memcpy = NodeType
Kernel
  pred NodeType
Memset = NodeType
Memcpy
  pred NodeType
Host = NodeType
Memset
  pred NodeType
Subgraph = NodeType
Host
  pred NodeType
Empty = NodeType
Subgraph
  pred NodeType
Count = NodeType
Empty
  pred NodeType
Kernel = String -> NodeType
forall a. HasCallStack => String -> a
error String
"NodeType.pred: Kernel has no predecessor"

  enumFromTo :: NodeType -> NodeType -> [NodeType]
enumFromTo NodeType
from NodeType
to = NodeType -> [NodeType]
forall t. Enum t => t -> [t]
go NodeType
from
    where
      end = fromEnum to
      go v = case compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 Ordering
EQ -> [t
v]
                 Ordering
GT -> []

  enumFrom :: NodeType -> [NodeType]
enumFrom NodeType
from = NodeType -> NodeType -> [NodeType]
forall a. Enum a => a -> a -> [a]
enumFromTo NodeType
from NodeType
Count

  fromEnum :: NodeType -> Int
fromEnum NodeType
Kernel = Int
0
  fromEnum NodeType
Memcpy = Int
1
  fromEnum NodeType
Memset = Int
2
  fromEnum NodeType
Host = Int
3
  fromEnum NodeType
Subgraph = Int
4
  fromEnum NodeType
Empty = Int
5
  fromEnum NodeType
Count = Int
6

  toEnum :: Int -> NodeType
toEnum Int
0 = NodeType
Kernel
  toEnum Int
1 = NodeType
Memcpy
  toEnum Int
2 = NodeType
Memset
  toEnum Int
3 = NodeType
Host
  toEnum Int
4 = NodeType
Subgraph
  toEnum Int
5 = NodeType
Empty
  toEnum Int
6 = NodeType
Count
  toEnum Int
unmatched = String -> NodeType
forall a. HasCallStack => String -> a
error (String
"NodeType.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 68 "src/Foreign/CUDA/Driver/Graph/Base.chs" #-}



newtype Executable = Executable { useExecutable :: ((C2HSImp.Ptr ()))}
  deriving (Eq, Show)