{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}

module Torch.Internal.Managed.Type.Context where


import Foreign.C.String
import Foreign.C.Types
import Foreign
import Torch.Internal.Type
import Torch.Internal.Class
import Torch.Internal.Cast
import Torch.Internal.Objects

import qualified Torch.Internal.Unmanaged.Type.Generator as Unmanaged
import qualified Torch.Internal.Unmanaged.Type.Context as Unmanaged









init
  :: IO (())
init :: IO ()
init = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO ()
Unmanaged.init

hasCUDA
  :: IO (CBool)
hasCUDA :: IO CBool
hasCUDA = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasCUDA

hasHIP
  :: IO (CBool)
hasHIP :: IO CBool
hasHIP = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasHIP

hasXLA
  :: IO (CBool)
hasXLA :: IO CBool
hasXLA = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasXLA

getNumGPUs
  :: IO (CSize)
getNumGPUs :: IO CSize
getNumGPUs = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CSize
Unmanaged.getNumGPUs

hasOpenMP
  :: IO (CBool)
hasOpenMP :: IO CBool
hasOpenMP = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasOpenMP

hasMKL
  :: IO (CBool)
hasMKL :: IO CBool
hasMKL = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasMKL

hasLAPACK
  :: IO (CBool)
hasLAPACK :: IO CBool
hasLAPACK = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasLAPACK

hasMAGMA
  :: IO (CBool)
hasMAGMA :: IO CBool
hasMAGMA = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasMAGMA

hasMKLDNN
  :: IO (CBool)
hasMKLDNN :: IO CBool
hasMKLDNN = forall a ca. Castable a ca => IO ca -> IO a
_cast0 IO CBool
Unmanaged.hasMKLDNN

manual_seed_L
  :: Word64
  -> IO (())
manual_seed_L :: Word64 -> IO ()
manual_seed_L = forall a ca y cy.
(Castable a ca, Castable y cy) =>
(ca -> IO cy) -> a -> IO y
_cast1 Word64 -> IO ()
Unmanaged.manual_seed_L

get_manual_seed
  :: IO (Word64)
get_manual_seed :: IO Word64
get_manual_seed = do
  Ptr Generator
g <- IO (Ptr Generator)
Unmanaged.getDefaultCPUGenerator
  Ptr Generator -> IO Word64
Unmanaged.generator_current_seed Ptr Generator
g