projects
/
ghc-base.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7bce4ee
)
[project @ 2005-01-07 11:37:02 by simonmar]
author
simonmar
<unknown>
Fri, 7 Jan 2005 11:37:02 +0000
(11:37 +0000)
committer
simonmar
<unknown>
Fri, 7 Jan 2005 11:37:02 +0000
(11:37 +0000)
Add unsafeIOToSTM
GHC/Conc.lhs
patch
|
blob
|
history
diff --git
a/GHC/Conc.lhs
b/GHC/Conc.lhs
index
b67847c
..
ee94777
100644
(file)
--- a/
GHC/Conc.lhs
+++ b/
GHC/Conc.lhs
@@
-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)
@@
-79,7
+80,6
@@
import GHC.Base ( Int(..) )
import GHC.Exception ( Exception(..), AsyncException(..) )
import GHC.Pack ( packCString# )
import GHC.Ptr ( Ptr(..), plusPtr, FunPtr(..) )
import GHC.Exception ( Exception(..), AsyncException(..) )
import GHC.Pack ( packCString# )
import GHC.Ptr ( Ptr(..), plusPtr, FunPtr(..) )
-import GHC.STRef
infixr 0 `par`, `pseq`
\end{code}
infixr 0 `par`, `pseq`
\end{code}
@@
-213,7
+213,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
+232,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 )