Haskell: POSIX: SIGCHLD signal handler sometimes isn't called - haskell

Question

As a learning exercise, I created a small shell in Haskell that supports background jobs and simple stdout redirection. However, there seems to be a race condition in my code that I don't understand. I'm using System.Posix.
-- ... imports ...
data Redirection = None
| StdOut String
deriving (Show)
data Command = Command
{ cProgramName :: String
, cProgramArgs :: [String]
, cRedirection :: Redirection
, cBackground :: Bool
} deriving (Show)
data Sync = Sync
{ sMVar :: MVar ()
, sRunningJobs :: IORef [ProcessID]
, sDeadJobs :: IORef [ProcessID]
}
withLock :: Sync -> IO () -> IO ()
withLock (Sync mvar _ _) action = do
putMVar mvar ()
action
takeMVar mvar
-- ... parser stuff ...
resolveLine :: Sync -> String -> IO Bool
resolveLine _ "quit" = return False
resolveLine sync line = do
case P.parse lineParser "" line of
Left err -> putStrLn (show err)
Right Nothing -> return ()
Right (Just (Command prog args redirect bg)) ->
case Map.lookup prog builtins of
(Just cmd) -> cmd sync args
Nothing -> do
pid <- forkProcess $ do
case redirect of
None -> return ()
StdOut target -> do
fd <- openFd target WriteOnly (Just 420) defaultFileFlags { trunc = True }
void $ dupTo fd stdOutput
closeFd fd
executeFile prog True args Nothing
when bg $
withLock sync $ modifyIORef (sRunningJobs sync) (pid:)
return True
runShell :: Sync -> IO ()
runShell sync = do
wd <- getCurrentDirectory
hd <- getHomeDirectory
line <- readline $ shortenDirectory hd wd ++ " > "
case line of
Nothing -> putStrLn "" >> return ()
Just line -> do
addHistory line
-- Reap dead children.
withLock sync $ readIORef (sDeadJobs sync) >>= mapM_
(\pid -> do
getProcessStatus True True pid
modifyIORef (sDeadJobs sync) (delete pid)
)
go <- resolveLine sync line
when go $ runShell sync
where shortenDirectory hd wd = if hd `isPrefixOf` wd
then "~" ++ drop (length hd) wd
else wd
handleSigChild :: Sync -> SignalInfo -> IO ()
handleSigChild sync si = do
withLock sync $ do
modifyIORef (sRunningJobs sync) (delete pid)
modifyIORef (sDeadJobs sync) (pid:)
where
pid = siginfoPid $ siginfoSpecific si
main :: IO ()
main = do
mvar <- newEmptyMVar
rjobs <- newIORef []
djobs <- newIORef []
void $ installHandler sigCHLD (CatchInfo $ handleSigChild $ Sync mvar rjobs djobs) Nothing
runShell $ Sync mvar rjobs djobs
Sometimes, when I run kill on a background job, the handleSigChild function is not called which results in a zombie process, because the child's pid is not added to the shared list of dead processes that will be reaped later. I'm running the kill command from within the shell.
Why is the handler executed only once? Is it because the kill process itself and the killed process both send the signal almost at the same time? How do I fix it?