{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies, CPP #-}
module Control.Monad.Par.Scheds.Sparks
(
Par(..), Future(..),
runPar,
get, spawn, spawn_, spawnP, fixPar
)
where
import Control.Applicative
import Control.Monad
import Control.DeepSeq
import Control.Parallel
import qualified Control.Monad.Par.Class as PC
import Control.Monad.Fix (MonadFix (mfix))
#ifdef NEW_GENERIC
import qualified Control.Par.Class as PN
import qualified Control.Par.Class.Unsafe as PU
import System.IO.Unsafe (unsafePerformIO)
#endif
{-# INLINE runPar #-}
{-# INLINE spawn #-}
{-# INLINE spawn_ #-}
{-# INLINE spawnP #-}
{-# INLINE get #-}
data Par a = Done a
data Future a = Future a
runPar :: Par a -> a
runPar :: forall a. Par a -> a
runPar (Done a
x) = a
x
spawn_ :: Par a -> Par (Future a)
spawn_ :: forall a. Par a -> Par (Future a)
spawn_ Par a
a = let a' :: a
a' = forall a. Par a -> a
runPar Par a
a in a
a' forall a b. a -> b -> b
`par` forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Future a
Future a
a')
spawn :: NFData a => Par a -> Par (Future a)
spawn :: forall a. NFData a => Par a -> Par (Future a)
spawn Par a
a = let a' :: a
a' = forall a. Par a -> a
runPar Par a
a in a
a' forall a b. a -> b -> b
`par` forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Future a
Future (forall a. NFData a => a -> ()
rnf a
a' forall a b. a -> b -> b
`pseq` a
a'))
spawnP :: NFData a => a -> Par (Future a)
spawnP :: forall a. NFData a => a -> Par (Future a)
spawnP a
a = a
a forall a b. a -> b -> b
`par` forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Future a
Future (forall a. NFData a => a -> ()
rnf a
a forall a b. a -> b -> b
`pseq` a
a))
get :: Future a -> Par a
get :: forall a. Future a -> Par a
get (Future a
a) = a
a forall a b. a -> b -> b
`pseq` forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance Monad Par where
return :: forall a. a -> Par a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Done a
x >>= :: forall a b. Par a -> (a -> Par b) -> Par b
>>= a -> Par b
k = a -> Par b
k a
x
instance PC.ParFuture Future Par where
get :: forall a. Future a -> Par a
get = forall a. Future a -> Par a
get
spawn :: forall a. NFData a => Par a -> Par (Future a)
spawn = forall a. NFData a => Par a -> Par (Future a)
spawn
spawn_ :: forall a. Par a -> Par (Future a)
spawn_ = forall a. Par a -> Par (Future a)
spawn_
spawnP :: forall a. NFData a => a -> Par (Future a)
spawnP = forall a. NFData a => a -> Par (Future a)
spawnP
instance Functor Par where
fmap :: forall a b. (a -> b) -> Par a -> Par b
fmap a -> b
f Par a
xs = Par a
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
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 = forall a. a -> Par a
Done
instance MonadFix Par where
mfix :: forall a. (a -> Par a) -> Par a
mfix = forall a. (a -> Par a) -> Par a
fixPar
fixPar :: (a -> Par a) -> Par a
fixPar :: forall a. (a -> Par a) -> Par a
fixPar a -> Par a
f =
let fr :: Par a
fr = a -> Par a
f (case Par a
fr of Done a
x -> a
x)
in Par a
fr
#ifdef NEW_GENERIC
doio :: IO a -> Par a
doio io = let x = unsafePerformIO io in
return $! x
instance PU.ParMonad Par where
fork m = m
internalLiftIO = doio
instance PU.ParThreadSafe Par where
unsafeParIO = doio
instance PN.ParFuture Par where
type Future Par = Future
type FutContents Par a = ()
get = get
spawn = spawn
spawn_ = spawn_
spawnP = spawnP
#endif