Haskell STM: Основная нить не завершится до тех пор, пока дочерний поток не завершит выполнение

Question

В следующей программе я хочу, чтобы основной поток не выходил, пока все его дочерние потоки не завершили выполнение. Обратите внимание, что я использовал шаблоны ударов для оценки вызова Fibonacci, чтобы он возвращал оцениваемый thunk в основной поток.

{-# LANGUAGE BangPatterns #-} 

module Main 
where 

import Control.Concurrent.STM 
import Control.Concurrent 
import System.IO 

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

type TInt = TVar Int 

updateNum :: TInt -> Int -> STM() 
updateNum n v = do writeTVar n v 

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

main :: IO() 
main = do 
    n <- newTVarIO 10 

    forkIO $ do    
     let v = 30 
     let !x = nfib v 
     updateTransaction n x 

    forkIO $ do    
     let v = 15 
     let !x = nfib v 
     updateTransaction n x 

    forkIO $ do    
     let v = 25 
     let !x = nfib v 
     updateTransaction n x 

    nv <- readTVarIO n 
    putStrLn ("Fib number of " ++ " = " ++ (show nv)) 

    nv <- readTVarIO n 
    putStrLn ("Fib number of " ++ " = " ++ (show nv)) 

    nv <- readTVarIO n 
    putStrLn ("Fib number of " ++ " = " ++ (show nv)) 

---

Я устал, чтобы решить эту проблему в соответствии с [ссылка] (Haskell MVar : How to execute shortest job first?). Я не знаю, правильный ли подход, а также ошибка при попытке распечатать значение TMVar. Вот код: - (NFIB такое же, как и выше)

type TMInt = TMVar Int 

updateNum1 :: TMInt -> Int -> STM() 
updateNum1 n v = do putTMVar n v 

updateTransaction1 :: TMInt -> Int -> IO() 
updateTransaction1 n v = do 
     atomically $ do 
      updateNum1 n v 

main1 :: IO() 
main1 = do 
    n <- newTMVarIO 0 
    forkIO $ do    
     let v = 30 
     let !x = nfib v 
     updateTransaction1 n x 

    forkIO $ do    
     let v = 15 
     let !x = nfib v 
     updateTransaction1 n x 

    forkIO $ do    
     let v = 25 
     let !x = nfib v 
     updateTransaction1 n x 

    -- t <- takeTMVar n 
    -- putStrLn("result: " ++ (show t)) 

** Ошибка заключается в следующем: -

Couldn't match type `STM' with `IO' 
Expected type: IO Int 
    Actual type: STM Int 
In the return type of a call of `takeTMVar' 
In a stmt of a 'do' block: t <- takeTMVar n 

Пожалуйста, помогите. Благодарю.

Answer 1

main1 находится в IO, но takeTMVar возвращает STM Int. Вам необходимо выполнить транзакцию:

t <- atomically $ takeTMVar n 
putStrLn("result: " ++ (show t))