Windows fixes

[ghc-base.git] / Control / Exception.hs

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 7dddc45..e923d90 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -68,18 +68,15 @@ module Control.Exception (
         -- ** The @catch@ functions
         catch,     -- :: IO a -> (Exception -> IO a) -> IO a
         catches, Handler(..),
-        catchAny,
         catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
 
         -- ** The @handle@ functions
         handle,    -- :: (Exception -> IO a) -> IO a -> IO a
-        handleAny,
         handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 
         -- ** The @try@ functions
         try,       -- :: IO a -> IO (Either Exception a)
         tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
-        ignoreExceptions,
         onException,
 
         -- ** The @evaluate@ function
@@ -130,12 +127,10 @@ module Control.Exception (
 import GHC.Base
 import GHC.IOBase
 import GHC.List
-import GHC.Num
 import GHC.Show
 import GHC.IOBase as ExceptionBase
 import GHC.Exception hiding ( Exception )
-import GHC.Conc         ( ThreadId(ThreadId) )
-import Foreign.C.String ( CString, withCString )
+import GHC.Conc
 #endif
 
 #ifdef __HUGS__
@@ -292,9 +287,6 @@ catchJust p a handler = catch a handler'
 handle     :: Exception e => (e -> IO a) -> IO a -> IO a
 handle     =  flip catch
 
-handleAny  :: (forall e . Exception e => e -> IO a) -> IO a -> IO a
-handleAny  =  flip catchAny
-
 -- | A version of 'catchJust' with the arguments swapped around (see
 -- 'handle').
 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
@@ -345,10 +337,7 @@ tryJust p a = do
                         Nothing -> throw e
                         Just b  -> return (Left b)
 
-ignoreExceptions :: IO () -> IO ()
-ignoreExceptions io = io `catchAny` \_ -> return ()
-
-onException :: IO a -> IO () -> IO a
+onException :: IO a -> IO b -> IO a
 onException io what = io `catch` \e -> do what
                                           throw (e :: SomeException)
 
@@ -383,9 +372,7 @@ bracket
 bracket before after thing =
   block (do
     a <- before 
-    r <- catchAny
-           (unblock (thing a))
-           (\e -> do { after a; throw e })
+    r <- unblock (thing a) `onException` after a
     after a
     return r
  )
@@ -400,9 +387,7 @@ finally :: IO a         -- ^ computation to run first
         -> IO a         -- returns the value from the first computation
 a `finally` sequel =
   block (do
-    r <- catchAny
-             (unblock a)
-             (\e -> do { sequel; throw e })
+    r <- unblock a `onException` sequel
     sequel
     return r
   )
@@ -422,9 +407,7 @@ bracketOnError
 bracketOnError before after thing =
   block (do
     a <- before 
-    catchAny
-        (unblock (thing a))
-        (\e -> do { after a; throw e })
+    unblock (thing a) `onException` after a
  )
 
 -- -----------------------------------------------------------------------------
@@ -575,16 +558,6 @@ instance Show NoMethodError where
 
 -----
 
-data AssertionFailed = AssertionFailed String
-INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
-
-instance Exception AssertionFailed
-
-instance Show AssertionFailed where
-    showsPrec _ (AssertionFailed err) = showString err
-
------
-
 data NonTermination = NonTermination
 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
 
@@ -615,39 +588,3 @@ nestedAtomically = toException NestedAtomically
 
 instance Exception Dynamic
 
------
-
-assertError :: Addr# -> Bool -> a -> a
-assertError str pred v
-  | pred      = v
-  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
-
-{-
-(untangle coded message) expects "coded" to be of the form
-        "location|details"
-It prints
-        location message details
--}
-untangle :: Addr# -> String -> String
-untangle coded message
-  =  location
-  ++ ": " 
-  ++ message
-  ++ details
-  ++ "\n"
-  where
-    coded_str = unpackCStringUtf8# coded
-
-    (location, details)
-      = case (span not_bar coded_str) of { (loc, rest) ->
-        case rest of
-          ('|':det) -> (loc, ' ' : det)
-          _         -> (loc, "")
-        }
-    not_bar c = c /= '|'
-
--- XXX From GHC.Conc
-throwTo :: Exception e => ThreadId -> e -> IO ()
-throwTo (ThreadId id) ex = IO $ \ s ->
-   case (killThread# id (toException ex) s) of s1 -> (# s1, () #)
-