-- 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 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
--   holding pointers and are allocated on the heap as foreign
--   pointers.
--
-- * 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
--   value, 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
  , datatypeLongLongInt
  , datatypeShort
  , datatypeUnsigned
  , datatypeUnsignedChar
  , datatypeUnsignedLong
  , 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 qualified Data.Store as Store
import Data.Version
import Foreign
import Foreign.C.String
import Foreign.C.Types
import GHC.Arr (indexError)
import GHC.Generics hiding (Datatype, from, to)
import System.IO.Unsafe (unsafePerformIO)

default (Int)


{-# LINE 264 "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 = unsafePerformIO $ peek rtsArgc
argv = unsafePerformIO $ peek rtsArgv



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

-- Arguments

fromEnum :: (Enum e, Integral i) => e -> i
fromEnum  = fromIntegral . Prelude.fromEnum

toEnum :: (Integral i, Enum e) => i -> e
toEnum  = Prelude.toEnum . fromIntegral

-- Return values

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

-- a Bool, probably represented as CInt
peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
peekBool  = liftM toBool . peek

-- a type that we wrapped, e.g. CInt and Rank
peekCoerce :: (Storable a, Coercible a b) => Ptr a -> IO b
peekCoerce = liftM coerce . peek

peekEnum :: (Integral i, Storable i, Enum e) => Ptr i -> IO e
peekEnum = liftM toEnum . peek

peekInt :: (Integral i, Storable i) => Ptr i -> IO Int
peekInt = liftM fromIntegral . 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, len) f = f ptr (toCount len) (getDatatype @a)

instance (Storable a, HasDatatype a, Integral i) => Buffer (ForeignPtr a, i)
    where
  type Elem (ForeignPtr a, i) = a
  withPtrLenType (fptr, len) f =
    withForeignPtr fptr $ \ptr -> f ptr (toCount len) (getDatatype @a)

instance (Storable a, HasDatatype a, Integral i) => Buffer (StablePtr a, i)
    where
  type Elem (StablePtr a, i) = a
  withPtrLenType (ptr, len) f =
    f (castPtr (castStablePtrToPtr ptr)) (toCount len) (getDatatype @a)

instance Buffer B.ByteString where
  type Elem B.ByteString = CChar
  withPtrLenType bs f =
    B.unsafeUseAsCStringLen bs $ \(ptr, len) -> f ptr (toCount len) 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 (C2HSImp.ForeignPtr (Comm))
