Haskell STM : How to store ThreadID as per their execution sequence

Question

In the following program Fibonacci number is generated from a given integer (generated randomly) and that value is stored into a TVar. As the execution time for generating the Fibonacci is different for different number, thus threads will not run sequentially. I want to store theadID, may be in a list, to check their execution pattern. Please help me. Thanks in advance.

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)
                    )

I want to store [TreadID,FibNo] into a List for all the threads as per their execution. Suppose T1 has executed Fib30, T2 Fib35, T3->32 and T4->40. And if the commit sequence of threads like T1,T3, T2 and T4 then I want to store T1-35,T3-32,t2-35,t4-40 in a list.

Edit: As suggested by @MathematicalOrchid, I have modified updateTrasaction as follows:-

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)]

Now I am trying to print the values from that list in main

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

At the time of execution. MVar values couldn't be read and generates error

Exception: thread blocked indefinitely in an MVar operation

What to do? Thank in advance.

Answer 1

Did you want something like

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

Or perhaps something like

updateTransaction :: TInt -> Int -> IO ThreadId
updateTransaction n v = do
  atomically $ updateNum n v
  myThreadId

and change forM_ to forM?

---

Also, this part:

do
  x1 <- readTVar n
  ...
  x2 <- readTVar n
  if x1 == x2 ...

If x1 /= x2 then GHC will automatically abort and restart your transaction. You do not need to manually check this yourself. Indeed, the else-branch can never execute. That's kind of the point of STM; it will appear to your transaction that nobody else changes the data you're looking at, so you don't ever have to worry about concurrent writes.

---

Edit: If you want to record the actual order in which the transactions committed, you're going to need some more inter-thread communication. Obviously you could do that with STM, but just for a list of stuff, maybe this could work?

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)]

(Obviously you have to make updateNum return the number it calculated.)