Write a little guyHEADmain

This program is in a weird state right now, but I'm checking it in to
git so that I can back it up, since I want to reinstall again.

1 files changed, 27 insertions, 0 deletions

diff --git a/Par.hs b/Par.hs
new file mode 100644
index 0000000..1465956
--- /dev/null
+++ b/Par.hs
@@ -0,0 +1,27 @@
+module Par (map, mapIO, mapIO_) where
+
+import Control.Parallel (par, pseq)
+import Control.Concurrent (forkIO)
+import qualified Control.Concurrent.MVar as MVar
+import Prelude hiding (map)
+
+map :: (a -> b) -> [a] -> [b]
+map _ [] = []
+map f (x:xs) =
+  let this = f x
+      that = Par.map f xs
+  in that `par` this `pseq` this : that
+
+mapIO :: (a -> IO b) -> [a] -> IO [b]
+mapIO _ [] = return []
+mapIO f (x:xs) = do restMVar <- MVar.newEmptyMVar
+                    _ <- forkIO (do rest <- mapIO f xs
+                                    MVar.putMVar restMVar rest)
+                    this <- f x
+                    rest <- MVar.takeMVar restMVar
+                    return (this : rest)
+
+mapIO_ :: (a -> IO ()) -> [a] -> IO ()
+mapIO_ _ [] = return ()
+mapIO_ f (x:xs) = do _ <- forkIO (mapIO_ f xs)
+                     f x