{-# LANGUAGE ScopedTypeVariables, FlexibleInstances,
MultiParamTypeClasses, UndecidableInstances, CPP #-}
module Control.Monad.Par.State
(
SplittableState(..)
)
where
import Control.Monad
import qualified Control.Monad.Par.Class as PC
import Control.Monad.Trans
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Trans.State.Lazy as SL
class SplittableState a where
splitState :: a -> (a,a)
instance (SplittableState s, PC.ParFuture fut p)
=> PC.ParFuture fut (S.StateT s p)
where
get :: forall a. fut a -> StateT s p a
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
future a -> m a
PC.get
spawn_ :: forall a. StateT s p a -> StateT s p (fut a)
spawn_ (StateT s p a
task :: S.StateT s p ans) =
do s
s <- forall (m :: * -> *) s. Monad m => StateT s m s
S.get
let (s
s1,s
s2) = forall a. SplittableState a => a -> (a, a)
splitState s
s
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put s
s2
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
m a -> m (future a)
PC.spawn_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT StateT s p a
task s
s1
instance (SplittableState s, PC.ParIVar iv p)
=> PC.ParIVar iv (S.StateT s p)
where
fork :: StateT s p () -> StateT s p ()
fork (StateT s p ()
task :: S.StateT s p ()) =
do s
s <- forall (m :: * -> *) s. Monad m => StateT s m s
S.get
let (s
s1,s
s2) = forall a. SplittableState a => a -> (a, a)
splitState s
s
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put s
s2
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (ivar :: * -> *) (m :: * -> *).
ParIVar ivar m =>
m () -> m ()
PC.fork forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT s p ()
task s
s1; forall (m :: * -> *) a. Monad m => a -> m a
return ()
new :: forall a. StateT s p (iv a)
new = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
m (ivar a)
PC.new
put_ :: forall a. iv a -> a -> StateT s p ()
put_ iv a
v a
x = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
ivar a -> a -> m ()
PC.put_ iv a
v a
x
newFull_ :: forall a. a -> StateT s p (iv a)
newFull_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
a -> m (ivar a)
PC.newFull_
#if 0
instance (SplittableState s, PC.ParChan snd rcv p)
=> PC.ParChan snd rcv (S.StateT s p)
where
newChan = lift PC.newChan
recv r = lift $ PC.recv r
send s x = lift $ PC.send s x
#endif
instance (SplittableState s, PC.ParFuture fut p)
=> PC.ParFuture fut (SL.StateT s p)
where
get :: forall a. fut a -> StateT s p a
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
future a -> m a
PC.get
spawn_ :: forall a. StateT s p a -> StateT s p (fut a)
spawn_ (StateT s p a
task :: SL.StateT s p ans) =
do s
s <- forall (m :: * -> *) s. Monad m => StateT s m s
SL.get
let (s
s1,s
s2) = forall a. SplittableState a => a -> (a, a)
splitState s
s
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
SL.put s
s2
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
m a -> m (future a)
PC.spawn_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
SL.evalStateT StateT s p a
task s
s1
instance (SplittableState s, PC.ParIVar iv p)
=> PC.ParIVar iv (SL.StateT s p)
where
fork :: StateT s p () -> StateT s p ()
fork (StateT s p ()
task :: SL.StateT s p ()) =
do s
s <- forall (m :: * -> *) s. Monad m => StateT s m s
SL.get
let (s
s1,s
s2) = forall a. SplittableState a => a -> (a, a)
splitState s
s
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
SL.put s
s2
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (ivar :: * -> *) (m :: * -> *).
ParIVar ivar m =>
m () -> m ()
PC.fork forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
SL.runStateT StateT s p ()
task s
s1; forall (m :: * -> *) a. Monad m => a -> m a
return ()
new :: forall a. StateT s p (iv a)
new = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
m (ivar a)
PC.new
put_ :: forall a. iv a -> a -> StateT s p ()
put_ iv a
v a
x = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
ivar a -> a -> m ()
PC.put_ iv a
v a
x
newFull_ :: forall a. a -> StateT s p (iv a)
newFull_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ivar :: * -> *) (m :: * -> *) a.
ParIVar ivar m =>
a -> m (ivar a)
PC.newFull_
#if 0
instance (SplittableState s, PC.ParChan snd rcv p)
=> PC.ParChan snd rcv (SL.StateT s p)
where
newChan = lift PC.newChan
recv r = lift $ PC.recv r
send s x = lift $ PC.send s x
#endif