packages feed

libtorch-ffi 2.0.0.1 → 2.0.1.0

raw patch · 11 files changed

+146/−12 lines, 11 filesdep +text

Dependencies added: text

Files

libtorch-ffi.cabal view
@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                libtorch-ffi-version:             2.0.0.1+version:             2.0.1.0 -- The prefix(2.0) of this version("2.0.0.0") is the same as libtorch's one. synopsis:            Haskell bindings for PyTorch description:         This package provides Haskell bindings to libtorch, the C++ library underlying PyTorch, specifically designed for the Hasktorch ecosystem.@@ -148,6 +148,7 @@                     , sysinfo >= 0.1.1 && < 0.2                     , async >= 2.2.5 && < 2.3                     , libtorch-ffi-helper >= 2.0.0 && < 2.1+                    , text >= 2.0.2 && < 2.1  ghc-options:       -fplugin GHC.NotExport.Plugin  extra-libraries:     c10                     , torch@@ -194,6 +195,7 @@ --  libtorch-1.3 does not work this grad-function. But grad of higher level api works. --                 , BackwardSpec                  , CudaSpec+                 , MpsSpec                  , GeneratorSpec   default-language: Haskell2010   build-depends:       base
src/Torch/Internal/Const.hs view
@@ -26,9 +26,20 @@ C.include "<ATen/ScalarType.h>" C.include "<ATen/core/Reduction.h>" C.include "<c10/core/Layout.h>"+C.include "<torch/version.h>" +torchVersionMajor :: CInt+torchVersionMajor = [C.pure| int { TORCH_VERSION_MAJOR } |] +torchVersionMinor :: CInt+torchVersionMinor = [C.pure| int { TORCH_VERSION_MINOR } |] +torchVersionPatch :: CInt+torchVersionPatch = [C.pure| int { TORCH_VERSION_PATCH } |]++torchVersion :: String+torchVersion = show torchVersionMajor ++ "." ++ show torchVersionMinor ++ "." ++ show torchVersionPatch+ kByte :: ScalarType kByte = [C.pure| int8_t { (int8_t) at::ScalarType::Byte } |] @@ -86,6 +97,9 @@ kCUDA :: DeviceType kCUDA = [C.pure| int16_t { (int16_t) at::DeviceType::CUDA } |] +kMPS :: DeviceType+kMPS = [C.pure| int16_t { (int16_t) at::DeviceType::MPS } |]+ kMKLDNN :: DeviceType kMKLDNN = [C.pure| int16_t { (int16_t) at::DeviceType::MKLDNN } |] @@ -129,6 +143,9 @@  bCUDA :: Backend bCUDA = [C.pure| int { (int) at::Backend::CUDA } |]++bMPS :: Backend+bMPS = [C.pure| int { (int) at::Backend::MPS } |]  bHIP :: Backend bHIP = [C.pure| int { (int) at::Backend::HIP } |]
src/Torch/Internal/GC.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}  module Torch.Internal.GC where @@ -19,13 +20,19 @@ import Data.List (isPrefixOf) import Foreign.C.Types import GHC.ExecutionStack-import Language.C.Inline.Cpp.Exceptions+import Language.C.Inline.Cpp.Exception import System.Environment (lookupEnv) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafePerformIO) import System.Mem (performGC) import System.SysInfo+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as T+import qualified Data.Text as T+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B + foreign import ccall unsafe "hasktorch_finalizer.h showWeakPtrList"   c_showWeakPtrList :: CInt -> IO () @@ -53,29 +60,32 @@  instance Exception HasktorchException +bsToChars :: ByteString -> String+bsToChars = T.unpack . T.decodeUtf8With T.lenientDecode+ unsafeThrowableIO :: forall a m. MonadThrow m => IO a -> m a-unsafeThrowableIO a = unsafePerformIO $ (pure <$> a) `catch` (\(CppStdException msg) -> pure . throwM $ HasktorchException msg)+unsafeThrowableIO a = unsafePerformIO $ (pure <$> a) `catch` (\(CppStdException _ msg _) -> pure . throwM $ HasktorchException ("Exception: " <> bsToChars msg))  prettyException :: IO a -> IO a prettyException func =-  func `catch` \a@(CppStdException message) -> do+  func `catch` \a@(CppStdException _ message _) -> do     flag <- lookupEnv "HASKTORCH_DEBUG"     when (flag /= Just "0") $ do       mst <- showStackTrace       case mst of         Just st -> hPutStrLn stderr st         Nothing -> hPutStrLn stderr "Cannot show stacktrace"-      hPutStrLn stderr message+      B.hPutStr stderr message     throwIO a {-# INLINE prettyException #-}  retryWithGC' :: Int -> IO a -> IO a retryWithGC' count func =-  func `catch` \a@(CppStdException message) ->-    if isPrefixOf msgOutOfMemory message+  func `catch` \a@(CppStdException _ message _) ->+    if B.isPrefixOf msgOutOfMemory message       then         if count <= 0-          then throwIO $ userError $ "Too many calls to performGC, " ++ message+          then throwIO $ userError $ bsToChars $ "Too many calls to performGC, " <> message           else do             performGC             mallocTrim 0@@ -83,8 +93,11 @@             retryWithGC' (count -1) func       else throwIO a   where-    msgOutOfMemory :: String+#ifdef darwin_HOST_OS+    msgOutOfMemory = "MPS backend out of memory"+#else     msgOutOfMemory = "Exception: CUDA out of memory."+#endif {-# INLINE retryWithGC' #-}  retryWithGC :: IO a -> IO a
src/Torch/Internal/Managed/Type/Context.hs view
@@ -58,6 +58,10 @@   :: IO (CBool) hasMKL = _cast0 Unmanaged.hasMKL +hasMPS+  :: IO (CBool)+hasMPS = _cast0 Unmanaged.hasMPS+ hasLAPACK   :: IO (CBool) hasLAPACK = _cast0 Unmanaged.hasLAPACK
src/Torch/Internal/Managed/Type/Generator.hs view
@@ -28,6 +28,10 @@   -> IO (ForeignPtr Generator) newCUDAGenerator _device_index = _cast1 Unmanaged.newCUDAGenerator _device_index +newMPSGenerator+  :: IO (ForeignPtr Generator)+newMPSGenerator = _cast0 Unmanaged.newMPSGenerator+ newCPUGenerator   :: Word64   -> IO (ForeignPtr Generator)@@ -77,3 +81,8 @@   :: ForeignPtr Generator   -> IO CBool generator_is_hip _obj = _cast1 Unmanaged.generator_is_hip _obj++generator_is_mps+  :: ForeignPtr Generator+  -> IO CBool+generator_is_mps _obj = _cast1 Unmanaged.generator_is_mps _obj
src/Torch/Internal/Managed/Type/Tensor/Tensor0.hs view
@@ -61,6 +61,11 @@   -> IO (ForeignPtr Tensor) tensor_cuda = cast1 Unmanaged.tensor_cuda +tensor_mps+  :: ForeignPtr Tensor+  -> IO (ForeignPtr Tensor)+tensor_mps = cast1 Unmanaged.tensor_mps+ tensor_data_ptr   :: ForeignPtr Tensor   -> IO (Ptr ())@@ -116,6 +121,11 @@   :: ForeignPtr Tensor   -> IO (CBool) tensor_is_cuda = cast1 Unmanaged.tensor_is_cuda++tensor_is_mps+  :: ForeignPtr Tensor+  -> IO (CBool)+tensor_is_mps = cast1 Unmanaged.tensor_is_mps  tensor_is_hip   :: ForeignPtr Tensor
src/Torch/Internal/Unmanaged/Type/Context.hs view
@@ -79,6 +79,13 @@     ));   }|] +hasMPS+  :: IO (CBool)+hasMPS  =+  [C.throwBlock| bool { return (at::hasMPS(+    ));+  }|]+ hasLAPACK   :: IO (CBool) hasLAPACK  =
src/Torch/Internal/Unmanaged/Type/Generator.hs view
@@ -25,6 +25,7 @@ C.context $ C.cppCtx <> mempty { C.ctxTypesTable = typeTable }  C.include "<ATen/detail/CUDAHooksInterface.h>"+C.include "<ATen/detail/MPSHooksInterface.h>" C.include "<ATen/CPUGeneratorImpl.h>" C.include "<ATen/core/Generator.h>" @@ -33,6 +34,8 @@  newCUDAGenerator _device_index = getDefaultCUDAGenerator _device_index >>= generator_clone +newMPSGenerator = getDefaultMPSGenerator >>= generator_clone+ newCPUGenerator   :: Word64   -> IO (Ptr Generator)@@ -41,8 +44,6 @@     $(uint64_t _seed_in)));   }|] -- generator_set_current_seed   :: Ptr Generator   -> Word64@@ -104,12 +105,25 @@   [C.throwBlock| bool { return ((*$(at::Generator* _obj)).device().is_hip());   }|] +generator_is_mps+  :: Ptr Generator+  -> IO CBool+generator_is_mps _obj =+  [C.throwBlock| bool { return ((*$(at::Generator* _obj)).device().is_mps());+  }|]+ getDefaultCUDAGenerator   :: Word16   -> IO (Ptr Generator) getDefaultCUDAGenerator _device_index =   [C.throwBlock| at::Generator* { return new at::Generator(at::detail::getCUDAHooks().getDefaultCUDAGenerator(     $(uint16_t _device_index)));+  }|]++getDefaultMPSGenerator+  :: IO (Ptr Generator)+getDefaultMPSGenerator =+  [C.throwBlock| at::Generator* { return new at::Generator(at::detail::getMPSHooks().getDefaultMPSGenerator());   }|]  getDefaultCPUGenerator
src/Torch/Internal/Unmanaged/Type/Tensor/Tensor0.hs view
@@ -92,6 +92,13 @@     ));   }|] +tensor_mps+  :: Ptr Tensor+  -> IO (Ptr Tensor)+tensor_mps _obj =+  [C.throwBlock| at::Tensor* { return new at::Tensor((*$(at::Tensor* _obj)).to("mps"));+  }|]+ tensor_data_ptr   :: Ptr Tensor   -> IO (Ptr ())@@ -178,6 +185,14 @@   -> IO (CBool) tensor_is_cuda _obj =   [C.throwBlock| bool { return (*$(at::Tensor* _obj)).is_cuda(+    );+  }|]++tensor_is_mps+  :: Ptr Tensor+  -> IO (CBool)+tensor_is_mps _obj =+  [C.throwBlock| bool { return (*$(at::Tensor* _obj)).is_mps(     );   }|]
+ test/MpsSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+module MpsSpec (main, spec) where++import Test.Hspec+import Control.Exception.Safe (bracket,catch,throwIO)+import Control.Monad (forM_,forM)+import Data.Int+import Foreign+import Torch.Internal.Const+import Torch.Internal.Type+import Torch.Internal.Managed.Type.TensorOptions+import Torch.Internal.Managed.Type.Tensor+import Torch.Internal.Managed.Type.IntArray+import Torch.Internal.Managed.Type.Context+import Torch.Internal.Managed.Native+import Torch.Internal.GC++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "MpsSpec" $ do+    it "When MPS is out of memory, do GC and retry" $ do+      flag <- hasMPS+      monitorMemory $ do+        forM_ [0..1000] $ \i -> do -- 80MByte x 1000 = 80GByte+          dims <- fromList [1000,1000,10] -- 8 byte x 10M = 80MByte+          to <- device_D $ if flag == 0 then kCPU else kMPS+          tod <- tensorOptions_dtype_s to kFloat+          zeros_lo dims tod+          return ()++fromList :: [Int64] -> IO (ForeignPtr IntArray)+fromList dims = do+  ary <- newIntArray+  forM_ dims $ intArray_push_back_l ary+  return ary
test/Spec.hs view
@@ -4,13 +4,16 @@ import Test.Hspec (hspec) import qualified BasicSpec import qualified CudaSpec+import qualified MpsSpec import qualified GeneratorSpec import qualified MemorySpec  main :: IO () main = hspec $ do   BasicSpec.spec-#ifndef darwin_HOST_OS+#ifdef darwin_HOST_OS+  MpsSpec.spec+#else   CudaSpec.spec #endif   GeneratorSpec.spec