Haskell MVar : 如何先执行最短的作业？

Question

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

我已经厌倦了使用 MVar 编写代码。这里的工作是计算一个斐波那契数并写一个 MVar。第一个线程计算 Fibonacci 30，第二个线程计算 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

Answer 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 之外的斐波那契调用很重要（不想简单地 return 一个未评估的 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 empty/full 语义在每个子线程上阻塞主线程。

Haskell MVar : 如何先执行最短的作业？

Haskell MVar : How to execute shortest job first?

multithreading

haskell

concurrency