-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/Control/Distributed/MPI.chs" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-type-defaults #-}






-- | Module: Control.Distributed.MPI
-- Description: MPI bindings for Haskell
-- Copyright: (C) 2018, 2019, 2020 Erik Schnetter
-- License: Apache-2.0
-- Maintainer: Erik Schnetter <schnetter@gmail.com>
-- Stability: experimental
-- Portability: Requires an externally installed MPI library
--
-- 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
-- (_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/).
--
-- @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.
--
-- This module 'MPI' is the low-level interface.
--
-- In general, the MPI C API is translated to Haskell in the following
-- way, greatly aided by @c2hs@:
--
-- * Names of constants and functions have the @MPI_@ prefix removed.
--   Underscores are replaced by CamelCase. The 'MPI' module is
--   intended to be imported qualified, as in 'import qualified
--   Control.Distributed.MPI as MPI'.
--
-- * Opaque types such as @MPI_Request@ are wrapped via newtypes.
--
-- * The MPI error return code is omitted. Currently error codes are
--   ignored, since the default MPI behaviour is to terminate the
--   application instead of actually returning error codes. In the
--   future, error codes might be reported via exceptions.
--
-- * Output arguments that are written via pointers in C are returned.
--   Some functions now return tuples. If the output argument is a
--   boolean value that indicates whether another output argument is
--   valid, then this is translated into a 'Maybe'.
--
-- * MPI has a facility to pass @MPI_STATUS_IGNORE@ to indicate that
--   no message status should be returned. This is instead handled by
--   providing alternative functions ending with an underscore (e.g.
--   'recv_') that return @()@ instead of 'Status'.
--
-- * Datatype arguments are hidden. Instead, the correct MPI datatypes
--   are inferred from the pointer type specifying the communication
--   buffers. (This translation could be relaxed, and the original MPI
--   functions could be exposed as well when needed.)

module Control.Distributed.MPI
  ( -- * Types, and associated functions and constants

    -- ** Communication buffers
    Buffer(..)

    -- ** Communicators
  , Comm(..)
  , ComparisonResult(..)
  , commCompare
  , commRank
  , commSize
  , commNull
  , commSelf
  , commWorld

    -- ** Message sizes
  , Count(..)
  , fromCount
  , toCount
  , countUndefined

    -- ** Datatypes
  , Datatype(..)
  -- TODO: use a module for this namespace
  , datatypeNull
  , datatypeByte
  , datatypeChar
  , datatypeDouble
  , datatypeFloat
  , datatypeInt
  , datatypeLong
  , datatypeLongDouble
  , datatypeLongLong
  , datatypeLongLongInt
  , datatypeShort
  , datatypeUnsigned
  , datatypeUnsignedChar
  , datatypeUnsignedLong
  , datatypeUnsignedLongLong
  , datatypeUnsignedShort
  , HasDatatype(..)

    -- ** Reduction operations
  , Op(..)
  -- TODO: use a module for this namespace
  , opNull
  , opBand
  , opBor
  , opBxor
  , opLand
  , opLor
  , opLxor
  , opMax
  , opMaxloc
  , opMin
  , opMinloc
  , opProd
  , opSum
  -- , HasOp(..)

    -- ** Process ranks
  , Rank(..)
  , fromRank
  , rootRank
  , toRank
  , anySource

    -- ** Communication requests
  , Request(..)
  , requestNull

    -- ** Message status
  , Status(..)
  --, statusError
  , getSource
  , getTag
  -- , statusIgnore
  , getCount
  , getElements

    -- ** Message tags
  , Tag(..)
  , fromTag
  , toTag
  , unitTag
  , anyTag

    -- ** Thread support
  , ThreadSupport(..)
  , threadSupport

    -- * Functions

    -- ** Initialization and shutdown
  , abort
  , finalize
  , finalized
  , init
  , initThread
  , initialized

    -- ** Inquiry
  , getLibraryVersion
  , getProcessorName
  , getVersion

    -- ** Point-to-point (blocking)
  , probe
  , probe_
  , recv
  , recv_
  , send
  , sendrecv
  , sendrecv_
  , wait
  , wait_

    -- ** Point-to-point (non-blocking)
  , iprobe
  , iprobe_
  , irecv
  , isend
  , requestGetStatus
  , requestGetStatus_
  , test
  , test_

    -- ** Collective (blocking)
  , allgather
  , allreduce
  , alltoall
  , barrier
  , bcast
  , exscan
  , gather
  , reduce
  , scan
  , scatter

    -- ** Collective (non-blocking)
  , iallgather
  , iallreduce
  , ialltoall
  , ibarrier
  , ibcast
  , iexscan
  , igather
  , ireduce
  , iscan
  , iscatter

    -- ** Timing
  , wtick
  , wtime
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Prelude hiding (fromEnum, fst, init, toEnum)
import qualified Prelude

import Control.Exception
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Coerce
import Data.IORef
import Data.Ix
import qualified Data.Monoid as Monoid
import qualified Data.Semigroup as Semigroup
import Data.Version
import Foreign
import Foreign.C.String
import Foreign.C.Types
import GHC.Err (errorWithoutStackTrace)
import GHC.Generics hiding (Datatype, from, to)
import System.IO.Unsafe (unsafePerformIO)

default (Int)


{-# LINE 263 "lib/Control/Distributed/MPI.chs" #-}




--------------------------------------------------------------------------------

-- See GHC's includes/rts/Flags.h
foreign import ccall "&rts_argc" rtsArgc :: Ptr CInt
foreign import ccall "&rts_argv" rtsArgv :: Ptr (Ptr CString)
argc :: CInt
argv :: Ptr CString
argc :: CInt
argc = IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO (IO CInt -> CInt) -> IO CInt -> CInt
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rtsArgc
argv :: Ptr CString
argv = IO (Ptr CString) -> Ptr CString
forall a. IO a -> a
unsafePerformIO (IO (Ptr CString) -> Ptr CString)
-> IO (Ptr CString) -> Ptr CString
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
rtsArgv



--------------------------------------------------------------------------------

-- Arguments

fromEnum :: (Enum e, Integral i) => e -> i
fromEnum :: e -> i
fromEnum  = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (e -> Int) -> e -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum

toEnum :: (Integral i, Enum e) => i -> e
toEnum :: i -> e
toEnum  = Int -> e
forall a. Enum a => Int -> a
Prelude.toEnum (Int -> e) -> (i -> Int) -> i -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Return values

bool2maybe :: (Bool, a) -> Maybe a
bool2maybe :: (Bool, a) -> Maybe a
bool2maybe (False, _) = Maybe a
forall a. Maybe a
Nothing
bool2maybe (True, x :: a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- a Bool, probably represented as CInt
peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
peekBool :: Ptr a -> IO Bool
peekBool  = (a -> Bool) -> IO a -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO a -> IO Bool) -> (Ptr a -> IO a) -> Ptr a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek

-- a type that we wrapped, e.g. CInt and Rank
peekCoerce :: (Storable a, Coercible a b) => Ptr a -> IO b
peekCoerce :: Ptr a -> IO b
peekCoerce = (a -> b) -> IO a -> IO b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
forall a b. Coercible a b => a -> b
coerce (IO a -> IO b) -> (Ptr a -> IO a) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek

peekEnum :: (Integral i, Storable i, Enum e) => Ptr i -> IO e
peekEnum :: Ptr i -> IO e
peekEnum = (i -> e) -> IO i -> IO e
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM i -> e
forall i e. (Integral i, Enum e) => i -> e
toEnum (IO i -> IO e) -> (Ptr i -> IO i) -> Ptr i -> IO e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr i -> IO i
forall a. Storable a => Ptr a -> IO a
peek

peekInt :: (Integral i, Storable i) => Ptr i -> IO Int
peekInt :: Ptr i -> IO Int
peekInt = (i -> Int) -> IO i -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO i -> IO Int) -> (Ptr i -> IO i) -> Ptr i -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr i -> IO i
forall a. Storable a => Ptr a -> IO a
peek



--------------------------------------------------------------------------------

-- Types



-- | A generic pointer-like type that supports converting to a 'Ptr',
-- and which knows the type and number of its elements. This class
-- describes the MPI buffers used to send and receive messages.
class Buffer buf where
  type Elem buf
  withPtrLenType :: buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a

instance (Storable a, HasDatatype a, Integral i) => Buffer (Ptr a, i) where
  type Elem (Ptr a, i) = a
  withPtrLenType :: (Ptr a, i)
-> (Ptr (Elem (Ptr a, i)) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType (ptr :: Ptr a
ptr, len :: i
len) f :: Ptr (Elem (Ptr a, i)) -> Count -> Datatype -> IO a
f = Ptr (Elem (Ptr a, i)) -> Count -> Datatype -> IO a
f Ptr a
Ptr (Elem (Ptr a, i))
ptr (i -> Count
forall i. Integral i => i -> Count
toCount i
len) (HasDatatype a => Datatype
forall a. HasDatatype a => Datatype
getDatatype @a)

instance (Storable a, HasDatatype a, Integral i) => Buffer (ForeignPtr a, i)
    where
  type Elem (ForeignPtr a, i) = a
  withPtrLenType :: (ForeignPtr a, i)
-> (Ptr (Elem (ForeignPtr a, i)) -> Count -> Datatype -> IO a)
-> IO a
withPtrLenType (fptr :: ForeignPtr a
fptr, len :: i
len) f :: Ptr (Elem (ForeignPtr a, i)) -> Count -> Datatype -> IO a
f =
    ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr -> Ptr (Elem (ForeignPtr a, i)) -> Count -> Datatype -> IO a
f Ptr a
Ptr (Elem (ForeignPtr a, i))
ptr (i -> Count
forall i. Integral i => i -> Count
toCount i
len) (HasDatatype a => Datatype
forall a. HasDatatype a => Datatype
getDatatype @a)

instance (Storable a, HasDatatype a, Integral i) => Buffer (StablePtr a, i)
    where
  type Elem (StablePtr a, i) = a
  withPtrLenType :: (StablePtr a, i)
-> (Ptr (Elem (StablePtr a, i)) -> Count -> Datatype -> IO a)
-> IO a
withPtrLenType (ptr :: StablePtr a
ptr, len :: i
len) f :: Ptr (Elem (StablePtr a, i)) -> Count -> Datatype -> IO a
f =
    Ptr (Elem (StablePtr a, i)) -> Count -> Datatype -> IO a
f (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
ptr)) (i -> Count
forall i. Integral i => i -> Count
toCount i
len) (HasDatatype a => Datatype
forall a. HasDatatype a => Datatype
getDatatype @a)

instance Buffer B.ByteString where
  type Elem B.ByteString = CChar
  withPtrLenType :: ByteString
-> (Ptr (Elem ByteString) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType bs :: ByteString
bs f :: Ptr (Elem ByteString) -> Count -> Datatype -> IO a
f =
    ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(ptr :: CString
ptr, len :: Int
len) -> Ptr (Elem ByteString) -> Count -> Datatype -> IO a
f CString
Ptr (Elem ByteString)
ptr (Int -> Count
forall i. Integral i => i -> Count
toCount Int
len) Datatype
datatypeByte



-- | An MPI communicator, wrapping @MPI_Comm@. A communicator defines
-- an independent communication channel between a group of processes.
-- Communicators need to be explicitly created and freed by the MPI
-- library. 'commWorld' is a communicator that is always available,
-- and which includes all processes.

newtype Comm = Comm CComm
  deriving (Comm -> Comm -> Bool
(Comm -> Comm -> Bool) -> (Comm -> Comm -> Bool) -> Eq Comm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comm -> Comm -> Bool
$c/= :: Comm -> Comm -> Bool
== :: Comm -> Comm -> Bool
$c== :: Comm -> Comm -> Bool
Eq, Eq Comm
Eq Comm =>
(Comm -> Comm -> Ordering)
-> (Comm -> Comm -> Bool)
-> (Comm -> Comm -> Bool)
-> (Comm -> Comm -> Bool)
-> (Comm -> Comm -> Bool)
-> (Comm -> Comm -> Comm)
-> (Comm -> Comm -> Comm)
-> Ord Comm
Comm -> Comm -> Bool
Comm -> Comm -> Ordering
Comm -> Comm -> Comm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Comm -> Comm -> Comm
$cmin :: Comm -> Comm -> Comm
max :: Comm -> Comm -> Comm
$cmax :: Comm -> Comm -> Comm
>= :: Comm -> Comm -> Bool
$c>= :: Comm -> Comm -> Bool
> :: Comm -> Comm -> Bool
$c> :: Comm -> Comm -> Bool
<= :: Comm -> Comm -> Bool
$c<= :: Comm -> Comm -> Bool
< :: Comm -> Comm -> Bool
$c< :: Comm -> Comm -> Bool
compare :: Comm -> Comm -> Ordering
$ccompare :: Comm -> Comm -> Ordering
$cp1Ord :: Eq Comm
Ord, Int -> Comm -> ShowS
[Comm] -> ShowS
Comm -> String
(Int -> Comm -> ShowS)
-> (Comm -> String) -> ([Comm] -> ShowS) -> Show Comm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comm] -> ShowS
$cshowList :: [Comm] -> ShowS
show :: Comm -> String
$cshow :: Comm -> String
showsPrec :: Int -> Comm -> ShowS
$cshowsPrec :: Int -> Comm -> ShowS
Show)

type CComm = (C2HSImp.CInt)
{-# LINE 356 "lib/Control/Distributed/MPI.chs" #-}


-- Pass a communicator directly
fromComm :: Comm -> CComm
fromComm :: Comm -> CInt
fromComm (Comm ccomm :: CInt
ccomm) = CInt
ccomm

-- Pass a communicator as pointer
withComm :: Comm -> (Ptr CComm -> IO a) -> IO a
withComm :: Comm -> (Ptr CInt -> IO a) -> IO a
withComm (Comm ccomm :: CInt
ccomm) f :: Ptr CInt -> IO a
f =
  (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr CInt
ccomm
                      Ptr CInt -> IO a
f Ptr CInt
ptr
-- Read a communicator from a pointer
peekComm :: Ptr CComm -> IO Comm
peekComm :: Ptr CInt -> IO Comm
peekComm ptr :: Ptr CInt
ptr =
  do CInt
ccomm <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
     Comm -> IO Comm
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Comm
Comm CInt
ccomm)

-- | The result of comparing two MPI communicator (see 'commCompare').
data ComparisonResult = Identical
                      | Congruent
                      | Similar
                      | Unequal
  deriving (ComparisonResult -> ComparisonResult -> Bool
(ComparisonResult -> ComparisonResult -> Bool)
-> (ComparisonResult -> ComparisonResult -> Bool)
-> Eq ComparisonResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComparisonResult -> ComparisonResult -> Bool
$c/= :: ComparisonResult -> ComparisonResult -> Bool
== :: ComparisonResult -> ComparisonResult -> Bool
$c== :: ComparisonResult -> ComparisonResult -> Bool
Eq,Eq ComparisonResult
Eq ComparisonResult =>
(ComparisonResult -> ComparisonResult -> Ordering)
-> (ComparisonResult -> ComparisonResult -> Bool)
-> (ComparisonResult -> ComparisonResult -> Bool)
-> (ComparisonResult -> ComparisonResult -> Bool)
-> (ComparisonResult -> ComparisonResult -> Bool)
-> (ComparisonResult -> ComparisonResult -> ComparisonResult)
-> (ComparisonResult -> ComparisonResult -> ComparisonResult)
-> Ord ComparisonResult
ComparisonResult -> ComparisonResult -> Bool
ComparisonResult -> ComparisonResult -> Ordering
ComparisonResult -> ComparisonResult -> ComparisonResult
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComparisonResult -> ComparisonResult -> ComparisonResult
$cmin :: ComparisonResult -> ComparisonResult -> ComparisonResult
max :: ComparisonResult -> ComparisonResult -> ComparisonResult
$cmax :: ComparisonResult -> ComparisonResult -> ComparisonResult
>= :: ComparisonResult -> ComparisonResult -> Bool
$c>= :: ComparisonResult -> ComparisonResult -> Bool
> :: ComparisonResult -> ComparisonResult -> Bool
$c> :: ComparisonResult -> ComparisonResult -> Bool
<= :: ComparisonResult -> ComparisonResult -> Bool
$c<= :: ComparisonResult -> ComparisonResult -> Bool
< :: ComparisonResult -> ComparisonResult -> Bool
$c< :: ComparisonResult -> ComparisonResult -> Bool
compare :: ComparisonResult -> ComparisonResult -> Ordering
$ccompare :: ComparisonResult -> ComparisonResult -> Ordering
$cp1Ord :: Eq ComparisonResult
Ord,ReadPrec [ComparisonResult]
ReadPrec ComparisonResult
Int -> ReadS ComparisonResult
ReadS [ComparisonResult]
(Int -> ReadS ComparisonResult)
-> ReadS [ComparisonResult]
-> ReadPrec ComparisonResult
-> ReadPrec [ComparisonResult]
-> Read ComparisonResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComparisonResult]
$creadListPrec :: ReadPrec [ComparisonResult]
readPrec :: ReadPrec ComparisonResult
$creadPrec :: ReadPrec ComparisonResult
readList :: ReadS [ComparisonResult]
$creadList :: ReadS [ComparisonResult]
readsPrec :: Int -> ReadS ComparisonResult
$creadsPrec :: Int -> ReadS ComparisonResult
Read,Int -> ComparisonResult -> ShowS
[ComparisonResult] -> ShowS
ComparisonResult -> String
(Int -> ComparisonResult -> ShowS)
-> (ComparisonResult -> String)
-> ([ComparisonResult] -> ShowS)
-> Show ComparisonResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComparisonResult] -> ShowS
$cshowList :: [ComparisonResult] -> ShowS
show :: ComparisonResult -> String
$cshow :: ComparisonResult -> String
showsPrec :: Int -> ComparisonResult -> ShowS
$cshowsPrec :: Int -> ComparisonResult -> ShowS
Show,(forall x. ComparisonResult -> Rep ComparisonResult x)
-> (forall x. Rep ComparisonResult x -> ComparisonResult)
-> Generic ComparisonResult
forall x. Rep ComparisonResult x -> ComparisonResult
forall x. ComparisonResult -> Rep ComparisonResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComparisonResult x -> ComparisonResult
$cfrom :: forall x. ComparisonResult -> Rep ComparisonResult x
Generic)
instance Enum ComparisonResult where
  succ :: ComparisonResult -> ComparisonResult
