From 4eb6b55e980fda9c4d260820f5a6d38dde3d0991 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Mon, 8 Sep 2014 15:43:20 +0000
Subject: (1) Refactor concurrency, (2) write to .gfo.tmp then rename to .gfo

(1) introduces the module GF.Infra.Concurreny with lifted concurrency
    operators (to reduce uses of liftIO) and some additional concurrency
    utilities, e.g. a function for sequential logging that is used in
    both GF.CompileInParallel and GFServer.
(2) avoids leaving broken .gfo files behind if compilation is aborted.
---
 src/compiler/GF/Infra/Concurrency.hs | 48 ++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 src/compiler/GF/Infra/Concurrency.hs

(limited to 'src/compiler/GF/Infra')

diff --git a/src/compiler/GF/Infra/Concurrency.hs b/src/compiler/GF/Infra/Concurrency.hs
new file mode 100644
index 000000000..5fc15ead7
--- /dev/null
+++ b/src/compiler/GF/Infra/Concurrency.hs
@@ -0,0 +1,48 @@
+-- | Lifted concurrency operators and a some useful concurrency abstractions
+module GF.Infra.Concurrency(
+    module GF.Infra.Concurrency,
+    C.forkIO,
+    C.MVar,C.modifyMVar,C.modifyMVar_,
+    C.Chan
+ ) where
+import qualified Control.Concurrent as C
+import System.IO.Unsafe(unsafeInterleaveIO)
+import Control.Monad((<=<))
+import Control.Monad.Trans(MonadIO(..))
+
+-- * Futures
+
+newtype Future a = Future {now::IO a}
+
+spawn io = do v <- newEmptyMVar
+              C.forkIO $ putMVar v =<< io
+              return (Future (readMVar v))
+
+parMapM f = mapM now <=< mapM (spawn . f)
+
+-- * Single-threaded logging
+
+newLog put =
+  do logchan <- newChan
+     liftIO $ C.forkIO (mapM_ put =<< getChanContents logchan)
+     return (writeChan logchan)
+
+-- * Lifted concurrency operators
+
+newMVar x = liftIO $ C.newMVar x
+readMVar v = liftIO $ C.readMVar v
+putMVar v = liftIO . C.putMVar v
+
+newEmptyMVar :: MonadIO io => io (C.MVar a)
+newEmptyMVar = liftIO C.newEmptyMVar
+
+newChan :: MonadIO io => io (C.Chan a)
+newChan = liftIO C.newChan
+
+getChanContents ch = liftIO $ C.getChanContents ch
+writeChan ch = liftIO . C.writeChan ch
+
+
+-- * Delayed IO
+
+lazyIO = unsafeInterleaveIO
-- 
cgit v1.2.3