git.iko.soy/distributed-process
on master help sign in
Part 2 to making forkProcess exception-safe.
85068c2Mathieu Boespflug
src/Control/Distributed/Process/Internal/StrictMVar.hs+8
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ module Control.Distributed.Process.Internal.StrictMVar
10 , withMVar
10 , withMVar
11 , modifyMVar_
11 , modifyMVar_
12 , modifyMVar
12 , modifyMVar
13+ , modifyMVarMasked
13 , mkWeakMVar
14 , mkWeakMVar
14 ) where
15 ) where
15
16
@@ -26,6 +27,7 @@ import qualified Control.Concurrent.MVar as MVar
26 , withMVar
27 , withMVar
27 , modifyMVar_
28 , modifyMVar_
28 , modifyMVar
29 , modifyMVar
30+ , modifyMVarMasked
29 )
31 )
30import GHC.MVar (MVar(MVar))
32import GHC.MVar (MVar(MVar))
31import GHC.IO (IO(IO))
33import GHC.IO (IO(IO))
@@ -61,6 +63,12 @@ modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)
61 evaluateFst :: (a, b) -> IO (a, b)
63 evaluateFst :: (a, b) -> IO (a, b)
62 evaluateFst (x, y) = evaluate x >> return (x, y)
64 evaluateFst (x, y) = evaluate x >> return (x, y)
63
65
66+modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b
67+modifyMVarMasked (StrictMVar v) f = MVar.modifyMVarMasked v (f >=> evaluateFst)
68+ where
69+ evaluateFst :: (a, b) -> IO (a, b)
70+ evaluateFst (x, y) = evaluate x >> return (x, y)
71+
64mkWeakMVar :: StrictMVar a -> IO () -> IO (Weak (StrictMVar a))
72mkWeakMVar :: StrictMVar a -> IO () -> IO (Weak (StrictMVar a))
65mkWeakMVar m@(StrictMVar (MVar m#)) f = IO $ \s ->
73mkWeakMVar m@(StrictMVar (MVar m#)) f = IO $ \s ->
66 case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
74 case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
src/Control/Distributed/Process/Node.hs+3−2
@@ -71,7 +71,7 @@ import Control.Concurrent (forkIO, forkIOWithUnmask, myThreadId)
71import Control.Distributed.Process.Internal.StrictMVar
71import Control.Distributed.Process.Internal.StrictMVar
72 ( newMVar
72 ( newMVar
73 , withMVar
73 , withMVar
74− , modifyMVar
74+ , modifyMVarMasked
75 , modifyMVar_
75 , modifyMVar_
76 , newEmptyMVar
76 , newEmptyMVar
77 , putMVar
77 , putMVar
@@ -332,7 +332,8 @@ runProcess node proc = do
332
332
333-- | Spawn a new process on a local node
333-- | Spawn a new process on a local node
334forkProcess :: LocalNode -> Process () -> IO ProcessId
334forkProcess :: LocalNode -> Process () -> IO ProcessId
335+forkProcess node proc =
335−forkProcess node proc = modifyMVar (localState node) startProcess
336+ modifyMVarMasked (localState node) startProcess
336 where
337 where
337 startProcess :: LocalNodeState -> IO (LocalNodeState, ProcessId)
338 startProcess :: LocalNodeState -> IO (LocalNodeState, ProcessId)
338 startProcess st = do
339 startProcess st = do