关于haskell：QSem似乎没有阻止线程

QSem doesn't seem to block threads

我正在编写一个简单的脚本来使用Shelly库并行运行大量任务，但我想限制一次运行的最大任务数。该脚本接受一个文件，每行都有一个输入，并为该输入运行一个任务。文件中有几百个输入，我希望一次限制到大约16个进程。

使用初始计数为1的qsem，当前脚本实际上限制为1(很好尝试这样做)。不过，我似乎遗漏了一些东西，因为当我运行带有4个输入的测试文件时，我看到了：

1
2
3
4
5
6
7
8

Starting
Starting
Starting
Starting
Done
Done
Done
Done

所以线程不会像我预期的那样阻塞qsem，它们都是同时运行的。我甚至在MVar和TVar上实现了我自己的信号量，但都没有达到我预期的效果。我显然错过了一些基本的东西，但是什么呢？我还尝试编译代码并将其作为二进制文件运行。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

#!/usr/bin/env runhaskell
{-# LANGUAGE TemplateHaskell, QuasiQuotes, DeriveDataTypeable, OverloadedStrings #-}

import Shelly
import Prelude hiding (FilePath)
import Text.Shakespeare.Text (lt)
import qualified Data.Text.Lazy as LT
import Control.Monad (forM)
import System.Environment (getArgs)

import qualified Control.Concurrent.QSem as QSem
import Control.Concurrent (forkIO, MVar, putMVar, newEmptyMVar, takeMVar)

-- Define max number of simultaneous processes
maxProcesses :: IO QSem.QSem
maxProcesses = QSem.newQSem 1

bkGrnd :: ShIO a -&gt ShIO (MVar a)
bkGrnd proc = do
mvar &lt- liftIO newEmptyMVar
_ &lt- liftIO $ forkIO $ do
-- Block until there are free processes
sem &lt- maxProcesses
QSem.waitQSem sem
putStrLn"Starting"
-- Run the shell command
result &lt- shelly $ silently proc
liftIO $ putMVar mvar result
putStrLn"Done"
-- Signal that this process is done and another can run.
QSem.signalQSem sem
return mvar

main :: IO ()
main = shelly $ silently $ do
[img, file] &lt- liftIO $ getArgs
contents &lt- readfile $ fromText $ LT.pack file
-- Run a backgrounded process for each line of input.
results &lt- forM (LT.lines contents) $ \line -> bkGrnd $ do
runStdin &ltcommand> &ltarguments>
liftIO $ mapM_ takeMVar results

号

相关讨论

正如我在评论中所说，每个对bkGrnd的调用都会创建自己的信号灯，允许每个线程继续运行而不必等待。我将尝试类似的方法，其中信号量是在main中创建的，并且每次传递给bkGrnd。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

bkGrnd :: QSem.QSem -> ShIO a -> ShIO (MVar a)
bkGrnd sem proc = do
mvar <- liftIO newEmptyMVar
_ <- liftIO $ forkIO $ do
-- Block until there are free processes
QSem.waitQSem sem
--
-- code continues as before
--

main :: IO ()
main = shelly $ silently $ do
[img, file] <- liftIO $ getArgs
contents <- readfile $ fromText $ LT.pack file
sem <- maxProcesses
-- Run a backgrounded process for each line of input.
results <- forM (LT.lines contents) $ \line -> bkGrnd sem $ do
runStdin <command>
liftIO $ mapM_ takeMVar results