STMの実験

stm.hs

import System.Random
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Word
import Data.IORef
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM
import Control.Concurrent

data Session = Session { ip1 :: Word32, port1 :: Word16,
                         ip2 :: Word32, port2 :: Word16} deriving (Show, Ord, Eq)

enqueue :: TVar (Seq Session) -> Int -> StdGen -> IO ()
enqueue s delay gen = do
  let (r1, gen1) = random gen
      (r2, gen2) = random gen1
      (r3, gen3) = random gen2
      (r4, gen4) = random gen3 in
   do
     atomically $ do
       s0 <- readTVar s
       writeTVar s $ (Session {ip1=r1, ip2=r2, port1=r3, port2=r4}) Seq.<| s0
     threadDelay delay
     enqueue s delay gen4

dequeue :: TVar (Seq Session) -> TVar Session -> IO ()
dequeue s v = do
  atomically $ do
    s0 <- readTVar s
    case Seq.viewr s0 of
     EmptyR -> retry
     h :> t -> do writeTVar v t
                  writeTVar s h
  v0 <- readTVarIO v
  print v0
  dequeue s v

main = do
  gen0 <- newStdGen
  gen1 <- newStdGen
  s <- newTVarIO $ Seq.fromList ([]::[Session])
  v <- newTVarIO Session{ip1=0, ip2=0, port1=0, port2=0}
  th0 <- forkIO $ enqueue s 5000000 gen0
  th1 <- forkIO $ enqueue s 2500000 gen1
  dequeue s v