当多个线程正在等待编写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
答案 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空/完整语义来阻止每个子线程上的主线程。