Commit 7b067f2d authored by Simon Marlow's avatar Simon Marlow

Rewrite of the IO library, including Unicode support

Highlights:

* Unicode support for Handle I/O:

  ** Automatic encoding and decoding using a per-Handle encoding.

  ** The encoding defaults to the locale encoding (only on Unix 
     so far, perhaps Windows later).

  ** Built-in UTF-8, UTF-16 (BE/LE), and UTF-32 (BE/LE) codecs.

  ** iconv-based codec for other encodings on Unix

* Modularity: the low-level IO interface is exposed as a type class
  (GHC.IO.IODevice) so you can build your own low-level IO providers and
  make Handles from them.

* Newline translation: instead of being Windows-specific wired-in
  magic, the translation from \r\n -> \n and back again is available
  on all platforms and is configurable for reading/writing
  independently.


Unicode-aware Handles
~~~~~~~~~~~~~~~~~~~~~

This is a significant restructuring of the Handle implementation with
the primary goal of supporting Unicode character encodings.

The only change to the existing behaviour is that by default, text IO
is done in the prevailing locale encoding of the system (except on
Windows [1]).  

Handles created by openBinaryFile use the Latin-1 encoding, as do
Handles placed in binary mode using hSetBinaryMode.

We provide a way to change the encoding for an existing Handle:

   GHC.IO.Handle.hSetEncoding :: Handle -> TextEncoding -> IO ()

and various encodings (from GHC.IO.Encoding):

   latin1,
   utf8,
   utf16, utf16le, utf16be,
   utf32, utf32le, utf32be,
   localeEncoding,

and a way to lookup other encodings:

   GHC.IO.Encoding.mkTextEncoding :: String -> IO TextEncoding

(it's system-dependent whether the requested encoding will be
available).

We may want to export these from somewhere more permanent; that's a
topic for a future library proposal.

Thanks to suggestions from Duncan Coutts, it's possible to call
hSetEncoding even on buffered read Handles, and the right thing
happens.  So we can read from text streams that include multiple
encodings, such as an HTTP response or email message, without having
to turn buffering off (though there is a penalty for switching
encodings on a buffered Handle, as the IO system has to do some
re-decoding to figure out where it should start reading from again).

If there is a decoding error, it is reported when an attempt is made
to read the offending character from the Handle, as you would expect.

Performance varies.  For "hGetContents >>= putStr" I found the new
library was faster on my x86_64 machine, but slower on an x86.  On the
whole I'd expect things to be a bit slower due to the extra
decoding/encoding, but probabaly not noticeably.  If performance is
critical for your app, then you should be using bytestring and text
anyway.

[1] Note: locale encoding is not currently implemented on Windows due
to the built-in Win32 APIs for encoding/decoding not being sufficient
for our purposes.  Ask me for details.  Offers of help gratefully
accepted.


Newline Translation
~~~~~~~~~~~~~~~~~~~

In the old IO library, text-mode Handles on Windows had automatic
translation from \r\n -> \n on input, and the opposite on output.  It
was implemented using the underlying CRT functions, which meant that
there were certain odd restrictions, such as read/write text handles
needing to be unbuffered, and seeking not working at all on text
Handles.

In the rewrite, newline translation is now implemented in the upper
layers, as it needs to be since we have to perform Unicode decoding
before newline translation.  This means that it is now available on
all platforms, which can be quite handy for writing portable code.

For now, I have left the behaviour as it was, namely \r\n -> \n on
Windows, and no translation on Unix.  However, another reasonable
default (similar to what Python does) would be to do \r\n -> \n on
input, and convert to the platform-native representation (either \r\n
or \n) on output.  This is called universalNewlineMode (below).

The API is as follows.  (available from GHC.IO.Handle for now, again
this is something we will probably want to try to get into System.IO
at some point):

-- | The representation of a newline in the external file or stream.
data Newline = LF    -- ^ "\n"
             | CRLF  -- ^ "\r\n"
             deriving Eq

