projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2005-01-17 11:08:52 by simonmar]
[ghc-base.git]
/
GHC
/
Conc.lhs
diff --git
a/GHC/Conc.lhs
b/GHC/Conc.lhs
index
b67847c
..
02b256a
100644
(file)
--- a/
GHC/Conc.lhs
+++ b/
GHC/Conc.lhs
@@
-1,5
+1,5
@@
\begin{code}
\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Conc
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Conc
@@
-53,6
+53,7
@@
module GHC.Conc
, newTVar -- :: a -> STM (TVar a)
, readTVar -- :: TVar a -> STM a
, writeTVar -- :: a -> TVar a -> STM ()
, newTVar -- :: a -> STM (TVar a)
, readTVar -- :: TVar a -> STM a
, writeTVar -- :: a -> TVar a -> STM ()
+ , unsafeIOToSTM -- :: IO a -> STM a
#ifdef mingw32_TARGET_OS
, asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
#ifdef mingw32_TARGET_OS
, asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
@@
-213,7
+214,7
@@
instance Monad STM where
{-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
{-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
- m >> k = m >>= \_ -> k
+ m >> k = thenSTM m k
return x = returnSTM x
m >>= k = bindSTM m k
return x = returnSTM x
m >>= k = bindSTM m k
@@
-232,6
+233,10
@@
thenSTM (STM m) k = STM ( \s ->
returnSTM :: a -> STM a
returnSTM x = STM (\s -> (# s, x #))
returnSTM :: a -> STM a
returnSTM x = STM (\s -> (# s, x #))
+-- | Unsafely performs IO in the STM monad.
+unsafeIOToSTM :: IO a -> STM a
+unsafeIOToSTM (IO m) = STM m
+
-- |Perform a series of STM actions atomically.
atomically :: STM a -> IO a
atomically (STM m) = IO (\s -> (atomically# m) s )
-- |Perform a series of STM actions atomically.
atomically :: STM a -> IO a
atomically (STM m) = IO (\s -> (atomically# m) s )