succ Identical = ComparisonResult
Congruent
  succ Congruent = Similar
  succ Similar = Unequal
  succ Unequal = String -> ComparisonResult
forall a. HasCallStack => String -> a
error "ComparisonResult.succ: Unequal has no successor"

  pred Congruent = Identical
  pred Similar = Congruent
  pred Unequal = Similar
  pred Identical = error "ComparisonResult.pred: Identical has no predecessor"

  enumFromTo :: ComparisonResult -> ComparisonResult -> [ComparisonResult]
enumFromTo from :: ComparisonResult
from to :: ComparisonResult
to = ComparisonResult -> [ComparisonResult]
go ComparisonResult
from
    where
      end :: Int
end = ComparisonResult -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum ComparisonResult
to
      go :: ComparisonResult -> [ComparisonResult]
go v :: ComparisonResult
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ComparisonResult -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum ComparisonResult
v) Int
end of
                 LT -> ComparisonResult
v ComparisonResult -> [ComparisonResult] -> [ComparisonResult]
forall a. a -> [a] -> [a]
: ComparisonResult -> [ComparisonResult]
go (ComparisonResult -> ComparisonResult
forall a. Enum a => a -> a
succ ComparisonResult
v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Unequal

  fromEnum Identical = 0
  fromEnum Congruent = 1
  fromEnum Similar = 2
  fromEnum Unequal = 3

  toEnum 0 = Identical
  toEnum 1 = Congruent
  toEnum 2 = Similar
  toEnum 3 = Unequal
  toEnum unmatched = error ("ComparisonResult.toEnum: Cannot match " ++ show unmatched)

{-# LINE 374 "lib/Control/Distributed/MPI.chs" #-}




-- | A newtype wrapper describing the size of a message. Use 'toCount'
-- and 'fromCount' to convert between 'Count' and other integral
-- types.
newtype Count = Count CInt
  deriving (Eq, Ord, Enum, Generic, Integral, Num, Real, Storable)

instance Read Count where
  readsPrec p = map (\(c, s) -> (Count c, s)) . readsPrec p

instance Show Count where
  showsPrec p (Count c) = showsPrec p c

-- | Convert an integer to a count.
toCount :: Integral i => i -> Count
toCount i = Count (fromIntegral i)

-- | Convert a count to an integer.
fromCount :: Integral i => Count -> i
fromCount (Count c) = fromIntegral c



-- | An MPI datatype, wrapping @MPI_Datatype@. Datatypes need to be
-- explicitly created and freed by the MPI library. Predefined
-- datatypes exist for most simple C types such as 'CInt' or
-- 'CDouble'.

newtype Datatype = Datatype CDatatype
  deriving (Eq, Ord, Show)

type CDatatype = (C2HSImp.CInt)
{-# LINE 408 "lib/Control/Distributed/MPI.chs" #-}


-- Pass a datatype directly
fromDatatype :: Datatype -> CDatatype
fromDatatype :: Datatype -> CInt
fromDatatype (Datatype cdatatype :: CInt
cdatatype) = CInt
cdatatype

-- Pass a datatype as pointer
withDatatype :: Datatype -> (Ptr CDatatype -> IO a) -> IO a
withDatatype :: Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype (Datatype cdatatype :: CInt
cdatatype) f :: Ptr CInt -> IO a
f =
  (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr CInt
cdatatype
                      Ptr CInt -> IO a
f Ptr CInt
ptr
-- Read a datatype from a pointer
peekDatatype :: Ptr CDatatype -> IO Datatype
peekDatatype :: Ptr CInt -> IO Datatype
peekDatatype ptr :: Ptr CInt
ptr =
  do CInt
cdatatype <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
     Datatype -> IO Datatype
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Datatype
Datatype CInt
cdatatype)



-- | An MPI reduction operation, wrapping @MPI_Op@. Reduction
-- operations need to be explicitly created and freed by the MPI
-- library. Predefined operation exist for simple semigroups such as
-- sum, maximum, or minimum.
--
-- An MPI reduction operation corresponds to a Semigroup, not a
-- Monoid, i.e. MPI has no notion of a respective neutral element.

newtype Op = Op COp
  deriving (Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, Eq Op
Eq Op =>
(Op -> Op -> Ordering)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Op)
-> (Op -> Op -> Op)
-> Ord Op
Op -> Op -> Bool
Op -> Op -> Ordering
Op -> Op -> Op
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Op -> Op -> Op
$cmin :: Op -> Op -> Op
max :: Op -> Op -> Op
$cmax :: Op -> Op -> Op
>= :: Op -> Op -> Bool
$c>= :: Op -> Op -> Bool
> :: Op -> Op -> Bool
$c> :: Op -> Op -> Bool
<= :: Op -> Op -> Bool
$c<= :: Op -> Op -> Bool
< :: Op -> Op -> Bool
$c< :: Op -> Op -> Bool
compare :: Op -> Op -> Ordering
$ccompare :: Op -> Op -> Ordering
$cp1Ord :: Eq Op
Ord, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show)

type COp = (C2HSImp.CInt)
{-# LINE 438 "lib/Control/Distributed/MPI.chs" #-}


-- Pass a operator directly
fromOp :: Op -> COp
fromOp :: Op -> CInt
fromOp (Op cop :: CInt
cop) = CInt
cop

-- Pass a operator as pointer
withOp :: Op -> (Ptr COp -> IO a) -> IO a
withOp :: Op -> (Ptr CInt -> IO a) -> IO a
withOp (Op cop :: CInt
cop) f :: Ptr CInt -> IO a
f =
  (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr CInt
cop
                      Ptr CInt -> IO a
f Ptr CInt
ptr
-- Read a operator from a pointer
peekOp :: Ptr COp -> IO Op
peekOp :: Ptr CInt -> IO Op
peekOp ptr :: Ptr CInt
ptr =
  do CInt
cop <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
     Op -> IO Op
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Op
Op CInt
cop)



-- | A newtype wrapper describing the source or destination of a
-- message, i.e. a process. Each communicator numbers its processes
-- sequentially starting from zero. Use 'toRank' and 'fromRank' to
-- convert between 'Rank' and other integral types. 'rootRank' is the
-- root (first) process of a communicator.
--
-- The association between a rank and a communicator is not explicitly
-- tracked. From MPI's point of view, ranks are simply integers. The
-- same rank might correspond to different processes in different
-- communicators.
newtype Rank = Rank CInt
  deriving (Rank -> Rank -> Bool
(Rank -> Rank -> Bool) -> (Rank -> Rank -> Bool) -> Eq Rank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq, Eq Rank
Eq Rank =>
(Rank -> Rank -> Ordering)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> Ord Rank
Rank -> Rank -> Bool
Rank -> Rank -> Ordering
Rank -> Rank -> Rank
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rank -> Rank -> Rank
$cmin :: Rank -> Rank -> Rank
max :: Rank -> Rank -> Rank
$cmax :: Rank -> Rank -> Rank
>= :: Rank -> Rank -> Bool
$c>= :: Rank -> Rank -> Bool
> :: Rank -> Rank -> Bool
$c> :: Rank -> Rank -> Bool
<= :: Rank -> Rank -> Bool
$c<= :: Rank -> Rank -> Bool
< :: Rank -> Rank -> Bool
$c< :: Rank -> Rank -> Bool
compare :: Rank -> Rank -> Ordering
$ccompare :: Rank -> Rank -> Ordering
$cp1Ord :: Eq Rank
Ord, Int -> Rank
Rank -> Int
Rank -> [Rank]
Rank -> Rank
Rank -> Rank -> [Rank]
Rank -> Rank -> Rank -> [Rank]
(Rank -> Rank)
-> (Rank -> Rank)
-> (Int -> Rank)
-> (Rank -> Int)
-> (Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> Rank -> [Rank])
-> Enum Rank
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
$cenumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
enumFromTo :: Rank -> Rank -> [Rank]
$cenumFromTo :: Rank -> Rank -> [Rank]
enumFromThen :: Rank -> Rank -> [Rank]
$cenumFromThen :: Rank -> Rank -> [Rank]
enumFrom :: Rank -> [Rank]
$cenumFrom :: Rank -> [Rank]
fromEnum :: Rank -> Int
$cfromEnum :: Rank -> Int
toEnum :: Int -> Rank
$ctoEnum :: Int -> Rank
pred :: Rank -> Rank
$cpred :: Rank -> Rank
succ :: Rank -> Rank
$csucc :: Rank -> Rank
Enum, Enum Rank
Real Rank
(Real Rank, Enum Rank) =>
(Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> (Rank, Rank))
-> (Rank -> Rank -> (Rank, Rank))
-> (Rank -> Integer)
-> Integral Rank
Rank -> Integer
Rank -> Rank -> (Rank, Rank)
Rank -> Rank -> Rank
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Rank -> Integer
$ctoInteger :: Rank -> Integer
divMod :: Rank -> Rank -> (Rank, Rank)
$cdivMod :: Rank -> Rank -> (Rank, Rank)
quotRem :: Rank -> Rank -> (Rank, Rank)
$cquotRem :: Rank -> Rank -> (Rank, Rank)
mod :: Rank -> Rank -> Rank
$cmod :: Rank -> Rank -> Rank
div :: Rank -> Rank -> Rank
$cdiv :: Rank -> Rank -> Rank
rem :: Rank -> Rank -> Rank
$crem :: Rank -> Rank -> Rank
quot :: Rank -> Rank -> Rank
$cquot :: Rank -> Rank -> Rank
$cp2Integral :: Enum Rank
$cp1Integral :: Real Rank
Integral, Integer -> Rank
Rank -> Rank
Rank -> Rank -> Rank
(Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank)
-> (Rank -> Rank)
-> (Rank -> Rank)
-> (Integer -> Rank)
-> Num Rank
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Rank
$cfromInteger :: Integer -> Rank
signum :: Rank -> Rank
$csignum :: Rank -> Rank
abs :: Rank -> Rank
$cabs :: Rank -> Rank
negate :: Rank -> Rank
$cnegate :: Rank -> Rank
* :: Rank -> Rank -> Rank
$c* :: Rank -> Rank -> Rank
- :: Rank -> Rank -> Rank
$c- :: Rank -> Rank -> Rank
+ :: Rank -> Rank -> Rank
$c+ :: Rank -> Rank -> Rank
Num, Num Rank
Ord Rank
(Num Rank, Ord Rank) => (Rank -> Rational) -> Real Rank
Rank -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: Rank -> Rational
$ctoRational :: Rank -> Rational
$cp2Real :: Ord Rank
$cp1Real :: Num Rank
Real, Ptr b -> Int -> IO Rank
Ptr b -> Int -> Rank -> IO ()
Ptr Rank -> IO Rank
Ptr Rank -> Int -> IO Rank
Ptr Rank -> Int -> Rank -> IO ()
Ptr Rank -> Rank -> IO ()
Rank -> Int
(Rank -> Int)
-> (Rank -> Int)
-> (Ptr Rank -> Int -> IO Rank)
-> (Ptr Rank -> Int -> Rank -> IO ())
-> (forall b. Ptr b -> Int -> IO Rank)
-> (forall b. Ptr b -> Int -> Rank -> IO ())
-> (Ptr Rank -> IO Rank)
-> (Ptr Rank -> Rank -> IO ())
-> Storable Rank
forall b. Ptr b -> Int -> IO Rank
forall b. Ptr b -> Int -> Rank -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Rank -> Rank -> IO ()
$cpoke :: Ptr Rank -> Rank -> IO ()
peek :: Ptr Rank -> IO Rank
$cpeek :: Ptr Rank -> IO Rank
pokeByteOff :: Ptr b -> Int -> Rank -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Rank -> IO ()
peekByteOff :: Ptr b -> Int -> IO Rank
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Rank
pokeElemOff :: Ptr Rank -> Int -> Rank -> IO ()
$cpokeElemOff :: Ptr Rank -> Int -> Rank -> IO ()
peekElemOff :: Ptr Rank -> Int -> IO Rank
$cpeekElemOff :: Ptr Rank -> Int -> IO Rank
alignment :: Rank -> Int
$calignment :: Rank -> Int
sizeOf :: Rank -> Int
$csizeOf :: Rank -> Int
Storable, (forall x. Rank -> Rep Rank x)
-> (forall x. Rep Rank x -> Rank) -> Generic Rank
forall x. Rep Rank x -> Rank
forall x. Rank -> Rep Rank x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rank x -> Rank
$cfrom :: forall x. Rank -> Rep Rank x
Generic)
instance Read Rank where
  readsPrec :: Int -> ReadS Rank
readsPrec p :: Int
p = ((CInt, String) -> (Rank, String))
-> [(CInt, String)] -> [(Rank, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(r :: CInt
r, s :: String
s) -> (CInt -> Rank
Rank CInt
r, String
s)) ([(CInt, String)] -> [(Rank, String)])
-> (String -> [(CInt, String)]) -> ReadS Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(CInt, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p

instance Show Rank where
  showsPrec :: Int -> Rank -> ShowS
showsPrec p :: Int
p (Rank r :: CInt
r) = Int -> CInt -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p CInt
r

{-# NOINLINE indexError #-}
indexError :: Show a => (a,a) -> a -> String -> b
indexError :: (a, a) -> a -> String -> b
indexError rng :: (a, a)
rng i :: a
i tp :: String
tp =
  String -> b
forall a. String -> a
errorWithoutStackTrace
  (String -> ShowS
showString "Ix{" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
tp ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "}.index: Index " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Bool -> ShowS -> ShowS
showParen Bool
True (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 a
i) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
showString " out of range " ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    Bool -> ShowS -> ShowS
showParen Bool
True (Int -> (a, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (a, a)
rng) "")

instance Ix Rank where
  range :: (Rank, Rank) -> [Rank]
range (Rank rmin :: CInt
rmin, Rank rmax :: CInt
rmax) = CInt -> Rank
Rank (CInt -> Rank) -> [CInt] -> [Rank]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CInt
rmin..CInt
rmax]
  {-# INLINE index #-}
  index :: (Rank, Rank) -> Rank -> Int
index b :: (Rank, Rank)
b@(Rank rmin :: CInt
rmin, _) i :: Rank
i@(Rank r :: CInt
r)
    | (Rank, Rank) -> Rank -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Rank, Rank)
b Rank
i = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
r CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
rmin)
    | Bool
otherwise   = (Rank, Rank) -> Rank -> String -> Int
forall a b. Show a => (a, a) -> a -> String -> b
indexError (Rank, Rank)
b Rank
i "MPI.Rank"
  inRange :: (Rank, Rank) -> Rank -> Bool
inRange (Rank rmin :: CInt
rmin, Rank rmax :: CInt
rmax) (Rank r :: CInt
r) = CInt
rmin CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
r Bool -> Bool -> Bool
&& CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
rmax

-- | Convert an enum to a rank.
toRank :: Enum e => e -> Rank
toRank :: e -> Rank
toRank e :: e
e = CInt -> Rank
Rank (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum e
e))

-- | Convert a rank to an enum.
fromRank :: Enum e => Rank -> e
fromRank :: Rank -> e
fromRank (Rank r :: CInt
r) = Int -> e
forall i e. (Integral i, Enum e) => i -> e
toEnum (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r)

-- | The root (first) rank of a communicator.
rootRank :: Rank
rootRank :: Rank
rootRank = Int -> Rank
forall e. Enum e => e -> Rank
toRank 0



-- | An MPI request, wrapping @MPI_Request@. A request describes a
-- communication that is currently in progress. Each request must be
-- explicitly freed via 'cancel', 'test', or 'wait'.
--
-- Some MPI functions modify existing requests. The new requests are
-- never interesting, and will not be returned.
--
-- TODO: Handle 'Comm', 'Datatype' etc. in this way as well (all
-- except 'Status').
newtype Request = Request CRequest
  deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Eq Request
Eq Request =>
(Request -> Request -> Ordering)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Request)
-> (Request -> Request -> Request)
-> Ord Request
Request -> Request -> Bool
Request -> Request -> Ordering
Request -> Request -> Request
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Request -> Request -> Request
$cmin :: Request -> Request -> Request
max :: Request -> Request -> Request
$cmax :: Request -> Request -> Request
>= :: Request -> Request -> Bool
$c>= :: Request -> Request -> Bool
> :: Request -> Request -> Bool
$c> :: Request -> Request -> Bool
<= :: Request -> Request -> Bool
$c<= :: Request -> Request -> Bool
< :: Request -> Request -> Bool
$c< :: Request -> Request -> Bool
compare :: Request -> Request -> Ordering
$ccompare :: Request -> Request -> Ordering
$cp1Ord :: Eq Request
Ord, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

type CRequest = (C2HSImp.CInt)
{-# LINE 518 "lib/Control/Distributed/MPI.chs" #-}


-- Pass a request directly
fromRequest :: Request -> CRequest
fromRequest :: Request -> CInt
fromRequest (Request creq :: CInt
creq) = CInt
creq

-- Pass a request as pointer
withRequest :: Request -> (Ptr CRequest -> IO a) -> IO a
withRequest :: Request -> (Ptr CInt -> IO a) -> IO a
withRequest (Request creq :: CInt
creq) f :: Ptr CInt -> IO a
f =
  (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CInt
ptr -> do Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr CInt
creq
                      Ptr CInt -> IO a
f Ptr CInt
ptr
-- Read a request from a pointer
peekRequest :: Ptr CRequest -> IO Request
peekRequest :: Ptr CInt -> IO Request
peekRequest ptr :: Ptr CInt
ptr =
  do CInt
creq <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
     Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Request
Request CInt
creq)



-- | An MPI status, wrapping @MPI_Status@. The status describes
-- certain properties of a message. It contains information such as
-- the source of a communication ('getSource'), the message tag
-- ('getTag'), or the size of the message ('getCount', 'getElements').
--
-- In many cases, the status is not interesting. In this case, you can
-- use alternative functions ending with an underscore (e.g. 'recv_')
-- that do not calculate a status.
--
-- The status is particularly interesting when using 'probe' or
-- 'iprobe', as it describes a message that is ready to be received,
-- but which has not been received yet.
newtype Status = Status (C2HSImp.ForeignPtr (Status))
withStatus :: Status -> (C2HSImp.Ptr Status -> IO b) -> IO b
withStatus :: Status -> (Ptr Status -> IO b) -> IO b
withStatus (Status fptr :: ForeignPtr Status
fptr) = ForeignPtr Status -> (Ptr Status -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr Status
fptr
{-# LINE 549 "lib/Control/Distributed/MPI.chs" #-}


deriving instance Eq Status
deriving instance Ord Status
deriving instance Show Status

-- statusError :: Status -> IO Error
-- statusError (Status mst) =
--   Error $ {#get MPI_Status.MPI_ERROR#} mst

-- | Get the source rank of a message (@MPI_SOURCE@).
getSource :: Status -> IO Rank
getSource :: Status -> IO Rank
getSource (Status fst :: ForeignPtr Status
fst) =
  ForeignPtr Status -> (Ptr Status -> IO Rank) -> IO Rank
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Status
fst (\pst :: Ptr Status
pst -> CInt -> Rank
Rank (CInt -> Rank) -> IO CInt -> IO Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\ptr :: Ptr Status
ptr -> do {Ptr Status -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Status
ptr 8 :: IO C2HSImp.CInt}) Ptr Status
pst)

-- | Get the message tag (@MPI_TAG@).
getTag :: Status -> IO Tag
getTag :: Status -> IO Tag
getTag (Status fst :: ForeignPtr Status
fst) =
  ForeignPtr Status -> (Ptr Status -> IO Tag) -> IO Tag
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Status
fst (\pst :: Ptr Status
pst -> CInt -> Tag
Tag (CInt -> Tag) -> IO CInt -> IO Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\ptr :: Ptr Status
ptr -> do {Ptr Status -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Status
ptr 12 :: IO C2HSImp.CInt}) Ptr Status
pst)



-- | A newtype wrapper describing a message tag. A tag defines a
-- sub-channel within a communicator. While communicators are
-- heavy-weight object that are expensive to set up and tear down, a
-- tag is a lightweight mechanism using an integer. Use 'toTag' and
-- 'fromTag' to convert between 'Count' and other enum types.
-- 'unitTag' defines a standard tag that can be used as default.
newtype Tag = Tag CInt
  deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag =>
(Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, ReadPrec [Tag]
ReadPrec Tag
Int -> ReadS Tag
ReadS [Tag]
(Int -> ReadS Tag)
-> ReadS [Tag] -> ReadPrec Tag -> ReadPrec [Tag] -> Read Tag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tag]
$creadListPrec :: ReadPrec [Tag]
readPrec :: ReadPrec Tag
$creadPrec :: ReadPrec Tag
readList :: ReadS [Tag]
$creadList :: ReadS [Tag]
readsPrec :: Int -> ReadS Tag
$creadsPrec :: Int -> ReadS Tag
Read, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic, Int -> Tag
Tag -> Int
Tag -> [Tag]
Tag -> Tag
Tag -> Tag -> [Tag]
Tag -> Tag -> Tag -> [Tag]
(Tag -> Tag)
-> (Tag -> Tag)
-> (Int -> Tag)
-> (Tag -> Int)
-> (Tag -> [Tag])
-> (Tag -> Tag -> [Tag])
-> (Tag -> Tag -> [Tag])
-> (Tag -> Tag -> Tag -> [Tag])
-> Enum Tag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tag -> Tag -> Tag -> [Tag]
$cenumFromThenTo :: Tag -> Tag -> Tag -> [Tag]
enumFromTo :: Tag -> Tag -> [Tag]
$cenumFromTo :: Tag -> Tag -> [Tag]
enumFromThen :: Tag -> Tag -> [Tag]
$cenumFromThen :: Tag -> Tag -> [Tag]
enumFrom :: Tag -> [Tag]
$cenumFrom :: Tag -> [Tag]
fromEnum :: Tag -> Int
$cfromEnum :: Tag -> Int
toEnum :: Int -> Tag
$ctoEnum :: Int -> Tag
pred :: Tag -> Tag
$cpred :: Tag -> Tag
succ :: Tag -> Tag
$csucc :: Tag -> Tag
Enum, Integer -> Tag
Tag -> Tag
Tag -> Tag -> Tag
(Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag)
-> (Tag -> Tag)
-> (Tag -> Tag)
-> (Integer -> Tag)
-> Num Tag
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tag
$cfromInteger :: Integer -> Tag
signum :: Tag -> Tag
$csignum :: Tag -> Tag
abs :: Tag -> Tag
$cabs :: Tag -> Tag
negate :: Tag -> Tag
$cnegate :: Tag -> Tag
* :: Tag -> Tag -> Tag
$c* :: Tag -> Tag -> Tag
- :: Tag -> Tag -> Tag
$c- :: Tag -> Tag -> Tag
+ :: Tag -> Tag -> Tag
$c+ :: Tag -> Tag -> Tag
Num, Ptr b -> Int -> IO Tag
Ptr b -> Int -> Tag -> IO ()
Ptr Tag -> IO Tag
Ptr Tag -> Int -> IO Tag
Ptr Tag -> Int -> Tag -> IO ()
Ptr Tag -> Tag -> IO ()
Tag -> Int
(Tag -> Int)
-> (Tag -> Int)
-> (Ptr Tag -> Int -> IO Tag)
-> (Ptr Tag -> Int -> Tag -> IO ())
-> (forall b. Ptr b -> Int -> IO Tag)
-> (forall b. Ptr b -> Int -> Tag -> IO ())
-> (Ptr Tag -> IO Tag)
-> (Ptr Tag -> Tag -> IO ())
-> Storable Tag
forall b. Ptr b -> Int -> IO Tag
forall b. Ptr b -> Int -> Tag -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Tag -> Tag -> IO ()
$cpoke :: Ptr Tag -> Tag -> IO ()
peek :: Ptr Tag -> IO Tag
$cpeek :: Ptr Tag -> IO Tag
pokeByteOff :: Ptr b -> Int -> Tag -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Tag -> IO ()
peekByteOff :: Ptr b -> Int -> IO Tag
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Tag
pokeElemOff :: Ptr Tag -> Int -> Tag -> IO ()
$cpokeElemOff :: Ptr Tag -> Int -> Tag -> IO ()
peekElemOff :: Ptr Tag -> Int -> IO Tag
$cpeekElemOff :: Ptr Tag -> Int -> IO Tag
alignment :: Tag -> Int
$calignment :: Tag -> Int
sizeOf :: Tag -> Int
$csizeOf :: Tag -> Int
Storable)

-- | Convert an enum to a tag.
toTag :: Enum e => e -> Tag
toTag :: e -> Tag
toTag e :: e
e = CInt -> Tag
Tag (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum e
e))

-- | Convert a tag to an enum.
fromTag :: Enum e => Tag -> e
fromTag :: Tag -> e
fromTag (Tag t :: CInt
t) = Int -> e
forall i e. (Integral i, Enum e) => i -> e
toEnum (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
t)

-- | Useful default tag.
unitTag :: Tag
unitTag :: Tag
unitTag = () -> Tag
forall e. Enum e => e -> Tag
toTag ()



-- | Thread support levels for MPI (see 'initThread'):
--
-- * 'ThreadSingle' (@MPI_THREAD_SINGLE@): The application must be
-- * single-threaded
--
-- * 'ThreadFunneled' (@MPI_THREAD_FUNNELED@): The application might
--   be multi-threaded, but only a single thread will call MPI
--
-- * 'ThreadSerialized' (@MPI_THREAD_SERIALIZED@): The application
--   might be multi-threaded, but the application guarantees that only
--   one thread at a time will call MPI
--
-- * 'ThreadMultiple' (@MPI_THREAD_MULTIPLE@): The application is
--   multi-threaded, and different threads might call MPI at the same
--   time
data ThreadSupport = ThreadSingle
                   | ThreadFunneled
                   | ThreadSerialized
                   | ThreadMultiple
  deriving (ThreadSupport -> ThreadSupport -> Bool
(ThreadSupport -> ThreadSupport -> Bool)
-> (ThreadSupport -> ThreadSupport -> Bool) -> Eq ThreadSupport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadSupport -> ThreadSupport -> Bool
$c/= :: ThreadSupport -> ThreadSupport -> Bool
== :: ThreadSupport -> ThreadSupport -> Bool
$c== :: ThreadSupport -> ThreadSupport -> Bool
Eq,Eq ThreadSupport
Eq ThreadSupport =>
(ThreadSupport -> ThreadSupport -> Ordering)
-> (ThreadSupport -> ThreadSupport -> Bool)
-> (ThreadSupport -> ThreadSupport -> Bool)
-> (ThreadSupport -> ThreadSupport -> Bool)
-> (ThreadSupport -> ThreadSupport -> Bool)
-> (ThreadSupport -> ThreadSupport -> ThreadSupport)
-> (ThreadSupport -> ThreadSupport -> ThreadSupport)
-> Ord ThreadSupport
ThreadSupport -> ThreadSupport -> Bool
ThreadSupport -> ThreadSupport -> Ordering
ThreadSupport -> ThreadSupport -> ThreadSupport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ThreadSupport -> ThreadSupport -> ThreadSupport
$cmin :: ThreadSupport -> ThreadSupport -> ThreadSupport
max :: ThreadSupport -> ThreadSupport -> ThreadSupport
$cmax :: ThreadSupport -> ThreadSupport -> ThreadSupport
>= :: ThreadSupport -> ThreadSupport -> Bool
$c>= :: ThreadSupport -> ThreadSupport -> Bool
> :: ThreadSupport -> ThreadSupport -> Bool
$c> :: ThreadSupport -> ThreadSupport -> Bool
<= :: ThreadSupport -> ThreadSupport -> Bool
$c<= :: ThreadSupport -> ThreadSupport -> Bool
< :: ThreadSupport -> ThreadSupport -> Bool
$c< :: ThreadSupport -> ThreadSupport -> Bool
compare :: ThreadSupport -> ThreadSupport -> Ordering
$ccompare :: ThreadSupport -> ThreadSupport -> Ordering
$cp1Ord :: Eq ThreadSupport
Ord,ReadPrec [ThreadSupport]
ReadPrec ThreadSupport
Int -> ReadS ThreadSupport
ReadS [ThreadSupport]
(Int -> ReadS ThreadSupport)
-> ReadS [ThreadSupport]
-> ReadPrec ThreadSupport
-> ReadPrec [ThreadSupport]
-> Read ThreadSupport
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ThreadSupport]
$creadListPrec :: ReadPrec [ThreadSupport]
readPrec :: ReadPrec ThreadSupport
$creadPrec :: ReadPrec ThreadSupport
readList :: ReadS [ThreadSupport]
$creadList :: ReadS [ThreadSupport]
readsPrec :: Int -> ReadS ThreadSupport
$creadsPrec :: Int -> ReadS ThreadSupport
Read,Int -> ThreadSupport -> ShowS
[ThreadSupport] -> ShowS
ThreadSupport -> String
(Int -> ThreadSupport -> ShowS)
-> (ThreadSupport -> String)
-> ([ThreadSupport] -> ShowS)
-> Show ThreadSupport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadSupport] -> ShowS
$cshowList :: [ThreadSupport] -> ShowS
show :: ThreadSupport -> String
$cshow :: ThreadSupport -> String
showsPrec :: Int -> ThreadSupport -> ShowS
$cshowsPrec :: Int -> ThreadSupport -> ShowS
Show,(forall x. ThreadSupport -> Rep ThreadSupport x)
-> (forall x. Rep ThreadSupport x -> ThreadSupport)
-> Generic ThreadSupport
forall x. Rep ThreadSupport x -> ThreadSupport
forall x. ThreadSupport -> Rep ThreadSupport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ThreadSupport x -> ThreadSupport
$cfrom :: forall x. ThreadSupport -> Rep ThreadSupport x
Generic)
instance Enum ThreadSupport where
  succ ThreadSingle = ThreadFunneled
  succ ThreadFunneled = ThreadSerialized
  succ ThreadSerialized = ThreadMultiple
  succ ThreadMultiple = error "ThreadSupport.succ: ThreadMultiple has no successor"

  pred :: ThreadSupport -> ThreadSupport
pred ThreadFunneled = ThreadSupport
ThreadSingle
  pred ThreadSerialized = ThreadSupport
ThreadFunneled
  pred ThreadMultiple = ThreadSupport
ThreadSerialized
  pred ThreadSingle = String -> ThreadSupport
forall a. HasCallStack => String -> a
error "ThreadSupport.pred: ThreadSingle has no predecessor"

  enumFromTo :: ThreadSupport -> ThreadSupport -> [ThreadSupport]
enumFromTo from :: ThreadSupport
from to :: ThreadSupport
to = ThreadSupport -> [ThreadSupport]
go ThreadSupport
from
    where
      end :: Int
end = ThreadSupport -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum ThreadSupport
to
      go :: ThreadSupport -> [ThreadSupport]
go v :: ThreadSupport
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ThreadSupport -> Int
forall e i. (Enum e, Integral i) => e -> i
fromEnum ThreadSupport
v) Int
end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ThreadMultiple

  fromEnum ThreadSingle = 0
  fromEnum ThreadFunneled = 1
  fromEnum ThreadSerialized = 2
  fromEnum ThreadMultiple = 3

  toEnum 0 = ThreadSingle
  toEnum 1 = ThreadFunneled
  toEnum 2 = ThreadSerialized
  toEnum 3 = ThreadMultiple
  toEnum unmatched = error ("ThreadSupport.toEnum: Cannot match " ++ show unmatched)

