Simpler thread waiting system.

diff --git a/RCMA/Auxiliary/Concurrent.hs b/RCMA/Auxiliary/Concurrent.hs
new file mode 100644 (file)
index 0000000..2531fd0
--- /dev/null
+++ b/RCMA/Auxiliary/Concurrent.hs
@@ -0,0 +1,10 @@
+module RCMA.Auxiliary.Concurrent where
+
+import Control.Concurrent
+import Control.Concurrent.MVar
+
+forkChild :: IO () -> IO (MVar ())
+forkChild io = do
+  mvar <- newEmptyMVar
+  forkFinally io (\_ -> putMVar mvar ())
+  return mvar

diff --git a/RCMA/Main.hs b/RCMA/Main.hs
index 4eaa5f121cb796f754532dc467e2bfc6bfea4811..a20516ce7c3d0ce12e7dc9ea7cfa20de81c8a0ee 100644 (file)
--- a/RCMA/Main.hs
+++ b/RCMA/Main.hs
@@ -6,6 +6,7 @@ import Control.Concurrent
 import Data.ReactiveValue
 import FRP.Yampa
 import Hails.Yampa
+import RCMA.Auxiliary.Concurrent
 import RCMA.Layer.Board
 import RCMA.Layer.Layer
 import RCMA.Semantics
@@ -48,27 +49,9 @@ bpb = 4
 tempoRV :: ReactiveFieldReadWrite IO Tempo
 tempoRV = ReactiveFieldReadWrite (\_ -> return ()) (return 96) (\_ -> return ())
 
-waitForChildren :: MVar [MVar ()] -> IO ()
-waitForChildren children = do
-  cs <- takeMVar children
-  case cs of
-    []   -> return ()
-    m:ms -> do
-      putMVar children ms
-      takeMVar m
-      waitForChildren children
-
 main :: IO ()
 main = do
-  (children :: MVar [MVar ()]) <- newMVar []
-  let forkChild :: IO () -> IO ThreadId
-      forkChild io = do
-        mvar <- newEmptyMVar
-        childs <- takeMVar children
-        putMVar children (mvar:childs)
-        forkFinally io (\_ -> putMVar mvar ())
-
   layerRV <- getDefaultLayerRV
   boardInRV <- boardSetup board tempoRV layerRV
   jackT <- forkChild $ jackSetup (liftR2 (\t n -> (t, 0, n)) tempoRV boardInRV)
-  waitForChildren children
+  return ()