{-# LANGUAGE BangPatterns #-}

import Text.Printf
import System.Environment
import Control.Monad
import Control.Concurrent
import Control.Concurrent.QSem

nTasksDefault = 10
beginOffsetDefault = 15

parseArgs :: [String] -> (Int, Int)
parseArgs [n, beg] = (read n, read beg)
parseArgs       _  = (nTasksDefault, beginOffsetDefault)

fib x | x < 3 = 1
      | otherwise = (fib $ x - 1) + (fib $ x - 2)

routine :: QSem -> (MVar Int, Int) -> IO ()
routine outputMutex (resultMVar, x) = do
    safeIOWithSem outputMutex $ printf "Thread id = %d start\n" x
    let !result = fib x
    putMVar resultMVar result
    safeIOWithSem outputMutex $ printf "Thread id = %d end\n" x

safeIOWithSem :: QSem -> IO () -> IO ()
safeIOWithSem m f = waitQSem m >> f >> signalQSem m

main :: IO ()
main = do
    args <- getArgs
    let (nTasks, beginOffset) = parseArgs args
    outputMutex <- newQSem 1
    resultMVars <- replicateM nTasks newEmptyMVar
    let tasks = zip resultMVars [beginOffset .. beginOffset + nTasks]

    safeIOWithSem outputMutex $ getNumCapabilities >>= printf "Processors = %d\n"
    safeIOWithSem outputMutex $ putStrLn "Start"

    mapM_ (forkIO . routine outputMutex) tasks

    forM_ tasks $ \(m, x) -> do
        r <- takeMVar m
        safeIOWithSem outputMutex $ printf "Fib(%d) = %d\n" x r

    safeIOWithSem outputMutex $ putStrLn "End"