Haskell STM:如何根据执行顺序存储ThreadID

Amm*_*osh 2 haskell stm

在以下程序中,Fibonacci数是从给定的整数(随机生成)生成的,并且该值存储在TVar中.由于生成Fibonacci的执行时间因不同的数量而不同,因此线程不会按顺序运行.我想存储theadID,可能在列表中,检查它们的执行模式. 请帮我.提前致谢.

module Main
where
import Control.Parallel
import Control.Concurrent.STM
import Control.Concurrent
import System.Random 
import Control.Monad
import Data.IORef
import System.IO

nfib :: Int -> Int
nfib n | n <= 2 = 1
   | otherwise = par n1 (pseq n2 (n1 + n2 ))
                 where n1 = nfib (n-1)
                       n2 = nfib (n-2)


type TInt = TVar Int


updateNum :: TInt -> Int -> STM()
updateNum n v = do x1 <- readTVar n
                   let y = nfib v
                   x2 <- readTVar n
                   if x1 == x2
                   then writeTVar n y   
                   else retry

updateTransaction :: TInt -> Int -> IO ()
updateTransaction n v = do atomically $ updateNum n v

incR :: IORef Int -> Int -> IO ()
incR r x = do { v <- readIORef r;                    
      writeIORef r (v - x) }

main :: IO ()
main = do 
    n <- newTVarIO 10
    r <- newIORef 40;
    forM_ [1..10] (\i -> do 
                     incR r i
                     ;v <- readIORef r
                     ;forkIO (updateTransaction n v)
                    )
Run Code Online (Sandbox Code Playgroud)

我想根据执行情况将[TreadID,FibNo]存储到所有线程的List中.假设T1执行了Fib30,T2 Fib35,T3-> 32和T4-> 40.如果线程的提交顺序如T1,T3,T2和T4,那么我想在列表中存储T1-35,T3-32,t2-35,t4-40.

编辑: 正如@MathematicalOrchid所建议的那样,我修改了updateTrasaction如下: -

updateTransaction :: MVar [(ThreadId, Int)] -> TInt -> Int -> IO ()
updateTransaction mvar n v = do
  tid <- myThreadId
  atomically $ updateNum n v
  list <- takeMVar mvar
  putMVar mvar $ list ++ [(tid, v)]
Run Code Online (Sandbox Code Playgroud)

现在我试图在main中打印该列表中的值

main :: IO ()
main = do 
  ...
  ...
  m <- newEmptyMVar
  ...
  ...
  mv <- readMVar m
  putStrLn ("ThreadId, FibVal : "  ++ " = " ++ (show mv)) 
Run Code Online (Sandbox Code Playgroud)

在执行时.无法读取MVar值并生成错误

Exception: thread blocked indefinitely in an MVar operation
Run Code Online (Sandbox Code Playgroud)

该怎么办?预先感谢.

Mat*_*hid 5

你想要的东西吗?

updateTransaction :: TInt -> Int -> IO ()
updateTransaction n v = do
  tid <- myThreadId
  putStrLn $ "Start " ++ show tid
  atomically $ updateNum n v
  putStrLn $ "End " ++ show tid
Run Code Online (Sandbox Code Playgroud)

或者类似的东西

updateTransaction :: TInt -> Int -> IO ThreadId
updateTransaction n v = do
  atomically $ updateNum n v
  myThreadId
Run Code Online (Sandbox Code Playgroud)

forM_改为forM


另外,这部分:

do
  x1 <- readTVar n
  ...
  x2 <- readTVar n
  if x1 == x2 ...
Run Code Online (Sandbox Code Playgroud)

如果x1 /= x2那么GHC将自动中止并重启您的交易.您无需亲自手动检查.实际上,else分支永远不会执行.这是一种在的 STM的; 在您的事务中,没有其他人会更改您正在查看的数据,因此您不必担心并发写入.


编辑:如果要记录事务提交的实际顺序,则需要更多的线程间通信.显然你可以用STM做到这一点,但只是为了列出一些东西,也许这可行吗?

updateTransaction :: MVar [(ThreadId, Int)] -> TInt -> Int -> IO ()
updateTransaction mvar n v = do
  tid <- myThreadId
  fib <- atomically $ updateNum n v
  list <- takeMVar mvar
  putMVar mvar $ list ++ [(tid, fib)]
Run Code Online (Sandbox Code Playgroud)

(显然你必须updateNum返回它计算的数字.)