QSem이 스레드를 차단하지 않는 것 같습니다

Question

Shelly 라이브러리를 사용하여 여러 작업을 병렬로 실행하는 간단한 스크립트를 작성하고 있지만 한 번에 실행되는 최대 작업 수를 제한하려고합니다. 이 스크립트는 각 행에 입력 된 파일을 가져 와서 해당 입력에 대한 작업을 실행합니다. 파일에는 수백 개의 입력이 있으며 한 번에 약 16 개의 프로세스로 제한하려고합니다. (1) 실제로 한계 (잘하려고) 1. 초기 계수와 QSem를 사용하여 내가 4 개 입력이 테스트 파일을 실행할 때 나는이보기 때문에 그래도 뭔가 빠진 것 같다

현재 스크립트

 
Starting 
Starting 
Starting 
Starting 
Done 
Done 
Done 
Done 

그래서 예상대로 QSem에서 스레드가 블로킹되지 않으므로 모든 스레드가 동시에 실행됩니다. 나는 지금까지 심지어 내 MVar과 TVar 둘 다 내 자신의 세마포를 구현하고 어느 쪽도 예상대로 작동하지 않았다. 나는 근본적으로 무언가를 놓치고 있지만 무엇? 또한 코드를 컴파일하고 바이너리로 실행 해 보았습니다.

 
#!/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 -> ShIO (MVar a) 
bkGrnd proc = do 
    mvar <- liftIO newEmptyMVar 
    _ <- liftIO $ forkIO $ do 
    -- Block until there are free processes 
    sem <- maxProcesses 
    QSem.waitQSem sem 
    putStrLn "Starting" 
    -- Run the shell command 
    result <- 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] <- liftIO $ getArgs 
    contents <- readfile $ fromText $ LT.pack file 
    -- Run a backgrounded process for each line of input. 
    results <- forM (LT.lines contents) $ \line -> bkGrnd $ do 
     runStdin &ltcommand> &ltarguments> 
    liftIO $ mapM_ takeMVar results 

Answer 1

내 의견에, bkGrnd 호출 할 때마다 모든 스레드가 대기하지 않고 계속 할 수 있도록, 자신의 semaphonre를 생성 말했듯이. 세마포어가 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 

Answer 2

당신은 대답을 가지고,하지만 난 추가해야합니다 killThread 또는 비동기 스레드 죽음이 가능한 경우 QSem 및 QSemN는 스레드에 안전하지 않습니다.

내 버그 신고 및 패치는 GHC trac ticket #3160입니다. 고정 코드는 Control.Concurrent.MSem, MSemN, MSampleVar 및 보너스 FairRWLock 모듈을 사용하여 SafeSemaphore이라는 새 라이브러리로 제공됩니다.

Answer 3

그것은

bkGrnd sem proc = do 
    QSem.waitQSem sem 
    mvar <- liftIO newEmptyMVar 
    _ <- liftIO $ forkIO $ do 
    ... 

그래서 당신이 세마포어를 얻지도 forkIO 더 나은 때까지 아닌가?