-- | Specifies the translation, if any, of newline characters between
-- internal Strings and the external file or stream.  Haskell Strings
-- are assumed to represent newlines with the '\n' character; the
-- newline mode specifies how to translate '\n' on output, and what to
-- translate into '\n' on input.
data NewlineMode 
  = NewlineMode { inputNL :: Newline,
                    -- ^ the representation of newlines on input
                  outputNL :: Newline
                    -- ^ the representation of newlines on output
                 }
             deriving Eq

-- | The native newline representation for the current platform
nativeNewline :: Newline

-- | Map "\r\n" into "\n" on input, and "\n" to the native newline
-- represetnation on output.  This mode can be used on any platform, and
-- works with text files using any newline convention.  The downside is
-- that @readFile a >>= writeFile b@ might yield a different file.
universalNewlineMode :: NewlineMode
universalNewlineMode  = NewlineMode { inputNL  = CRLF, 
                                      outputNL = nativeNewline }

-- | Use the native newline representation on both input and output
nativeNewlineMode    :: NewlineMode
nativeNewlineMode     = NewlineMode { inputNL  = nativeNewline, 
                                      outputNL = nativeNewline }

-- | Do no newline translation at all.
noNewlineTranslation :: NewlineMode
noNewlineTranslation  = NewlineMode { inputNL  = LF, outputNL = LF }


-- | Change the newline translation mode on the Handle.
hSetNewlineMode :: Handle -> NewlineMode -> IO ()



IO Devices
~~~~~~~~~~

The major change here is that the implementation of the Handle
operations is separated from the underlying IO device, using type
classes.  File descriptors are just one IO provider; I have also
implemented memory-mapped files (good for random-access read/write)
and a Handle that pipes output to a Chan (useful for testing code that
writes to a Handle).  New kinds of Handle can be implemented outside
the base package, for instance someone could write bytestringToHandle.
A Handle is made using mkFileHandle:

-- | makes a new 'Handle'
mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
              => dev -- ^ the underlying IO device, which must support
                     -- 'IODevice', 'BufferedIO' and 'Typeable'
              -> FilePath
                     -- ^ a string describing the 'Handle', e.g. the file
                     -- path for a file.  Used in error messages.
              -> IOMode
                     -- ^ The mode in which the 'Handle' is to be used
              -> Maybe TextEncoding
                     -- ^ text encoding to use, if any
              -> NewlineMode
                     -- ^ newline translation mode
              -> IO Handle

This also means that someone can write a completely new IO
implementation on Windows based on native Win32 HANDLEs, and
distribute it as a separate package (I really hope somebody does
this!).

This restructuring isn't as radical as previous designs.  I haven't
made any attempt to make a separate binary I/O layer, for example
(although hGetBuf/hPutBuf do bypass the text encoding and newline
translation).  The main goal here was to get Unicode support in, and
to allow others to experiment with making new kinds of Handle.  We
could split up the layers further later.


API changes and Module structure
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

NB. GHC.IOBase and GHC.Handle are now DEPRECATED (they are still
present, but are just re-exporting things from other modules now).
For 6.12 we'll want to bump base to version 5 and add a base4-compat.
For now I'm using #if __GLASGOW_HASKEL__ >= 611 to avoid deprecated
warnings.

I split modules into smaller parts in many places.  For example, we
now have GHC.IORef, GHC.MVar and GHC.IOArray containing the
implementations of IORef, MVar and IOArray respectively.  This was
necessary for untangling dependencies, but it also makes things easier
to follow.

The new module structurue for the IO-relatied parts of the base
package is:

GHC.IO
   Implementation of the IO monad; unsafe*; throw/catch

GHC.IO.IOMode
   The IOMode type

GHC.IO.Buffer
   Buffers and operations on them

GHC.IO.Device
   The IODevice and RawIO classes.

GHC.IO.BufferedIO
   The BufferedIO class.

