X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException%2FBase.hs;h=cb5321b76b1524313eedceef2bbb25e903d0c1cc;hb=41e8fba828acbae1751628af50849f5352b27873;hp=5794de38c45a727f4483adf7afde188d4b8c10c8;hpb=47d4d2af6d13d4871f378e38d9a780837d93cf7c;p=ghc-base.git

diff --git a/Control/Exception/Base.hs b/Control/Exception/Base.hs
index 5794de3..cb5321b 100644
--- a/Control/Exception/Base.hs
+++ b/Control/Exception/Base.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
 
 #include "Typeable.h"
 
@@ -78,6 +78,16 @@ module Control.Exception.Base (
         -- * Asynchronous Exceptions
 
         -- ** Asynchronous exception control
+        mask,
+#ifndef __NHC__
+        mask_,
+        uninterruptibleMask,
+        uninterruptibleMask_,
+        MaskingState(..),
+        getMaskingState,
+#endif
+
+        -- ** (deprecated) Asynchronous exception control
 
         block,
         unblock,
@@ -99,6 +109,7 @@ module Control.Exception.Base (
         -- * Calls for GHC runtime
         recSelError, recConError, irrefutPatError, runtimeError,
         nonExhaustiveGuardsError, patError, noMethodBindingError,
+        absentError,
         nonTermination, nestedAtomically,
 #endif
   ) where
@@ -110,7 +121,7 @@ import GHC.IO.Exception
 import GHC.Exception
 import GHC.Show
 -- import GHC.Exception hiding ( Exception )
-import GHC.Conc
+import GHC.Conc.Sync
 #endif
 
 #ifdef __HUGS__
@@ -214,6 +225,10 @@ assert :: Bool -> a -> a
 assert True  x = x
 assert False _ = throw (toException (UserError "" "Assertion failed"))
 
+mask   :: ((IO a-> IO a) -> IO a) -> IO a
+mask action = action restore
+    where restore act = act
+
 #endif
 
 #ifdef __HUGS__
@@ -411,7 +426,7 @@ catchJust
         -> IO a
 catchJust p a handler = catch a handler'
   where handler' e = case p e of
-                        Nothing -> throw e
+                        Nothing -> throwIO e
                         Just b  -> handler b
 
 -- | A version of 'catch' with the arguments swapped around; useful in
@@ -437,7 +452,7 @@ handleJust p =  flip (catchJust p)
 
 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
 mapException f v = unsafePerformIO (catch (evaluate v)
-                                          (\x -> throw (f x)))
+                                          (\x -> throwIO (f x)))
 
 -----------------------------------------------------------------------------
 -- 'try' and variations.
@@ -467,14 +482,14 @@ tryJust p a = do
   case r of
         Right v -> return (Right v)
         Left  e -> case p e of
-                        Nothing -> throw e
+                        Nothing -> throwIO e
                         Just b  -> return (Left b)
 
 -- | Like 'finally', but only performs the final action if there was an
 -- exception raised by the computation.
 onException :: IO a -> IO b -> IO a
 onException io what = io `catch` \e -> do _ <- what
-                                          throw (e :: SomeException)
+                                          throwIO (e :: SomeException)
 
 -----------------------------------------------------------------------------
 -- Some Useful Functions
@@ -505,12 +520,11 @@ bracket
         -> (a -> IO c)  -- ^ computation to run in-between
         -> IO c         -- returns the value from the in-between computation
 bracket before after thing =
-  block (do
+  mask $ \restore -> do
     a <- before
-    r <- unblock (thing a) `onException` after a
+    r <- restore (thing a) `onException` after a
     _ <- after a
     return r
- )
 #endif
 
 -- | A specialised variant of 'bracket' with just a computation to run
@@ -521,11 +535,10 @@ finally :: IO a         -- ^ computation to run first
                         -- was raised)
         -> IO a         -- returns the value from the first computation
 a `finally` sequel =
-  block (do
-    r <- unblock a `onException` sequel
+  mask $ \restore -> do
+    r <- restore a `onException` sequel
     _ <- sequel
     return r
-  )
 
 -- | A variant of 'bracket' where the return value from the first computation
 -- is not required.
@@ -540,10 +553,9 @@ bracketOnError
         -> (a -> IO c)  -- ^ computation to run in-between
         -> IO c         -- returns the value from the in-between computation
 bracketOnError before after thing =
-  block (do
+  mask $ \restore -> do
     a <- before
-    unblock (thing a) `onException` after a
-  )
+    restore (thing a) `onException` after a
 
 #if !(__GLASGOW_HASKELL__ || __NHC__)
 assert :: Bool -> a -> a
@@ -694,12 +706,14 @@ instance Exception NestedAtomically
 
 #ifdef __GLASGOW_HASKELL__
 recSelError, recConError, irrefutPatError, runtimeError,
-             nonExhaustiveGuardsError, patError, noMethodBindingError
+  nonExhaustiveGuardsError, patError, noMethodBindingError,
+  absentError
         :: Addr# -> a   -- All take a UTF8-encoded C string
 
 recSelError              s = throw (RecSelError ("No match in record selector "
 			                         ++ unpackCStringUtf8# s))  -- No location info unfortunately
 runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately
+absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
 
 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
 irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))