CODEWITHSUNDEEP
multithreadinghaskellstm
Ammlan Ghosh
Ammlan Ghosh

Reputation: 375

Haskell STM : Main thread will not exit until child thread completes execution

In the following program, I want that main thread will not exit until all its child threads complete execution. Please note that I have used bang patterns to evaluate the Fibonacci call so that it returns an evaluated thunk to main thread.

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

I have tired to solve this problem as per [link] (Haskell MVar : How to execute shortest job first?). I don't know whether approach is correct not not and also getting an error when try to print the value of TMVar. Here is the code :- (nfib is same as above) 

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

** Error is as follows:- 

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

Please help. Thanks.

Upvotes: 0

Views: 235

Answers (1)

Lee
Lee

Reputation: 144106

main1 is in IO but takeTMVar returns an STM Int. You need to run the transaction:

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

Upvotes: 2

Related Questions