{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns,
             ExistentialQuantification, CPP, DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}

-- | This module exposes the internals of the @Par@ monad so that you
-- can build your own scheduler or other extensions.  Do not use this
-- module for purposes other than extending the @Par@ monad with new
-- functionality.

module Control.Monad.Par.Scheds.TraceInternal (
   Trace(..), Sched(..), Par(..),
   IVar(..), IVarContents(..),
   sched,
   runPar, runParIO, runParAsync,
   -- runParAsyncHelper,
   new, newFull, newFull_, get, put_, put,
   pollIVar, yield, fixPar, FixParException (..)
 ) where

#if MIN_VERSION_base(4,6,0)
import Prelude hiding (mapM, sequence, head,tail)
#else
import Prelude hiding (mapM, sequence, head,tail,catch)
#endif

import Control.Monad as M hiding (mapM, sequence, join)
import Data.IORef
import System.IO.Unsafe
#if MIN_VERSION_base(4,9,0)
import GHC.IO.Unsafe (unsafeDupableInterleaveIO)
#else
import System.IO.Unsafe (unsafeInterleaveIO)
#endif
import Control.Concurrent hiding (yield)
import GHC.Conc (numCapabilities)
import Control.DeepSeq
import Control.Monad.Fix (MonadFix (mfix))
import Control.Exception (Exception, throwIO, BlockedIndefinitelyOnMVar (..),
                          catch)
import Data.Typeable (Typeable)
-- import Text.Printf

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

#if __GLASGOW_HASKELL__ <= 700
import GHC.Conc (forkOnIO)
forkOn = forkOnIO
#endif


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

data Trace = forall a . Get (IVar a) (a -> Trace)
           | forall a . Put (IVar a) a Trace
           | forall a . New (IVarContents a) (IVar a -> Trace)
           | Fork Trace Trace
           | Done
           | Yield Trace
           | forall a . LiftIO (IO a) (a -> Trace)

-- | The main scheduler loop.
sched :: Bool -> Sched -> Trace -> IO ()
sched :: Bool -> Sched -> Trace -> IO ()
sched Bool
_doSync Sched
queue Trace
t = Trace -> IO ()
loop Trace
t
 where
  loop :: Trace -> IO ()
loop Trace
t = case Trace
t of
    New IVarContents a
a IVar a -> Trace
f -> do
      IORef (IVarContents a)
r <- forall a. a -> IO (IORef a)
newIORef IVarContents a
a
      Trace -> IO ()
loop (IVar a -> Trace
f (forall a. IORef (IVarContents a) -> IVar a
IVar IORef (IVarContents a)
r))
    Get (IVar IORef (IVarContents a)
v) a -> Trace
c -> do
      IVarContents a
e <- forall a. IORef a -> IO a
readIORef IORef (IVarContents a)
v
      case IVarContents a
e of
         Full a
a -> Trace -> IO ()
loop (a -> Trace
c a
a)
         IVarContents a
_other -> do
           IO ()
r <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (IVarContents a)
v forall a b. (a -> b) -> a -> b
$ \IVarContents a
e -> case IVarContents a
e of
                        IVarContents a
Empty    -> (forall a. [a -> Trace] -> IVarContents a
Blocked [a -> Trace
c], Sched -> IO ()
reschedule Sched
queue)
                        Full a
a   -> (forall a. a -> IVarContents a
Full a
a,      Trace -> IO ()
loop (a -> Trace
c a
a))
                        Blocked [a -> Trace]
cs -> (forall a. [a -> Trace] -> IVarContents a
Blocked (a -> Trace
cforall a. a -> [a] -> [a]
:[a -> Trace]
cs), Sched -> IO ()
reschedule Sched
queue)
           IO ()
r
    Put (IVar IORef (IVarContents a)
v) a
a Trace
t  -> do
      [a -> Trace]
cs <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (IVarContents a)
v forall a b. (a -> b) -> a -> b
$ \IVarContents a
e -> case IVarContents a
e of
               IVarContents a