GHC.IO.FD
   The FD type, with instances of IODevice, RawIO and BufferedIO.

GHC.IO.Exception
   IO-related Exceptions

GHC.IO.Encoding
   The TextEncoding type; built-in TextEncodings; mkTextEncoding

GHC.IO.Encoding.Types
GHC.IO.Encoding.Iconv
GHC.IO.Encoding.Latin1
GHC.IO.Encoding.UTF8
GHC.IO.Encoding.UTF16
GHC.IO.Encoding.UTF32
   Implementation internals for GHC.IO.Encoding

GHC.IO.Handle
   The main API for GHC's Handle implementation, provides all the Handle
   operations + mkFileHandle + hSetEncoding.

GHC.IO.Handle.Types
GHC.IO.Handle.Internals
GHC.IO.Handle.Text
   Implementation of Handles and operations.

GHC.IO.Handle.FD
   Parts of the Handle API implemented by file-descriptors: openFile,
   stdin, stdout, stderr, fdToHandle etc.
parent 16f57103
......@@ -100,9 +100,8 @@ import GHC.Exception
import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield,
threadDelay, forkIO, childHandler )
import qualified GHC.Conc
import GHC.IOBase ( IO(..) )
import GHC.IOBase ( unsafeInterleaveIO )
import GHC.IOBase ( newIORef, readIORef, writeIORef )
import GHC.IO ( IO(..), unsafeInterleaveIO )
import GHC.IORef ( newIORef, readIORef, writeIORef )
import GHC.Base
import System.Posix.Types ( Fd )
......@@ -113,7 +112,6 @@ import Control.Monad ( when )
#ifdef mingw32_HOST_OS
import Foreign.C
import System.IO
import GHC.Handle
#endif
#endif
......
......@@ -40,7 +40,7 @@ import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
)
#endif
......
......@@ -138,7 +138,7 @@ import Control.Exception.Base
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.IOBase
import GHC.IO hiding ( onException, finally )
import Data.Maybe
#else
import Prelude hiding (catch)
......
......@@ -106,9 +106,10 @@ module Control.Exception.Base (
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.IOBase
import GHC.IO hiding (finally,onException)
import GHC.IO.Exception
import GHC.Exception
import GHC.Show
import GHC.IOBase
import GHC.Exception hiding ( Exception )
import GHC.Conc
#endif
......@@ -382,7 +383,7 @@ catch :: Exception e
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
#if __GLASGOW_HASKELL__
catch = GHC.IOBase.catchException
catch = GHC.IO.catchException
#elif __HUGS__
catch m h = Hugs.Exception.catchException m h'
where h' e = case fromException e of
......
......@@ -57,7 +57,7 @@ unsafeInterleaveST =
#ifdef __GLASGOW_HASKELL__
import GHC.ST ( ST, runST, fixST, unsafeInterleaveST )
import GHC.Base ( RealWorld )
import GHC.IOBase ( stToIO, unsafeIOToST, unsafeSTToIO )
import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO )
#endif
instance MonadFix (ST s) where
......
......@@ -134,13 +134,15 @@ module Control.OldException (
import GHC.Base
import GHC.Num
import GHC.Show
import GHC.IOBase ( IO )
import qualified GHC.IOBase as New
import GHC.IO ( IO )
import GHC.IO.Handle.FD ( stdout )
import qualified GHC.IO as New
import qualified GHC.IO.Exception as New
import GHC.Conc hiding (setUncaughtExceptionHandler,
getUncaughtExceptionHandler)
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import Foreign.C.String ( CString, withCString )
import GHC.Handle ( stdout, hFlush )
import GHC.IO.Handle ( hFlush )
#endif
#ifdef __HUGS__
......
......@@ -50,9 +50,9 @@ import GHC.Real ( fromIntegral )
import GHC.Show ( Show(..) )
import GHC.Int ( Int64 )
import GHC.IOBase ( IO, IOArray, newIOArray,
unsafeReadIOArray, unsafeWriteIOArray, unsafePerformIO,
IORef, newIORef, readIORef, writeIORef )
import GHC.IO
import GHC.IOArray
import GHC.IORef
#else
import Data.Char ( ord )
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
......
......@@ -35,7 +35,9 @@ import Hugs.IORef
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.STRef
import GHC.IOBase
import GHC.IO
import GHC.IORef hiding (atomicModifyIORef)
import qualified GHC.IORef
#if !defined(__PARALLEL_HASKELL__)
import GHC.Weak
#endif
......@@ -75,7 +77,7 @@ modifyIORef ref f = readIORef ref >>= writeIORef ref . f
--
atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
#if defined(__GLASGOW_HASKELL__)
atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s
atomicModifyIORef = GHC.IORef.atomicModifyIORef
#elif defined(__HUGS__)
atomicModifyIORef = plainModifyIORef -- Hugs has no preemption
......
......@@ -95,12 +95,14 @@ import GHC.Show (Show(..), ShowS,
import GHC.Err (undefined)
import GHC.Num (Integer, fromInteger, (+))
import GHC.Real ( rem, Ratio )
import GHC.IOBase (IORef,newIORef,unsafePerformIO)
import GHC.IORef (IORef,newIORef)
import GHC.IO (IO, unsafePerformIO,block)
-- These imports are so we can define Typeable instances
-- It'd be better to give Typeable instances in the modules themselves
-- but they all have to be compiled before Typeable
import GHC.IOBase ( IOArray, IO, MVar, Handle, block )
import GHC.IOArray
import GHC.MVar
import GHC.ST ( ST )
import GHC.STRef ( STRef )
import GHC.Ptr ( Ptr, FunPtr )
......@@ -488,7 +490,7 @@ INSTANCE_TYPEABLE2((->),funTc,"->")
INSTANCE_TYPEABLE1(IO,ioTc,"IO")
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
-- Types defined in GHC.IOBase
-- Types defined in GHC.MVar
INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
#endif
......@@ -538,7 +540,9 @@ INSTANCE_TYPEABLE0(Word,wordTc,"Word" )
#endif
INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
#ifndef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
#endif
INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
......
......@@ -108,7 +108,9 @@ import Foreign.Marshal.Error ( void )
import Data.Maybe
#if __GLASGOW_HASKELL__
import GHC.IOBase
import GHC.IO
import GHC.IO.Exception
import GHC.IO.Handle.Types
import GHC.Num
import GHC.Base
#elif __HUGS__
......
......@@ -99,7 +99,7 @@ import Data.Word
import GHC.List
import GHC.Real
import GHC.Num
import GHC.IOBase
import GHC.IO
import GHC.Base
#else
import Data.Char ( chr, ord )
......
......@@ -69,7 +69,7 @@ module Foreign.C.Types
#ifndef __NHC__
import {-# SOURCE #-} Foreign.Storable
import Foreign.Storable
import Data.Bits ( Bits(..) )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )
......
......@@ -28,7 +28,7 @@ module Foreign.Concurrent
) where
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( IO )
import GHC.IO ( IO )
import GHC.Ptr ( Ptr )
import GHC.ForeignPtr ( ForeignPtr )
import qualified GHC.ForeignPtr
......
......@@ -78,7 +78,7 @@ import Foreign.Storable ( Storable(sizeOf) )
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.IOBase
import GHC.IO
import GHC.Num
import GHC.Err ( undefined )
import GHC.ForeignPtr
......
......@@ -40,7 +40,8 @@ import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
#ifdef __GLASGOW_HASKELL__
import Foreign.ForeignPtr ( FinalizerPtr )
import GHC.IOBase
import GHC.IO
import GHC.IO.Exception
import GHC.Real
import GHC.Ptr
import GHC.Err
......
......@@ -68,7 +68,7 @@ import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes)
import Foreign.Marshal.Utils (copyBytes, moveBytes)
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase
import GHC.IO
import GHC.Num
import GHC.List
import GHC.Err
......
......@@ -37,7 +37,8 @@ import System.IO.Error
#endif
import GHC.Base
import GHC.Num
import GHC.IOBase
import GHC.IO
import GHC.IO.Exception
#endif
-- exported functions
......
......@@ -48,8 +48,8 @@ module Foreign.Marshal.Pool (
import GHC.Base ( Int, Monad(..), (.), not )
import GHC.Err ( undefined )
import GHC.Exception ( throw )
import GHC.IOBase ( IO, IORef, newIORef, readIORef, writeIORef,
block, unblock, catchAny )
import GHC.IO ( IO, block, unblock, catchAny )
import GHC.IORef ( IORef, newIORef, readIORef, writeIORef )
import GHC.List ( elem, length )
import GHC.Num ( Num(..) )
#else
......
......@@ -53,7 +53,7 @@ import Foreign.C.Types ( CSize )
import Foreign.Marshal.Alloc ( malloc, alloca )
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase
import GHC.IO
import GHC.Real ( fromIntegral )
import GHC.Num
import GHC.Base
......
......@@ -50,7 +50,7 @@ module Foreign.Ptr (
#ifdef __GLASGOW_HASKELL__
import GHC.Ptr
import GHC.IOBase
import GHC.IO
import GHC.Base
import GHC.Num
import GHC.Read
......
......@@ -47,7 +47,7 @@ import GHC.Int
import GHC.Word
import GHC.Ptr
import GHC.Err
import GHC.IOBase
import GHC.IO
import GHC.Base
#else
import Data.Int
......
{-# OPTIONS_GHC -XNoImplicitPrelude #-}
module Foreign.Storable where
import GHC.Base
import GHC.Int
import GHC.Word
class Storable a
instance Storable Int8
instance Storable Int16
instance Storable Int32
instance Storable Int64
instance Storable Word8
instance Storable Word16
instance Storable Word32
instance Storable Word64
instance Storable Float
instance Storable Double
......@@ -50,17 +50,6 @@ module GHC.Conc
, threadWaitRead -- :: Int -> IO ()
, threadWaitWrite -- :: Int -> IO ()
-- * MVars
, MVar(..)
, newMVar -- :: a -> IO (MVar a)
, newEmptyMVar -- :: IO (MVar a)
, takeMVar -- :: MVar a -> IO a
, putMVar -- :: MVar a -> a -> IO ()
, tryTakeMVar -- :: MVar a -> IO (Maybe a)
, tryPutMVar -- :: MVar a -> a -> IO Bool
, isEmptyMVar -- :: MVar a -> IO Bool
, addMVarFinalizer -- :: MVar a -> IO () -> IO ()
-- * TVars
, STM(..)
, atomically -- :: STM a -> IO a
......@@ -78,6 +67,7 @@ module GHC.Conc
, unsafeIOToSTM -- :: IO a -> STM a
-- * Miscellaneous
, withMVar
#ifdef mingw32_HOST_OS
, asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
, asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
......@@ -121,11 +111,17 @@ import Control.Monad
import Data.Maybe
import GHC.Base
import {-# SOURCE #-} GHC.Handle
import GHC.IOBase
import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
import GHC.IO
import GHC.IO.Exception
import GHC.Exception
import GHC.IORef
import GHC.MVar
import GHC.Num ( Num(..) )
import GHC.Real ( fromIntegral )
#ifndef mingw32_HOST_OS
import GHC.IOArray
import GHC.Arr ( inRange )
#endif
#ifdef mingw32_HOST_OS
......@@ -136,10 +132,8 @@ import GHC.Ptr ( plusPtr, FunPtr(..) )
import GHC.Read ( Read )
import GHC.Enum ( Enum )
#endif
import GHC.Exception ( SomeException(..), throw )
import GHC.Pack ( packCString# )
import GHC.Ptr ( Ptr(..) )
import GHC.STRef
import GHC.Show ( Show(..), showString )
import Data.Typeable
import GHC.Err
......@@ -599,111 +593,19 @@ writeTVar (TVar tvar#) val = STM $ \s1# ->
\end{code}
%************************************************************************
%* *
\subsection[mvars]{M-Structures}
%* *
%************************************************************************
M-Vars are rendezvous points for concurrent threads. They begin
empty, and any attempt to read an empty M-Var blocks. When an M-Var
is written, a single blocked thread may be freed. Reading an M-Var
toggles its state from full back to empty. Therefore, any value
written to an M-Var may only be read once. Multiple reads and writes
are allowed, but there must be at least one read between any two
writes.
MVar utilities
\begin{code}
--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
-- |Create an 'MVar' which is initially empty.
newEmptyMVar :: IO (MVar a)
newEmptyMVar = IO $ \ s# ->
case newMVar# s# of
(# s2#, svar# #) -> (# s2#, MVar svar# #)
-- |Create an 'MVar' which contains the supplied value.
newMVar :: a -> IO (MVar a)
newMVar value =
newEmptyMVar >>= \ mvar ->
putMVar mvar value >>
return mvar
-- |Return the contents of the 'MVar'. If the 'MVar' is currently
-- empty, 'takeMVar' will wait until it is full. After a 'takeMVar',
-- the 'MVar' is left empty.
--
-- There are two further important properties of 'takeMVar':
--
-- * 'takeMVar' is single-wakeup. That is, if there are multiple
-- threads blocked in 'takeMVar', and the 'MVar' becomes full,
-- only one thread will be woken up. The runtime guarantees that
-- the woken thread completes its 'takeMVar' operation.
--
-- * When multiple threads are blocked on an 'MVar', they are
-- woken up in FIFO order. This is useful for providing
-- fairness properties of abstractions built using 'MVar's.
--
takeMVar :: MVar a -> IO a
takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
-- |Put a value into an 'MVar'. If the 'MVar' is currently full,
-- 'putMVar' will wait until it becomes empty.
--
-- There are two further important properties of 'putMVar':
--
-- * 'putMVar' is single-wakeup. That is, if there are multiple
-- threads blocked in 'putMVar', and the 'MVar' becomes empty,
-- only one thread will be woken up. The runtime guarantees that
-- the woken thread completes its 'putMVar' operation.
--
-- * When multiple threads are blocked on an 'MVar', they are
-- woken up in FIFO order. This is useful for providing
-- fairness properties of abstractions built using 'MVar's.
--
putMVar :: MVar a -> a -> IO ()
putMVar (MVar mvar#) x = IO $ \ s# ->
case putMVar# mvar# x s# of
s2# -> (# s2#, () #)
-- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function
-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
-- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar',
-- the 'MVar' is left empty.
tryTakeMVar :: MVar a -> IO (Maybe a)
tryTakeMVar (MVar m) = IO $ \ s ->
case tryTakeMVar# m s of
(# s', 0#, _ #) -> (# s', Nothing #) -- MVar is empty
(# s', _, a #) -> (# s', Just a #) -- MVar is full
-- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function
-- attempts to put the value @a@ into the 'MVar', returning 'True' if
-- it was successful, or 'False' otherwise.
tryPutMVar :: MVar a -> a -> IO Bool
tryPutMVar (MVar mvar#) x = IO $ \ s# ->
case tryPutMVar# mvar# x s# of
(# s, 0# #) -> (# s, False #)
(# s, _ #) -> (# s, True #)
-- |Check whether a given 'MVar' is empty.
--
-- Notice that the boolean value returned is just a snapshot of
-- the state of the MVar. By the time you get to react on its result,
-- the MVar may have been filled (or emptied) - so be extremely
-- careful when using this operation. Use 'tryTakeMVar' instead if possible.
isEmptyMVar :: MVar a -> IO Bool
isEmptyMVar (MVar mv#) = IO $ \ s# ->
case isEmptyMVar# mv# s# of
(# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
-- |Add a finalizer to an 'MVar' (GHC only). See "Foreign.ForeignPtr" and
-- "System.Mem.Weak" for more about finalizers.
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer (MVar m) finalizer =
IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar m io =
block $ do
a <- takeMVar m
b <- catchAny (unblock (io a))
(\e -> do putMVar m a; throw e)
putMVar m a
return b
\end{code}
%************************************************************************
%* *
\subsection{Thread waiting}
......@@ -898,10 +800,6 @@ delayTime (DelaySTM t _) = t
type USecs = Word64
-- XXX: move into GHC.IOBase from Data.IORef?
atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s
foreign import ccall unsafe "getUSecOfDay"
getUSecOfDay :: IO USecs
......@@ -1408,14 +1306,4 @@ setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
getUncaughtExceptionHandler :: IO (SomeException -> IO ())
getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar m io =
block $ do
a <- takeMVar m
b <- catchAny (unblock (io a))
(\e -> do putMVar m a; throw e)
putMVar m a
return b
\end{code}
......@@ -34,10 +34,13 @@ import Prelude -- necessary to get dependencies right
import Foreign
import Foreign.C
import GHC.IOBase
import GHC.IO.FD
import GHC.IO.Exception
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import GHC.Conc
import GHC.Handle
import Control.Exception (onException)
import Control.Concurrent.MVar
import Data.Typeable
data Handler
= Default
......@@ -134,19 +137,16 @@ foreign import ccall unsafe "RtsExternal.h rts_ConsoleHandlerDone"
flushConsole :: Handle -> IO ()
flushConsole h =
wantReadableHandle "flushConsole" h $ \ h_ ->
throwErrnoIfMinus1Retry_ "flushConsole"
(flush_console_fd (fromIntegral (haFD h_)))
wantReadableHandle_ "flushConsole" h $ \ Handle__{haDevice=dev} ->
case cast dev of
Nothing -> ioException $
IOError (Just h) IllegalOperation "flushConsole"
"handle is not a file descriptor" Nothing Nothing
Just fd -> do
throwErrnoIfMinus1Retry_ "flushConsole" $
flush_console_fd (fromIntegral (fdFD fd))
foreign import ccall unsafe "consUtils.h flush_input_console__"
flush_console_fd :: CInt -> IO CInt
-- XXX Copied from Control.Concurrent.MVar
modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
modifyMVar m io =
block $ do
a <- takeMVar m
(a',b) <- unblock (io a) `onException` putMVar m a
putMVar m a'
return b
#endif /* mingw32_HOST_OS */
......@@ -42,7 +42,8 @@ import Data.Typeable
import GHC.Show
import GHC.List ( null )
import GHC.Base
import GHC.IOBase
import GHC.IO
import GHC.IORef
import GHC.STRef ( STRef(..) )
import GHC.Ptr ( Ptr(..), FunPtr(..) )
import GHC.Err
......
This diff is collapsed.
This diff is collapsed.
{-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.Buffer
-- Copyright : (c) The University of Glasgow 2008
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- Buffers used in the IO system
--
-----------------------------------------------------------------------------
module GHC.IO.Buffer (
-- * Buffers of any element
Buffer(..), BufferState(..), CharBuffer, CharBufElem,
-- ** Creation
newByteBuffer,
newCharBuffer,
newBuffer,
emptyBuffer,
-- ** Insertion/removal
bufferRemove,
bufferAdd,
slideContents,
bufferAdjustL,
-- ** Inspecting
isEmptyBuffer,
isFullBuffer,
isFullCharBuffer,
isWriteBuffer,
bufferElems,
bufferAvailable,
summaryBuffer,
-- ** Operating on the raw buffer as a Ptr
withBuffer,
withRawBuffer,
-- ** Assertions
checkBuffer,
-- * Raw buffers
RawBuffer,
readWord8Buf,