Haskell MVar：如何首先执行最短的作业？答案

【问题标题】：Haskell MVar : How to execute shortest job first?Haskell MVar：如何首先执行最短的作业？
【发布时间】：2015-01-02 11:28:14
【问题描述】：

当多个线程在等待写入 MVar 时，它们会以先进先出的方式执行。我想按照最短的作业调度执行线程。

我已经厌倦了使用 MVar 进行编码。这里的工作是计算一个斐波那契数并写一个 MVar。第一个线程计算斐波那契 30，第二个线程计算斐波那契 10。由于计算斐波那契 10 所用的时间小于 30，因此应该首先执行第二个线程。我没有从下面的代码块中得到想要的结果。

如何在 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

【问题讨论】：

您的main 是连续的。您不需要在某处为作业分叉线程吗？
@DonStewart，我无法理解。请详细说明。谢谢。
@DonStewart，我已经更新了代码 [forkIO()]，但得到了相同的结果。

标签： multithreading haskell concurrency

【解决方案1】：

要实现调度，您需要同时使用 MVar 和线程。从一个空的 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

请注意，使用 bang 模式来评估 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 空/满语义来阻塞每个子线程上的主线程。

【讨论】：