Haskell MVar:如何首先执行最短的工作?

时间:2015-01-02 11:28:14

标签: multithreading haskell concurrency

当多个线程正在等待编写MVar时,它们将以先进先出方案执行。我想按照最短的作业调度执行线程。

我已经厌倦了使用MVar对此进行编码。这里的工作是计算斐波纳契数并写一个MVar。第1个线程计算Fibonacci 30,第2个线程计算Fibonacci 10.由于计算Fibonacci 10的时间小于30,因此第2个线程应首先执行。我没有从下面的代码块中获得所需的结果。

如何在Haskell中实现最短作业优先调度(或者可能正在使用Haskell STM)?

代码

module Main
where
import Control.Parallel
import Control.Concurrent

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 MInt = MVar Int

updateMVar :: MInt -> Int -> IO ()
updateMVar n v = do x1 <- readMVar n
        let y = nfib v
        x2 <- readMVar n            
        if x1 == x2 
        then do t <- takeMVar n 
            putMVar n y
        else return()

main :: IO ()
main = do
 n <- newEmptyMVar
 putMVar n 0

 forkIO(updateMVar n 30)
 t <- readMVar n
 putStrLn("n is : " ++  (show t))   

 forkIO(updateMVar n 10)
 t <- readMVar n
 putStrLn("n is : " ++  (show t))

输出

n is : 832040
n is : 55

1 个答案:

答案 0 :(得分:2)

要实现调度,您需要一起使用MVars和线程。从一个空的MVar开始。分叉您希望在后台运行的作业。然后主线程可以依次阻止每个结果。最快的将是第一个。像这样:

{-# LANGUAGE BangPatterns #-}

import Control.Parallel
import Control.Concurrent

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)

main :: IO ()
main = do
    result <- newEmptyMVar

    forkIO $ do
        let !x = nfib 40
        putMVar result x
    forkIO $ do
        let !x = nfib 30
        putMVar result x

    t      <- takeMVar result
    print $ "Fastest result was: " ++ show t
    t      <- takeMVar result
    print $ "Slowest result was: " ++ show t

请注意,使用爆炸模式来评估MVar外部的斐波纳契调用很重要(不要简单地将未评估的thunk返回到主线程)。

使用线程运行时编译:

$ ghc -o A --make A.hs -threaded  -fforce-recomp -rtsopts
[1 of 1] Compiling Main             ( A.hs, A.o )
Linking A.exe ...

在两个核心上运行:

$ ./A.exe  +RTS -N2
"Fastest result was: 832040"
"Slowest result was: 102334155"

生产力也相当不错(使用+ RTS -s来查看运行时性能统计信息)。

Productivity  89.3% of total user, 178.1% of total elapsed

要完成的第一个线程将首先打印其结果。然后主线程将阻塞,直到第二个线程完成。

主要的是利用MVar空/完整语义来阻止每个子线程上的主线程。