[project @ 2005-02-03 10:32:11 by ross]

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

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index edb9679..6dbe991 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -14,7 +14,7 @@
 -- 
 -----------------------------------------------------------------------------
 
-#include "ghcconfig.h"
+-- #hide
 module GHC.Conc
        ( ThreadId(..)
 
@@ -55,7 +55,7 @@ module GHC.Conc
        , writeTVar     -- :: a -> TVar a -> STM ()
        , unsafeIOToSTM -- :: IO a -> STM a
 
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
        , asyncRead     -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
        , asyncWrite    -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
        , asyncDoProc   -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
@@ -82,7 +82,6 @@ import GHC.Pack               ( packCString# )
 import GHC.Ptr          ( Ptr(..), plusPtr, FunPtr(..) )
 import GHC.STRef
 import Data.Typeable
-#include "Typeable.h"
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -94,7 +93,7 @@ infixr 0 `par`, `pseq`
 %************************************************************************
 
 \begin{code}
-data ThreadId = ThreadId ThreadId#
+data ThreadId = ThreadId ThreadId# deriving( Typeable )
 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
 -- But since ThreadId# is unlifted, the Weak type must use open
 -- type variables.
@@ -116,9 +115,6 @@ This misfeature will hopefully be corrected at a later date.
 it defines 'ThreadId' as a synonym for ().
 -}
 
-INSTANCE_TYPEABLE0(ThreadId,threadIdTc,"ThreadId")
-
-
 --forkIO has now been hoisted out into the Concurrent library.
 
 {- | 'killThread' terminates the given thread (GHC only).
@@ -207,9 +203,7 @@ TVars are shared memory locations which support atomic memory
 transactions.
 
 \begin{code}
-newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
-
-INSTANCE_TYPEABLE1(STM,stmTc,"STM" )
+newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) deriving( Typeable )
 
 unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
 unSTM (STM a) = a
@@ -267,9 +261,7 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
 catchSTM :: STM a -> (Exception -> STM a) -> STM a
 catchSTM (STM m) k = STM $ \s -> catchSTM# m (\ex -> unSTM (k ex)) s
 
-data TVar a = TVar (TVar# RealWorld a)
-
-INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar" )
+data TVar a = TVar (TVar# RealWorld a) deriving( Typeable )
 
 instance Eq (TVar a) where
        (TVar tvar1#) == (TVar tvar2#) = sameTVar# tvar1# tvar2#
@@ -309,8 +301,6 @@ writes.
 \begin{code}
 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 
-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
-
 -- |Create an 'MVar' which is initially empty.
 newEmptyMVar  :: IO (MVar a)
 newEmptyMVar = IO $ \ s# ->
@@ -388,25 +378,20 @@ addMVarFinalizer (MVar m) finalizer =
 %************************************************************************
 
 \begin{code}
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
 
 -- Note: threadDelay, threadWaitRead and threadWaitWrite aren't really functional
 -- on Win32, but left in there because lib code (still) uses them (the manner
 -- in which they're used doesn't cause problems on a Win32 platform though.)
 
 asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
-asyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) = do
-  (l, rc) <- IO (\s -> case asyncRead# fd isSock len buf s  of 
-                        (# s, len#, err# #) -> (# s, (I# len#, I# err#) #))
-    -- special handling for Ctrl+C-aborted 'standard input' reads;
-    -- see rts/win32/ConsoleHandler.c for details.
-  if (l == 0 && rc == -2)
-   then asyncRead (I# fd) (I# isSock) (I# len) (Ptr buf)
-   else return (l,rc)
+asyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) =
+  IO $ \s -> case asyncRead# fd isSock len buf s of 
+              (# s, len#, err# #) -> (# s, (I# len#, I# err#) #)
 
 asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
-asyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) = 
-  IO $ \s -> case asyncWrite# fd isSock len buf s  of 
+asyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) =
+  IO $ \s -> case asyncWrite# fd isSock len buf s of 
               (# s, len#, err# #) -> (# s, (I# len#, I# err#) #)
 
 asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
@@ -437,7 +422,7 @@ asyncWriteBA fd isSock len off bufB =
 -- given file descriptor (GHC only).
 threadWaitRead :: Fd -> IO ()
 threadWaitRead fd
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
   | threaded  = waitForReadEvent fd
 #endif
   | otherwise = IO $ \s -> 
@@ -449,7 +434,7 @@ threadWaitRead fd
 -- given file descriptor (GHC only).
 threadWaitWrite :: Fd -> IO ()
 threadWaitWrite fd
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
   | threaded  = waitForWriteEvent fd
 #endif
   | otherwise = IO $ \s -> 
@@ -470,7 +455,7 @@ threadWaitWrite fd
 --
 threadDelay :: Int -> IO ()
 threadDelay time
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
   | threaded  = waitForDelayEvent time
 #else
   | threaded  = c_Sleep (fromIntegral (time `quot` 1000))
@@ -481,7 +466,7 @@ threadDelay time
        }}
 
 -- On Windows, we just make a safe call to 'Sleep' to implement threadDelay.
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
 foreign import ccall safe "Sleep" c_Sleep :: CInt -> IO ()
 #endif
 
@@ -519,7 +504,7 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 --     - forkProcess will kill the IO manager thread.  Let's just
 --       hope we don't need to do any blocking IO between fork & exec.
 
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
 
 data IOReq
   = Read   {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ())