[commit: ghc] master: Don't remove the thread from interruptTargetThread on ^C (#6116) (4b523bc)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4b523bc139a05a52a58811623d638c43d398f245

>---------------------------------------------------------------

commit 4b523bc139a05a52a58811623d638c43d398f245
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Tue May 22 11:39:03 2012 +0100

    Don't remove the thread from interruptTargetThread on ^C (#6116)

>---------------------------------------------------------------

 compiler/utils/Panic.lhs |   33 ++++++++++++++++++---------------
 1 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index faaa628..38ee6fc 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -243,7 +243,7 @@ installSignalHandlers = do
       interrupt_exn = (toException UserInterrupt)
 
       interrupt = do
-        mt <- popInterruptTargetThread
+        mt <- peekInterruptTargetThread
         case mt of
           Nothing -> return ()
           Just t  -> throwTo t interrupt_exn
@@ -280,19 +280,18 @@ interruptTargetThread = unsafePerformIO (newMVar [])
 pushInterruptTargetThread :: ThreadId -> IO ()
 pushInterruptTargetThread tid = do
  wtid <- mkWeakThreadId tid
- modifyMVar_ interruptTargetThread $
-   return . (wtid :)
+ modifyMVar_ interruptTargetThread $ return . (wtid :)
 
-popInterruptTargetThread :: IO (Maybe ThreadId)
-popInterruptTargetThread =
-  modifyMVar interruptTargetThread $ loop
+peekInterruptTargetThread :: IO (Maybe ThreadId)
+peekInterruptTargetThread =
+  withMVar interruptTargetThread $ loop
  where
-   loop [] = return ([], Nothing)
+   loop [] = return Nothing
    loop (t:ts) = do
      r <- deRefWeak t
      case r of
        Nothing -> loop ts
-       Just t  -> return (ts, Just t)
+       Just t  -> return (Just t)
 #else
 {-# NOINLINE interruptTargetThread #-}
 interruptTargetThread :: MVar [ThreadId]
@@ -300,13 +299,17 @@ interruptTargetThread = unsafePerformIO (newMVar [])
 
 pushInterruptTargetThread :: ThreadId -> IO ()
 pushInterruptTargetThread tid = do
- modifyMVar_ interruptTargetThread $
-   return . (tid :)
+ modifyMVar_ interruptTargetThread $ return . (tid :)
 
-popInterruptTargetThread :: IO (Maybe ThreadId)
-popInterruptTargetThread =
-  modifyMVar interruptTargetThread $
-   \tids -> return $! case tids of [] -> ([], Nothing)
-                                   (t:ts) -> (ts, Just t)
+peekInterruptTargetThread :: IO (Maybe ThreadId)
+peekInterruptTargetThread =
+  withMVar interruptTargetThread $ return . listToMaybe
 #endif
+
+popInterruptTargetThread :: IO ()
+popInterruptTargetThread =
+  modifyMVar_ interruptTargetThread $
+   \tids -> return $! case tids of []     -> []
+                                   (t:ts) -> ts
+
 \end{code}