Use explicit language extensions & remove extension fields from base.cabal

[ghc-base.git] / GHC / Conc / Sync.lhs

diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index cc16853..b4de53a 100644 (file)
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -1,7 +1,16 @@
 \begin{code}
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , MagicHash
+           , UnboxedTuples
+           , UnliftedFFITypes
+           , ForeignFunctionInterface
+           , DeriveDataTypeable
+  #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_HADDOCK not-home #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Conc.Sync
@@ -52,7 +61,8 @@ module GHC.Conc.Sync
         , atomically    -- :: STM a -> IO a
         , retry         -- :: STM a
         , orElse        -- :: STM a -> STM a -> STM a
-        , catchSTM      -- :: STM a -> (Exception -> STM a) -> STM a
+        , throwSTM      -- :: Exception e => e -> STM a
+        , catchSTM      -- :: Exception e => STM a -> (e -> STM a) -> STM a
         , alwaysSucceeds -- :: STM a -> STM ()
         , always        -- :: STM Bool -> STM ()
         , TVar(..)
@@ -96,7 +106,6 @@ import GHC.IO.Exception
 import GHC.Exception
 import GHC.IORef
 import GHC.MVar
-import GHC.Num          ( Num(..) )
 import GHC.Real         ( fromIntegral )
 import GHC.Pack         ( packCString# )
 import GHC.Show         ( Show(..), showString )
@@ -274,7 +283,10 @@ another thread.
 If the target thread is currently making a foreign call, then the
 exception will not be raised (and hence 'throwTo' will not return)
 until the call has completed.  This is the case regardless of whether
-the call is inside a 'mask' or not.
+the call is inside a 'mask' or not.  However, in GHC a foreign call
+can be annotated as @interruptible@, in which case a 'throwTo' will
+cause the RTS to attempt to cause the call to return; see the GHC
+documentation for more details.
 
 Important note: the behaviour of 'throwTo' differs from that described in
 the paper \"Asynchronous exceptions in Haskell\"
@@ -506,9 +518,34 @@ retry = STM $ \s# -> retry# s#
 orElse :: STM a -> STM a -> STM a
 orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
 
+-- | A variant of 'throw' that can only be used within the 'STM' monad.
+--
+-- Throwing an exception in @STM@ aborts the transaction and propagates the
+-- exception.
+--
+-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e    `seq` x  ===> throw e
+-- > throwSTM e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwSTM' will only cause
+-- an exception to be raised when it is used within the 'STM' monad.
+-- The 'throwSTM' variant should be used in preference to 'throw' to
+-- raise an exception within the 'STM' monad because it guarantees
+-- ordering with respect to other 'STM' operations, whereas 'throw'
+-- does not.
+throwSTM :: Exception e => e -> STM a
+throwSTM e = STM $ raiseIO# (toException e)
+
 -- |Exception handling within STM actions.
-catchSTM :: STM a -> (SomeException -> STM a) -> STM a
-catchSTM (STM m) k = STM $ \s -> catchSTM# m (\ex -> unSTM (k ex)) s
+catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
+catchSTM (STM m) handler = STM $ catchSTM# m handler'
+    where
+      handler' e = case fromException e of
+                     Just e' -> unSTM (handler e')
+                     Nothing -> raiseIO# e
 
 -- | Low-level primitive on which always and alwaysSucceeds are built.
 -- checkInv differs form these in that (i) the invariant is not