Empty    -> (forall a. a -> IVarContents a
Full a
a, [])
               Full a
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"multiple put"
               Blocked [a -> Trace]
cs -> (forall a. a -> IVarContents a
Full a
a, [a -> Trace]
cs)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Sched -> Trace -> IO ()
pushWork Sched
queueforall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$a
a)) [a -> Trace]
cs
      Trace -> IO ()
loop Trace
t
    Fork Trace
child Trace
parent -> do
         Sched -> Trace -> IO ()
pushWork Sched
queue Trace
child
         Trace -> IO ()
loop Trace
parent
    Trace
Done ->
         if Bool
_doSync
         then Sched -> IO ()
reschedule Sched
queue
-- We could fork an extra thread here to keep numCapabilities workers
-- even when the main thread returns to the runPar caller...
         else do [Char] -> IO ()
putStrLn [Char]
" [par] Forking replacement thread..\n"
                 IO () -> IO ThreadId
forkIO (Sched -> IO ()
reschedule Sched
queue); forall (m :: * -> *) a. Monad m => a -> m a
return ()
-- But even if we don't we are not orphaning any work in this
-- threads work-queue because it can be stolen by other threads.
--       else return ()

    Yield Trace
parent -> do
        -- Go to the end of the worklist:
        let Sched { IORef [Trace]
workpool :: Sched -> IORef [Trace]
workpool :: IORef [Trace]
workpool } = Sched
queue
        -- TODO: Perhaps consider Data.Seq here.
        -- This would also be a chance to steal and work from opposite ends of the queue.
        forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [Trace]
workpool forall a b. (a -> b) -> a -> b
$ \[Trace]
ts -> ([Trace]
tsforall a. [a] -> [a] -> [a]
++[Trace
parent], ())
        Sched -> IO ()
reschedule Sched
queue
    LiftIO IO a
io a -> Trace
c -> do
        a
r <- IO a
io
        Trace -> IO ()
loop (a -> Trace
c a
r)

data FixParException = FixParException deriving (Int -> FixParException -> ShowS
[FixParException] -> ShowS
FixParException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FixParException] -> ShowS
$cshowList :: [FixParException] -> ShowS
show :: FixParException -> [Char]
$cshow :: FixParException -> [Char]
showsPrec :: Int -> FixParException -> ShowS
$cshowsPrec :: Int -> FixParException -> ShowS
Show, Typeable)
instance Exception FixParException

-- | Process the next item on the work queue or, failing that, go into
--   work-stealing mode.
reschedule :: Sched -> IO ()
reschedule :: Sched -> IO ()
reschedule queue :: Sched
queue@Sched{ IORef [Trace]
workpool :: IORef [Trace]
workpool :: Sched -> IORef [Trace]
workpool } = do
  Maybe Trace
e <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [Trace]
workpool forall a b. (a -> b) -> a -> b
$ \[Trace]
ts ->
         case [Trace]
ts of
           []      -> ([], forall a. Maybe a
Nothing)
           (Trace
t:[Trace]
ts') -> ([Trace]
ts', forall a. a -> Maybe a
Just Trace
t)
  case Maybe Trace
e of
    Maybe Trace
Nothing -> Sched -> IO ()
steal Sched
queue
    Just Trace
t  -> Bool -> Sched -> Trace -> IO ()
sched Bool
True Sched
queue Trace
t


-- RRN: Note -- NOT doing random work stealing breaks the traditional
-- Cilk time/space bounds if one is running strictly nested (series
-- parallel) programs.

-- | Attempt to steal work or, failing that, give up and go idle.
steal :: Sched -> IO ()
steal :: Sched -> IO ()
steal q :: Sched
q@Sched{ IORef [MVar Bool]
idle :: Sched -> IORef [MVar Bool]
idle :: IORef [MVar Bool]
idle, [Sched]
scheds :: Sched -> [Sched]
scheds :: [Sched]
scheds, no :: Sched -> Int
no=Int
my_no } = do
  -- printf "cpu %d stealing\n" my_no
  [Sched] -> IO ()
