mpi-hs 0.4.0.0 → 0.4.1.0

raw patch · 6 files changed

+105/−19 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• lib/Control/Distributed/MPI/Packing.hs +40/−8
• lib/Control/Distributed/MPI/Store.hs +40/−8
• mpi-hs.cabal +2/−2
• package.yaml +1/−1
• tests/packing/Main.hs +11/−0
• tests/store/Main.hs +11/−0

@@ -73,6 +73,8 @@      -- ** Collective (non-blocking)   , ibarrier+  , ibcastRecv+  , ibcastSend   ) where  import Prelude hiding (init)@@ -229,8 +231,11 @@      -> IO () send sendobj sendrank sendtag comm =   do sendbuf <- serialize sendobj-     req <- MPI.isend sendbuf sendrank sendtag comm-     whileM_ (not <$> MPI.test_ req) yield+     -- Use 'unsafeUseAsCStringLen' to ensure 'sendbuf' is not freed+     -- too early+     B.unsafeUseAsCStringLen sendbuf $ \_ ->+       do req <- MPI.isend sendbuf sendrank sendtag comm+          whileM_ (not <$> MPI.test_ req) yield  -- | Send and receive objects simultaneously. sendrecv :: (CanSerialize a, CanSerialize b)@@ -326,11 +331,13 @@   do rank <- MPI.commRank comm      mpiAssert (rank /= root) "bcastRecv: expected rank /= root"      lenbuf <- mallocForeignPtr @CLong-     MPI.bcast (lenbuf, 1::Int) root comm+     lenreq <- MPI.ibcast (lenbuf, 1::Int) root comm+     whileM_ (not <$> MPI.test_ lenreq) yield      len <- withForeignPtr lenbuf peek      ptr <- mallocBytes (fromIntegral len)      recvbuf <- B.unsafePackMallocCStringLen (ptr, fromIntegral len)-     MPI.bcast recvbuf root comm               +     req <- MPI.ibcast recvbuf root comm               +     whileM_ (not <$> MPI.test_ req) yield      recvobj <- deserialize recvbuf      return recvobj @@ -348,17 +355,42 @@      sendbuf <- serialize sendobj      lenbuf <- mallocForeignPtr @CLong      withForeignPtr lenbuf $ \ptr -> poke ptr (fromIntegral (B.length sendbuf))-     MPI.bcast (lenbuf, 1::Int) root comm-     MPI.bcast sendbuf root comm+     lenreq <- MPI.ibcast (lenbuf, 1::Int) root comm+     whileM_ (not <$> MPI.test_ lenreq) yield+     req <- MPI.ibcast sendbuf root comm+     whileM_ (not <$> MPI.test_ req) yield +ibcastRecv :: CanSerialize a+           => Rank+           -> Comm+           -> IO (Request a)+ibcastRecv root comm =+  do result <- newEmptyMVar+     _ <- forkIO $+       do recvobj <- bcastRecv root comm+          putMVar result (Status root MPI.anyTag, recvobj)+     return (Request result)++ibcastSend :: CanSerialize a+           => a+           -> Rank+           -> Comm+           -> IO (Request ())+ibcastSend sendobj root comm =+  do result <- newEmptyMVar+     _ <- forkIO $+       do bcastSend sendobj root comm+          putMVar result (Status root MPI.anyTag, ())+     return (Request result)+ -- | Begin a barrier. Call 'test' or 'wait' to finish the -- communication. ibarrier :: Comm          -> IO (Request ()) ibarrier comm =   do result <- newEmptyMVar-     req <- MPI.ibarrier comm      _ <- forkIO $-       do whileM_ (not <$> MPI.test_ req) yield+       do req <- MPI.ibarrier comm+          whileM_ (not <$> MPI.test_ req) yield           putMVar result (Status MPI.anySource MPI.anyTag, ())      return (Request result)

