FAI 0.1.0.17 → 0.1.0.20

raw patch · 7 files changed

+18/−11 lines, 7 files

Files

• FAI.cabal +2/−2
• src/Foreign/FAI/Internal.hs +3/−2
• src/Foreign/FAI/Platform/CUDA.hs +2/−2
• src/Foreign/FAI/Platform/Host.hs +2/−2
• src/Foreign/FAI/Types.hs +5/−1
• test/Foreign/FAI/Platform/CUDASpec.hs +2/−1
• test/Foreign/FAI/Platform/HostSpec.hs +2/−1

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/
 
 name:                FAI
-version:             0.1.0.17
+version:             0.1.0.20
 synopsis:            Haskell Foreign Accelerate Interface
 description:         The haskell interface for foreign accelerate framework.
 homepage:            https://github.com/Qinka/HaskellFAI
@@ -19,7 +19,7 @@ stability:           experimental
 
 flag enable-cuda
-      default:             True
+      default:             False
       manual:              False
       description:         Enable the Nvidia's CUDA platform.
 

@@ -52,8 +52,9 @@                   -> Int                            -- ^ Size
                   -> IO (Buffer p a)                -- ^ buffer
 autoNewForeignPtr fin cc ptr size = fmap (`Buffer` size) $ case fin of
-  Left  f -> newForeignPtrEnv f (unContextPtr cc) ptr
-  Right f -> newForeignPtr    f                   ptr
+  Left  f -> withForeignPtr (unContextPtr cc) $ \p ->
+             newForeignPtrEnv f p ptr
+  Right f -> newForeignPtr    f   ptr
 
 replaceContext :: Context p2 -> (a, Context p1) -> (a, Context p2)
 replaceContext cc (a, _) = (a, cc)

@@ -151,5 +151,5 @@     cudaMemCopy doCopyCC (bufPtr dst) (bufPtr src) $ fromIntegral $ bufSize dst
 
 -- | Null pointer context of CUDA
-nullCUDAContext :: Context CUDA
-nullCUDAContext = Context nullPtr
+nullCUDAContext :: IO (Context CUDA)
+nullCUDAContext = Context <$> newForeignPtr_ nullPtr

@@ -92,5 +92,5 @@     hostMemCopy (bufPtr dst) (bufPtr src) $ fromIntegral $ bufSize dst
 
 -- | Null pointer context of Host
-nullHostContext :: Context Host
-nullHostContext = Context nullPtr
+nullHostContext :: IO (Context Host)
+nullHostContext = Context <$> newForeignPtr_ nullPtr

@@ -65,8 +65,12 @@   deriving (Show, Eq)
 
 -- | Context of platform
+--
+-- The Haskell GC can not guarantee that @Context p@ will be released after
+-- all the @Buffer p a@ is released.
+-- So the C implement at lower level need to make sure it.
 newtype Context p = Context
-  { unContextPtr :: Ptr (Context p)
+  { unContextPtr :: ForeignPtr (Context p)
   }
   deriving (Show, Eq)
 

@@ -17,6 +17,7 @@ import           Foreign.Marshal.Array
 import           Foreign.Ptr
 import           Foreign.Storable
+import           System.IO.Unsafe
 
 peekBuffer :: (Storable b, Pf Host a ~ b) => Buffer Host a -> IO [b]
 peekBuffer (Buffer fp len) = withForeignPtr fp $ \p -> peekArray len p
@@ -44,7 +45,7 @@       (arr1, arr2) <- acc
       arr1 `shouldBe` arr2
 
-cc = Context nullPtr
+cc = unsafePerformIO nullCUDAContext
 
 #else
 spec = describe "Skip CUDA Test" $ it "Do nothing" $ putStrLn "Skip."

@@ -9,6 +9,7 @@ import           Foreign.FAI.Platform.Host.Debug
 import           Foreign.Ptr
 import           Foreign.Storable
+import           System.IO.Unsafe
 import           Test.Hspec
 
 peekBufferA :: (Storable b, Pf Host a ~ b) => Buffer Host a -> Accelerate Host [b]
@@ -55,4 +56,4 @@       arr1 `shouldBe` arr2
 
 cc :: Context Host
-cc = Context nullPtr
+cc = unsafePerformIO nullHostContext