From c71f875f0b7d51cb6a61396d5f3cc5771a638728 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Fri, 7 Jan 2005 11:37:02 +0000
Subject: [PATCH] [project @ 2005-01-07 11:37:02 by simonmar] Add
 unsafeIOToSTM

---
 GHC/Conc.lhs |    8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index b67847c..ee94777 100644
--- 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 ()
+	, unsafeIOToSTM	-- :: IO a -> STM a
 
 #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.STRef
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -213,7 +213,7 @@ instance  Monad STM  where
     {-# INLINE return #-}
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
-    m >> k      =  m >>= \_ -> k
+    m >> k      = thenSTM 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 #))
 
+-- | 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 )
-- 
1.7.10.4