go [Sched]
scheds
  where
    go :: [Sched] -> IO ()
go [] = do MVar Bool
m <- forall a. IO (MVar a)
newEmptyMVar
               [MVar Bool]
r <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [MVar Bool]
idle forall a b. (a -> b) -> a -> b
$ \[MVar Bool]
is -> (MVar Bool
mforall a. a -> [a] -> [a]
:[MVar Bool]
is, [MVar Bool]
is)
               if forall (t :: * -> *) a. Foldable t => t a -> Int
length [MVar Bool]
r forall a. Eq a => a -> a -> Bool
== Int
numCapabilities forall a. Num a => a -> a -> a
- Int
1
                  then do
                     -- printf "cpu %d initiating shutdown\n" my_no
                     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\MVar Bool
m -> forall a. MVar a -> a -> IO ()
putMVar MVar Bool
m Bool
True) [MVar Bool]
r
                  else do
                    Bool
done <- forall a. MVar a -> IO a
takeMVar MVar Bool
m
                    if Bool
done
                       then do
                         -- printf "cpu %d shutting down\n" my_no
                         forall (m :: * -> *) a. Monad m => a -> m a
return ()
                       else do
                         -- printf "cpu %d woken up\n" my_no
                         [Sched] -> IO ()
go [Sched]
scheds
    go (Sched
x:[Sched]
xs)
      | Sched -> Int
no Sched
x forall a. Eq a => a -> a -> Bool
== Int
my_no = [Sched] -> IO ()
go [Sched]
xs
      | Bool
otherwise     = do
         Maybe Trace
r <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (Sched -> IORef [Trace]
workpool Sched
x) forall a b. (a -> b) -> a -> b
$ \ [Trace]
ts ->
                 case [Trace]
ts of
                    []     -> ([], forall a. Maybe a
Nothing)
                    (Trace
x:[Trace]
xs) -> ([Trace]
xs, forall a. a -> Maybe a
Just Trace
x)
         case Maybe Trace
r of
           Just Trace
t  -> do
              -- printf "cpu %d got work from cpu %d\n" my_no (no x)
              Bool -> Sched -> Trace -> IO ()
sched Bool
True Sched
q Trace
t
           Maybe Trace
Nothing -> [Sched] -> IO ()
go [Sched]
xs

-- | If any worker is idle, wake one up and give it work to do.
pushWork :: Sched -> Trace -> IO ()
pushWork :: Sched -> Trace -> IO ()
pushWork Sched { IORef [Trace]
workpool :: IORef [Trace]
workpool :: Sched -> IORef [Trace]
workpool, IORef [MVar Bool]
idle :: IORef [MVar Bool]
idle :: Sched -> IORef [MVar Bool]
idle } Trace
t = do
  forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [Trace]
workpool forall a b. (a -> b) -> a -> b
$ \[Trace]
ts -> (Trace
tforall a. a -> [a] -> [a]
:[Trace]
ts, ())
  [MVar Bool]
idles <- forall a. IORef a -> IO a
readIORef IORef [MVar Bool]
idle
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MVar Bool]
idles)) forall a b. (a -> b) -> a -> b
$ do
    IO ()