withComm :: Comm -> (C2HSImp.Ptr Comm -> IO b) -> IO b
withComm (Comm fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 353 "lib/Control/Distributed/MPI.chs" #-}


deriving instance Eq Comm
deriving instance Ord Comm
deriving instance Show Comm

-- | The result of comparing two MPI communicator (see 'commCompare').
data ComparisonResult = Identical
                      | Congruent
                      | Similar
                      | Unequal
  deriving (Eq,Ord,Read,Show,Generic)
instance Enum ComparisonResult where
  succ Identical = Congruent
  succ Congruent = Similar
  succ Similar = Unequal
  succ Unequal = 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 from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ 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 360 "lib/Control/Distributed/MPI.chs" #-}


instance Store.Store ComparisonResult



-- | A newtype wrapper describing the size of a message. Use 'toCount'
-- and 'fromCount' to convert between 'Count' and other integral
-- types.
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

instance Store.Store Count

-- | 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 (C2HSImp.ForeignPtr (Datatype))
withDatatype :: Datatype -> (C2HSImp.Ptr Datatype -> IO b) -> IO b
withDatatype (Datatype fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 394 "lib/Control/Distributed/MPI.chs" #-}


deriving instance Eq Datatype
deriving instance Ord Datatype
deriving instance Show Datatype



-- | 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 (C2HSImp.ForeignPtr (Op))
withOp :: Op -> (C2HSImp.Ptr Op -> IO b) -> IO b
withOp (Op fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 409 "lib/Control/Distributed/MPI.chs" #-}


deriving instance Eq Op
deriving instance Ord Op
deriving instance Show Op



-- | 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 (Eq, Ord, Enum, Integral, Num, Real, Storable, Generic)
instance Read Rank where
  readsPrec p = map (\(r, s) -> (Rank r, s)) . readsPrec p

instance Show Rank where
  showsPrec p (Rank r) = showsPrec p r

instance Ix Rank where
  range (Rank rmin, Rank rmax) = Rank <$> [rmin..rmax]
  {-# INLINE index #-}
  index b@(Rank rmin, _) i@(Rank r)
    | inRange b i = fromIntegral (r - rmin)
    | otherwise   = indexError b i "MPI.Rank"
  inRange (Rank rmin, Rank rmax) (Rank r) = rmin <= r && r <= rmax

instance Store.Store Rank

-- | Convert an enum to a rank.
toRank :: Enum e => e -> Rank
toRank e = Rank (fromIntegral (fromEnum e))

-- | Convert a rank to an enum.
fromRank :: Enum e => Rank -> e
fromRank (Rank r) = toEnum (fromIntegral r)

-- | The root (first) rank of a communicator.
rootRank :: Rank
rootRank = 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'.
newtype Request = Request (C2HSImp.ForeignPtr (Request))
withRequest :: Request -> (C2HSImp.Ptr Request -> IO b) -> IO b
withRequest (Request fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 462 "lib/Control/Distributed/MPI.chs" #-}


deriving instance Eq Request
deriving instance Ord Request
deriving instance Show Request



-- | 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 fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 482 "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 fst) =
  withForeignPtr fst (\pst -> Rank <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) pst)

-- | Get the message tag (@MPI_TAG@).
getTag :: Status -> IO Tag
getTag (Status fst) =
  withForeignPtr fst (\pst -> Tag <$> (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt}) 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 (Eq, Ord, Read, Show, Generic, Enum, Num, Storable)

instance Store.Store Tag

-- | Convert an enum to a tag.
toTag :: Enum e => e -> Tag
toTag e = Tag (fromIntegral (fromEnum e))

-- | Convert a tag to an enum.
fromTag :: Enum e => Tag -> e
fromTag (Tag t) = toEnum (fromIntegral t)

-- | Useful default tag.
unitTag :: Tag
unitTag = 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 (Eq,Ord,Read,Show,Generic)
instance Enum ThreadSupport where
  succ ThreadSingle = ThreadFunneled
  succ ThreadFunneled = ThreadSerialized
  succ ThreadSerialized = ThreadMultiple
  succ ThreadMultiple = error "ThreadSupport.succ: ThreadMultiple has no successor"

  pred ThreadFunneled = ThreadSingle
  pred ThreadSerialized = ThreadFunneled
  pred ThreadMultiple = ThreadSerialized
  pred ThreadSingle = error "ThreadSupport.pred: ThreadSingle has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) 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 544 "lib/Control/Distributed/MPI.chs" #-}


instance Store.Store ThreadSupport

-- | When MPI is initialized with this library, then it will remember
-- the provided level of thread support. (This might be less than the
-- 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 $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  commNull'_ a1' >>
  return (Comm a1'')

{-# LINE 566 "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 $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  commSelf'_ a1' >>
  return (Comm a1'')

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


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

{-# LINE 574 "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 =
  C2HSImp.unsafePerformIO $
  countUndefined'_ >>= \res ->
  let {res' = toCount res} in
  return (res')

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




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

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


-- | MPI datatype for a byte (essentially 'CUChar') (@MPI_BYTE@).
datatypeByte :: (Datatype)
datatypeByte =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  datatypeByte'_ a1' >>
  return (Datatype a1'')

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


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

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


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

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


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

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


-- | MPI datatype for 'CInt' (@MPI_INT@).
datatypeInt :: (Datatype)
datatypeInt =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  datatypeInt'_ a1' >>
  return (Datatype a1'')

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


-- | MPI datatype for 'CLong' (@MPI_LONG@).
datatypeLong :: (Datatype)
datatypeLong =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  datatypeLong'_ a1' >>
  return (Datatype a1'')

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


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

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


-- | MPI datatype for 'CLLong' (@MPI_LONG_LONG_INT@). (There is no MPI
-- datatype for 'CULLong@).
datatypeLongLongInt :: (Datatype)
datatypeLongLongInt =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  datatypeLongLongInt'_ a1' >>
  return (Datatype a1'')

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


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

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


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

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


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

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


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

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


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

{-# LINE 626 "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 = datatypeDouble
instance HasDatatype CFloat where getDatatype = datatypeFloat
instance HasDatatype CInt where getDatatype = datatypeInt
instance HasDatatype CLLong where getDatatype = datatypeLongLongInt
instance HasDatatype CLong where getDatatype = datatypeLong
instance HasDatatype CShort where getDatatype = datatypeShort
instance HasDatatype CUChar where getDatatype = datatypeUnsignedChar
instance HasDatatype CUInt where getDatatype = datatypeUnsigned
instance HasDatatype CULong where getDatatype = datatypeUnsignedLong
instance HasDatatype CUShort where getDatatype = datatypeUnsignedShort



-- | A null (invalid) reduction operation (@MPI_OP_NULL@).
opNull :: (Op)
opNull =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opNull'_ a1' >>
  return (Op a1'')

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


-- | The bitwise and @(.&.)@ reduction operation (@MPI_BAND@).
opBand :: (Op)
opBand =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opBand'_ a1' >>
  return (Op a1'')

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


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

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


-- | The bitwise (@xor@) reduction operation (@MPI_BXOR@).
opBxor :: (Op)
opBxor =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opBxor'_ a1' >>
  return (Op a1'')

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


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

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


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

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


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

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


-- | The 'maximum' reduction operation (@MPI_MAX@).
opMax :: (Op)
opMax =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opMax'_ a1' >>
  return (Op a1'')

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


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

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


-- | The 'minimum' reduction operation (@MPI_MIN@).
opMin :: (Op)
opMin =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opMin'_ a1' >>
  return (Op a1'')

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


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

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


-- | The (@product@) reduction operation (@MPI_PROD@).
opProd :: (Op)
opProd =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  opProd'_ a1' >>
  return (Op a1'')

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


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

{-# LINE 685 "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 = 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 =
  C2HSImp.unsafePerformIO $
  anySource'_ >>= \res ->
  let {res' = toRank res} in
  return (res')

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




-- | A null (invalid) request (@MPI_REQUEST_NULL@).
requestNull :: (Request)
requestNull =
  C2HSImp.unsafePerformIO $
  C2HSImp.mallocForeignPtrBytes 8 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  requestNull'_ a1' >>
  return (Request a1'')

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




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

{-# LINE 721 "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 =
  C2HSImp.unsafePerformIO $
  anyTag'_ >>= \res ->
  let {res' = toTag res} in
  return (res')

{-# LINE 732 "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 a1 a2 =
  withComm a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  abort'_ a1' a2' >>= \res ->
  return res >>
  return ()

{-# LINE 748 "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 $ \a3' ->
  let {a4' = id a4} in
  let {a5' = fromCount a5} in
  withDatatype a6 $ \a6' ->
  withComm a7 $ \a7' ->
  allgatherTyped'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return res >>
  return ()

{-# LINE 758 "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 sendbuf recvbuf comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  allgatherTyped (castPtr sendptr) sendcount senddatatype
                 (castPtr recvptr) recvcount recvdatatype
                 comm

allreduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ()
allreduceTyped 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' ->
  allreduceTyped'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return res >>
  return ()

{-# LINE 782 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  allreduceTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op
                 comm

alltoallTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ()
alltoallTyped a1 a2 a3 a4 a5 a6 a7 =
  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' ->
  withComm a7 $ \a7' ->
  alltoallTyped'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return res >>
  return ()

{-# LINE 810 "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 sendbuf recvbuf comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  alltoallTyped (castPtr sendptr) sendcount senddatatype
                (castPtr recvptr) recvcount recvdatatype
                comm

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

{-# LINE 832 "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 840 "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 buf root comm =
  withPtrLenType buf $ \ptr count datatype ->
  bcastTyped (castPtr ptr) count datatype root 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 a1 a2 =
  withComm a1 $ \a1' ->
  withComm a2 $ \a2' ->
  alloca $ \a3' ->
  commCompare'_ a1' a2' a3' >>= \res ->
  return res >>
  peekEnum  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 862 "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 869 "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 876 "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 885 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  exscanTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op 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 =
  finalize'_ >>= \res ->
  return res >>
  return ()

{-# LINE 911 "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 915 "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
  withComm a8 $ \a8' ->
  gatherTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  return res >>
  return ()

{-# LINE 926 "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 sendbuf recvbuf root comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  gatherTyped (castPtr sendptr) sendcount senddatatype
              (castPtr recvptr) recvcount recvdatatype
              root 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 a1 a2 =
  withStatus a1 $ \a1' ->
  withDatatype a2 $ \a2' ->
  alloca $ \a3' ->
  getCount'_ a1' a2' a3' >>= \res ->
  return res >>
  peekCoerce  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 953 "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 a1 a2 =
  withStatus a1 $ \a1' ->
  withDatatype a2 $ \a2' ->
  alloca $ \a3' ->
  getElements'_ a1' a2' a3' >>= \res ->
  return res >>
  peekInt  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 965 "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 970 "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 =
  do buf <- mallocForeignPtrBytes 256
{-# LINE 978 "lib/Control/Distributed/MPI.chs" #-}

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

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

{-# LINE 987 "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 =
  do buf <- mallocForeignPtrBytes 256
{-# LINE 995 "lib/Control/Distributed/MPI.chs" #-}

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

getVersion_ :: IO ((Int), (Int))
getVersion_ =
  alloca $ \a1' ->
  alloca $ \a2' ->
  getVersion_'_ a1' a2' >>= \res ->
  return res >>
  peekInt  a1'>>= \a1'' ->
  peekInt  a2'>>= \a2'' ->
  return (a1'', a2'')

{-# LINE 1004 "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 =
  do (major, minor) <- getVersion_
     return (makeVersion [major, minor])

iallgatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ((Request))
iallgatherTyped a1 a2 a3 a4 a5 a6 a7 =
  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' ->
  withComm a7 $ \a7' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a8'' -> C2HSImp.withForeignPtr a8'' $ \a8' ->
  iallgatherTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return (Request a8'')

{-# LINE 1025 "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 sendbuf recvbuf comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  iallgatherTyped (castPtr sendptr) sendcount senddatatype
                  (castPtr recvptr) recvcount recvdatatype
                  comm

iallreduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iallreduceTyped 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' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  iallreduceTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Request a7'')

{-# LINE 1054 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  iallreduceTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op
                  comm

ialltoallTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Comm) -> IO ((Request))
ialltoallTyped a1 a2 a3 a4 a5 a6 a7 =
  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' ->
  withComm a7 $ \a7' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a8'' -> C2HSImp.withForeignPtr a8'' $ \a8' ->
  ialltoallTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return (Request a8'')

{-# LINE 1085 "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 sendbuf recvbuf comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  ialltoallTyped (castPtr sendptr) sendcount senddatatype
                 (castPtr recvptr) recvcount recvdatatype
                 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 a1 =
  withComm a1 $ \a1' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a2'' -> C2HSImp.withForeignPtr a2'' $ \a2' ->
  ibarrier'_ a1' a2' >>
  return (Request a2'')

{-# LINE 1113 "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' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a6'' -> C2HSImp.withForeignPtr a6'' $ \a6' ->
  ibcastTyped'_ a1' a2' a3' a4' a5' a6' >>
  return (Request a6'')

{-# LINE 1122 "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 buf root comm =
  withPtrLenType buf $ \ptr count datatype->
  ibcastTyped (castPtr ptr) count datatype root comm

iexscanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iexscanTyped 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' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  iexscanTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Request a7'')

{-# LINE 1149 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  iexscanTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op
               comm

igatherTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ((Request))
igatherTyped 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
  withComm a8 $ \a8' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a9'' -> C2HSImp.withForeignPtr a9'' $ \a9' ->
  igatherTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>
  return (Request a9'')

{-# LINE 1187 "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 sendbuf recvbuf root comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  igatherTyped (castPtr sendptr) sendcount senddatatype
               (castPtr recvptr) recvcount recvdatatype
               root 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 =
  alloca $ \a1' ->
  initialized'_ a1' >>= \res ->
  return res >>
  peekBool  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 1211 "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 1216 "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 = do init_ argc argv
          writeIORef providedThreadSupport (Just ThreadSingle)

initThread_ :: (CInt) -> (Ptr CString) -> (ThreadSupport) -> IO ((ThreadSupport))
initThread_ a1 a2 a3 =
  with a1 $ \a1' ->
  with a2 $ \a2' ->
  let {a3' = fromEnum a3} in
  alloca $ \a4' ->
  initThread_'_ a1' a2' a3' a4' >>= \res ->
  return res >>
  peekEnum  a4'>>= \a4'' ->
  return (a4'')

{-# LINE 1230 "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 ts = do ts' <- initThread_ argc argv ts
                   writeIORef providedThreadSupport (Just ts')
                   return ts'

iprobeBool :: Rank -> Tag -> Comm -> IO (Bool, Status)
iprobeBool rank tag comm =
  withComm comm $ \comm' ->
  do st <- Status <$> mallocForeignPtrBytes 24
{-# LINE 1245 "lib/Control/Distributed/MPI.chs" #-}

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

                    (fromRank rank) (fromTag tag) 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 = bool2maybe <$> iprobeBool rank tag 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 =
  withComm comm $ \comm' ->
  do withStatusIgnore $ \st ->
       do alloca $ \flag ->
            do _ <- iprobe__
{-# LINE 1275 "lib/Control/Distributed/MPI.chs" #-}

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

irecvTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Request))
irecvTyped 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 8 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  irecvTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Request a7'')

{-# LINE 1287 "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 recvbuf recvrank recvtag comm =
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  irecvTyped (castPtr recvptr) recvcount recvdatatype recvrank recvtag comm

ireduceTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Rank) -> (Comm) -> IO ((Request))
ireduceTyped a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = fromCount a3} in
  withDatatype a4 $ \a4' ->
  withOp a5 $ \a5' ->
  let {a6' = fromRank a6} in
  withComm a7 $ \a7' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a8'' -> C2HSImp.withForeignPtr a8'' $ \a8' ->
  ireduceTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return (Request a8'')

{-# LINE 1314 "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 sendbuf recvbuf op rank comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  ireduceTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op
               rank comm

iscanTyped :: (Ptr ()) -> (Ptr ()) -> (Count) -> (Datatype) -> (Op) -> (Comm) -> IO ((Request))
iscanTyped 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' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  iscanTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Request a7'')

{-# LINE 1344 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  iscanTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op comm

iscatterTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ((Request))
iscatterTyped 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
  withComm a8 $ \a8' ->
  C2HSImp.mallocForeignPtrBytes 8 >>= \a9'' -> C2HSImp.withForeignPtr a9'' $ \a9' ->
  iscatterTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>
  return (Request a9'')

{-# LINE 1376 "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 sendbuf recvbuf root comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  iscatterTyped (castPtr sendptr) sendcount senddatatype
                (castPtr recvptr) recvcount recvdatatype
                root comm

isendTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Request))
isendTyped 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 8 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  isendTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Request a7'')

{-# LINE 1406 "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 sendbuf sendrank sendtag comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  isendTyped (castPtr sendptr) sendcount senddatatype sendrank sendtag 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 a1 a2 a3 =
  let {a1' = fromRank a1} in
  let {a2' = fromTag a2} in
  withComm a3 $ \a3' ->
  C2HSImp.mallocForeignPtrBytes 24 >>= \a4'' -> C2HSImp.withForeignPtr a4'' $ \a4' ->
  probe'_ a1' a2' a3' a4' >>
  return (Status a4'')

{-# LINE 1432 "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_ a1 a2 a3 =
  let {a1' = fromRank a1} in
  let {a2' = fromTag a2} in
  withComm a3 $ \a3' ->
  withStatusIgnore $ \a4' ->
  probe_'_ a1' a2' a3' a4' >>= \res ->
  return res >>
  return ()

{-# LINE 1443 "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 24 >>= \a7'' -> C2HSImp.withForeignPtr a7'' $ \a7' ->
  recvTyped'_ a1' a2' a3' a4' a5' a6' a7' >>
  return (Status a7'')

{-# LINE 1453 "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 recvbuf recvrank recvtag comm =
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  recvTyped (castPtr recvptr) recvcount recvdatatype recvrank recvtag comm

recvTyped_ :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ()
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' ->
  withStatusIgnore $ \a7' ->
  recvTyped_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return res >>
  return ()

{-# LINE 1477 "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_ recvbuf recvrank recvtag comm =
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  recvTyped_ (castPtr recvptr) recvcount recvdatatype recvrank recvtag comm

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

{-# LINE 1502 "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 sendbuf recvbuf op rank comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  reduceTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op rank
              comm

requestGetStatusBool :: Request -> IO (Bool, Status)
requestGetStatusBool req =
  withRequest req $ \req' ->
  alloca $ \flag ->
  do st <- Status <$> mallocForeignPtrBytes 24
{-# LINE 1526 "lib/Control/Distributed/MPI.chs" #-}

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

               (castPtr 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 req = bool2maybe <$> requestGetStatusBool req

-- {#fun Request_get_status as requestGetStatus_
--     { withRequest* `Request'
--     , alloca- `Bool' peekBool*
--     , withStatusIgnore- `Status'
--     } -> `()' return*-#}

-- | 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    -- ^ Communication request
                  -> IO Bool    -- ^ Whether the request had completed
requestGetStatus_ req =
  withRequest req $ \req' ->
  alloca $ \flag ->
  withStatusIgnore $ \st ->
  do _ <- requestGetStatus__
{-# LINE 1559 "lib/Control/Distributed/MPI.chs" #-}

          (castPtr req') flag st
     peekBool flag

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 1570 "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 sendbuf recvbuf op comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  assert (sendcount == recvcount && senddatatype == recvdatatype) $
  scanTyped (castPtr sendptr) (castPtr recvptr) sendcount senddatatype op comm

scatterTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Comm) -> IO ()
scatterTyped 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
  withComm a8 $ \a8' ->
  scatterTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  return res >>
  return ()

{-# LINE 1599 "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 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 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' ->
  sendTyped'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return res >>
  return ()

{-# LINE 1625 "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 sendbuf sendrank sendtag comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  sendTyped (castPtr sendptr) sendcount senddatatype sendrank sendtag comm

sendrecvTyped :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ((Status))
sendrecvTyped a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
  let {a1' = id a1} in
  let {a2' = fromCount a2} in
  withDatatype a3 $ \a3' ->
  let {a4' = fromRank a4} in
  let {a5' = fromTag a5} in
  let {a6' = id a6} in
  let {a7' = fromCount a7} in
  withDatatype a8 $ \a8' ->
  let {a9' = fromRank a9} in
  let {a10' = fromTag a10} in
  withComm a11 $ \a11' ->
  C2HSImp.mallocForeignPtrBytes 24 >>= \a12'' -> C2HSImp.withForeignPtr a12'' $ \a12' ->
  sendrecvTyped'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>
  return (Status a12'')

{-# LINE 1654 "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 sendbuf sendrank sendtag
         recvbuf recvrank recvtag
         comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  sendrecvTyped (castPtr sendptr) sendcount senddatatype sendrank sendtag
                (castPtr recvptr) recvcount recvdatatype recvrank recvtag
                comm

sendrecvTyped_ :: (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Ptr ()) -> (Count) -> (Datatype) -> (Rank) -> (Tag) -> (Comm) -> IO ()
sendrecvTyped_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
  let {a1' = id a1} in
  let {a2' = fromCount a2} in
  withDatatype a3 $ \a3' ->
  let {a4' = fromRank a4} in
  let {a5' = fromTag a5} in
  let {a6' = id a6} in
  let {a7' = fromCount a7} in
  withDatatype a8 $ \a8' ->
  let {a9' = fromRank a9} in
  let {a10' = fromTag a10} in
  withComm a11 $ \a11' ->
  withStatusIgnore $ \a12' ->
  sendrecvTyped_'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
  return res >>
  return ()

{-# LINE 1691 "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_ sendbuf sendrank sendtag
          recvbuf recvrank recvtag
          comm =
  withPtrLenType sendbuf $ \sendptr sendcount senddatatype ->
  withPtrLenType recvbuf $ \recvptr recvcount recvdatatype ->
  sendrecvTyped_ (castPtr sendptr) sendcount senddatatype sendrank sendtag
                 (castPtr recvptr) recvcount recvdatatype recvrank recvtag
                 comm

testBool :: Request -> IO (Bool, Status)
testBool req =
  withRequest req $ \req' ->
  alloca $ \flag ->
  do st <- Status <$> mallocForeignPtrBytes 24
{-# LINE 1720 "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 req = bool2maybe <$> testBool req

-- {#fun Test as test_
--     { withRequest* `Request'
--     , alloca- `Bool' peekBool*
--     , withStatusIgnore- `Status'
--     } -> `()' return*-#}

-- | 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                -- ^ Communication request
      -> IO Bool                -- ^ Whether the request had completed
test_ req =
  withRequest req $ \req' ->
  alloca $ \flag ->
  withStatusIgnore $ \st ->
  do _ <- test__ req' flag st
     peekBool flag

-- | 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 a1 =
  withRequest a1 $ \a1' ->
  C2HSImp.mallocForeignPtrBytes 24 >>= \a2'' -> C2HSImp.withForeignPtr a2'' $ \a2' ->
  wait'_ a1' a2' >>
  return (Status a2'')

{-# LINE 1761 "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_ a1 =
  withRequest a1 $ \a1' ->
  withStatusIgnore $ \a2' ->
  wait_'_ a1' a2' >>= \res ->
  return res >>
  return ()

{-# LINE 1771 "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 1774 "lib/Control/Distributed/MPI.chs" #-}


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

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


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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_comm_world"
  commWorld'_ :: ((C2HSImp.Ptr (Comm)) -> (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 (Datatype)) -> (IO ()))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_get_sum"
  opSum'_ :: ((C2HSImp.Ptr (Op)) -> (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 (Request)) -> (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 (Comm)) -> (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 (Datatype)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> ((C2HSImp.Ptr (Comm)) -> (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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> (IO C2HSImp.CInt)))))))

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

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

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

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

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

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Comm_size"
  commSize'_ :: ((C2HSImp.Ptr (Comm)) -> ((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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> (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 (Datatype)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> (IO C2HSImp.CInt)))))))))

foreign import ccall unsafe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Get_count"
  getCount'_ :: ((C2HSImp.Ptr (Status)) -> ((C2HSImp.Ptr (Datatype)) -> ((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 (Datatype)) -> ((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 (Datatype)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (IO C2HSImp.CInt))))))))

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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Ibcast"
  ibcastTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Igather"
  igatherTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (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 mpihs_iprobe"
  iprobeBool_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h mpihs_iprobe"
  iprobe__ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((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 (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Request)) -> (IO C2HSImp.CInt))))))))

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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Probe"
  probe'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((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 (Comm)) -> ((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 (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((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 (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Request_get_status"
  requestGetStatusBool_ :: ((C2HSImp.Ptr ()) -> ((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.Ptr ()) -> ((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 (Datatype)) -> ((C2HSImp.Ptr (Op)) -> ((C2HSImp.Ptr (Comm)) -> (IO C2HSImp.CInt)))))))

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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h __c2hs_wrapped__MPI_Sendrecv"
  sendrecvTyped'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((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 (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Datatype)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Comm)) -> ((C2HSImp.Ptr (Status)) -> (IO C2HSImp.CInt)))))))))))))

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

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

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

foreign import ccall safe "Control/Distributed/MPI.chs.h MPI_Wait"
  wait_'_ :: ((C2HSImp.Ptr (Request)) -> ((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)