@@ -73,6 +73,8 @@      -- ** Collective (non-blocking)   , ibarrier+  , ibcastRecv+  , ibcastSend   ) where  import Prelude hiding (init)@@ -227,8 +229,11 @@      -> IO () send sendobj sendrank sendtag comm =   do sendbuf <- serialize sendobj-     req <- MPI.isend sendbuf sendrank sendtag comm-     whileM_ (not <$> MPI.test_ req) yield+     -- Use 'unsafeUseAsCStringLen' to ensure 'sendbuf' is not freed+     -- too early+     B.unsafeUseAsCStringLen sendbuf $ \_ ->+       do req <- MPI.isend sendbuf sendrank sendtag comm+          whileM_ (not <$> MPI.test_ req) yield  -- | Send and receive objects simultaneously. sendrecv :: (CanSerialize a, CanSerialize b)@@ -324,11 +329,13 @@   do rank <- MPI.commRank comm      mpiAssert (rank /= root) "bcastRecv: expected rank /= root"      lenbuf <- mallocForeignPtr @CLong-     MPI.bcast (lenbuf, 1::Int) root comm+     lenreq <- MPI.ibcast (lenbuf, 1::Int) root comm+     whileM_ (not <$> MPI.test_ lenreq) yield      len <- withForeignPtr lenbuf peek      ptr <- mallocBytes (fromIntegral len)      recvbuf <- B.unsafePackMallocCStringLen (ptr, fromIntegral len)-     MPI.bcast recvbuf root comm               +     req <- MPI.ibcast recvbuf root comm               +     whileM_ (not <$> MPI.test_ req) yield      recvobj <- deserialize recvbuf      return recvobj @@ -346,17 +353,42 @@      sendbuf <- serialize sendobj      lenbuf <- mallocForeignPtr @CLong      withForeignPtr lenbuf $ \ptr -> poke ptr (fromIntegral (B.length sendbuf))-     MPI.bcast (lenbuf, 1::Int) root comm-     MPI.bcast sendbuf root comm+     lenreq <- MPI.ibcast (lenbuf, 1::Int) root comm+     whileM_ (not <$> MPI.test_ lenreq) yield+     req <- MPI.ibcast sendbuf root comm+     whileM_ (not <$> MPI.test_ req) yield +ibcastRecv :: CanSerialize a+           => Rank+           -> Comm+           -> IO (Request a)+ibcastRecv root comm =+  do result <- newEmptyMVar+     _ <- forkIO $+       do recvobj <- bcastRecv root comm+          putMVar result (Status root MPI.anyTag, recvobj)+     return (Request result)++ibcastSend :: CanSerialize a+           => a+           -> Rank+           -> Comm+           -> IO (Request ())+ibcastSend sendobj root comm =+  do result <- newEmptyMVar+     _ <- forkIO $+       do bcastSend sendobj root comm+          putMVar result (Status root MPI.anyTag, ())+     return (Request result)+ -- | Begin a barrier. Call 'test' or 'wait' to finish the -- communication. ibarrier :: Comm          -> IO (Request ()) ibarrier comm =   do result <- newEmptyMVar-     req <- MPI.ibarrier comm      _ <- forkIO $-       do whileM_ (not <$> MPI.test_ req) yield+       do req <- MPI.ibarrier comm+          whileM_ (not <$> MPI.test_ req) yield           putMVar result (Status MPI.anySource MPI.anyTag, ())      return (Request result)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5c902ab43e71de0472124cd5087d38762a8c74caf1bf2af33a04eb72da015285+-- hash: 78a9591a1cd036f2ecd9afed2b5c9b1a094791c057255536650d00de3174f23c  name:           mpi-hs-version:        0.4.0.0+version:        0.4.1.0 synopsis:       MPI bindings for Haskell description:    MPI (the [Message Passing Interface](https://www.mpi-forum.org)) is                 widely used standard for distributed-memory programming on HPC (High

@@ -1,5 +1,5 @@ name: mpi-hs-version: '0.4.0.0'+version: '0.4.1.0' github: "eschnett/mpi-hs" license: Apache-2.0 author: "Erik Schnetter <schnetter@gmail.com>"

@@ -152,4 +152,15 @@   [ testCase "barrier" $     do req <- MPI.ibarrier MPI.commWorld        MPI.wait_ req+  , testCase "bcast" $+    do rank <- MPI.commRank MPI.commWorld+       let sendmsg :: String = "Hello, World!"+       recvmsg :: String <-+         if rank == MPI.rootRank+         then do req <- MPI.ibcastSend sendmsg MPI.rootRank MPI.commWorld+                 MPI.wait_ req+                 return sendmsg+         else do req <- MPI.ibcastRecv MPI.rootRank MPI.commWorld+                 MPI.wait_ req+       recvmsg == sendmsg @? ""   ]

@@ -152,4 +152,15 @@   [ testCase "barrier" $     do req <- MPI.ibarrier MPI.commWorld        MPI.wait_ req+  , testCase "bcast" $+    do rank <- MPI.commRank MPI.commWorld+       let sendmsg :: String = "Hello, World!"+       recvmsg :: String <-+         if rank == MPI.rootRank+         then do req <- MPI.ibcastSend sendmsg MPI.rootRank MPI.commWorld+                 MPI.wait_ req+                 return sendmsg+         else do req <- MPI.ibcastRecv MPI.rootRank MPI.commWorld+                 MPI.wait_ req+       recvmsg == sendmsg @? ""   ]