r <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [MVar Bool]
idle (\[MVar Bool]
is -> case [MVar Bool]
is of
                                          [] -> ([], forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                          (MVar Bool
i:[MVar Bool]
is) -> ([MVar Bool]
is, forall a. MVar a -> a -> IO ()
putMVar MVar Bool
i Bool
False))
    IO ()
r -- wake one up

data Sched = Sched
    { Sched -> Int
no       :: {-# UNPACK #-} !Int,
      Sched -> IORef [Trace]
workpool :: IORef [Trace],
      Sched -> IORef [MVar Bool]
idle     :: IORef [MVar Bool],
      Sched -> [Sched]
scheds   :: [Sched] -- Global list of all per-thread workers.
    }
--  deriving Show

newtype Par a = Par {
    forall a. Par a -> (a -> Trace) -> Trace
runCont :: (a -> Trace) -> Trace
}

instance Functor Par where
    fmap :: forall a b. (a -> b) -> Par a -> Par b
fmap a -> b
f Par a
m = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \b -> Trace
c -> forall a. Par a -> (a -> Trace) -> Trace
runCont Par a
m (b -> Trace
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Monad Par where
    return :: forall a. a -> Par a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Par a
m >>= :: forall a b. Par a -> (a -> Par b) -> Par b
>>= a -> Par b
k  = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \b -> Trace
c -> forall a. Par a -> (a -> Trace) -> Trace
runCont Par a
m forall a b. (a -> b) -> a -> b
$ \a
a -> forall a. Par a -> (a -> Trace) -> Trace
runCont (a -> Par b
k a
a) b -> Trace
c

instance Applicative Par where
   <*> :: forall a b. Par (a -> b) -> Par a -> Par b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
   pure :: forall a. a -> Par a
pure a
a = forall a. ((a -> Trace) -> Trace) -> Par a
Par (forall a b. (a -> b) -> a -> b
$ a
a)

instance MonadFix Par where
   mfix :: forall a. (a -> Par a) -> Par a
mfix = forall a. (a -> Par a) -> Par a
fixPar

-- | Take the monadic fixpoint of a 'Par' computation. This is
-- the definition of 'mfix' for 'Par'. Throws 'FixParException'
-- if the result is demanded strictly within the computation.
fixPar :: (a -> Par a) -> Par a
-- We do this IO-style, rather than ST-style, in order to get a
-- consistent exception type. Using the ST-style mfix, a strict
-- argument could lead us to *either* a <<loop>> exception *or*
-- (if the wrong sort of computation gets re-run) a "multiple-put"
-- error.
fixPar :: forall a. (a -> Par a) -> Par a
fixPar a -> Par a
f = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \ a -> Trace
c ->
  forall a. IO a -> (a -> Trace) -> Trace
LiftIO (do
    MVar a
mv <- forall a. IO (MVar a)
newEmptyMVar
    a
ans <- forall a. IO a -> IO a
unsafeDupableInterleaveIO (forall a. MVar a -> IO a
readMVar MVar a
mv
             forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \ ~BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar -> forall e a. Exception e => e -> IO a
throwIO FixParException
FixParException)
    case a -> Par a
f a
ans of
      Par (a -> Trace) -> Trace
q -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (a -> Trace) -> Trace
q forall a b. (a -> b) -> a -> b
$ \a
a -> forall a. IO a -> (a -> Trace) -> Trace
LiftIO (forall a. MVar a -> a -> IO ()
putMVar MVar a
mv a
a) (\ ~() -> a -> Trace
c a
a)) forall a. a -> a
id

#if !MIN_VERSION_base(4,9,0)
unsafeDupableInterleaveIO :: IO a -> IO a
unsafeDupableInterleaveIO = unsafeInterleaveIO
#endif

newtype IVar a = IVar (IORef (IVarContents a))
-- data IVar a = IVar (IORef (IVarContents a))

-- | Equality for IVars is physical equality, as with other reference types.
instance Eq (IVar a) where
  (IVar IORef (IVarContents a)
r1) == :: IVar a -> IVar a -> Bool
== (IVar IORef (IVarContents a)
r2) = IORef (IVarContents a)
r1 forall a. Eq a => a -> a -> Bool
== IORef (IVarContents a)
r2

instance NFData (IVar a) where
  rnf :: IVar a -> ()
rnf !IVar a
_ = ()


-- From outside the Par computation we can peek.  But this is nondeterministic.
pollIVar :: IVar a -> IO (Maybe a)
pollIVar :: forall a. IVar a -> IO (Maybe a)
pollIVar (IVar IORef (IVarContents a)
ref) =
  do IVarContents a
contents <- forall a. IORef a -> IO a
readIORef IORef (IVarContents a)
ref
     case IVarContents a
contents of
       Full a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
       IVarContents a
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing)


data IVarContents a = Full a | Empty | Blocked [a -> Trace]


{-# INLINE runPar_internal #-}
runPar_internal :: Bool -> Par a -> IO a
runPar_internal :: forall a. Bool -> Par a -> IO a
runPar_internal Bool
_doSync Par a
x = do
   [IORef [Trace]]
workpools <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numCapabilities forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []
   IORef [MVar Bool]
idle <- forall a. a -> IO (IORef a)
newIORef []
   let states :: [Sched]
states = [ Sched { no :: Int
no=Int
x, workpool :: IORef [Trace]
workpool=IORef [Trace]
wp, IORef [MVar Bool]
idle :: IORef [MVar Bool]
idle :: IORef [MVar Bool]
idle, scheds :: [Sched]
scheds=[Sched]
states }
                | (Int
x,IORef [Trace]
wp) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [IORef [Trace]]
workpools ]

#if __GLASGOW_HASKELL__ >= 701 /* 20110301 */
    --
    -- We create a thread on each CPU with forkOn.  The CPU on which
    -- the current thread is running will host the main thread; the
    -- other CPUs will host worker threads.
    --
    -- Note: GHC 7.1.20110301 is required for this to work, because that
    -- is when threadCapability was added.
    --
   (Int
main_cpu, Bool
_) <- ThreadId -> IO (Int, Bool)
threadCapability forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ThreadId
myThreadId
#else
    --
    -- Lacking threadCapability, we always pick CPU #0 to run the main
    -- thread.  If the current thread is not running on CPU #0, this
    -- will require some data to be shipped over the memory bus, and
    -- hence will be slightly slower than the version above.
    --
   let main_cpu = 0
#endif

   MVar (IVarContents a)
m <- forall a. IO (MVar a)
newEmptyMVar
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Sched]
states) forall a b. (a -> b) -> a -> b
$ \(Int
cpu,Sched
state) ->
        Int -> IO () -> IO ThreadId
forkOn Int
cpu forall a b. (a -> b) -> a -> b
$
          if (Int
cpu forall a. Eq a => a -> a -> Bool
/= Int
main_cpu)
             then Sched -> IO ()
reschedule Sched
state
             else do
                  IORef (IVarContents a)
rref <- forall a. a -> IO (IORef a)
newIORef forall a. IVarContents a
Empty
                  Bool -> Sched -> Trace -> IO ()
sched Bool
_doSync Sched
state forall a b. (a -> b) -> a -> b
$ forall a. Par a -> (a -> Trace) -> Trace
runCont (Par a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IVar a -> a -> Par ()
put_ (forall a. IORef (IVarContents a) -> IVar a
IVar IORef (IVarContents a)
rref)) (forall a b. a -> b -> a
const Trace
Done)
                  forall a. IORef a -> IO a
readIORef IORef (IVarContents a)
rref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MVar a -> a -> IO ()
putMVar MVar (IVarContents a)
m

   IVarContents a
r <- forall a. MVar a -> IO a
takeMVar MVar (IVarContents a)
m
   case IVarContents a
r of
     Full a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
     IVarContents a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"no result"


-- | Run a parallel, deterministic computation and return its result.
-- 
--   Note: you must NOT return an IVar in the output of the parallel
--   computation.  This is unfortunately not enforced, as it is with
--   `runST` or with newer libraries that export a Par monad, such as
--   `lvish`.
runPar :: Par a -> a
runPar :: forall a. Par a -> a
runPar = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> Par a -> IO a
runPar_internal Bool
True

-- | A version that avoids an internal `unsafePerformIO` for calling
--   contexts that are already in the `IO` monad.
--
--   Returning any value containing IVar is still disallowed, as it
--   can compromise type safety.
runParIO :: Par a -> IO a
runParIO :: forall a. Par a -> IO a
runParIO = forall a. Bool -> Par a -> IO a
runPar_internal Bool
True

-- | An asynchronous version in which the main thread of control in a
-- Par computation can return while forked computations still run in
-- the background.
runParAsync :: Par a -> a
runParAsync :: forall a. Par a -> a
runParAsync = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> Par a -> IO a
runPar_internal Bool
False

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

-- | Creates a new @IVar@
new :: Par (IVar a)
new :: forall a. Par (IVar a)
new  = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ forall a. IVarContents a -> (IVar a -> Trace) -> Trace
New forall a. IVarContents a
Empty

-- | Creates a new @IVar@ that contains a value
newFull :: NFData a => a -> Par (IVar a)
-- What are we doing here? We're manually raising the arity
-- of newFull from 2 to 3, which seems like it's probably what
-- we want most of the time. Notably, fmapping over the result
-- gives really awful-looking Core if we don't do this.
-- Regardless, I think we logically want to force the
-- value when it's installed in the IVar rather than
-- when we create the action to install it in the IVar.
newFull :: forall a. NFData a => a -> Par (IVar a)
newFull a
x = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \IVar a -> Trace
c -> a
x forall a b. NFData a => a -> b -> b
`deepseq` forall a. IVarContents a -> (IVar a -> Trace) -> Trace
New (forall a. a -> IVarContents a
Full a
x) IVar a -> Trace
c

-- | Creates a new @IVar@ that contains a value (head-strict only)
newFull_ :: a -> Par (IVar a)
newFull_ :: forall a. a -> Par (IVar a)
newFull_ !a
x = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ forall a. IVarContents a -> (IVar a -> Trace) -> Trace
New (forall a. a -> IVarContents a
Full a
x)

-- | Read the value in an @IVar@.  The 'get' operation can only return when the
-- value has been written by a prior or parallel @put@ to the same
-- @IVar@.
get :: IVar a -> Par a
get :: forall a. IVar a -> Par a
get IVar a
v = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \a -> Trace
c -> forall a. IVar a -> (a -> Trace) -> Trace
Get IVar a
v a -> Trace
c

-- | Like 'put', but only head-strict rather than fully-strict.
put_ :: IVar a -> a -> Par ()
put_ :: forall a. IVar a -> a -> Par ()
put_ IVar a
v !a
a = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \() -> Trace
c -> forall a. IVar a -> a -> Trace -> Trace
Put IVar a
v a
a (() -> Trace
c ())

-- | Put a value into an @IVar@.  Multiple 'put's to the same @IVar@
-- are not allowed, and result in a runtime error.
--
-- 'put' fully evaluates its argument, which therefore must be an
-- instance of 'NFData'.  The idea is that this forces the work to
-- happen when we expect it, rather than being passed to the consumer
-- of the @IVar@ and performed later, which often results in less
-- parallelism than expected.
--
-- Sometimes partial strictness is more appropriate: see 'put_'.
--
put :: NFData a => IVar a -> a -> Par ()
-- Manually raise the arity, which seems likely to be what
-- we want most of the time. We really want to force the
-- value when it's installed in the IVar, not when we
-- create the Par action to install it in the IVar.
put :: forall a. NFData a => IVar a -> a -> Par ()
put IVar a
v a
a = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \() -> Trace
c -> a
a forall a b. NFData a => a -> b -> b
`deepseq` forall a. IVar a -> a -> Trace -> Trace
Put IVar a
v a
a (() -> Trace
c ())

-- | Allows other parallel computations to progress.  (should not be
-- necessary in most cases).
yield :: Par ()
yield :: Par ()
yield = forall a. ((a -> Trace) -> Trace) -> Par a
Par forall a b. (a -> b) -> a -> b
$ \() -> Trace
c -> Trace -> Trace
Yield (() -> Trace
c ())