daily pastebin goal
5%
SHARE
TWEET

Untitled

a guest Jun 13th, 2018 47 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Main where
  2.  
  3. import Control.Distributed.STM.DSTM
  4. import System.Environment (getArgs)
  5.  
  6. main = startDist goTasks
  7.  
  8. goTasks = do
  9.   (arg:_) <- getArgs
  10.   let n = read arg
  11.   case n of
  12.       1 -> goHost
  13.       2 -> goClient
  14.  
  15. goHost = do
  16.   q <- atomic $ newTVar []
  17.   registerTVar gDefaultNameServer q "queue"
  18.   hostLoop q 0
  19.  
  20. hostLoop :: TVar [Integer] -> Integer -> IO ()
  21. hostLoop q base = do
  22.   (_, now) <- atomic $ modifyTVar q (++ enumFromTo base (base+9))
  23.   putStrLn $ "filling queue: " ++ show now
  24.   getLine
  25.   hostLoop q (base + 10)
  26.  
  27. goClient = do
  28.   putStrLn "client"
  29.   Just q <- lookupTVar gDefaultNameServer "queue"
  30.   clientLoop q
  31.  
  32. clientLoop q = do
  33.   (old, new) <- atomic $ takeJob q
  34.   putStrLn $ "changing " ++ show old ++ " to " ++ show new
  35.   clientLoop q
  36.  
  37. takeJob :: TVar [Integer] -> STM ([Integer], [Integer])
  38. takeJob q = do
  39.   theQueue <- readTVar q
  40.   if null theQueue
  41.     then retry
  42.     else modifyTVar q (tail)
  43.  
  44. modifyTVar :: Dist a => TVar a -> (a -> a) -> STM (a, a)
  45. modifyTVar var f = do
  46.   old <- readTVar var
  47.   let new = f old
  48.   writeTVar var new
  49.   return (old, new)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top