From: Ian Lynagh <igloo@earth.li>
Date: Thu, 21 Aug 2008 11:07:23 +0000 (+0000)
Subject: Provide blockedOnDeadMVar, blockedIndefinitely for the RTS
X-Git-Tag: 6_10_branch_has_been_forked~30
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c29fd9b3fba1752d2775432c615d50575c92bc00;p=ghc-base.git

Provide blockedOnDeadMVar, blockedIndefinitely for the RTS
---

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index d55be42..c15d6c7 100644
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -47,7 +47,8 @@ module GHC.IOBase(
     throwIO, block, unblock, blocked, catchAny, catchException,
     evaluate,
     ErrorCall(..), AssertionFailed(..), assertError, untangle,
-    BlockedOnDeadMVar(..), BlockedIndefinitely(..), Deadlock(..)
+    BlockedOnDeadMVar(..), BlockedIndefinitely(..), Deadlock(..),
+    blockedOnDeadMVar, blockedIndefinitely
   ) where
 
 import GHC.ST
@@ -641,6 +642,9 @@ instance Exception BlockedOnDeadMVar
 instance Show BlockedOnDeadMVar where
     showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
 
+blockedOnDeadMVar :: SomeException -- for the RTS
+blockedOnDeadMVar = toException BlockedOnDeadMVar
+
 -----
 
 data BlockedIndefinitely = BlockedIndefinitely
@@ -651,6 +655,9 @@ instance Exception BlockedIndefinitely
 instance Show BlockedIndefinitely where
     showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
 
+blockedIndefinitely :: SomeException -- for the RTS
+blockedIndefinitely = toException BlockedIndefinitely
+
 -----
 
 data Deadlock = Deadlock