[project @ 2000-04-10 16:02:58 by simonpj]
[ghc-hetmet.git] / ghc / lib / std / PrelHandle.lhs
index 25b98ea..22ca0d6 100644 (file)
@@ -8,15 +8,15 @@ This module defines Haskell {\em handles} and the basic operations
 which are supported for them.
 
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
+{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 #include "cbits/stgerror.h"
 
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelHandle where
 
+import PrelArr
 import PrelBase
 import PrelAddr                ( Addr, nullAddr )
-import PrelArr         ( newVar, readVar, writeVar )
 import PrelByteArr     ( ByteArray(..), MutableByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( span )
@@ -32,11 +32,8 @@ import PrelPack         ( packString )
 #ifndef __PARALLEL_HASKELL__
 import PrelWeak                ( addForeignFinalizer )
 #endif
-import Ix
 
-#ifdef __CONCURRENT_HASKELL__
 import PrelConc
-#endif
 
 #ifndef __PARALLEL_HASKELL__
 import PrelForeign  ( makeForeignObj )
@@ -66,20 +63,11 @@ The @Handle@ and @Handle__@ types are defined in @IOBase@.
 
 \begin{code}
 {-# INLINE newHandle   #-}
-{-# INLINE withHandle #-}
 newHandle     :: Handle__ -> IO Handle
 
-#if defined(__CONCURRENT_HASKELL__)
-
 -- Use MVars for concurrent Haskell
 newHandle hc  = newMVar        hc      >>= \ h ->
                return (Handle h)
-#else 
-
--- Use ordinary MutableVars for non-concurrent Haskell
-newHandle hc  = stToIO (newVar hc      >>= \ h ->
-                       return (Handle h))
-#endif
 \end{code}
 
 %*********************************************************
@@ -109,8 +97,8 @@ orignal handle is always replaced [ this is the case at the moment,
 but we might want to revisit this in the future --SDM ].
 
 \begin{code}
-#ifdef __CONCURRENT_HASKELL__
 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
+{-# INLINE withHandle #-}
 withHandle (Handle h) act = do
    h_ <- takeMVar h
    (h',v)  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
@@ -118,6 +106,7 @@ withHandle (Handle h) act = do
    return v
 
 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
+{-# INLINE withHandle_ #-}
 withHandle_ (Handle h) act = do
    h_ <- takeMVar h
    v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
@@ -125,22 +114,12 @@ withHandle_ (Handle h) act = do
    return v
    
 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
+{-# INLINE withHandle__ #-}
 withHandle__ (Handle h) act = do
    h_ <- takeMVar h
    h'  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
    putMVar h h'
    return ()
-
-#else
-   -- of questionable value to install this exception
-   -- handler, but let's do it in the non-concurrent
-   -- case too, for now.
-withHandle (Handle h) act = do
-   h_ <- stToIO (readVar h)
-   v  <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
-   return v
-
-#endif
 \end{code}
 
 nullFile__ is only used for closed handles, plugging it in as a null
@@ -726,11 +705,7 @@ hIsWritable handle =
     isWritable _              = False
 
 
-#ifndef __PARALLEL_HASKELL__
-getBMode__ :: ForeignObj -> IO (BufferMode, Int)
-#else
-getBMode__ :: Addr -> IO (BufferMode, Int)
-#endif
+getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
 getBMode__ fo = do
   rc <- getBufferMode fo    -- ConcHask: SAFE, won't block
   case (rc::Int) of
@@ -848,13 +823,6 @@ hConnectHdl_ hW hR is_tty =
   wantRWHandle "hConnectTo" hW $ \ hW_ ->
   wantRWHandle "hConnectTo" hR $ \ hR_ -> do
   setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
-
-#ifndef __PARALLEL_HASKELL__
-#define FILE_OBJECT     ForeignObj
-#else
-#define FILE_OBJECT     Addr
-#endif
-
 \end{code}
 
 As an extension, we also allow characters to be pushed back.
@@ -1136,12 +1104,7 @@ Internal helper functions for Concurrent Haskell implementation
 of IO:
 
 \begin{code}
-#ifndef __PARALLEL_HASKELL__
-mayBlock :: ForeignObj -> IO Int -> IO Int
-#else
-mayBlock :: Addr  -> IO Int -> IO Int
-#endif
-
+mayBlock :: FILE_OBJECT -> IO Int -> IO Int
 mayBlock fo act = do
    rc <- act
    case rc of
@@ -1165,7 +1128,7 @@ data MayBlock
   | BlockWrite Int
   | NoBlock Int
 
-mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
 mayBlockRead fname handle fn = do
     r <- wantReadableHandle fname handle $ \ handle_ -> do
         let fo = haFO__ handle_
@@ -1193,7 +1156,7 @@ mayBlockRead fname handle fn = do
           mayBlockRead fname handle fn
        NoBlock c -> return c
 
-mayBlockWrite :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
 mayBlockWrite fname handle fn = do
     r <- wantWriteableHandle fname handle $ \ handle_ -> do
         let fo = haFO__ handle_