{-# LINE 609 "lib/Control/Distributed/MPI.chs" #-}


-- | When MPI is initialized with this library, then it will remember
-- the provided level of thread support. (This might be less than the
-- requested level.)
threadSupport :: IO (Maybe ThreadSupport)
threadSupport = readIORef providedThreadSupport

providedThreadSupport :: IORef (Maybe ThreadSupport)
providedThreadSupport = unsafePerformIO (newIORef Nothing)



--------------------------------------------------------------------------------

-- Constants



-- | A null (invalid) communicator (@MPI_COMM_NULL@).
commNull :: (Comm)
commNull =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  commNull'_ a1' >>
  peekComm  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 631 "lib/Control/Distributed/MPI.chs" #-}


-- | The self communicator (@MPI_COMM_SELF@). Each process has its own
-- self communicator that includes only this process.
commSelf :: (Comm)
commSelf =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  commSelf'_ a1' >>
  peekComm  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 637 "lib/Control/Distributed/MPI.chs" #-}


-- | The world communicator, which includes all processes
-- (@MPI_COMM_WORLD@).
commWorld :: (Comm)
commWorld =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  commWorld'_ a1' >>
  peekComm  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 643 "lib/Control/Distributed/MPI.chs" #-}




-- | Error value returned by 'getCount' if the message is too large,
-- or if the message size is not an integer multiple of the provided
-- datatype (@MPI_UNDEFINED@).
countUndefined :: (Count)
countUndefined :: Count
countUndefined =
  IO Count -> Count
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Count -> Count) -> IO Count -> Count
forall a b. (a -> b) -> a -> b
$
  IO CInt
countUndefined'_ IO CInt -> (CInt -> IO Count) -> IO Count
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Count
res' = CInt -> Count
forall i. Integral i => i -> Count
toCount CInt
res} in
  Count -> IO Count
forall (m :: * -> *) a. Monad m => a -> m a
return (Count
res')

{-# LINE 650 "lib/Control/Distributed/MPI.chs" #-}




-- | A null (invalid) datatype.
datatypeNull :: (Datatype)
datatypeNull =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeNull'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 657 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for a byte (essentially 'CUChar') (@MPI_BYTE@).
datatypeByte :: (Datatype)
datatypeByte =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
datatypeByte'_ Ptr CInt
a1' IO () -> IO Datatype -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Datatype
peekDatatype  Ptr CInt
a1'IO Datatype -> (Datatype -> IO Datatype) -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Datatype
a1'' -> 
  Datatype -> IO Datatype
forall (m :: * -> *) a. Monad m => a -> m a
return (a1'')

{-# LINE 662 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CChar' (@MPI_CHAR@).
datatypeChar :: (Datatype)
datatypeChar =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeChar'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 667 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CDouble' (@MPI_DOUBLE@).
datatypeDouble :: (Datatype)
datatypeDouble =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeDouble'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 672 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CFloat' (@MPI_FLOAT@).
datatypeFloat :: (Datatype)
datatypeFloat =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeFloat'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 677 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CInt' (@MPI_INT@).
datatypeInt :: (Datatype)
datatypeInt =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
datatypeInt'_ Ptr CInt
a1' IO () -> IO Datatype -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Datatype
peekDatatype  Ptr CInt
a1'IO Datatype -> (Datatype -> IO Datatype) -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Datatype
a1'' -> 
  Datatype -> IO Datatype
forall (m :: * -> *) a. Monad m => a -> m a
return (a1'')

{-# LINE 682 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CLong' (@MPI_LONG@).
datatypeLong :: (Datatype)
datatypeLong =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeLong'_ :: Ptr CInt -> IO ()
datatypeLong'_ Ptr CInt
a1' IO () -> IO Datatype -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Datatype
peekDatatype  Ptr CInt
a1'IO Datatype -> (Datatype -> IO Datatype) -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Datatype
a1'' -> 
  Datatype -> IO Datatype
forall (m :: * -> *) a. Monad m => a -> m a
return (a1'')

{-# LINE 687 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for the C type 'long double' (@MPI_LONG_DOUBLE@).
datatypeLongDouble :: (Datatype)
datatypeLongDouble =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeLongDouble'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 692 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CLLong' (@MPI_LONG_LONG@).
datatypeLongLong :: (Datatype)
datatypeLongLong =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeLongLong'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 697 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CLLong' (@MPI_LONG_LONG_INT@).
datatypeLongLongInt :: (Datatype)
datatypeLongLongInt =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeLongLongInt'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 702 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CShort' (@MPI_SHORT@).
datatypeShort :: (Datatype)
datatypeShort =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeShort'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 707 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CUInt' (@MPI_UNSIGNED@).
datatypeUnsigned :: (Datatype)
datatypeUnsigned =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeUnsigned'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 712 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CUChar' (@MPI_UNSIGNED_CHAR@).
datatypeUnsignedChar :: (Datatype)
datatypeUnsignedChar =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeUnsignedChar'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 717 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CULong' (@MPI_UNSIGNED_LONG@).
datatypeUnsignedLong :: (Datatype)
datatypeUnsignedLong =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeUnsignedLong'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 722 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CULLong' (@MPI_UNSIGNED_LONG_LONG@).
datatypeUnsignedLongLong :: (Datatype)
datatypeUnsignedLongLong =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeUnsignedLongLong'_ :: Ptr CInt -> IO ()
datatypeUnsignedLongLong'_ Ptr CInt
a1' IO () -> IO Datatype -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Datatype
peekDatatype  Ptr CInt
a1'IO Datatype -> (Datatype -> IO Datatype) -> IO Datatype
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Datatype
a1'' -> 
  Datatype -> IO Datatype
forall (m :: * -> *) a. Monad m => a -> m a
return (a1'')

{-# LINE 727 "lib/Control/Distributed/MPI.chs" #-}


-- | MPI datatype for 'CUShort' (@MPI_UNSIGNED_SHORT@).
datatypeUnsignedShort :: (Datatype)
datatypeUnsignedShort =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  datatypeUnsignedShort'_ a1' >>
  peekDatatype  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 732 "lib/Control/Distributed/MPI.chs" #-}


-- | A type class mapping Haskell types to MPI datatypes. This is used
-- to automatically determine the MPI datatype for communication
-- buffers.
class HasDatatype a where getDatatype :: Datatype
instance HasDatatype CChar where getDatatype = datatypeChar
instance HasDatatype CDouble where getDatatype :: Datatype
getDatatype = Datatype
datatypeDouble
instance HasDatatype CFloat where getDatatype :: Datatype
getDatatype = Datatype
datatypeFloat
instance HasDatatype CInt where getDatatype :: Datatype
getDatatype = Datatype
datatypeInt
instance HasDatatype CLLong where getDatatype :: Datatype
getDatatype = Datatype
datatypeLongLong
instance HasDatatype CLong where getDatatype :: Datatype
getDatatype = Datatype
datatypeLong
instance HasDatatype CShort where getDatatype :: Datatype
getDatatype = Datatype
datatypeShort
instance HasDatatype CUChar where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedChar
instance HasDatatype CUInt where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsigned
instance HasDatatype CULLong where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedLongLong
instance HasDatatype CULong where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedLong
instance HasDatatype CUShort where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedShort
instance HasDatatype Int8 where getDatatype :: Datatype
getDatatype = Datatype
datatypeChar
instance HasDatatype Int16 where getDatatype :: Datatype
getDatatype = Datatype
datatypeShort
instance HasDatatype Int32 where getDatatype :: Datatype
getDatatype = Datatype
datatypeInt
instance HasDatatype Int64 where getDatatype :: Datatype
getDatatype = Datatype
datatypeLongLong
instance HasDatatype Word8 where getDatatype :: Datatype
getDatatype = Datatype
datatypeByte
instance HasDatatype Word16 where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedShort
instance HasDatatype Word32 where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsigned
instance HasDatatype Word64 where getDatatype :: Datatype
getDatatype = Datatype
datatypeUnsignedLongLong



-- | A null (invalid) reduction operation (@MPI_OP_NULL@).
opNull :: (Op)
opNull :: Op
opNull =
  IO Op -> Op
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Op -> Op) -> IO Op -> Op
forall a b. (a -> b) -> a -> b
$
  (Ptr CInt -> IO Op) -> IO Op
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Op) -> IO Op) -> (Ptr CInt -> IO Op) -> IO Op
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
opNull'_ Ptr CInt
a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Op
peekOp  Ptr CInt
a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  return (a1'')

{-# LINE 764 "lib/Control/Distributed/MPI.chs" #-}


-- | The bitwise and @(.&.)@ reduction operation (@MPI_BAND@).
opBand :: (Op)
opBand =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opBand'_ a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  peekOp  a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  return (a1'')

{-# LINE 769 "lib/Control/Distributed/MPI.chs" #-}


-- | The bitwise or @(.|.)@ reduction operation (@MPI_BOR@).
opBor :: (Op)
opBor =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opBor'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 774 "lib/Control/Distributed/MPI.chs" #-}


-- | The bitwise (@xor@) reduction operation (@MPI_BXOR@).
opBxor :: (Op)
opBxor =
  C2HSImp.unsafePerformIO $
  alloca ((Ptr CInt -> IO Op) -> IO Op) -> (Ptr CInt -> IO Op) -> IO Op
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
opBxor'_ Ptr CInt
a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Op
peekOp  Ptr CInt
a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  return (a1'')

{-# LINE 779 "lib/Control/Distributed/MPI.chs" #-}


-- | The logical and @(&&)@ reduction operation (@MPI_LAND@).
opLand :: (Op)
opLand =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opLand'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 784 "lib/Control/Distributed/MPI.chs" #-}


-- | The logical or @(||)@ reduction operation (@MPI_LOR@).
opLor :: (Op)
opLor =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opLor'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 789 "lib/Control/Distributed/MPI.chs" #-}


-- | The logical xor reduction operation (@MPI_LXOR@).
opLxor :: (Op)
opLxor =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opLxor'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 794 "lib/Control/Distributed/MPI.chs" #-}


-- | The 'maximum' reduction operation (@MPI_MAX@).
opMax :: (Op)
opMax =
  C2HSImp.unsafePerformIO $
  alloca ((Ptr CInt -> IO Op) -> IO Op) -> (Ptr CInt -> IO Op) -> IO Op
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
opMax'_ Ptr CInt
a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Op
peekOp  Ptr CInt
a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  Op -> IO Op
forall (m :: * -> *) a. Monad m => a -> m a
return (Op
a1'')

{-# LINE 799 "lib/Control/Distributed/MPI.chs" #-}


-- | The argmax reduction operation to find the maximum and its rank
-- (@MPI_MAXLOC@).
opMaxloc :: (Op)
opMaxloc =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opMaxloc'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 805 "lib/Control/Distributed/MPI.chs" #-}


-- | The 'minimum' reduction operation (@MPI_MIN@).
opMin :: (Op)
opMin =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opMin'_ a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CInt -> IO Op
peekOp  Ptr CInt
a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  Op -> IO Op
forall (m :: * -> *) a. Monad m => a -> m a
return (Op
a1'')

{-# LINE 810 "lib/Control/Distributed/MPI.chs" #-}


-- | The argmin reduction operation to find the minimum and its rank
-- (@MPI_MINLOC@).
opMinloc :: (Op)
opMinloc =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opMinloc'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 816 "lib/Control/Distributed/MPI.chs" #-}


-- | The (@product@) reduction operation (@MPI_PROD@).
opProd :: (Op)
opProd =
  C2HSImp.unsafePerformIO $
  alloca ((Ptr CInt -> IO Op) -> IO Op) -> (Ptr CInt -> IO Op) -> IO Op
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO ()
opProd'_ Ptr CInt
a1' IO () -> IO Op -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  peekOp  a1'IO Op -> (Op -> IO Op) -> IO Op
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Op
a1'' -> 
  return (a1'')

{-# LINE 821 "lib/Control/Distributed/MPI.chs" #-}


-- | The (@sum@) reduction operation (@MPI_SUM@).
opSum :: (Op)
opSum =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  opSum'_ a1' >>
  peekOp  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 826 "lib/Control/Distributed/MPI.chs" #-}


instance HasDatatype a => HasDatatype (Monoid.Product a) where
  getDatatype = getDatatype @a
instance HasDatatype a => HasDatatype (Monoid.Sum a) where
  getDatatype = getDatatype @a
instance HasDatatype a => HasDatatype (Semigroup.Max a) where
  getDatatype = getDatatype @a
instance HasDatatype a => HasDatatype (Semigroup.Min a) where
  getDatatype :: Datatype
getDatatype = HasDatatype a => Datatype
forall a. HasDatatype a => Datatype
getDatatype @a

-- class (Monoid a, HasDatatype a) => HasOp a where op :: Op
-- instance (Num a, HasDatatype a) => HasOp (Monoid.Product a) where
--   op = opProd
-- instance (Num a, HasDatatype a) => HasOp (Monoid.Sum a) where
--   op = opSum
-- instance (Bounded a, Ord a, HasDatatype a) => HasOp (Semigroup.Max a) where
--   op = opMax
-- instance (Bounded a, Ord a, HasDatatype a) => HasOp (Semigroup.Min a) where
--   op = opMin



-- | Rank placeholder to specify that a message can be received from
-- any source (@MPI_ANY_SOURCE@). When calling 'probe' or 'recv' (or
-- 'iprobe' or 'irecv') with 'anySource' as source, the actual source
-- can be determined from the returned message status via 'getSource'.
anySource :: (Rank)
anySource :: Rank
anySource =
  IO Rank -> Rank
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Rank -> Rank) -> IO Rank -> Rank
forall a b. (a -> b) -> a -> b
$
  IO CInt
anySource'_ IO CInt -> (CInt -> IO Rank) -> IO Rank
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Rank
res' = CInt -> Rank
forall e. Enum e => e -> Rank
toRank CInt
res} in
  Rank -> IO Rank
forall (m :: * -> *) a. Monad m => a -> m a
return (Rank
res')

{-# LINE 853 "lib/Control/Distributed/MPI.chs" #-}




-- | A null (invalid) request (@MPI_REQUEST_NULL@).
requestNull :: IO ((Request))
requestNull =
  alloca $ \a1' -> 
  requestNull'_ a1' >>
  peekRequest  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 860 "lib/Control/Distributed/MPI.chs" #-}




statusIgnore :: (Status)
statusIgnore =
  C2HSImp.unsafePerformIO $
  statusIgnore'_ >>= \res ->
  (\x -> C2HSImp.newForeignPtr_ x >>=  (return . Status)) res >>= \res' ->
  return (res')

{-# LINE 864 "lib/Control/Distributed/MPI.chs" #-}


withStatusIgnore :: (Ptr Status -> IO a) -> IO a
withStatusIgnore = withStatus statusIgnore



-- | Tag placeholder to specify that a message can have any tag
-- (@MPI_ANY_TAG@). When calling 'probe' or 'recv' (or 'iprobe' or
-- 'irecv') with 'anyTag' as tag, the actual tag can be determined
-- from the returned message status via 'getTag'.
anyTag :: (Tag)
anyTag :: Tag
anyTag =
  IO Tag -> Tag
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Tag -> Tag) -> IO Tag -> Tag
forall a b. (a -> b) -> a -> b
$
  IO CInt
anyTag'_ IO CInt -> (CInt -> IO Tag) -> IO Tag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Tag
res' = CInt -> Tag
forall e. Enum e => e -> Tag
toTag CInt
res} in
  Tag -> IO Tag
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag
res')

{-# LINE 875 "lib/Control/Distributed/MPI.chs" #-}




--------------------------------------------------------------------------------

-- Functions



-- | Terminate MPI execution environment
-- (@[MPI_Abort](https://www.open-mpi.org/doc/current/man3/MPI_Abort.3.php)@).
abort :: (Comm) -- ^ Communicator describing which processes  to terminate
 -> (Int) -- ^ Error code
 -> IO ()
abort :: Comm -> Int -> IO ()
abort a1 :: Comm
a1 a2 :: Int
a2 =
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a1 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  Ptr CInt -> CInt -> IO CInt
abort'_ Ptr CInt
a1' CInt
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
return res >> 
  return ()

{-# LINE 891 "lib/Control/Distributed/MPI.chs" #-}


allgatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ()
allgatherTyped a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in 
  let {a2' = fromCount a2} in 
  withDatatype a3 $ :: forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
allgatherTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 901 "lib/Control/Distributed/MPI.chs" #-}


-- | Gather data from all processes and broadcast the result
-- (collective,
-- @[MPI_Allgather](https://www.open-mpi.org/doc/current/man3/MPI_Allgather.3.php)@).
allgather :: (Buffer sb, Buffer rb)
          => sb                 -- ^ Source buffer
          -> rb                 -- ^ Destination buffer
          -> Comm               -- ^ Communicator
          -> IO ()
allgather :: sb -> rb -> Comm -> IO ()
allgather sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO ()
allgatherTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
                 (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
                 Comm
comm

allreduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ()
allreduceTyped :: Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO ()
allreduceTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO ()) -> IO ()
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Ptr ()
-> Ptr () -> CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
allreduceTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' Ptr CInt
a6' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 925 "lib/Control/Distributed/MPI.chs" #-}


-- | Reduce data from all processes and broadcast the result
-- (collective,
-- @[MPI_Allreduce](https://www.open-mpi.org/doc/current/man3/MPI_Allreduce.3.php)@).
-- The MPI datatype is determined automatically from the buffer
-- pointer types.
allreduce :: (Buffer sb, Buffer rb)
          => sb                 -- ^ Source buffer
          -> rb                 -- ^ Destination buffer
          -> Op                 -- ^ Reduction operation
          -> Comm               -- ^ Communicator
          -> IO ()
allreduce :: sb -> rb -> Op -> Comm -> IO ()
allreduce sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO ()
allreduceTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op
                 Comm
comm

alltoallTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ()
alltoallTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO ()
alltoallTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Comm
a7 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
alltoallTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 953 "lib/Control/Distributed/MPI.chs" #-}


-- | Send data from all processes to all processes (collective,
-- @[MPI_Alltoall](https://www.open-mpi.org/doc/current/man3/MPI_Alltoall.php)@).
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
alltoall :: (Buffer sb, Buffer rb)
         => sb                  -- ^ Source buffer
         -> rb                  -- ^ Destination buffer
         -> Comm                -- ^ Communicator
         -> IO ()
alltoall :: sb -> rb -> Comm -> IO ()
alltoall sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO ()
alltoallTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
                (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
                Comm
comm

-- | Barrier (collective,
-- @[MPI_Barrier](https://www.open-mpi.org/doc/current/man3/MPI_Barrier.3.php)@).
barrier :: (Comm) -- ^ Communicator
 -> IO ()
barrier :: Comm -> IO ()
barrier a1 :: Comm
a1 =
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a1 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
barrier'_ Ptr CInt
a1' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 975 "lib/Control/Distributed/MPI.chs" #-}


bcastTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ()
bcastTyped a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromCount a2} in 
  withDatatype a3 $ \a3' -> 
  let {a4' = fromRank a4} in 
  withComm a5 $ \a5' -> 
  bcastTyped'_ a1' a2' a3' a4' a5' >>= \res ->
  return res >> 
  return ()

{-# LINE 983 "lib/Control/Distributed/MPI.chs" #-}


-- | Broadcast data from one process to all processes (collective,
-- @[MPI_Bcast](https://www.open-mpi.org/doc/current/man3/MPI_Bcast.3.php)@).
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
bcast :: Buffer b
      => b -- ^ Buffer (read on the root process, written on all other
           -- processes)
      -> Rank                   -- ^ Root rank (sending process)
      -> Comm                   -- ^ Communicator
      -> IO ()
bcast :: b -> Rank -> Comm -> IO ()
bcast buf :: b
buf root :: Rank
root comm :: Comm
comm =
  b -> (Ptr (Elem b) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType b
buf ((Ptr (Elem b) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem b) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr (Elem b)
ptr count :: Count
count datatype :: Datatype
datatype ->
  Ptr () -> Count -> Datatype -> Rank -> Comm -> IO ()
bcastTyped (Ptr (Elem b) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem b)
ptr) Count
count Datatype
datatype Rank
root Comm
comm

-- | Compare two communicators
-- (@[MPI_Comm_compare](https://www.open-mpi.org/doc/current/man3/MPI_Comm_compare.3.php)@).
commCompare :: (Comm) -- ^ Communicator
 -> (Comm) -- ^ Other communicator
 -> IO ((ComparisonResult))
commCompare :: Comm -> Comm -> IO ComparisonResult
commCompare a1 :: Comm
a1 a2 :: Comm
a2 =
  Comm -> (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a1 ((Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult)
-> (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Comm -> (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a2 ((Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult)
-> (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult)
-> (Ptr CInt -> IO ComparisonResult) -> IO ComparisonResult
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
commCompare'_ Ptr CInt
a1' Ptr CInt
a2' Ptr CInt
a3' IO CInt -> (CInt -> IO ComparisonResult) -> IO ComparisonResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO ComparisonResult -> IO ComparisonResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO ComparisonResult
forall i e. (Integral i, Storable i, Enum e) => Ptr i -> IO e
peekEnum  Ptr CInt
a3'IO ComparisonResult
-> (ComparisonResult -> IO ComparisonResult) -> IO ComparisonResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a3'' :: ComparisonResult
a3'' -> 
  ComparisonResult -> IO ComparisonResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ComparisonResult
a3'')

{-# LINE 1005 "lib/Control/Distributed/MPI.chs" #-}


-- | Return this process's rank in a communicator
-- (@[MPI_Comm_rank](https://www.open-mpi.org/doc/current/man3/MPI_Comm_rank.3.php)@).
commRank :: (Comm) -- ^ Communicator
 -> IO ((Rank))
commRank a1 =
  withComm a1 $ \a1' -> 
  alloca $ \a2' -> 
  commRank'_ a1' a2' >>= \res ->
  return res >> 
  peekCoerce  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 1012 "lib/Control/Distributed/MPI.chs" #-}


-- | Return the number of processes in a communicator
-- (@[MPI_Comm_size](https://www.open-mpi.org/doc/current/man3/MPI_Comm_size.3.php)@).
commSize :: (Comm) -- ^ Communicator
 -> IO ((Rank))
commSize a1 =
  withComm a1 $ \a1' -> 
  alloca $ \a2' -> 
  commSize'_ a1' a2' >>= \res ->
  return res >> 
  peekCoerce  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 1019 "lib/Control/Distributed/MPI.chs" #-}


exscanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ()
exscanTyped a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromCount a3} in 
  withDatatype a4 $ \a4' -> 
  withOp a5 $ \a5' -> 
  withComm a6 $ \a6' -> 
  exscanTyped'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return res >> 
  return ()

{-# LINE 1028 "lib/Control/Distributed/MPI.chs" #-}


-- | Reduce data from all processes via an exclusive (prefix) scan
-- (collective,
-- @[MPI_Exscan](https://www.open-mpi.org/doc/current/man3/MPI_Exscan.3.php)@).
-- Each process with rank @r@ receives the result of reducing data
-- from rank @0@ to rank @r-1@ (inclusive). Rank 0 should logically
-- receive a neutral element of the reduction operation, but instead
-- receives an undefined value since MPI is not aware of neutral
-- values for reductions.
--
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
exscan :: (Buffer sb, Buffer rb)
       => sb                    -- ^ Source buffer
       -> rb                    -- ^ Destination buffer
       -> Op                    -- ^ Reduction operation
       -> Comm                  -- ^ Communicator
       -> IO ()
exscan :: sb -> rb -> Op -> Comm -> IO ()
exscan sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO ()
exscanTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op Comm
comm

-- | Finalize (shut down) the MPI library (collective, @[MPI_Finalize](https://www.open-mpi.org/doc/current/man3/MPI_Finalize.3.php)@).
finalize :: IO ()
finalize :: IO ()
finalize =
  IO CInt
finalize'_ IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1054 "lib/Control/Distributed/MPI.chs" #-}


-- | Return whether the MPI library has been finalized
-- (@[MPI_Finalized](https://www.open-mpi.org/doc/current/man3/MPI_Finalized.3.php)@).
finalized :: IO ((Bool))
finalized =
  alloca $ \a1' -> 
  finalized'_ a1' >>= \res ->
  return res >> 
  peekBool  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 1058 "lib/Control/Distributed/MPI.chs" #-}


gatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ()
gatherTyped a1 a2 a3 a4 a5 a6 a7 a8 =
  let {a1' = id a1} in 
  let {a2' = fromCount a2} in 
  withDatatype a3 $ \a3' -> 
  let {a4' = id a4} in 
  let {a5' = fromCount a5} in 
  withDatatype a6 $ \a6' -> 
  let {a7' = fromRank a7} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a8 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> IO CInt
gatherTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' CInt
a7' Ptr CInt
a8' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1069 "lib/Control/Distributed/MPI.chs" #-}


-- | Gather data from all processes to the root process (collective,
-- @[MPI_Gather](https://www.open-mpi.org/doc/current/man3/MPI_Gather.3.php)@).
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
gather :: (Buffer sb, Buffer rb)
       => sb                    -- ^ Source buffer
       -> rb   -- ^ Destination buffer (only used on the root process)
       -> Rank                  -- ^ Root rank
       -> Comm                  -- ^ Communicator
       -> IO ()
gather :: sb -> rb -> Rank -> Comm -> IO ()
gather sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf root :: Rank
root comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO ()
gatherTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
              (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
              Rank
root Comm
comm

-- | Get the size of a message, in terms of objects of type 'Datatype'
-- (@[MPI_Get_count](https://www.open-mpi.org/doc/current/man3/MPI_Get_count.3.php)@).
-- To determine the MPI datatype for a given Haskell type, use
-- 'datatype' (call e.g. as 'datatype @CInt').
getCount :: (Status) -- ^ Message status
 -> (Datatype) -- ^ MPI datatype
 -> IO ((Count))
getCount :: Status -> Datatype -> IO Count
getCount a1 :: Status
a1 a2 :: Datatype
a2 =
  Status -> (Ptr Status -> IO Count) -> IO Count
forall b. Status -> (Ptr Status -> IO b) -> IO b
withStatus Status
a1 ((Ptr Status -> IO Count) -> IO Count)
-> (Ptr Status -> IO Count) -> IO Count
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr Status
a1' -> 
  Datatype -> (Ptr CInt -> IO Count) -> IO Count
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a2 ((Ptr CInt -> IO Count) -> IO Count)
-> (Ptr CInt -> IO Count) -> IO Count
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  (Ptr CInt -> IO Count) -> IO Count
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Count) -> IO Count)
-> (Ptr CInt -> IO Count) -> IO Count
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  Ptr Status -> Ptr CInt -> Ptr CInt -> IO CInt
getCount'_ Ptr Status
a1' Ptr CInt
a2' Ptr CInt
a3' IO CInt -> (CInt -> IO Count) -> IO Count
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Count -> IO Count
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Count
forall a b. (Storable a, Coercible a b) => Ptr a -> IO b
peekCoerce  Ptr CInt
a3'IO Count -> (Count -> IO Count) -> IO Count
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a3'' :: Count
a3'' -> 
  Count -> IO Count
forall (m :: * -> *) a. Monad m => a -> m a
return (Count
a3'')

{-# LINE 1096 "lib/Control/Distributed/MPI.chs" #-}


-- | Get the number of elements in message, in terms of sub-object of
-- the type 'datatype'
-- (@[MPI_Get_elements](https://www.open-mpi.org/doc/current/man3/MPI_Get_elements.3.php)@).
-- This is useful when a message contains partial objects of type
-- 'datatype'. To determine the MPI datatype for a given Haskell type,
-- use 'datatype' (call e.g. as 'datatype @CInt').
getElements :: (Status) -- ^ Message status
 -> (Datatype) -- ^ MPI datatype
 -> IO ((Int))
getElements :: Status -> Datatype -> IO Int
getElements a1 :: Status
a1 a2 :: Datatype
a2 =
  Status -> (Ptr Status -> IO Int) -> IO Int
forall b. Status -> (Ptr Status -> IO b) -> IO b
withStatus Status
a1 ((Ptr Status -> IO Int) -> IO Int)
-> (Ptr Status -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr Status
a1' -> 
  Datatype -> (Ptr CInt -> IO Int) -> IO Int
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a2 ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  Ptr Status -> Ptr CInt -> Ptr CInt -> IO CInt
getElements'_ Ptr Status
a1' Ptr CInt
a2' Ptr CInt
a3' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Int -> IO Int
>> 
  peekInt  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 1108 "lib/Control/Distributed/MPI.chs" #-}


getLibraryVersion_ :: (CString) -> IO ((Int))
getLibraryVersion_ a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  getLibraryVersion_'_ a1' a2' >>= \res ->
  return res >> 
  peekInt  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 1113 "lib/Control/Distributed/MPI.chs" #-}


-- | Return the version of the MPI library
-- (@[MPI_Get_library_version](https://www.open-mpi.org/doc/current/man3/MPI_Get_library_version.3.php)@).
-- Note that the version of the MPI standard that this library
-- implements is returned by 'getVersion'.
getLibraryVersion :: IO String
getLibraryVersion :: IO String
getLibraryVersion =
  do ForeignPtr CChar
buf <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes 8192
{-# LINE 1121 "lib/Control/Distributed/MPI.chs" #-}

     withForeignPtr buf $ \ptr ->
       do len <- getLibraryVersion_ ptr
          str <- peekCStringLen (ptr, len)
          return str

getProcessorName_ :: (CString) -> IO ((Int))
getProcessorName_ :: CString -> IO Int
getProcessorName_ a1 :: CString
a1 =
  let {a1' :: CString
a1' = CString -> CString
forall a. a -> a
id CString
a1} in 
  (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  CString -> Ptr CInt -> IO CInt
getProcessorName_'_ CString
a1' Ptr CInt
a2' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Int
forall i. (Integral i, Storable i) => Ptr i -> IO Int
peekInt  Ptr CInt
a2'IO Int -> (Int -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: Int
a2'' -> 
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a2'')

{-# LINE 1130 "lib/Control/Distributed/MPI.chs" #-}


-- | Return the name of the current process
-- (@[MPI_Get_Processor_name](https://www.open-mpi.org/doc/current/man3/MPI_Get_processor_name.3.php)@).
-- This should uniquely identify the hardware on which this process is
-- running.
getProcessorName :: IO String
getProcessorName :: IO String
getProcessorName =
  do ForeignPtr CChar
buf <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes 128
{-# LINE 1138 "lib/Control/Distributed/MPI.chs" #-}

     withForeignPtr buf $ \ptr ->
       do len <- getProcessorName_ ptr
          str <- peekCStringLen (ptr, len)
          return str

getVersion_ :: IO ((Int), (Int))
getVersion_ :: IO (Int, Int)
getVersion_ =
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  Ptr CInt -> Ptr CInt -> IO CInt
getVersion_'_ Ptr CInt
a1' Ptr CInt
a2' IO CInt -> (CInt -> IO (Int, Int)) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Int
forall i. (Integral i, Storable i) => Ptr i -> IO Int
peekInt  Ptr CInt
a1'IO Int -> (Int -> IO (Int, Int)) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Int
a1'' -> 
  Ptr CInt -> IO Int
forall i. (Integral i, Storable i) => Ptr i -> IO Int
peekInt  Ptr CInt
a2'IO Int -> (Int -> IO (Int, Int)) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: Int
a2'' -> 
  (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a1'', Int
a2'')

{-# LINE 1147 "lib/Control/Distributed/MPI.chs" #-}


-- | Return the version of the MPI standard implemented by this
-- library
-- (@[MPI_Get_version](https://www.open-mpi.org/doc/current/man3/MPI_Get_version.3.php)@).
-- Note that the version of the MPI library itself is returned by
-- 'getLibraryVersion'.
getVersion :: IO Version
getVersion :: IO Version
getVersion =
  do (major :: Int
major, minor :: Int
minor) <- IO (Int, Int)
getVersion_
     Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Version
makeVersion [Int
major, Int
minor])

iallgatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ((Request))
iallgatherTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO Request
iallgatherTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Comm
a7 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
iallgatherTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' Ptr CInt
a8' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a8'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a8'' :: Request
a8'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a8'')

{-# LINE 1168 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to gather data from all processes and broadcast the result,
-- and return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Iallgather](https://www.open-mpi.org/doc/current/man3/MPI_Iallgather.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
iallgather :: (Buffer sb, Buffer rb)
           => sb                -- ^ Source buffer
           -> rb                -- ^ Destination buffer
           -> Comm              -- ^ Communicator
           -> IO Request        -- ^ Communication request
iallgather :: sb -> rb -> Comm -> IO Request
iallgather sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO Request
iallgatherTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
                  (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
                  Comm
comm

iallreduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iallreduceTyped :: Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iallreduceTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO Request) -> IO Request
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
iallreduceTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a7'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a7'' :: Request
a7'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a7'')

{-# LINE 1197 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to reduce data from all processes and broadcast the result,
-- and return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Iallreduce](https://www.open-mpi.org/doc/current/man3/MPI_Iallreduce.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatype is determined automatically from the buffer
-- pointer types.
iallreduce :: (Buffer sb, Buffer rb)
           => sb                -- ^ Source buffer
           -> rb                -- ^ Destination buffer
           -> Op                -- ^ Reduction operation
           -> Comm              -- ^ Communicator
           -> IO Request        -- ^ Communication request
iallreduce :: sb -> rb -> Op -> Comm -> IO Request
iallreduce sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO Request -> IO Request
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iallreduceTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op
                  Comm
comm

ialltoallTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ((Request))
ialltoallTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO Request
ialltoallTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Comm
a7 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
ialltoallTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' Ptr CInt
a8' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a8'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a8'' :: Request
a8'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a8'')

{-# LINE 1228 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to send data from all processes to all processes, and
-- return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Ialltoall](https://www.open-mpi.org/doc/current/man3/MPI_Ialltoall.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
ialltoall :: (Buffer sb, Buffer rb)
          => sb                 -- ^ Source buffer
          -> rb                 -- ^ Destination buffer
          -> Comm               -- ^ Communicator
          -> IO Request         -- ^ Communication request
ialltoall :: sb -> rb -> Comm -> IO Request
ialltoall sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Comm
-> IO Request
ialltoallTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
                 (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
                 Comm
comm

-- | Start a barrier, and return a handle to the communication request
-- (collective, non-blocking,
-- @[MPI_Ibarrier](https://www.open-mpi.org/doc/current/man3/MPI_Ibarrier.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
ibarrier :: (Comm) -- ^ Communicator
 -> IO ((Request))
ibarrier :: Comm -> IO Request
ibarrier a1 :: Comm
a1 =
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a1 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  Ptr CInt -> Ptr CInt -> IO CInt
ibarrier'_ Ptr CInt
a1' Ptr CInt
a2' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a2'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: Request
a2'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a2'')

{-# LINE 1256 "lib/Control/Distributed/MPI.chs" #-}


ibcastTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ((Request))
ibcastTyped a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromCount a2} in 
  withDatatype a3 $ \a3' -> 
  let {a4' = fromRank a4} in 
  withComm a5 $ \a5' -> 
  alloca $ \a6' -> 
  ibcastTyped'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return res >> 
  peekRequest  a6'>>= \a6'' -> 
  return (a6'')

{-# LINE 1265 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to broadcast data from one process to all processes, and
-- return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Ibcast](https://www.open-mpi.org/doc/current/man3/MPI_Ibcast.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
ibcast :: Buffer b
       => b      -- ^ Buffer (read on the root process, written on all
                 -- other processes)
       -> Rank                  -- ^ Root rank (sending process)
       -> Comm                  -- ^ Communicator
       -> IO Request            -- ^ Communication request
ibcast :: b -> Rank -> Comm -> IO Request
ibcast buf :: b
buf root :: Rank
root comm :: Comm
comm =
  b
-> (Ptr (Elem b) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType b
buf ((Ptr (Elem b) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem b) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr (Elem b)
ptr count :: Count
count datatype :: Datatype
datatype->
  Ptr () -> Count -> Datatype -> Rank -> Comm -> IO Request
ibcastTyped (Ptr (Elem b) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem b)
ptr) Count
count Datatype
datatype Rank
root Comm
comm

iexscanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iexscanTyped :: Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iexscanTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO Request) -> IO Request
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
iexscanTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a7'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a7'' :: Request
a7'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a7'')

{-# LINE 1292 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to reduce data from all processes via an exclusive (prefix)
-- scan, and return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Iexscan](https://www.open-mpi.org/doc/current/man3/MPI_Iexscan.3.php)@).
-- Each process with rank @r@ receives the result of reducing data
-- from rank @0@ to rank @r-1@ (inclusive). Rank 0 should logically
-- receive a neutral element of the reduction operation, but instead
-- receives an undefined value since MPI is not aware of neutral
-- values for reductions.
--
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
iexscan :: (Buffer sb, Buffer rb)
        => sb                   -- ^ Source buffer
        -> rb                   -- ^ Destination buffer
        -> Op                   -- ^ Reduction operation
        -> Comm                 -- ^ Communicator
        -> IO Request           -- ^ Communication request
iexscan :: sb -> rb -> Op -> Comm -> IO Request
iexscan sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO Request -> IO Request
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iexscanTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op
               Comm
comm

igatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ((Request))
igatherTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO Request
igatherTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Rank
a7 a8 :: Comm
a8 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  let {a7' :: CInt
a7' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a7} in 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a8 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a9' :: Ptr CInt
a9' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
igatherTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' CInt
a7' Ptr CInt
a8' Ptr CInt
a9' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a9'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a9'' :: Request
a9'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a9'')

{-# LINE 1330 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to gather data from all processes to the root process, and
-- return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Igather](https://www.open-mpi.org/doc/current/man3/MPI_Igather.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
igather :: (Buffer rb, Buffer sb)
        => sb                   -- ^ Source buffer
        -> rb -- ^ Destination buffer (relevant only on the root process)
        -> Rank                 -- ^ Root rank
        -> Comm                 -- ^ Communicator
        -> IO Request           -- ^ Communication request
igather :: sb -> rb -> Rank -> Comm -> IO Request
igather sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf root :: Rank
root comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO Request
igatherTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
               (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
               Rank
root Comm
comm

-- | Return whether the MPI library has been initialized
-- (@[MPI_Initialized](https://www.open-mpi.org/doc/current/man3/MPI_Initialized.3.php)@).
initialized :: IO ((Bool))
initialized :: IO Bool
initialized =
  (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
initialized'_ Ptr CInt
a1' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Bool
forall a. (Integral a, Storable a) => Ptr a -> IO Bool
peekBool  Ptr CInt
a1'IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' :: Bool
a1'' -> 
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
a1'')

{-# LINE 1354 "lib/Control/Distributed/MPI.chs" #-}


init_ :: (CInt) -> (Ptr CString) -> IO ()
init_ a1 a2 =
  with a1 $ \a1' -> 
  with a2 $ \a2' -> 
  init_'_ a1' a2' >>= \res ->
  return res >> 
  return ()

{-# LINE 1359 "lib/Control/Distributed/MPI.chs" #-}


-- | Initialize the MPI library (collective,
-- @[MPI_Init](https://www.open-mpi.org/doc/current/man3/MPI_Init.3.php)@).
-- This corresponds to calling 'initThread' 'ThreadSingle'.
init :: IO ()
init :: IO ()
init = do CInt -> Ptr CString -> IO ()
init_ CInt
argc Ptr CString
argv
          IORef (Maybe ThreadSupport) -> Maybe ThreadSupport -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ThreadSupport)
providedThreadSupport (ThreadSupport -> Maybe ThreadSupport
forall a. a -> Maybe a
Just ThreadSupport
ThreadSingle)

initThread_ :: (CInt) -> (Ptr CString) -> (ThreadSupport) -> IO ((ThreadSupport))
initThread_ :: CInt -> Ptr CString -> ThreadSupport -> IO ThreadSupport
initThread_ a1 :: CInt
a1 a2 :: Ptr CString
a2 a3 :: ThreadSupport
a3 =
  CInt -> (Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
a1 ((Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport)
-> (Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Ptr CString
-> (Ptr (Ptr CString) -> IO ThreadSupport) -> IO ThreadSupport
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr CString
a2 ((Ptr (Ptr CString) -> IO ThreadSupport) -> IO ThreadSupport)
-> (Ptr (Ptr CString) -> IO ThreadSupport) -> IO ThreadSupport
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr (Ptr CString)
a2' -> 
  let {a3' :: CInt
a3' = ThreadSupport -> CInt
forall e i. (Enum e, Integral i) => e -> i
fromEnum ThreadSupport
a3} in 
  (Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport)
-> (Ptr CInt -> IO ThreadSupport) -> IO ThreadSupport
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Ptr CInt -> Ptr (Ptr CString) -> CInt -> Ptr CInt -> IO CInt
initThread_'_ Ptr CInt
a1' Ptr (Ptr CString)
a2' CInt
a3' Ptr CInt
a4' IO CInt -> (CInt -> IO ThreadSupport) -> IO ThreadSupport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO ThreadSupport -> IO ThreadSupport
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO ThreadSupport
forall i e. (Integral i, Storable i, Enum e) => Ptr i -> IO e
peekEnum  Ptr CInt
a4'IO ThreadSupport
-> (ThreadSupport -> IO ThreadSupport) -> IO ThreadSupport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a4'' :: ThreadSupport
a4'' -> 
  ThreadSupport -> IO ThreadSupport
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadSupport
a4'')

{-# LINE 1373 "lib/Control/Distributed/MPI.chs" #-}


-- | Initialize the MPI library (collective,
-- @[MPI_Init_thread](https://www.open-mpi.org/doc/current/man3/MPI_Init_thread.3.php)@).
-- Note that the provided level of thread support might be less than
-- (!) the required level.
initThread :: ThreadSupport    -- ^ required level of thread support
           -> IO ThreadSupport -- ^ provided level of thread support
initThread :: ThreadSupport -> IO ThreadSupport
initThread ts :: ThreadSupport
ts = do ThreadSupport
ts' <- CInt -> Ptr CString -> ThreadSupport -> IO ThreadSupport
initThread_ CInt
argc Ptr CString
argv ThreadSupport
ts
                   IORef (Maybe ThreadSupport) -> Maybe ThreadSupport -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ThreadSupport)
providedThreadSupport (ThreadSupport -> Maybe ThreadSupport
forall a. a -> Maybe a
Just ThreadSupport
ts')
                   ThreadSupport -> IO ThreadSupport
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadSupport
ts'

iprobeBool :: Rank -> Tag -> Comm -> IO (Bool, Status)
iprobeBool :: Rank -> Tag -> Comm -> IO (Bool, Status)
iprobeBool rank :: Rank
rank tag :: Tag
tag comm :: Comm
comm =
  do Status
st <- ForeignPtr Status -> Status
Status (ForeignPtr Status -> Status)
-> IO (ForeignPtr Status) -> IO Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes 20
{-# LINE 1387 "lib/Control/Distributed/MPI.chs" #-}

     withStatus st $ \st' ->
       do alloca $ \flag ->
            do _ <- iprobeBool_
{-# LINE 1390 "lib/Control/Distributed/MPI.chs" #-}

                    (fromRank rank) (fromTag tag) (fromComm comm) flag st'
               b <- peekBool flag
               return (b, st)

-- | Probe (check) for incoming messages without waiting
-- (non-blocking,
-- @[MPI_Iprobe](https://www.open-mpi.org/doc/current/man3/MPI_Iprobe.3.php)@).
iprobe :: Rank                  -- ^ Source rank (may be 'anySource')
       -> Tag                   -- ^ Message tag (may be 'anyTag')
       -> Comm                  -- ^ Communicator
       -> IO (Maybe Status) -- ^ 'Just' 'Status' of the message if a
                            -- message is available, else 'Nothing'
iprobe :: Rank -> Tag -> Comm -> IO (Maybe Status)
iprobe rank :: Rank
rank tag :: Tag
tag comm :: Comm
comm = (Bool, Status) -> Maybe Status
forall a. (Bool, a) -> Maybe a
bool2maybe ((Bool, Status) -> Maybe Status)
-> IO (Bool, Status) -> IO (Maybe Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rank -> Tag -> Comm -> IO (Bool, Status)
iprobeBool Rank
rank Tag
tag Comm
comm

-- | Probe (check) for an incoming message without waiting
-- (@[MPI_Iprobe](https://www.open-mpi.org/doc/current/man3/MPI_Iprobe.3.php)@).
-- This function does not return a status, which might be more
-- efficient if the status is not needed.
iprobe_ :: Rank                 -- ^ Source rank (may be 'anySource')
        -> Tag                  -- ^ Message tag (may be 'anyTag')
        -> Comm                 -- ^ Communicator
        -> IO Bool              -- ^ Whether a message is available
iprobe_ :: Rank -> Tag -> Comm -> IO Bool
iprobe_ rank :: Rank
rank tag :: Tag
tag comm :: Comm
comm =
  do (Ptr Status -> IO Bool) -> IO Bool
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO Bool) -> IO Bool)
-> (Ptr Status -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \st :: Ptr Status
st ->
       do (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \flag :: Ptr CInt
flag ->
            do CInt
_ <- CInt -> CInt -> CInt -> Ptr CInt -> Ptr Status -> IO CInt
iprobe__
{-# LINE 1416 "lib/Control/Distributed/MPI.chs" #-}

                    (fromRank rank) (fromTag tag) (fromComm comm) flag st
               peekBool flag

irecvTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Request))
irecvTyped :: Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO Request
irecvTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
irecvTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a7'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a7'' :: Request
a7'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a7'')

{-# LINE 1428 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to receive a message, and return a handle to the
-- communication request (non-blocking,
-- @[MPI_Irecv](https://www.open-mpi.org/doc/current/man3/MPI_Irecv.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
irecv :: Buffer rb
      => rb                     -- ^ Receive buffer
      -> Rank                   -- ^ Source rank (may be 'anySource')
      -> Tag                    -- ^ Message tag (may be 'anyTag')
      -> Comm                   -- ^ Communicator
      -> IO Request             -- ^ Communication request
irecv :: rb -> Rank -> Tag -> Comm -> IO Request
irecv recvbuf :: rb
recvbuf recvrank :: Rank
recvrank recvtag :: Tag
recvtag comm :: Comm
comm =
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO Request
irecvTyped (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype Rank
recvrank Tag
recvtag Comm
comm

ireduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Rank) -> (Comm) -> IO ((Request))
ireduceTyped :: Ptr ()
-> Ptr () -> Count -> Datatype -> Op -> Rank -> Comm -> IO Request
ireduceTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Rank
a6 a7 :: Comm
a7 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO Request) -> IO Request
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  let {a6' :: CInt
a6' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a6} in 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  Ptr ()
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
ireduceTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' CInt
a6' Ptr CInt
a7' Ptr CInt
a8' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a8'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a8'' :: Request
a8'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a8'')

{-# LINE 1455 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to reduce data from all processes, and return a handle to
-- the communication request (collective, non-blocking,
-- @[MPI_Ireduce](https://www.open-mpi.org/doc/current/man3/MPI_Ireduce.3.php)@).
-- The result is only available on the root process. The request must
-- be freed by calling 'test', 'wait', or similar. The MPI datatypes
-- are determined automatically from the buffer pointer types.
ireduce :: (Buffer sb, Buffer rb)
        => sb                   -- ^ Source buffer
        -> rb                   -- ^ Destination buffer
        -> Op                   -- ^ Reduction operation
        -> Rank                 -- ^ Root rank
        -> Comm                 -- ^ Communicator
        -> IO Request           -- ^ Communication request
ireduce :: sb -> rb -> Op -> Rank -> Comm -> IO Request
ireduce sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op rank :: Rank
rank comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO Request -> IO Request
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$
  Ptr ()
-> Ptr () -> Count -> Datatype -> Op -> Rank -> Comm -> IO Request
ireduceTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op
               Rank
rank Comm
comm

iscanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iscanTyped :: Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iscanTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO Request) -> IO Request
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
iscanTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a7'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a7'' :: Request
a7'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a7'')

{-# LINE 1485 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to reduce data from all processes via an (inclusive) scan,
-- and return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Iscan](https://www.open-mpi.org/doc/current/man3/MPI_Iscan.3.php)@).
-- Each process with rank @r@ receives the result of reducing data
-- from rank @0@ to rank @r@ (inclusive). The request must be freed by
-- calling 'test', 'wait', or similar. The MPI datatype is determined
-- automatically from the buffer pointer type.
iscan :: (Buffer sb, Buffer rb)
      => sb                     -- ^ Source buffer
      -> rb                     -- ^ Destination buffer
      -> Op                     -- ^ Reduction operation
      -> Comm                   -- ^ Communicator
      -> IO Request             -- ^ Communication request
iscan :: sb -> rb -> Op -> Comm -> IO Request
iscan sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO Request -> IO Request
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO Request
iscanTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op Comm
comm

iscatterTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ((Request))
iscatterTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO Request
iscatterTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Rank
a7 a8 :: Comm
a8 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  let {a7' :: CInt
a7' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a7} in 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a8 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a9' :: Ptr CInt
a9' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
iscatterTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' CInt
a7' Ptr CInt
a8' Ptr CInt
a9' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a9'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a9'' :: Request
a9'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a9'')

{-# LINE 1517 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to scatter data from the root process to all processes, and
-- return a handle to the communication request (collective,
-- non-blocking,
-- @[MPI_Iscatter](https://www.open-mpi.org/doc/current/man3/MPI_Iscatter.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
iscatter :: (Buffer sb, Buffer rb)
         => sb      -- ^ Source buffer (only used on the root process)
         -> rb                  -- ^ Destination buffer
         -> Rank                -- ^ Root rank
         -> Comm                -- ^ Communicator
         -> IO Request          -- ^ Communication request
iscatter :: sb -> rb -> Rank -> Comm -> IO Request
iscatter sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf root :: Rank
root comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO Request
iscatterTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
                (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
                Rank
root Comm
comm

isendTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Request))
isendTyped :: Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO Request
isendTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Request) -> IO Request
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  Comm -> (Ptr CInt -> IO Request) -> IO Request
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr CInt -> IO Request) -> IO Request
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Request) -> IO Request)
-> (Ptr CInt -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
isendTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Request
peekRequest  Ptr CInt
a7'IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a7'' :: Request
a7'' -> 
  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
a7'')

{-# LINE 1547 "lib/Control/Distributed/MPI.chs" #-}


-- | Begin to send a message, and return a handle to the
-- communication request (non-blocking,
-- @[MPI_Isend](https://www.open-mpi.org/doc/current/man3/MPI_Isend.3.php)@).
-- The request must be freed by calling 'test', 'wait', or similar.
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
isend :: Buffer sb
      => sb                     -- ^ Send buffer
      -> Rank                   -- ^ Destination rank
      -> Tag                    -- ^ Message tag
      -> Comm                   -- ^ Communicator
      -> IO Request             -- ^ Communication request
isend :: sb -> Rank -> Tag -> Comm -> IO Request
isend sendbuf :: sb
sendbuf sendrank :: Rank
sendrank sendtag :: Tag
sendtag comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Request) -> IO Request
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO Request
isendTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype Rank
sendrank Tag
sendtag Comm
comm

-- | Probe (wait) for an incoming message
-- (@[MPI_Probe](https://www.open-mpi.org/doc/current/man3/MPI_Probe.3.php)@).
probe :: (Rank) -- ^ Source rank (may be 'anySource')
 -> (Tag) -- ^ Message tag (may be 'anyTag')
 -> (Comm) -- ^ Communicator
 -> IO ((Status)) -- ^ Message status

probe :: Rank -> Tag -> Comm -> IO Status
probe a1 :: Rank
a1 a2 :: Tag
a2 a3 :: Comm
a3 =
  let {a1' :: CInt
a1' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a1} in 
  let {a2' :: CInt
a2' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a2} in 
  Comm -> (Ptr CInt -> IO Status) -> IO Status
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a3 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
C2HSImp.mallocForeignPtrBytes 20 IO (ForeignPtr Status)
-> (ForeignPtr Status -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a4'' :: ForeignPtr Status
a4'' -> ForeignPtr Status -> (Ptr Status -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr Status
a4'' ((Ptr Status -> IO Status) -> IO Status)
-> (Ptr Status -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr Status
a4' -> 
  CInt -> CInt -> Ptr CInt -> Ptr Status -> IO CInt
probe'_ CInt
a1' CInt
a2' Ptr CInt
a3' Ptr Status
a4' IO CInt -> IO Status -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Status -> Status
Status ForeignPtr Status
a4'')

{-# LINE 1573 "lib/Control/Distributed/MPI.chs" #-}


-- | Probe (wait) for an incoming message
-- (@[MPI_Probe](https://www.open-mpi.org/doc/current/man3/MPI_Probe.3.php)@).
-- This function does not return a status, which might be more
-- efficient if the status is not needed.
probe_ :: (Rank) -- ^ Source rank (may be 'anySource')
 -> (Tag) -- ^ Message tag (may be 'anyTag')
 -> (Comm) -- ^ Communicator
 -> IO ()
probe_ :: Rank -> Tag -> Comm -> IO ()
probe_ a1 :: Rank
a1 a2 :: Tag
a2 a3 :: Comm
a3 =
  let {a1' :: CInt
a1' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a1} in 
  let {a2' :: CInt
a2' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a2} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  (Ptr Status -> IO ()) -> IO ()
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO ()) -> IO ()) -> (Ptr Status -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr Status
a4' -> 
  CInt -> CInt -> Ptr CInt -> Ptr Status -> IO CInt
probe_'_ CInt
a1' CInt
a2' Ptr CInt
a3' Ptr Status
a4' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  return ()

{-# LINE 1584 "lib/Control/Distributed/MPI.chs" #-}


recvTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Status))
recvTyped a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = fromCount a2} in 
  withDatatype a3 $ \a3' -> 
  let {a4' = fromRank a4} in 
  let {a5' = fromTag a5} in 
  withComm a6 $ \a6' -> 
  C2HSImp.mallocForeignPtrBytes 20 >>= \a7'' -> C2HSImp.withForeignPtr a7'' forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr Status
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr Status
-> IO CInt
recvTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr CInt
a6' Ptr Status
a7' IO CInt -> IO Status -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Status -> Status
Status ForeignPtr Status
a7'')

{-# LINE 1594 "lib/Control/Distributed/MPI.chs" #-}


-- | Receive a message
-- (@[MPI_Recv](https://www.open-mpi.org/doc/current/man3/MPI_Recv.3.php)@).
-- The MPI datatypeis determined automatically from the buffer
-- pointer type.
recv :: Buffer rb
     => rb                      -- ^ Receive buffer
     -> Rank                    -- ^ Source rank (may be 'anySource')
     -> Tag                     -- ^ Message tag (may be 'anyTag')
     -> Comm                    -- ^ Communicator
     -> IO Status               -- ^ Message status
recv :: rb -> Rank -> Tag -> Comm -> IO Status
recv recvbuf :: rb
recvbuf recvrank :: Rank
recvrank recvtag :: Tag
recvtag comm :: Comm
comm =
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO Status
recvTyped (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype Rank
recvrank Tag
recvtag Comm
comm

recvTyped_ :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ()
recvTyped_ :: Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO ()
recvTyped_ a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  (Ptr Status -> IO ()) -> IO ()
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO ()) -> IO ()) -> (Ptr Status -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr Status
a7' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr Status
-> IO CInt
recvTyped_'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr CInt
a6' Ptr Status
a7' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1618 "lib/Control/Distributed/MPI.chs" #-}


-- | Receive a message
-- (@[MPI_Recv](https://www.open-mpi.org/doc/current/man3/MPI_Recv.3.php)@).
-- The MPI datatype is determined automatically from the buffer
-- pointer type. This function does not return a status, which might
-- be more efficient if the status is not needed.
recv_ :: Buffer rb
      => rb                     -- ^ Receive buffer
      -> Rank                   -- ^ Source rank (may be 'anySource')
      -> Tag                    -- ^ Message tag (may be 'anyTag')
      -> Comm                   -- ^ Communicator
      -> IO ()
recv_ :: rb -> Rank -> Tag -> Comm -> IO ()
recv_ recvbuf :: rb
recvbuf recvrank :: Rank
recvrank recvtag :: Tag
recvtag comm :: Comm
comm =
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO ()
recvTyped_ (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype Rank
recvrank Tag
recvtag Comm
comm

reduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Rank) -> (Comm) -> IO ()
reduceTyped :: Ptr ()
-> Ptr () -> Count -> Datatype -> Op -> Rank -> Comm -> IO ()
reduceTyped a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 a3 :: Count
a3 a4 :: Datatype
a4 a5 :: Op
a5 a6 :: Rank
a6 a7 :: Comm
a7 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  let {a3' :: CInt
a3' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a3} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a4 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a4' :: Ptr CInt
a4' -> 
  Op -> (Ptr CInt -> IO ()) -> IO ()
forall a. Op -> (Ptr CInt -> IO a) -> IO a
withOp Op
a5 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a5' :: Ptr CInt
a5' -> 
  let {a6' :: CInt
a6' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a6} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a7 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a7' :: Ptr CInt
a7' -> 
  Ptr ()
-> Ptr ()
-> CInt
-> Ptr CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> IO CInt
reduceTyped'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' Ptr CInt
a4' Ptr CInt
a5' CInt
a6' Ptr CInt
a7' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1643 "lib/Control/Distributed/MPI.chs" #-}


-- | Reduce data from all processes (collective,
-- @[MPI_Reduce](https://www.open-mpi.org/doc/current/man3/MPI_Reduce.3.php)@).
-- The result is only available on the root process. The MPI datatypes
-- are determined automatically from the buffer pointer types.
reduce :: (Buffer sb, Buffer rb)
       => sb                    -- ^ Source buffer
       -> rb                    -- ^ Destination buffer
       -> Op                    -- ^ Reduction operation
       -> Rank                  -- ^ Root rank
       -> Comm                  -- ^ Communicator
       -> IO ()
reduce :: sb -> rb -> Op -> Rank -> Comm -> IO ()
reduce sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op rank :: Rank
rank comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  Ptr ()
-> Ptr () -> Count -> Datatype -> Op -> Rank -> Comm -> IO ()
reduceTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op Rank
rank
              Comm
comm

requestGetStatusBool :: Request -> IO (Bool, Status)
requestGetStatusBool :: Request -> IO (Bool, Status)
requestGetStatusBool req :: Request
req =
  (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status))
-> (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a b. (a -> b) -> a -> b
$ \flag :: Ptr CInt
flag ->
  do Status
st <- ForeignPtr Status -> Status
Status (ForeignPtr Status -> Status)
-> IO (ForeignPtr Status) -> IO Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes 20
{-# LINE 1666 "lib/Control/Distributed/MPI.chs" #-}

     withStatus st $ \st' ->
       do _ <- requestGetStatusBool_
{-# LINE 1668 "lib/Control/Distributed/MPI.chs" #-}

               (fromRequest req) flag st'
          b <- peekBool flag
          return (b, st)

-- | Check whether a communication has completed without freeing the
-- communication request
-- (@[MPI_Request_get_status](https://www.open-mpi.org/doc/current/man3/MPI_Request_get_status.3.php)@).
requestGetStatus :: Request     -- ^ Communication request
                 -> IO (Maybe Status) -- ^ 'Just' 'Status' if the
                                      -- request has completed, else
                                      -- 'Nothing'
requestGetStatus :: Request -> IO (Maybe Status)
requestGetStatus req :: Request
req = (Bool, Status) -> Maybe Status
forall a. (Bool, a) -> Maybe a
bool2maybe ((Bool, Status) -> Maybe Status)
-> IO (Bool, Status) -> IO (Maybe Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Bool, Status)
requestGetStatusBool Request
req

-- | Check whether a communication has completed without freeing the
-- communication request
-- (@[MPI_Request_get_status](https://www.open-mpi.org/doc/current/man3/MPI_Request_get_status.3.php)@).
-- This function does not return a status, which might be more
-- efficient if the status is not needed.
requestGetStatus_ :: (Request) -> IO ((Bool))
requestGetStatus_ :: Request -> IO Bool
requestGetStatus_ a1 :: Request
a1 =
  let {a1' :: CInt
a1' = Request -> CInt
fromRequest Request
a1} in 
  (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  (Ptr Status -> IO Bool) -> IO Bool
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO Bool) -> IO Bool)
-> (Ptr Status -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr Status
a3' -> 
  CInt -> Ptr CInt -> Ptr Status -> IO CInt
requestGetStatus_'_ CInt
a1' Ptr CInt
a2' Ptr Status
a3' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Bool
forall a. (Integral a, Storable a) => Ptr a -> IO Bool
peekBool  Ptr CInt
a2'IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: Bool
a2'' -> 
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
a2'')

{-# LINE 1691 "lib/Control/Distributed/MPI.chs" #-}


scanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ()
scanTyped a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromCount a3} in 
  withDatatype a4 $ \a4' -> 
  withOp a5 $ \a5' -> 
  withComm a6 $ \a6' -> 
  scanTyped'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return res >> 
  return ()

{-# LINE 1700 "lib/Control/Distributed/MPI.chs" #-}


-- | Reduce data from all processes via an (inclusive) scan
--  (collective,
--  @[MPI_Scan](https://www.open-mpi.org/doc/current/man3/MPI_Scan.3.php)@).
--  Each process with rank @r@ receives the result of reducing data
--  from rank @0@ to rank @r@ (inclusive). The MPI datatype is
--  determined automatically from the buffer pointer type.
scan :: (Buffer sb, Buffer rb)
     => sb                      -- ^ Source buffer
     -> rb                      -- ^ Destination buffer
     -> Op                      -- ^ Reduction operation
     -> Comm                    -- ^ Communicator
     -> IO ()
scan :: sb -> rb -> Op -> Comm -> IO ()
scan sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf op :: Op
op comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Count
sendcount Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
recvcount Bool -> Bool -> Bool
&& Datatype
senddatatype Datatype -> Datatype -> Bool
forall a. Eq a => a -> a -> Bool
== Datatype
recvdatatype) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  Ptr () -> Ptr () -> Count -> Datatype -> Op -> Comm -> IO ()
scanTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
sendcount Datatype
senddatatype Op
op Comm
comm

scatterTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ()
scatterTyped :: Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO ()
scatterTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Ptr ()
a4 a5 :: Count
a5 a6 :: Datatype
a6 a7 :: Rank
a7 a8 :: Comm
a8 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: Ptr ()
a4' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a4} in 
  let {a5' :: CInt
a5' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a5} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  let {a7' :: CInt
a7' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a7} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a8 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> IO CInt
scatterTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' Ptr ()
a4' CInt
a5' Ptr CInt
a6' CInt
a7' Ptr CInt
a8' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1729 "lib/Control/Distributed/MPI.chs" #-}


-- | Scatter data from the root process to all processes (collective,
-- @[MPI_Scatter](https://www.open-mpi.org/doc/current/man3/MPI_Scatter.3.php)@).
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
scatter :: (Buffer sb, Buffer rb)
        => sb        -- ^ Source buffer (only used on the root process)
        -> rb                   -- ^ Destination buffer
        -> Rank                 -- ^ Root rank
        -> Comm                 -- ^ Communicator
        -> IO ()
scatter :: sb -> rb -> Rank -> Comm -> IO ()
scatter sendbuf :: sb
sendbuf recvbuf :: rb
recvbuf root :: Rank
root comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Comm
-> IO ()
scatterTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype
               (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype
               Rank
root Comm
comm

-- -- | Scatter data from the root process to all processes, allowing
-- -- varying send counts to each process (collective,
-- -- @[MPI_Scatterv](https://www.open-mpi.org/doc/current/man3/MPI_Scatterv.3.php)@).
-- -- The MPI datatypes are determined automatically from the buffer
-- -- pointer types.
-- scatterv :: (Buffer sb, Buffer rb)
--          => sb        -- ^ Source buffer (only used on the root process)
--          -> rb                   -- ^ Destination buffer
--          -> Rank                 -- ^ Root rank
--          -> Comm                 -- ^ Communicator
--          -> IO ()
-- scatterv sendbuf recvbuf root comm =
--   withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
--   withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
--   scatterTyped (castPtr sendptr) sendcount senddatatype
--                (castPtr recvptr) recvcount recvdatatype
--                root comm

sendTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ()
sendTyped :: Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO ()
sendTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Comm
a6 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a6 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a6' :: Ptr CInt
a6' -> 
  Ptr () -> CInt -> Ptr CInt -> CInt -> CInt -> Ptr CInt -> IO CInt
sendTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr CInt
a6' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1773 "lib/Control/Distributed/MPI.chs" #-}


-- | Send a message
-- (@[MPI_Send](https://www.open-mpi.org/doc/current/man3/MPI_Send.3.php)@).
-- The MPI datatype is determined automatically from the buffer
-- pointer type.
send :: Buffer sb
     => sb                      -- ^ Send buffer
     -> Rank                    -- ^ Destination rank
     -> Tag                     -- ^ Message tag
     -> Comm                    -- ^ Communicator
     -> IO ()
send :: sb -> Rank -> Tag -> Comm -> IO ()
send sendbuf :: sb
sendbuf sendrank :: Rank
sendrank sendtag :: Tag
sendtag comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  Ptr () -> Count -> Datatype -> Rank -> Tag -> Comm -> IO ()
sendTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype Rank
sendrank Tag
sendtag Comm
comm

sendrecvTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Status))
sendrecvTyped :: Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Comm
-> IO Status
sendrecvTyped a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Ptr ()
a6 a7 :: Count
a7 a8 :: Datatype
a8 a9 :: Rank
a9 a10 :: Tag
a10 a11 :: Comm
a11 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO Status) -> IO Status
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  let {a6' :: Ptr ()
a6' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a6} in 
  let {a7' :: CInt
a7' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a7} in 
  Datatype -> (Ptr CInt -> IO Status) -> IO Status
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a8 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  let {a9' :: CInt
a9' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a9} in 
  let {a10' :: CInt
a10' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a10} in 
  Comm -> (Ptr CInt -> IO Status) -> IO Status
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a11 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a11' :: Ptr CInt
a11' -> 
  Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
C2HSImp.mallocForeignPtrBytes 20 IO (ForeignPtr Status)
-> (ForeignPtr Status -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a12'' :: ForeignPtr Status
a12'' -> ForeignPtr Status -> (Ptr Status -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr Status
a12'' ((Ptr Status -> IO Status) -> IO Status)
-> (Ptr Status -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a12' :: Ptr Status
a12' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr Status
-> IO CInt
sendrecvTyped'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr ()
a6' CInt
a7' Ptr CInt
a8' CInt
a9' CInt
a10' Ptr CInt
a11' Ptr Status
a12' IO CInt -> IO Status -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Status -> Status
Status ForeignPtr Status
a12'')

{-# LINE 1802 "lib/Control/Distributed/MPI.chs" #-}


-- | Send and receive a message with a single call
-- (@[MPI_Sendrecv](https://www.open-mpi.org/doc/current/man3/MPI_Sendrecv.3.php)@).
-- The MPI datatypes are determined automatically from the buffer
-- pointer types.
sendrecv :: (Buffer sb, Buffer rb)
         => sb                  -- ^ Send buffer
         -> Rank                -- ^ Destination rank
         -> Tag                 -- ^ Sent message tag
         -> rb                  -- ^ Receive buffer
         -> Rank                -- ^ Source rank (may be 'anySource')
         -> Tag                 -- ^ Received message tag (may be 'anyTag')
         -> Comm                -- ^ Communicator
         -> IO Status           -- ^ Status for received message
sendrecv :: sb -> Rank -> Tag -> rb -> Rank -> Tag -> Comm -> IO Status
sendrecv sendbuf :: sb
sendbuf sendrank :: Rank
sendrank sendtag :: Tag
sendtag
         recvbuf :: rb
recvbuf recvrank :: Rank
recvrank recvtag :: Tag
recvtag
         comm :: Comm
comm =
  sb
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Status) -> IO Status
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO Status) -> IO Status)
-> (Ptr (Elem sb) -> Count -> Datatype -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status)
-> (Ptr (Elem rb) -> Count -> Datatype -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Comm
-> IO Status
sendrecvTyped (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype Rank
sendrank Tag
sendtag
                (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype Rank
recvrank Tag
recvtag
                Comm
comm

sendrecvTyped_ :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ()
sendrecvTyped_ :: Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Comm
-> IO ()
sendrecvTyped_ a1 :: Ptr ()
a1 a2 :: Count
a2 a3 :: Datatype
a3 a4 :: Rank
a4 a5 :: Tag
a5 a6 :: Ptr ()
a6 a7 :: Count
a7 a8 :: Datatype
a8 a9 :: Rank
a9 a10 :: Tag
a10 a11 :: Comm
a11 =
  let {a1' :: Ptr ()
a1' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a2} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a3 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr CInt
a3' -> 
  let {a4' :: CInt
a4' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a4} in 
  let {a5' :: CInt
a5' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a5} in 
  let {a6' :: Ptr ()
a6' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a6} in 
  let {a7' :: CInt
a7' = Count -> CInt
forall i. Integral i => Count -> i
fromCount Count
a7} in 
  Datatype -> (Ptr CInt -> IO ()) -> IO ()
forall a. Datatype -> (Ptr CInt -> IO a) -> IO a
withDatatype Datatype
a8 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a8' :: Ptr CInt
a8' -> 
  let {a9' :: CInt
a9' = Rank -> CInt
forall e. Enum e => Rank -> e
fromRank Rank
a9} in 
  let {a10' :: CInt
a10' = Tag -> CInt
forall e. Enum e => Tag -> e
fromTag Tag
a10} in 
  Comm -> (Ptr CInt -> IO ()) -> IO ()
forall a. Comm -> (Ptr CInt -> IO a) -> IO a
withComm Comm
a11 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a11' :: Ptr CInt
a11' -> 
  (Ptr Status -> IO ()) -> IO ()
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO ()) -> IO ()) -> (Ptr Status -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a12' :: Ptr Status
a12' -> 
  Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr ()
-> CInt
-> Ptr CInt
-> CInt
-> CInt
-> Ptr CInt
-> Ptr Status
-> IO CInt
sendrecvTyped_'_ Ptr ()
a1' CInt
a2' Ptr CInt
a3' CInt
a4' CInt
a5' Ptr ()
a6' CInt
a7' Ptr CInt
a8' CInt
a9' CInt
a10' Ptr CInt
a11' Ptr Status
a12' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1839 "lib/Control/Distributed/MPI.chs" #-}


-- | Send and receive a message with a single call
-- (@[MPI_Sendrecv](https://www.open-mpi.org/doc/current/man3/MPI_Sendrecv.3.php)@).
-- The MPI datatypes are determined automatically from the buffer
-- pointer types. This function does not return a status, which might
-- be more efficient if the status is not needed.
sendrecv_ :: (Buffer sb, Buffer rb)
          => sb                 -- ^ Send buffer
          -> Rank               -- ^ Destination rank
          -> Tag                -- ^ Sent message tag
          -> rb                 -- ^ Receive buffer
          -> Rank               -- ^ Source rank (may be 'anySource')
          -> Tag                -- ^ Received message tag (may be 'anyTag')
          -> Comm               -- ^ Communicator
          -> IO ()
sendrecv_ :: sb -> Rank -> Tag -> rb -> Rank -> Tag -> Comm -> IO ()
sendrecv_ sendbuf :: sb
sendbuf sendrank :: Rank
sendrank sendtag :: Tag
sendtag
          recvbuf :: rb
recvbuf recvrank :: Rank
recvrank recvtag :: Tag
recvtag
          comm :: Comm
comm =
  sb -> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType sb
sendbuf ((Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem sb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sendptr :: Ptr (Elem sb)
sendptr sendcount :: Count
sendcount senddatatype :: Datatype
senddatatype ->
  rb -> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall buf a.
Buffer buf =>
buf -> (Ptr (Elem buf) -> Count -> Datatype -> IO a) -> IO a
withPtrLenType rb
recvbuf ((Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ())
-> (Ptr (Elem rb) -> Count -> Datatype -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \recvptr :: Ptr (Elem rb)
recvptr recvcount :: Count
recvcount recvdatatype :: Datatype
recvdatatype ->
  Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Ptr ()
-> Count
-> Datatype
-> Rank
-> Tag
-> Comm
-> IO ()
sendrecvTyped_ (Ptr (Elem sb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem sb)
sendptr) Count
sendcount Datatype
senddatatype Rank
sendrank Tag
sendtag
                 (Ptr (Elem rb) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Elem rb)
recvptr) Count
recvcount Datatype
recvdatatype Rank
recvrank Tag
recvtag
                 Comm
comm

testBool :: Request -> IO (Bool, Status)
testBool :: Request -> IO (Bool, Status)
testBool req :: Request
req =
  Request -> (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a. Request -> (Ptr CInt -> IO a) -> IO a
withRequest Request
req ((Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status))
-> (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a b. (a -> b) -> a -> b
$ \req' :: Ptr CInt
req' ->
  (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status))
-> (Ptr CInt -> IO (Bool, Status)) -> IO (Bool, Status)
forall a b. (a -> b) -> a -> b
$ \flag :: Ptr CInt
flag ->
  do Status
st <- ForeignPtr Status -> Status
Status (ForeignPtr Status -> Status)
-> IO (ForeignPtr Status) -> IO Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes 20
{-# LINE 1868 "lib/Control/Distributed/MPI.chs" #-}

     withStatus st $ \st' ->
       do _ <- testBool_ req' flag st'
          b <- peekBool flag
          return (b, st)

-- | Check whether a communication has completed, and free the
-- communication request if so
-- (@[MPI_Test](https://www.open-mpi.org/doc/current/man3/MPI_Test.3.php)@).
test :: Request           -- ^ Communication request
     -> IO (Maybe Status) -- ^ 'Just' 'Status' if the request has completed,
                          -- else 'Nothing'
test :: Request -> IO (Maybe Status)
test req :: Request
req = (Bool, Status) -> Maybe Status
forall a. (Bool, a) -> Maybe a
bool2maybe ((Bool, Status) -> Maybe Status)
-> IO (Bool, Status) -> IO (Maybe Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Bool, Status)
testBool Request
req

-- | Check whether a communication has completed, and free the
-- communication request if so
-- (@[MPI_Test](https://www.open-mpi.org/doc/current/man3/MPI_Test.3.php)@).
-- This function does not return a status, which might be more
-- efficient if the status is not needed.
test_ :: (Request) -> IO ((Bool))
test_ :: Request -> IO Bool
test_ a1 :: Request
a1 =
  Request -> (Ptr CInt -> IO Bool) -> IO Bool
forall a. Request -> (Ptr CInt -> IO a) -> IO a
withRequest Request
a1 ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr CInt
a2' -> 
  (Ptr Status -> IO Bool) -> IO Bool
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO Bool) -> IO Bool)
-> (Ptr Status -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr Status
a3' -> 
  Ptr CInt -> Ptr CInt -> Ptr Status -> IO CInt
test_'_ Ptr CInt
a1' Ptr CInt
a2' Ptr Status
a3' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  Ptr CInt -> IO Bool
forall a. (Integral a, Storable a) => Ptr a -> IO Bool
peekBool  Ptr CInt
a2'IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: Bool
a2'' -> 
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
a2'')

{-# LINE 1891 "lib/Control/Distributed/MPI.chs" #-}


-- | Wait for a communication request to complete, then free the
--  request
--  (@[MPI_Wait](https://www.open-mpi.org/doc/current/man3/MPI_Wait.3.php)@).
wait :: (Request) -- ^ Communication request
 -> IO ((Status)) -- ^ Message status

wait :: Request -> IO Status
wait a1 :: Request
a1 =
  Request -> (Ptr CInt -> IO Status) -> IO Status
forall a. Request -> (Ptr CInt -> IO a) -> IO a
withRequest Request
a1 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  Int -> IO (ForeignPtr Status)
forall a. Int -> IO (ForeignPtr a)
C2HSImp.mallocForeignPtrBytes 20 IO (ForeignPtr Status)
-> (ForeignPtr Status -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a2'' :: ForeignPtr Status
a2'' -> ForeignPtr Status -> (Ptr Status -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr Status
a2'' ((Ptr Status -> IO Status) -> IO Status)
-> (Ptr Status -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr Status
a2' -> 
  Ptr CInt -> Ptr Status -> IO CInt
wait'_ Ptr CInt
a1' Ptr Status
a2' IO CInt -> IO Status -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Status -> Status
Status ForeignPtr Status
a2'')

{-# LINE 1900 "lib/Control/Distributed/MPI.chs" #-}


-- | Wait for a communication request to complete, then free the
--  request
--  (@[MPI_Wait](https://www.open-mpi.org/doc/current/man3/MPI_Wait.3.php)@).
-- This function does not return a status, which might be more
-- efficient if the status is not needed.
wait_ :: (Request) -- ^ Communication request
 -> IO ()
wait_ :: Request -> IO ()
wait_ a1 :: Request
a1 =
  Request -> (Ptr CInt -> IO ()) -> IO ()
forall a. Request -> (Ptr CInt -> IO a) -> IO a
withRequest Request
a1 ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr CInt
a1' -> 
  (Ptr Status -> IO ()) -> IO ()
forall a. (Ptr Status -> IO a) -> IO a
withStatusIgnore ((Ptr Status -> IO ()) -> IO ()) -> (Ptr Status -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr Status
a2' -> 
  Ptr CInt -> Ptr Status -> IO CInt
wait_'_ Ptr CInt
a1' Ptr Status
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1910 "lib/Control/Distributed/MPI.chs" #-}


-- | Wall time tick (accuracy of 'wtime') (in seconds)
wtick :: IO ((Double))
wtick =
  wtick'_ >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 1913 "lib/Control/Distributed/MPI.chs" #-}


-- | Current wall time (in seconds)
wtime :: IO ((Double))
wtime =
  wtime'_ >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 1916 "lib/Control/Distributed/MPI.chs" #-}


foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_comm_null"
  commNull'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_comm_self"
  commSelf'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_comm_world"
  commWorld'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_undefined"
  countUndefined'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_datatype_null"
  datatypeNull'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_byte"
  datatypeByte'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_char"
  datatypeChar'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_double"
  datatypeDouble'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_float"
  datatypeFloat'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_int"
  datatypeInt'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_long"
  datatypeLong'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_long_double"
  datatypeLongDouble'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_long_long"
  datatypeLongLong'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_long_long_int"
  datatypeLongLongInt'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_short"
  datatypeShort'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_unsigned"
  datatypeUnsigned'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_unsigned_char"
  datatypeUnsignedChar'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_unsigned_long"
  datatypeUnsignedLong'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_unsigned_long_long"
  datatypeUnsignedLongLong'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_unsigned_short"
  datatypeUnsignedShort'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_op_null"
  opNull'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_band"
  opBand'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_bor"
  opBor'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_bxor"
  opBxor'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_land"
  opLand'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_lor"
  opLor'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_lxor"
  opLxor'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_max"
  opMax'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_maxloc"
  opMaxloc'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_min"
  opMin'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_minloc"
  opMinloc'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_prod"
  opProd'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_sum"
  opSum'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_any_source"
  anySource'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_request_null"
  requestNull'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_status_ignore"
  statusIgnore'_ :: (IO (C2HSImp.Ptr (Status)))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_any_tag"
  anyTag'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Abort"
  abort'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Allgather"
  allgatherTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Allreduce"
  allreduceTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Alltoall"
  alltoallTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Barrier"
  barrier'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Bcast"
  bcastTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Comm_compare"
  commCompare'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Comm_rank"
  commRank'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Comm_size"
  commSize'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Exscan"
  exscanTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Finalize"
  finalize'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Finalized"
  finalized'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Gather"
  gatherTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Get_count"
  getCount'_ :: ((C2HSImp.Ptr (Status)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Get_elements"
  getElements'_ :: ((C2HSImp.Ptr (Status)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Get_library_version"
  getLibraryVersion_'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Get_processor_name"
  getProcessorName_'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Get_version"
  getVersion_'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Iallgather"
  iallgatherTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Iallreduce"
  iallreduceTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Ialltoall"
  ialltoallTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Ibarrier"
  ibarrier'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Ibcast"
  ibcastTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Iexscan"
  iexscanTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Igather"
  igatherTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Initialized"
  initialized'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Init"
  init_'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Init_thread"
  initThread_'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Iprobe"
  iprobeBool_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Iprobe"
  iprobe__ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Irecv"
  irecvTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Ireduce"
  ireduceTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Iscan"
  iscanTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Iscatter"
  iscatterTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Isend"
  isendTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Probe"
  probe'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Probe"
  probe_'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Recv"
  recvTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Recv"
  recvTyped_'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Reduce"
  reduceTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Request_get_status"
  requestGetStatusBool_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Request_get_status"
  requestGetStatus_'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Scan"
  scanTyped'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Scatter"
  scatterTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Send"
  sendTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Sendrecv"
  sendrecvTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))))))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Sendrecv"
  sendrecvTyped_'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))))))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Test"
  testBool_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Test"
  test_'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Wait"
  wait'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Wait"
  wait_'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Wtick"
  wtick'_ :: (IO C2HSImp.CDouble)

foreign import ccall unsafe "Control/Distributed/MPI.chs.h MPI_Wtime"
  wtime'_ :: (IO C2HSImp.CDouble)