haskell - QSem 似乎不会阻塞线程

Question

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

当前脚本实际上限制为 1(尝试使用初始计数为 1 的 QSem)。但我似乎遗漏了一些东西，因为当我在具有 4 个输入的测试文件上运行时，我看到了这一点:

开始
开始
开始
开始
完毕
完毕
完毕
完毕

所以线程并没有像我期望的那样在 QSem 上阻塞，它们都在同时运行。我什至在 MVar 上都实现了我自己的信号量。和 TVar并且都没有按我预期的方式工作。我显然缺少一些基本的东西，但是什么？我还尝试编译代码并将其作为二进制文件运行。

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

进口雪莉
导入前奏隐藏 (FilePath)
导入 Text.Shakespeare.Text (lt)
导入合格的 Data.Text.Lazy 作为 LT
导入 Control.Monad (forM)
导入 System.Environment (getArgs)

导入合格的 Control.Concurrent.QSem 作为 QSem
导入 Control.Concurrent (forkIO, MVar, putMVar, newEmptyMVar, takeMVar)

-- 定义最大并发进程数
maxProcesses::IO QSem.QSem
maxProcesses = QSem.newQSem 1

bkGrnd::Shio a -> Shio (MVar a)
bkGrnd proc = 做
mvar <-liftIO newEmptyMVar
_ <-liftIO $ forkIO $ do
-- 阻塞直到有空闲进程
sem <- maxProcesses
QSem.waitQSem sem
putStrLn "开始"
-- 运行shell命令
结果 <- shelly $ 默默地 proc
LiftIO $ putMVar mvar 结果
putStrLn“完成”
-- 表示此过程已完成，另一个可以运行。
QSem.signalQSem sem
返回无功

主要::IO()
main = shelly $ 默默地 $ 做
[img, 文件] <-liftIO $ getArgs
内容 <- readfile $ fromText $ LT.pack 文件
-- 为每一行输入运行一个后台进程。
结果 <- forM (LT.lines 内容) $\line -> bkGrnd $ do
runStdin <命令> <参数>
LiftIO $ mapM_ takeMVar 结果

Answer 1

正如我在评论中所说，每次调用 bkGrnd创建自己的信号机，允许每个线程继续运行而无需等待。我会尝试这样的事情，其中​​信号量是在 main 中创建的。并且每次都通过bkGrnd .

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> <arguments>
    liftIO $ mapM_ takeMVar results