mpi-hs 0.5.3.0 → 0.6.0.0

raw patch · 11 files changed

+103/−2005 lines, 11 filesdep −binarydep −cerealdep −storedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: binary, cereal, store

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +71/−65
• lib/Control/Distributed/MPI.chs +0/−11
• lib/Control/Distributed/MPI/Binary.hs +0/−403
• lib/Control/Distributed/MPI/Serialize.hs +0/−399
• lib/Control/Distributed/MPI/Store.hs +0/−394
• mpi-hs.cabal +14/−164
• package.yaml +16/−69
• stack.yaml +2/−2
• tests/binary/Main.hs +0/−166
• tests/serialize/Main.hs +0/−166
• tests/store/Main.hs +0/−166

@@ -8,15 +8,15 @@ * [Stackage](https://www.stackage.org/package/mpi-hs): Stackage   snapshots * [Azure-  Pipelines](https://dev.azure.com/schnetter/ringal/_build):+  Pipelines](https://dev.azure.com/schnetter/mpi-hs/_build):   Build Status [![Build-  Status](https://dev.azure.com/schnetter/mpi-hs/_apis/build/status/eschnett.mpi-hs?branchName=master)](https://dev.azure.com/schnetter/mpi-hs/_build/latest?definitionId=1&branchName=master)+  Status](https://dev.azure.com/schnetter/mpi-hs/_apis/build/status/eschnett.mpi-hs?branchName=master)](https://dev.azure.com/schnetter/mpi-hs/_build/latest&branchName=master)    ## Overview -MPI (the Message Passing Interface) is widely used standard for+MPI (the Message Passing Interface) is a widely used standard for distributed-memory programming on HPC (High Performance Computing) systems. MPI allows exchanging data (_messages_) between programs running in parallel. There are several high-quality open source MPI@@ -28,18 +28,19 @@ This library `mpi-hs` provides Haskell bindings for MPI. It is based on ideas taken from [haskell-mpi](https://github.com/bjpop/haskell-mpi),-[Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html),-and [MPI for Python](https://mpi4py.readthedocs.io/en/stable/).+[Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html)+for C++, and [MPI for+Python](https://mpi4py.readthedocs.io/en/stable/).  `mpi-hs` provides two API levels: A low-level API gives rather direct-access to the MPI API, apart from certain "reasonable" mappings from C-to Haskell (e.g. output arguments that are in C stored to a pointer-are in Haskell regular return values). A high-level API simplifies-exchanging arbitrary values that can be serialized.+access to the actual MPI API, apart from certain "reasonable" mappings+from C to Haskell (e.g. output arguments that are in C stored via a+pointer are in Haskell regular return values). A high-level API+simplifies exchanging arbitrary values that can be serialized.   -## Example+## Programming Example  This is a typical MPI C code: ```C@@ -59,15 +60,15 @@  The Haskell equivalent looks like this: ```Haskell-import Control.Distributed.MPI as MPI+import qualified Control.Distributed.MPI as MPI  main :: IO ()-main =-  do MPI.init-     rank <- MPI.commRank MPI.commWorld-     size <- MPI.commSize MPI.commWorld-     putStrLn $ "This is process " ++ show rank ++ " of " ++ show size-     MPI.finalize+main = do+  MPI.init+  rank <- MPI.commRank MPI.commWorld+  size <- MPI.commSize MPI.commWorld+  putStrLn $ "This is process " ++ show rank ++ " of " ++ show size+  MPI.finalize ```  @@ -89,45 +90,53 @@ such a mismatch.) --> -In many cases, the MPI library will be installed in `/usr/include`,+In some cases, the MPI library will be installed in `/usr/include`, `/usr/lib`, and `/usr/bin`, respectively. In this case, no further configuration is necessary, and `mpi-hs` will build out of the box with `stack build`. -On Ubuntu, one MPI package is `openmpi-dev`. It installs into-`/usr/lib/openmpi/include`, `/usr/lib/openmpi/lib`, and `/usr/bin/`.-You need to ensure that these settings are present in `stack.yaml`:+For convenience, this package offers Cabal flags to handle several+common cases where the MPI library is not installed in a standard+location: -```yaml-extra-include-dirs:-  - /usr/lib/openmpi/include-extra-lib-dirs:-  - /usr/lib/openmpi/lib+- OpenMPI on Debian Linux (package `openmpi-dev`): use `--flag+  mpi-hs:openmpi-debian`+- OpenMPI on Ubuntu Linux (package `openmpi-dev`): use `--flag+  mpi-hs:openmpi-ubuntu`+- OpenMPI on macOS with MacPorts (package `openmpi`): use `--flag+  mpi-hs:openmpi-macports`+- MPICH on Ubuntu Linux (package `mpich-dev`): use `--flag+  mpi-hs:mpich-ubuntu`+- MPICH on macOS with MacPorts (package `mpich`): use `--flag+  mpi-hs:mpich-macports`++For example, using the MPICH MPI implementation installed via MacPorts+on macOS, you build `mpi-hs` like this:++```sh+stack build --flag mpi-hs:mpich-macports ``` -On MacOS, one MPI package is the [MacPorts](https://www.macports.org)-package `openmpi`. It installs into `/opt/local/include/openmpi-mp`,-`/opt/local/lib/openmpi-mp`, and `/opt/local/bin`. You need to ensure-that these settings are present in `stack.yaml`:+In the general case, if your MPI library/operating system combination+is not supported by a Cabal flag, you need to describe the location of+your MPI library in `stack.yaml`. This might look like:  ```yaml extra-include-dirs:-  - /opt/local/include/openmpi-mp+  - /usr/lib/openmpi/include extra-lib-dirs:-  - /opt/local/lib/openmpi-mp+  - /usr/lib/openmpi/lib ``` -Both these settings are there by default.--### Testing the MPI installation+### Testing the MPI installation with a C program  To test your MPI installation independently of using Haskell, copy the example MPI C code into a file `mpi-example.c`, and run these commands:  ```sh-cc -I/usr/lib/openmpi/include -c mpi-example.c-cc -o mpi-example mpi-example.o -L/usr/lib/openmpi/lib -lmpi-mpirun -np 3 ./mpi-example+mpicc -c mpi-example.c+mpicc -o mpi-example mpi-example.o+mpiexec -n 3 ./mpi-example ```  All three commands must complete without error, and the last command@@ -139,9 +148,9 @@ This is process 2 of 3 ``` -where the order in which the lines are printed can be random. (The-output might even be jumbled, i.e. the characters of the three lines-might be mixed up.)+where the lines will be output in a random order. (The output might+even be jumbled, i.e. the characters in these three lines might be+mixed up.)  If these commands do not work, then this needs to be corrected before `mpi-hs` can work. If additional compiler options or libraries are@@ -160,36 +169,33 @@  ``` stack build-mpirun-openmpi-mp -np 3 stack exec example && echo SUCCESS || echo FAILURE+mpiexec -n 3 stack exec example ``` -With OpenMPI, and when running on a single node (e.g. on a laptop or a-workstation), these additional `mpirun` options might be useful:+### Running the tests +There are two test cases provided in `tests`. The first (`mpi-test`)+tests the low-level API, the second (`mpi-test-storable`) tests the+high-level API:+ ```-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec example && echo SUCCESS || echo FAILURE+stack build --test --no-run-tests+mpiexec -n 3 stack exec -- $(stack path --dist-dir)/build/mpi-test/mpi-test+mpiexec -n 3 stack exec -- $(stack path --dist-dir)/build/mpi-test-storable/mpi-test-storable ``` -The options `--mca btl self,vader` enable the shared memory byte-transfer layer (called "vader"), and also disable any network-communication. -The option `--oversubscribe` lets you run as many MPI processes on the-local node as you want, without being limited by the physical number-of cores. This is convenient for testing. -Other MPI implementations should have equivalent (but differently-named) options.--### Running the tests--There are four test cases provided in `tests`:+<!---+## Related packages -```-stack build --test --no-run-tests-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec -- $(stack path --dist-dir)/build/mpi-test/mpi-test && echo SUCCESS || echo FAILURE-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec -- $(stack path --dist-dir)/build/mpi-test-binary/mpi-test-binary && echo SUCCESS || echo FAILURE-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec -- $(stack path --dist-dir)/build/mpi-test-serialize/mpi-test-serialize && echo SUCCESS || echo FAILURE-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec -- $(stack path --dist-dir)/build/mpi-test-storable/mpi-test-storable && echo SUCCESS || echo FAILURE-mpirun-openmpi-mp -np 3 --mca btl self,vader --oversubscribe stack exec -- $(stack path --dist-dir)/build/mpi-test-store/mpi-test-store && echo SUCCESS || echo FAILURE-```+There are three companion packages that provide the same high-level+API via different serialization packages. These are separate packages+to reduce the number of dependencies of `mpi-hs`:+- `mpi-hs-binary`, based on `Data.Binary` from+  [`binary`](https://hackage.haskell.org/package/binary)+- `mpi-hs-serialize`, based on `Data.Serialize` from+  [`cereal`](https://hackage.haskell.org/package/cereal)+- `mpi-hs-store`, based on `Data.Store` from+  [`store`](https://hackage.haskell.org/package/store)+-->

@@ -248,7 +248,6 @@ import Data.Ix import qualified Data.Monoid as Monoid import qualified Data.Semigroup as Semigroup-import qualified Data.Store as Store import Data.Version import Foreign import Foreign.C.String@@ -372,10 +371,8 @@ -- | The result of comparing two MPI communicator (see 'commCompare'). {#enum ComparisonResult {} deriving (Eq, Ord, Read, Show, Generic)#} -instance Store.Store ComparisonResult  - -- | A newtype wrapper describing the size of a message. Use 'toCount' -- and 'fromCount' to convert between 'Count' and other integral -- types.@@ -388,8 +385,6 @@ instance Show Count where   showsPrec p (Count c) = showsPrec p c -instance Store.Store Count- -- | Convert an integer to a count. toCount :: Integral i => i -> Count toCount i = Count (fromIntegral i)@@ -483,8 +478,6 @@     | otherwise   = indexError b i "MPI.Rank"   inRange (Rank rmin, Rank rmax) (Rank r) = rmin <= r && r <= rmax -instance Store.Store Rank- -- | Convert an enum to a rank. toRank :: Enum e => e -> Rank toRank e = Rank (fromIntegral (fromEnum e))@@ -573,8 +566,6 @@ newtype Tag = Tag CInt   deriving (Eq, Ord, Read, Show, Generic, Enum, Num, Storable) -instance Store.Store Tag- -- | Convert an enum to a tag. toTag :: Enum e => e -> Tag toTag e = Tag (fromIntegral (fromEnum e))@@ -605,8 +596,6 @@ --   multi-threaded, and different threads might call MPI at the same --   time {#enum ThreadSupport {} deriving (Eq, Ord, Read, Show, Generic)#}--instance Store.Store ThreadSupport  -- | When MPI is initialized with this library, then it will remember -- the provided level of thread support. (This might be less than the

@@ -1,403 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeApplications #-}---- | Module: Control.Distributed.MPI.Binary--- Description: Simplified MPI bindings with automatic serialization---              based on Data.Binary--- Copyright: (C) 2018 Erik Schnetter--- License: Apache-2.0--- Maintainer: Erik Schnetter <schnetter@gmail.com>--- Stability: experimental--- Portability: Requires an externally installed MPI library--module Control.Distributed.MPI.Binary-  ( -- * Types, and associated functions and constants-    MPIException(..)--    -- ** Communicators-  , Comm(..)-  , commSelf-  , commWorld--    -- ** Message sizes-  , Count(..)-  , fromCount-  , toCount--    -- ** Process ranks-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank--    -- ** Message status-  , Status(..)--    -- ** Message tags-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag--  , Request--    -- * Functions--    -- ** Initialization and shutdown-  , abort-  , mainMPI--    -- ** Point-to-point (blocking)-  , recv-  , recv_-  , send-  , sendrecv-  , sendrecv_--    -- ** Point-to-point (non-blocking)-  , irecv-  , isend-  , test-  , test_-  , wait-  , wait_--    -- ** Collective (blocking)-  , barrier-  , bcastRecv-  , bcastSend--    -- ** Collective (non-blocking)-  , ibarrier-  , ibcastRecv-  , ibcastSend-  ) where--import Prelude hiding (init)--import Control.Concurrent-import Control.Exception-import Control.Monad-import Control.Monad.Loops-import qualified Data.Binary as Binary-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Unsafe as B-import Data.Coerce-import Data.Typeable-import Foreign-import Foreign.C.Types--import qualified Control.Distributed.MPI as MPI-import Control.Distributed.MPI-  ( Comm(..)-  , commSelf-  , commWorld-  , Count(..)-  , fromCount-  , toCount-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag-  , abort-  , barrier-  )------ Serialization, based on Data.Binary-type CanSerialize a = Binary.Binary a-serialize :: CanSerialize a => a -> IO B.ByteString-serialize = return . BL.toStrict . Binary.encode-deserialize :: CanSerialize a => B.ByteString -> IO a-deserialize = return . Binary.decode . BL.fromStrict---- Why is this necessary? Shouldn't 'Data.Binary' already contain--- this?-instance Binary.Binary CInt where-  put x = Binary.put @Int32 (coerce x)-  get = coerce <$> (Binary.get @Int32)-instance Binary.Binary Rank------ | Run the supplied Maybe computation repeatedly while it returns--- Nothing. If it returns a value, then returns that value.-whileNothing :: Monad m => m (Maybe a) -> m () -> m a-whileNothing cond loop = go-  where go = do mx <- cond-                case mx of-                  Nothing -> do loop-                                go-                  Just x -> return x------ | Exception type indicating an error in a call to MPI-newtype MPIException = MPIException String-  deriving (Eq, Ord, Read, Show, Typeable)-instance Exception MPIException--mpiAssert :: Bool -> String -> IO ()-mpiAssert cond msg =-  do when (not cond) $ throw (MPIException msg)-     return ()----data DidInit = DidInit | DidNotInit--initMPI :: IO DidInit-initMPI =-  do isInit <- MPI.initialized-     if isInit-       then return DidNotInit-       else do ts <- MPI.initThread MPI.ThreadMultiple-               mpiAssert (ts >= MPI.ThreadMultiple)-                 ("MPI.init: Insufficient thread support: requiring " ++-                  show MPI.ThreadMultiple ++-                  ", but MPI library provided only " ++ show ts)-               return DidInit--finalizeMPI :: DidInit -> IO ()-finalizeMPI DidInit =-  do isFinalized <- MPI.finalized-     if isFinalized-       then return ()-       else do MPI.finalize-finalizeMPI DidNotInit = return ()---- | Convenience function to initialize and finalize MPI. This--- initializes MPI with 'ThreadMultiple' thread support.-mainMPI :: IO () -- ^ action to run with MPI, typically the whole program-        -> IO ()-mainMPI action = bracket initMPI finalizeMPI (\_ -> action)------ | A communication request, usually created by a non-blocking--- communication function.-newtype Request a = Request (MVar (Status, a))---- | The status of a finished communication, indicating rank and tag--- of the other communication end point.-data Status = Status { msgRank :: !Rank-                     , msgTag :: !Tag-                     }-  deriving (Eq, Ord, Read, Show)------ | Receive an object.-recv :: CanSerialize a-     => Rank                    -- ^ Source rank-     -> Tag                     -- ^ Source tag-     -> Comm                    -- ^ Communicator-     -> IO (Status, a)          -- ^ Message status and received object-recv recvrank recvtag comm =-  do status <- whileNothing (MPI.iprobe recvrank recvtag comm) yield-     source <- MPI.getSource status-     tag <- MPI.getTag status-     count <- MPI.getCount status MPI.datatypeByte-     let len = MPI.fromCount count-     ptr <- mallocBytes len-     buffer <- B.unsafePackMallocCStringLen (ptr, len)-     req <- MPI.irecv buffer source tag comm-     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize buffer-     return (Status source tag, recvobj)---- | Receive an object without returning a status.-recv_ :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO a                   -- ^ Received object-recv_ recvrank recvtag comm =-  snd <$> recv recvrank recvtag comm---- | Send an object.-send :: CanSerialize a-     => a                     -- ^ Object to send-     -> Rank                  -- ^ Destination rank-     -> Tag                   -- ^ Message tag-     -> Comm                  -- ^ Communicator-     -> IO ()-send sendobj sendrank sendtag comm =-  do sendbuf <- serialize sendobj-     -- 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)-         => a                   -- ^ Object to send-         -> Rank                -- ^ Destination rank-         -> Tag                 -- ^ Send message tag-         -> Rank                -- ^ Source rank-         -> Tag                 -- ^ Receive message tag-         -> Comm                -- ^ Communicator-         -> IO (Status, b)      -- ^ Message status and received object-sendrecv sendobj sendrank sendtag recvrank recvtag comm =-  do recvreq <- irecv recvrank recvtag comm-     send sendobj sendrank sendtag comm-     wait recvreq---- | Send and receive objects simultaneously, without returning a--- status for the received message.-sendrecv_ :: (CanSerialize a, CanSerialize b)-          => a                  -- ^ Object to send-          -> Rank               -- ^ Destination rank-          -> Tag                -- ^ Send message tag-          -> Rank               -- ^ Source rank-          -> Tag                -- ^ Receive message tag-          -> Comm               -- ^ Communicator-          -> IO b               -- ^ Received object-sendrecv_ sendobj sendrank sendtag recvrank recvtag comm =-  snd <$> sendrecv sendobj sendrank sendtag recvrank recvtag comm---- | Begin to receive an object. Call `test` or `wait` to finish the--- communication, and to obtain the received object.-irecv :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO (Request a)         -- ^ Communication request-irecv recvrank recvtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $-       do res <- recv recvrank recvtag comm-          putMVar result res-     return (Request result)---- | Begin to send an object. Call 'test' or 'wait' to finish the--- communication.-isend :: CanSerialize a-      => a                     -- ^ Object to send-      -> Rank                  -- ^ Destination rank-      -> Tag                   -- ^ Message tag-      -> Comm                  -- ^ Communicator-      -> IO (Request ())       -- ^ Communication request-isend sendobj sendrank sendtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $ do send sendobj sendrank sendtag comm-                      putMVar result (Status sendrank sendtag, ())-     return (Request result)---- | Check whether a communication has finished, and return the--- communication result if so.-test :: Request a               -- ^ Communication request-     -> IO (Maybe (Status, a))  -- ^ 'Just' communication result, if-                                -- communication has finished, else 'Nothing'-test (Request result) = tryTakeMVar result---- | Check whether a communication has finished, and return the--- communication result if so, without returning a message status.-test_ :: Request a       -- ^ Communication request-      -> IO (Maybe a)    -- ^ 'Just' communication result, if-                         -- communication has finished, else 'Nothing'-test_ req = fmap snd <$> test req---- | Wait for a communication to finish and return the communication--- result.-wait :: Request a               -- ^ Communication request-     -> IO (Status, a)          -- ^ Message status and communication result-wait (Request result) = takeMVar result---- | Wait for a communication to finish and return the communication--- result, without returning a message status.-wait_ :: Request a              -- ^ Communication request-      -> IO a                   -- ^ Communication result-wait_ req = snd <$> wait req------ | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on all non-root--- processes. Call 'bcastSend' instead on the root process.-bcastRecv :: CanSerialize a-          => Rank-          -> Comm-          -> IO a-bcastRecv root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank /= root) "bcastRecv: expected rank /= root"-     lenbuf <- mallocForeignPtr @CLong-     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)-     req <- MPI.ibcast recvbuf root comm               -     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize recvbuf-     return recvobj---- | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on the root--- process. Call 'bcastRecv' instead on all non-root processes.-bcastSend :: CanSerialize a-          => a-          -> Rank-          -> Comm-          -> IO ()-bcastSend sendobj root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank == root) "bcastSend: expected rank == root"-     sendbuf <- serialize sendobj-     lenbuf <- mallocForeignPtr @CLong-     withForeignPtr lenbuf $ \ptr -> poke ptr (fromIntegral (B.length sendbuf))-     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-     _ <- forkIO $-       do req <- MPI.ibarrier comm-          whileM_ (not <$> MPI.test_ req) yield-          putMVar result (Status MPI.anySource MPI.anyTag, ())-     return (Request result)

@@ -1,399 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeApplications #-}---- | Module: Control.Distributed.MPI.Serialize--- Description: Simplified MPI bindings with automatic serialization---              based on Data.Serialize--- Copyright: (C) 2018 Erik Schnetter--- License: Apache-2.0--- Maintainer: Erik Schnetter <schnetter@gmail.com>--- Stability: experimental--- Portability: Requires an externally installed MPI library--module Control.Distributed.MPI.Serialize-  ( -- * Types, and associated functions and constants-    MPIException(..)--    -- ** Communicators-  , Comm(..)-  , commSelf-  , commWorld--    -- ** Message sizes-  , Count(..)-  , fromCount-  , toCount--    -- ** Process ranks-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank--    -- ** Message status-  , Status(..)--    -- ** Message tags-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag--  , Request--    -- * Functions--    -- ** Initialization and shutdown-  , abort-  , mainMPI--    -- ** Point-to-point (blocking)-  , recv-  , recv_-  , send-  , sendrecv-  , sendrecv_--    -- ** Point-to-point (non-blocking)-  , irecv-  , isend-  , test-  , test_-  , wait-  , wait_--    -- ** Collective (blocking)-  , barrier-  , bcastRecv-  , bcastSend--    -- ** Collective (non-blocking)-  , ibarrier-  , ibcastRecv-  , ibcastSend-  ) where--import Prelude hiding (init)--import Control.Concurrent-import Control.Exception-import Control.Monad-import Control.Monad.Loops-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Serialize as Serialize-import Data.Typeable-import Foreign-import Foreign.C.Types--import qualified Control.Distributed.MPI as MPI-import Control.Distributed.MPI-  ( Comm(..)-  , commSelf-  , commWorld-  , Count(..)-  , fromCount-  , toCount-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag-  , abort-  , barrier-  )------ Serialization, based on Data.Store-type CanSerialize a = Serialize.Serialize a-serialize :: CanSerialize a => a -> IO B.ByteString-serialize = return . Serialize.encode-deserialize :: CanSerialize a => B.ByteString -> IO a-deserialize buf =-  do let obj = Serialize.decode buf-     case obj of-       Left str -> throwIO $-         MPIException ("Data.Serialize.decode failed: " ++ str)-       Right x -> return x------ | Run the supplied Maybe computation repeatedly while it returns--- Nothing. If it returns a value, then returns that value.-whileNothing :: Monad m => m (Maybe a) -> m () -> m a-whileNothing cond loop = go-  where go = do mx <- cond-                case mx of-                  Nothing -> do loop-                                go-                  Just x -> return x------ | Exception type indicating an error in a call to MPI-newtype MPIException = MPIException String-  deriving (Eq, Ord, Read, Show, Typeable)-instance Exception MPIException--mpiAssert :: Bool -> String -> IO ()-mpiAssert cond msg =-  do when (not cond) $ throw (MPIException msg)-     return ()----data DidInit = DidInit | DidNotInit--initMPI :: IO DidInit-initMPI =-  do isInit <- MPI.initialized-     if isInit-       then return DidNotInit-       else do ts <- MPI.initThread MPI.ThreadMultiple-               mpiAssert (ts >= MPI.ThreadMultiple)-                 ("MPI.init: Insufficient thread support: requiring " ++-                  show MPI.ThreadMultiple ++-                  ", but MPI library provided only " ++ show ts)-               return DidInit--finalizeMPI :: DidInit -> IO ()-finalizeMPI DidInit =-  do isFinalized <- MPI.finalized-     if isFinalized-       then return ()-       else do MPI.finalize-finalizeMPI DidNotInit = return ()---- | Convenience function to initialize and finalize MPI. This--- initializes MPI with 'ThreadMultiple' thread support.-mainMPI :: IO () -- ^ action to run with MPI, typically the whole program-        -> IO ()-mainMPI action = bracket initMPI finalizeMPI (\_ -> action)------ | A communication request, usually created by a non-blocking--- communication function.-newtype Request a = Request (MVar (Status, a))---- | The status of a finished communication, indicating rank and tag--- of the other communication end point.-data Status = Status { msgRank :: !Rank-                     , msgTag :: !Tag-                     }-  deriving (Eq, Ord, Read, Show)------ | Receive an object.-recv :: CanSerialize a-     => Rank                    -- ^ Source rank-     -> Tag                     -- ^ Source tag-     -> Comm                    -- ^ Communicator-     -> IO (Status, a)          -- ^ Message status and received object-recv recvrank recvtag comm =-  do status <- whileNothing (MPI.iprobe recvrank recvtag comm) yield-     source <- MPI.getSource status-     tag <- MPI.getTag status-     count <- MPI.getCount status MPI.datatypeByte-     let len = MPI.fromCount count-     ptr <- mallocBytes len-     buffer <- B.unsafePackMallocCStringLen (ptr, len)-     req <- MPI.irecv buffer source tag comm-     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize buffer-     return (Status source tag, recvobj)---- | Receive an object without returning a status.-recv_ :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO a                   -- ^ Received object-recv_ recvrank recvtag comm =-  snd <$> recv recvrank recvtag comm---- | Send an object.-send :: CanSerialize a-     => a                     -- ^ Object to send-     -> Rank                  -- ^ Destination rank-     -> Tag                   -- ^ Message tag-     -> Comm                  -- ^ Communicator-     -> IO ()-send sendobj sendrank sendtag comm =-  do sendbuf <- serialize sendobj-     -- 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)-         => a                   -- ^ Object to send-         -> Rank                -- ^ Destination rank-         -> Tag                 -- ^ Send message tag-         -> Rank                -- ^ Source rank-         -> Tag                 -- ^ Receive message tag-         -> Comm                -- ^ Communicator-         -> IO (Status, b)      -- ^ Message status and received object-sendrecv sendobj sendrank sendtag recvrank recvtag comm =-  do recvreq <- irecv recvrank recvtag comm-     send sendobj sendrank sendtag comm-     wait recvreq---- | Send and receive objects simultaneously, without returning a--- status for the received message.-sendrecv_ :: (CanSerialize a, CanSerialize b)-          => a                  -- ^ Object to send-          -> Rank               -- ^ Destination rank-          -> Tag                -- ^ Send message tag-          -> Rank               -- ^ Source rank-          -> Tag                -- ^ Receive message tag-          -> Comm               -- ^ Communicator-          -> IO b               -- ^ Received object-sendrecv_ sendobj sendrank sendtag recvrank recvtag comm =-  snd <$> sendrecv sendobj sendrank sendtag recvrank recvtag comm---- | Begin to receive an object. Call `test` or `wait` to finish the--- communication, and to obtain the received object.-irecv :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO (Request a)         -- ^ Communication request-irecv recvrank recvtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $-       do res <- recv recvrank recvtag comm-          putMVar result res-     return (Request result)---- | Begin to send an object. Call 'test' or 'wait' to finish the--- communication.-isend :: CanSerialize a-      => a                     -- ^ Object to send-      -> Rank                  -- ^ Destination rank-      -> Tag                   -- ^ Message tag-      -> Comm                  -- ^ Communicator-      -> IO (Request ())       -- ^ Communication request-isend sendobj sendrank sendtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $ do send sendobj sendrank sendtag comm-                      putMVar result (Status sendrank sendtag, ())-     return (Request result)---- | Check whether a communication has finished, and return the--- communication result if so.-test :: Request a               -- ^ Communication request-     -> IO (Maybe (Status, a))  -- ^ 'Just' communication result, if-                                -- communication has finished, else 'Nothing'-test (Request result) = tryTakeMVar result---- | Check whether a communication has finished, and return the--- communication result if so, without returning a message status.-test_ :: Request a       -- ^ Communication request-      -> IO (Maybe a)    -- ^ 'Just' communication result, if-                         -- communication has finished, else 'Nothing'-test_ req = fmap snd <$> test req---- | Wait for a communication to finish and return the communication--- result.-wait :: Request a               -- ^ Communication request-     -> IO (Status, a)          -- ^ Message status and communication result-wait (Request result) = takeMVar result---- | Wait for a communication to finish and return the communication--- result, without returning a message status.-wait_ :: Request a              -- ^ Communication request-      -> IO a                   -- ^ Communication result-wait_ req = snd <$> wait req------ | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on all non-root--- processes. Call 'bcastSend' instead on the root process.-bcastRecv :: CanSerialize a-          => Rank-          -> Comm-          -> IO a-bcastRecv root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank /= root) "bcastRecv: expected rank /= root"-     lenbuf <- mallocForeignPtr @CLong-     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)-     req <- MPI.ibcast recvbuf root comm               -     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize recvbuf-     return recvobj---- | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on the root--- process. Call 'bcastRecv' instead on all non-root processes.-bcastSend :: CanSerialize a-          => a-          -> Rank-          -> Comm-          -> IO ()-bcastSend sendobj root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank == root) "bcastSend: expected rank == root"-     sendbuf <- serialize sendobj-     lenbuf <- mallocForeignPtr @CLong-     withForeignPtr lenbuf $ \ptr -> poke ptr (fromIntegral (B.length sendbuf))-     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-     _ <- forkIO $-       do req <- MPI.ibarrier comm-          whileM_ (not <$> MPI.test_ req) yield-          putMVar result (Status MPI.anySource MPI.anyTag, ())-     return (Request result)

@@ -1,394 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeApplications #-}---- | Module: Control.Distributed.MPI.Store--- Description: Simplified MPI bindings with automatic serialization---              based on Data.Store--- Copyright: (C) 2018 Erik Schnetter--- License: Apache-2.0--- Maintainer: Erik Schnetter <schnetter@gmail.com>--- Stability: experimental--- Portability: Requires an externally installed MPI library--module Control.Distributed.MPI.Store-  ( -- * Types, and associated functions and constants-    MPIException(..)--    -- ** Communicators-  , Comm(..)-  , commSelf-  , commWorld--    -- ** Message sizes-  , Count(..)-  , fromCount-  , toCount--    -- ** Process ranks-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank--    -- ** Message status-  , Status(..)--    -- ** Message tags-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag--  , Request--    -- * Functions--    -- ** Initialization and shutdown-  , abort-  , mainMPI--    -- ** Point-to-point (blocking)-  , recv-  , recv_-  , send-  , sendrecv-  , sendrecv_--    -- ** Point-to-point (non-blocking)-  , irecv-  , isend-  , test-  , test_-  , wait-  , wait_--    -- ** Collective (blocking)-  , barrier-  , bcastRecv-  , bcastSend--    -- ** Collective (non-blocking)-  , ibarrier-  , ibcastRecv-  , ibcastSend-  ) where--import Prelude hiding (init)--import Control.Concurrent-import Control.Exception-import Control.Monad-import Control.Monad.Loops-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Store as Store-import Data.Typeable-import Foreign-import Foreign.C.Types--import qualified Control.Distributed.MPI as MPI-import Control.Distributed.MPI-  ( Comm(..)-  , commSelf-  , commWorld-  , Count(..)-  , fromCount-  , toCount-  , Rank(..)-  , anySource-  , commRank-  , commSize-  , fromRank-  , rootRank-  , toRank-  , Tag(..)-  , anyTag-  , fromTag-  , toTag-  , unitTag-  , abort-  , barrier-  )------ Serialization, based on Data.Store-type CanSerialize a = Store.Store a-serialize :: CanSerialize a => a -> IO B.ByteString-serialize = return . Store.encode-deserialize :: CanSerialize a => B.ByteString -> IO a-deserialize = return . Store.decodeEx------ | Run the supplied Maybe computation repeatedly while it returns--- Nothing. If it returns a value, then returns that value.-whileNothing :: Monad m => m (Maybe a) -> m () -> m a-whileNothing cond loop = go-  where go = do mx <- cond-                case mx of-                  Nothing -> do loop-                                go-                  Just x -> return x------ | Exception type indicating an error in a call to MPI-newtype MPIException = MPIException String-  deriving (Eq, Ord, Read, Show, Typeable)-instance Exception MPIException--mpiAssert :: Bool -> String -> IO ()-mpiAssert cond msg =-  do when (not cond) $ throw (MPIException msg)-     return ()----data DidInit = DidInit | DidNotInit--initMPI :: IO DidInit-initMPI =-  do isInit <- MPI.initialized-     if isInit-       then return DidNotInit-       else do ts <- MPI.initThread MPI.ThreadMultiple-               mpiAssert (ts >= MPI.ThreadMultiple)-                 ("MPI.init: Insufficient thread support: requiring " ++-                  show MPI.ThreadMultiple ++-                  ", but MPI library provided only " ++ show ts)-               return DidInit--finalizeMPI :: DidInit -> IO ()-finalizeMPI DidInit =-  do isFinalized <- MPI.finalized-     if isFinalized-       then return ()-       else do MPI.finalize-finalizeMPI DidNotInit = return ()---- | Convenience function to initialize and finalize MPI. This--- initializes MPI with 'ThreadMultiple' thread support.-mainMPI :: IO () -- ^ action to run with MPI, typically the whole program-        -> IO ()-mainMPI action = bracket initMPI finalizeMPI (\_ -> action)------ | A communication request, usually created by a non-blocking--- communication function.-newtype Request a = Request (MVar (Status, a))---- | The status of a finished communication, indicating rank and tag--- of the other communication end point.-data Status = Status { msgRank :: !Rank-                     , msgTag :: !Tag-                     }-  deriving (Eq, Ord, Read, Show)------ | Receive an object.-recv :: CanSerialize a-     => Rank                    -- ^ Source rank-     -> Tag                     -- ^ Source tag-     -> Comm                    -- ^ Communicator-     -> IO (Status, a)          -- ^ Message status and received object-recv recvrank recvtag comm =-  do status <- whileNothing (MPI.iprobe recvrank recvtag comm) yield-     source <- MPI.getSource status-     tag <- MPI.getTag status-     count <- MPI.getCount status MPI.datatypeByte-     let len = MPI.fromCount count-     ptr <- mallocBytes len-     buffer <- B.unsafePackMallocCStringLen (ptr, len)-     req <- MPI.irecv buffer source tag comm-     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize buffer-     return (Status source tag, recvobj)---- | Receive an object without returning a status.-recv_ :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO a                   -- ^ Received object-recv_ recvrank recvtag comm =-  snd <$> recv recvrank recvtag comm---- | Send an object.-send :: CanSerialize a-     => a                     -- ^ Object to send-     -> Rank                  -- ^ Destination rank-     -> Tag                   -- ^ Message tag-     -> Comm                  -- ^ Communicator-     -> IO ()-send sendobj sendrank sendtag comm =-  do sendbuf <- serialize sendobj-     -- 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)-         => a                   -- ^ Object to send-         -> Rank                -- ^ Destination rank-         -> Tag                 -- ^ Send message tag-         -> Rank                -- ^ Source rank-         -> Tag                 -- ^ Receive message tag-         -> Comm                -- ^ Communicator-         -> IO (Status, b)      -- ^ Message status and received object-sendrecv sendobj sendrank sendtag recvrank recvtag comm =-  do recvreq <- irecv recvrank recvtag comm-     send sendobj sendrank sendtag comm-     wait recvreq---- | Send and receive objects simultaneously, without returning a--- status for the received message.-sendrecv_ :: (CanSerialize a, CanSerialize b)-          => a                  -- ^ Object to send-          -> Rank               -- ^ Destination rank-          -> Tag                -- ^ Send message tag-          -> Rank               -- ^ Source rank-          -> Tag                -- ^ Receive message tag-          -> Comm               -- ^ Communicator-          -> IO b               -- ^ Received object-sendrecv_ sendobj sendrank sendtag recvrank recvtag comm =-  snd <$> sendrecv sendobj sendrank sendtag recvrank recvtag comm---- | Begin to receive an object. Call `test` or `wait` to finish the--- communication, and to obtain the received object.-irecv :: CanSerialize a-      => Rank                   -- ^ Source rank-      -> Tag                    -- ^ Source tag-      -> Comm                   -- ^ Communicator-      -> IO (Request a)         -- ^ Communication request-irecv recvrank recvtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $-       do res <- recv recvrank recvtag comm-          putMVar result res-     return (Request result)---- | Begin to send an object. Call 'test' or 'wait' to finish the--- communication.-isend :: CanSerialize a-      => a                     -- ^ Object to send-      -> Rank                  -- ^ Destination rank-      -> Tag                   -- ^ Message tag-      -> Comm                  -- ^ Communicator-      -> IO (Request ())       -- ^ Communication request-isend sendobj sendrank sendtag comm =-  do result <- newEmptyMVar-     _ <- forkIO $ do send sendobj sendrank sendtag comm-                      putMVar result (Status sendrank sendtag, ())-     return (Request result)---- | Check whether a communication has finished, and return the--- communication result if so.-test :: Request a               -- ^ Communication request-     -> IO (Maybe (Status, a))  -- ^ 'Just' communication result, if-                                -- communication has finished, else 'Nothing'-test (Request result) = tryTakeMVar result---- | Check whether a communication has finished, and return the--- communication result if so, without returning a message status.-test_ :: Request a       -- ^ Communication request-      -> IO (Maybe a)    -- ^ 'Just' communication result, if-                         -- communication has finished, else 'Nothing'-test_ req = fmap snd <$> test req---- | Wait for a communication to finish and return the communication--- result.-wait :: Request a               -- ^ Communication request-     -> IO (Status, a)          -- ^ Message status and communication result-wait (Request result) = takeMVar result---- | Wait for a communication to finish and return the communication--- result, without returning a message status.-wait_ :: Request a              -- ^ Communication request-      -> IO a                   -- ^ Communication result-wait_ req = snd <$> wait req------ | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on all non-root--- processes. Call 'bcastSend' instead on the root process.-bcastRecv :: CanSerialize a-          => Rank-          -> Comm-          -> IO a-bcastRecv root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank /= root) "bcastRecv: expected rank /= root"-     lenbuf <- mallocForeignPtr @CLong-     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)-     req <- MPI.ibcast recvbuf root comm               -     whileM_ (not <$> MPI.test_ req) yield-     recvobj <- deserialize recvbuf-     return recvobj---- | Broadcast a message from one process (the "root") to all other--- processes in the communicator. Call this function on the root--- process. Call 'bcastRecv' instead on all non-root processes.-bcastSend :: CanSerialize a-          => a-          -> Rank-          -> Comm-          -> IO ()-bcastSend sendobj root comm =-  do rank <- MPI.commRank comm-     mpiAssert (rank == root) "bcastSend: expected rank == root"-     sendbuf <- serialize sendobj-     lenbuf <- mallocForeignPtr @CLong-     withForeignPtr lenbuf $ \ptr -> poke ptr (fromIntegral (B.length sendbuf))-     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-     _ <- forkIO $-       do req <- MPI.ibarrier comm-          whileM_ (not <$> MPI.test_ req) yield-          putMVar result (Status MPI.anySource MPI.anyTag, ())-     return (Request result)

@@ -4,14 +4,14 @@ -- -- see: https://github.com/sol/hpack ----- hash: ee6f377d4c7367443da512ba5c7dde6e0d0b3b95fa95e877b323a37f99ddba84+-- hash: 11b62fed3be3a0f857f2e02c4f51e8d2161fe465d5ef830539f21ba83ba7fb5d  name:           mpi-hs-version:        0.5.3.0+version:        0.6.0.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-                Performance Computing) systems. MPI allows exchanging data+description:    MPI (the [Message Passinag Interface](https://www.mpi-forum.org)) is+                a widely used standard for distributed-memory programming on HPC+                (High Performance Computing) systems. MPI allows exchanging data                 (_messages_) between programs running in parallel. There are several                 high-quality open source MPI implementations (e.g. MPICH, MVAPICH,                 OpenMPI) as well as a variety of closed-source implementations.@@ -21,19 +21,20 @@                 This library @mpi-hs@ provides Haskell bindings for MPI. It is based                 on ideas taken from                 [haskell-mpi](https://github.com/bjpop/haskell-mpi),-                [Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html),-                and [MPI for Python](https://mpi4py.readthedocs.io/en/stable/).+                [Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html)+                for C++, and [MPI for+                Python](https://mpi4py.readthedocs.io/en/stable/).                 .                 @mpi-hs@ provides two API levels: A low-level API gives rather-                direct access to the MPI API, apart from certain "reasonable"+                direct access to the actual MPI API, apart from certain "reasonable"                 mappings from C to Haskell (e.g. output arguments that are in C-                stored to a pointer are in Haskell regular return values). A+                stored via a pointer are in Haskell regular return values). A                 high-level API simplifies exchanging arbitrary values that can be                 serialized.                 .                 Note that the automated builds on                 [Hackage](http://hackage.haskell.org) will currently always fail-                since no MPI library is present there. However, builds on+                since no system MPI library is present there. However, builds on                 [Stackage](https://www.stackage.org) should succeed -- if not, there                 is an error in this package. category:       Distributed Computing@@ -69,25 +70,22 @@ flag openmpi-debian   description: Use OpenMPI on Debian   manual: True-  default: True+  default: False  flag openmpi-macports   description: Use OpenMPI on MacPorts   manual: True-  default: True+  default: False  flag openmpi-ubuntu   description: Use OpenMPI on Ubuntu   manual: True-  default: True+  default: False  library   exposed-modules:       Control.Distributed.MPI-      Control.Distributed.MPI.Binary-      Control.Distributed.MPI.Serialize       Control.Distributed.MPI.Storable-      Control.Distributed.MPI.Store   other-modules:       Paths_mpi_hs   hs-source-dirs:@@ -101,11 +99,8 @@       c2hs   build-depends:       base >=4 && <5-    , binary     , bytestring-    , cereal     , monad-loops-    , store   if flag(openmpi-debian)     include-dirs:         /usr/lib/x86_64-linux-gnu/openmpi/include@@ -152,7 +147,6 @@   ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N   build-depends:       base-    , binary     , mpi-hs   if flag(openmpi-debian)     include-dirs:@@ -240,102 +234,6 @@         mpich   default-language: Haskell2010 -test-suite mpi-test-binary-  type: exitcode-stdio-1.0-  main-is: Main.hs-  other-modules:-      Paths_mpi_hs-  hs-source-dirs:-      tests/binary-  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N-  build-depends:-      base-    , mpi-hs-  if flag(openmpi-debian)-    include-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/include-    extra-lib-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/lib-    extra-libraries:-        mpi-  if flag(openmpi-macports)-    include-dirs:-        /opt/local/include/openmpi-mp-    extra-lib-dirs:-        /opt/local/lib/openmpi-mp-    extra-libraries:-        mpi-  if flag(openmpi-ubuntu)-    include-dirs:-        /usr/lib/openmpi/include-    extra-lib-dirs:-        /usr/lib/openmpi/lib-    extra-libraries:-        mpi-  if flag(mpich-macports)-    include-dirs:-        /opt/local/include/mpich-gcc9-    extra-lib-dirs:-        /opt/local/lib/mpich-gcc9-    extra-libraries:-        mpi-  if flag(mpich-ubuntu)-    include-dirs:-        /usr/lib/mpich/include-    extra-lib-dirs:-        /usr/lib/mpich/lib-    extra-libraries:-        mpich-  default-language: Haskell2010--test-suite mpi-test-serialize-  type: exitcode-stdio-1.0-  main-is: Main.hs-  other-modules:-      Paths_mpi_hs-  hs-source-dirs:-      tests/serialize-  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N-  build-depends:-      base-    , mpi-hs-  if flag(openmpi-debian)-    include-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/include-    extra-lib-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/lib-    extra-libraries:-        mpi-  if flag(openmpi-macports)-    include-dirs:-        /opt/local/include/openmpi-mp-    extra-lib-dirs:-        /opt/local/lib/openmpi-mp-    extra-libraries:-        mpi-  if flag(openmpi-ubuntu)-    include-dirs:-        /usr/lib/openmpi/include-    extra-lib-dirs:-        /usr/lib/openmpi/lib-    extra-libraries:-        mpi-  if flag(mpich-macports)-    include-dirs:-        /opt/local/include/mpich-gcc9-    extra-lib-dirs:-        /opt/local/lib/mpich-gcc9-    extra-libraries:-        mpi-  if flag(mpich-ubuntu)-    include-dirs:-        /usr/lib/mpich/include-    extra-lib-dirs:-        /usr/lib/mpich/lib-    extra-libraries:-        mpich-  default-language: Haskell2010- test-suite mpi-test-storable   type: exitcode-stdio-1.0   main-is: Main.hs@@ -343,54 +241,6 @@       Paths_mpi_hs   hs-source-dirs:       tests/storable-  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N-  build-depends:-      base-    , mpi-hs-  if flag(openmpi-debian)-    include-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/include-    extra-lib-dirs:-        /usr/lib/x86_64-linux-gnu/openmpi/lib-    extra-libraries:-        mpi-  if flag(openmpi-macports)-    include-dirs:-        /opt/local/include/openmpi-mp-    extra-lib-dirs:-        /opt/local/lib/openmpi-mp-    extra-libraries:-        mpi-  if flag(openmpi-ubuntu)-    include-dirs:-        /usr/lib/openmpi/include-    extra-lib-dirs:-        /usr/lib/openmpi/lib-    extra-libraries:-        mpi-  if flag(mpich-macports)-    include-dirs:-        /opt/local/include/mpich-gcc9-    extra-lib-dirs:-        /opt/local/lib/mpich-gcc9-    extra-libraries:-        mpi-  if flag(mpich-ubuntu)-    include-dirs:-        /usr/lib/mpich/include-    extra-lib-dirs:-        /usr/lib/mpich/lib-    extra-libraries:-        mpich-  default-language: Haskell2010--test-suite mpi-test-store-  type: exitcode-stdio-1.0-  main-is: Main.hs-  other-modules:-      Paths_mpi_hs-  hs-source-dirs:-      tests/store   ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N   build-depends:       base

@@ -1,5 +1,5 @@ name: mpi-hs-version: '0.5.3.0'+version: '0.6.0.0' github: "eschnett/mpi-hs" license: Apache-2.0 author: "Erik Schnetter <schnetter@gmail.com>"@@ -7,31 +7,32 @@ category: Distributed Computing 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-  Performance Computing) systems. MPI allows exchanging data+  MPI (the [Message Passinag Interface](https://www.mpi-forum.org)) is+  a widely used standard for distributed-memory programming on HPC+  (High Performance Computing) systems. MPI allows exchanging data   (_messages_) between programs running in parallel. There are several   high-quality open source MPI implementations (e.g. MPICH, MVAPICH,   OpenMPI) as well as a variety of closed-source implementations.   These libraries can typically make use of high-bandwidth low-latency   communication hardware such as InfiniBand.-+     This library @mpi-hs@ provides Haskell bindings for MPI. It is based   on ideas taken from   [haskell-mpi](https://github.com/bjpop/haskell-mpi),-  [Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html),-  and [MPI for Python](https://mpi4py.readthedocs.io/en/stable/).-+  [Boost.MPI](https://www.boost.org/doc/libs/1_64_0/doc/html/mpi.html)+  for C++, and [MPI for+  Python](https://mpi4py.readthedocs.io/en/stable/).+     @mpi-hs@ provides two API levels: A low-level API gives rather-  direct access to the MPI API, apart from certain "reasonable"+  direct access to the actual MPI API, apart from certain "reasonable"   mappings from C to Haskell (e.g. output arguments that are in C-  stored to a pointer are in Haskell regular return values). A+  stored via a pointer are in Haskell regular return values). A   high-level API simplifies exchanging arbitrary values that can be   serialized.    Note that the automated builds on   [Hackage](http://hackage.haskell.org) will currently always fail-  since no MPI library is present there. However, builds on+  since no system MPI library is present there. However, builds on   [Stackage](https://www.stackage.org) should succeed -- if not, there   is an error in this package. @@ -39,15 +40,15 @@   openmpi-debian:     description: Use OpenMPI on Debian     manual: true-    default: true+    default: false   openmpi-macports:     description: Use OpenMPI on MacPorts     manual: true-    default: true+    default: false   openmpi-ubuntu:     description: Use OpenMPI on Ubuntu     manual: true-    default: true+    default: false   mpich-macports:     description: Use MPICH on MacPorts     manual: true@@ -70,12 +71,9 @@  library:   dependencies:-    - base >=4 && <5            # tested with 4.11 and 4.12-    - binary+    - base >=4 && <5            # tested with 4.11, 4.12, 4.13     - bytestring-    - cereal     - monad-loops-    - store   build-tools:     - c2hs   source-dirs: lib@@ -127,7 +125,6 @@     main: Main.hs     dependencies:       - base-      - binary       - mpi-hs     ghc-options:       - -rtsopts@@ -155,66 +152,16 @@       - base       - monad-loops       - mpi-hs-      # - tasty-      # - tasty-hunit-      # - tasty-hspec-      # - unix     ghc-options:       - -rtsopts       - -threaded       - -with-rtsopts=-N-  mpi-test-binary:-    source-dirs: tests/binary-    main: Main.hs-    dependencies:-      - base-      - mpi-hs-      # - tasty-      # - tasty-hunit-      # - tasty-hspec-      # - unix-    ghc-options:-      - -rtsopts-      - -threaded-      - -with-rtsopts=-N-  mpi-test-serialize:-    source-dirs: tests/serialize-    main: Main.hs-    dependencies:-      - base-      - mpi-hs-      # - tasty-      # - tasty-hunit-      # - tasty-hspec-      # - unix-    ghc-options:-      - -rtsopts-      - -threaded-      - -with-rtsopts=-N   mpi-test-storable:     source-dirs: tests/storable     main: Main.hs     dependencies:       - base       - mpi-hs-      # - tasty-      # - tasty-hunit-      # - tasty-hspec-      # - unix-    ghc-options:-      - -rtsopts-      - -threaded-      - -with-rtsopts=-N-  mpi-test-store:-    source-dirs: tests/store-    main: Main.hs-    dependencies:-      - base-      - mpi-hs-      # - tasty-      # - tasty-hunit-      # - tasty-hspec-      # - unix     ghc-options:       - -rtsopts       - -threaded

@@ -1,6 +1,6 @@ # Resolver to choose a 'specific' stackage snapshot or a compiler version.-resolver: lts-14.4-# resolver: nightly-2019-09-02+resolver: lts-15.5+# resolver: nightly-2020-03-24  # User packages to be built. packages:

@@ -1,166 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--import System.IO-import System.Exit--import qualified Control.Distributed.MPI.Binary as MPI--default (Int)--------------------------------------------------------------------------------------infix 1 @?-(@?) :: Bool -> String -> IO ()-x @? msg = if not x then die msg else return ()--infix 1 @?=-(@?=) :: Eq a => a -> a -> IO ()-x @?= y = x == y @? "test failed"----type TestTree = IO ()--testCase :: String -> IO () -> TestTree-testCase name test =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ "  " ++ name ++ "..."-               hFlush stdout-       else return ()-     MPI.barrier MPI.commWorld-     test-     MPI.barrier MPI.commWorld----testGroup :: String -> [TestTree] -> TestTree-testGroup name cases =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ name ++ ":"-               hFlush stdout-       else return ()-     sequence_ cases----defaultMain :: TestTree -> IO ()-defaultMain tree =-  do rank <- MPI.commRank MPI.commWorld-     size <- MPI.commSize MPI.commWorld-     if rank == 0-       then do putStrLn $ "MPI Tests: running on " ++ show size ++ " processes"-               hFlush stdout-       else return ()-     tree----------------------------------------------------------------------------------------main :: IO ()-main = MPI.mainMPI $ defaultMain tests--tests :: TestTree-tests = testGroup "MPI"-  [ rankSize-  , pointToPoint-  , pointToPointNonBlocking-  , collective-  , collectiveNonBlocking-  ]----rankSize :: TestTree-rankSize = testGroup "rank and size"-  [ testCase "commSelf" $-    do rank <- MPI.commRank MPI.commSelf-       size <- MPI.commSize MPI.commSelf-       rank == 0 && size == 1 @? ""-  , testCase "commWorld" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       rank >= 0 && rank < size @? ""-  ]----pointToPoint :: TestTree-pointToPoint = testGroup "point-to-point"-  [ testCase "sendrecv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       let recvrank = (rank - 1) `mod` size-       (status, recvmsg :: String) <--         MPI.sendrecv sendmsg sendrank MPI.unitTag recvrank MPI.unitTag-         MPI.commWorld-       (recvmsg == sendmsg &&-        MPI.msgRank status == recvrank &&-        MPI.msgTag status == MPI.unitTag) @? ""-  ]----pointToPointNonBlocking :: TestTree-pointToPointNonBlocking = testGroup "point-to-point non-blocking"-  [ testCase "send and recv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       sendreq <- MPI.isend sendmsg sendrank MPI.unitTag MPI.commWorld-       let recvrank = (rank - 1) `mod` size-       recvreq <- MPI.irecv recvrank MPI.unitTag MPI.commWorld-       (sendstatus, ()) <- MPI.wait sendreq-       (recvstatus, recvmsg :: String) <- MPI.wait recvreq-       (recvmsg == sendmsg &&-        MPI.msgRank sendstatus == sendrank &&-        MPI.msgTag sendstatus == MPI.unitTag &&-        MPI.msgRank recvstatus == recvrank &&-        MPI.msgTag recvstatus == MPI.unitTag) @? ""-  ]----collective :: TestTree-collective = testGroup "collective"-  [ testCase "barrier" $-    do MPI.barrier MPI.commWorld-  , testCase "bcast" $-    do rank <- MPI.commRank MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       recvmsg :: String <--         if rank == MPI.rootRank-         then do MPI.bcastSend sendmsg MPI.rootRank MPI.commWorld-                 return sendmsg-         else do MPI.bcastRecv MPI.rootRank MPI.commWorld-       recvmsg == sendmsg @? ""-  ]----collectiveNonBlocking :: TestTree-collectiveNonBlocking = testGroup "collective non-blocking"-  [ 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 @? ""-  ]

@@ -1,166 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--import System.IO-import System.Exit--import qualified Control.Distributed.MPI.Serialize as MPI--default (Int)--------------------------------------------------------------------------------------infix 1 @?-(@?) :: Bool -> String -> IO ()-x @? msg = if not x then die msg else return ()--infix 1 @?=-(@?=) :: Eq a => a -> a -> IO ()-x @?= y = x == y @? "test failed"----type TestTree = IO ()--testCase :: String -> IO () -> TestTree-testCase name test =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ "  " ++ name ++ "..."-               hFlush stdout-       else return ()-     MPI.barrier MPI.commWorld-     test-     MPI.barrier MPI.commWorld----testGroup :: String -> [TestTree] -> TestTree-testGroup name cases =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ name ++ ":"-               hFlush stdout-       else return ()-     sequence_ cases----defaultMain :: TestTree -> IO ()-defaultMain tree =-  do rank <- MPI.commRank MPI.commWorld-     size <- MPI.commSize MPI.commWorld-     if rank == 0-       then do putStrLn $ "MPI Tests: running on " ++ show size ++ " processes"-               hFlush stdout-       else return ()-     tree----------------------------------------------------------------------------------------main :: IO ()-main = MPI.mainMPI $ defaultMain tests--tests :: TestTree-tests = testGroup "MPI"-  [ rankSize-  , pointToPoint-  , pointToPointNonBlocking-  , collective-  , collectiveNonBlocking-  ]----rankSize :: TestTree-rankSize = testGroup "rank and size"-  [ testCase "commSelf" $-    do rank <- MPI.commRank MPI.commSelf-       size <- MPI.commSize MPI.commSelf-       rank == 0 && size == 1 @? ""-  , testCase "commWorld" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       rank >= 0 && rank < size @? ""-  ]----pointToPoint :: TestTree-pointToPoint = testGroup "point-to-point"-  [ testCase "sendrecv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       let recvrank = (rank - 1) `mod` size-       (status, recvmsg :: String) <--         MPI.sendrecv sendmsg sendrank MPI.unitTag recvrank MPI.unitTag-         MPI.commWorld-       (recvmsg == sendmsg &&-        MPI.msgRank status == recvrank &&-        MPI.msgTag status == MPI.unitTag) @? ""-  ]----pointToPointNonBlocking :: TestTree-pointToPointNonBlocking = testGroup "point-to-point non-blocking"-  [ testCase "send and recv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       sendreq <- MPI.isend sendmsg sendrank MPI.unitTag MPI.commWorld-       let recvrank = (rank - 1) `mod` size-       recvreq <- MPI.irecv recvrank MPI.unitTag MPI.commWorld-       (sendstatus, ()) <- MPI.wait sendreq-       (recvstatus, recvmsg :: String) <- MPI.wait recvreq-       (recvmsg == sendmsg &&-        MPI.msgRank sendstatus == sendrank &&-        MPI.msgTag sendstatus == MPI.unitTag &&-        MPI.msgRank recvstatus == recvrank &&-        MPI.msgTag recvstatus == MPI.unitTag) @? ""-  ]----collective :: TestTree-collective = testGroup "collective"-  [ testCase "barrier" $-    do MPI.barrier MPI.commWorld-  , testCase "bcast" $-    do rank <- MPI.commRank MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       recvmsg :: String <--         if rank == MPI.rootRank-         then do MPI.bcastSend sendmsg MPI.rootRank MPI.commWorld-                 return sendmsg-         else do MPI.bcastRecv MPI.rootRank MPI.commWorld-       recvmsg == sendmsg @? ""-  ]----collectiveNonBlocking :: TestTree-collectiveNonBlocking = testGroup "collective non-blocking"-  [ 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 @? ""-  ]

@@ -1,166 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--import System.IO-import System.Exit--import qualified Control.Distributed.MPI.Store as MPI--default (Int)--------------------------------------------------------------------------------------infix 1 @?-(@?) :: Bool -> String -> IO ()-x @? msg = if not x then die msg else return ()--infix 1 @?=-(@?=) :: Eq a => a -> a -> IO ()-x @?= y = x == y @? "test failed"----type TestTree = IO ()--testCase :: String -> IO () -> TestTree-testCase name test =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ "  " ++ name ++ "..."-               hFlush stdout-       else return ()-     MPI.barrier MPI.commWorld-     test-     MPI.barrier MPI.commWorld----testGroup :: String -> [TestTree] -> TestTree-testGroup name cases =-  do rank <- MPI.commRank MPI.commWorld-     if rank == 0-       then do putStrLn $ name ++ ":"-               hFlush stdout-       else return ()-     sequence_ cases----defaultMain :: TestTree -> IO ()-defaultMain tree =-  do rank <- MPI.commRank MPI.commWorld-     size <- MPI.commSize MPI.commWorld-     if rank == 0-       then do putStrLn $ "MPI Tests: running on " ++ show size ++ " processes"-               hFlush stdout-       else return ()-     tree----------------------------------------------------------------------------------------main :: IO ()-main = MPI.mainMPI $ defaultMain tests--tests :: TestTree-tests = testGroup "MPI"-  [ rankSize-  , pointToPoint-  , pointToPointNonBlocking-  , collective-  , collectiveNonBlocking-  ]----rankSize :: TestTree-rankSize = testGroup "rank and size"-  [ testCase "commSelf" $-    do rank <- MPI.commRank MPI.commSelf-       size <- MPI.commSize MPI.commSelf-       rank == 0 && size == 1 @? ""-  , testCase "commWorld" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       rank >= 0 && rank < size @? ""-  ]----pointToPoint :: TestTree-pointToPoint = testGroup "point-to-point"-  [ testCase "sendrecv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       let recvrank = (rank - 1) `mod` size-       (status, recvmsg :: String) <--         MPI.sendrecv sendmsg sendrank MPI.unitTag recvrank MPI.unitTag-         MPI.commWorld-       (recvmsg == sendmsg &&-        MPI.msgRank status == recvrank &&-        MPI.msgTag status == MPI.unitTag) @? ""-  ]----pointToPointNonBlocking :: TestTree-pointToPointNonBlocking = testGroup "point-to-point non-blocking"-  [ testCase "send and recv" $-    do rank <- MPI.commRank MPI.commWorld-       size <- MPI.commSize MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       let sendrank = (rank + 1) `mod` size-       sendreq <- MPI.isend sendmsg sendrank MPI.unitTag MPI.commWorld-       let recvrank = (rank - 1) `mod` size-       recvreq <- MPI.irecv recvrank MPI.unitTag MPI.commWorld-       (sendstatus, ()) <- MPI.wait sendreq-       (recvstatus, recvmsg :: String) <- MPI.wait recvreq-       (recvmsg == sendmsg &&-        MPI.msgRank sendstatus == sendrank &&-        MPI.msgTag sendstatus == MPI.unitTag &&-        MPI.msgRank recvstatus == recvrank &&-        MPI.msgTag recvstatus == MPI.unitTag) @? ""-  ]----collective :: TestTree-collective = testGroup "collective"-  [ testCase "barrier" $-    do MPI.barrier MPI.commWorld-  , testCase "bcast" $-    do rank <- MPI.commRank MPI.commWorld-       let sendmsg :: String = "Hello, World!"-       recvmsg :: String <--         if rank == MPI.rootRank-         then do MPI.bcastSend sendmsg MPI.rootRank MPI.commWorld-                 return sendmsg-         else do MPI.bcastRecv MPI.rootRank MPI.commWorld-       recvmsg == sendmsg @? ""-  ]----collectiveNonBlocking :: TestTree-collectiveNonBlocking = testGroup "collective non-blocking"-  [ 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 @? ""-  ]