[project @ 2003-07-21 16:50:20 by simonmar]
[haskell-directory.git] / GHC / IOBase.lhs
index 54ec69f..cbad7db 100644 (file)
@@ -123,7 +123,7 @@ ioToST (IO m) = (ST m)
 -- Unsafe IO operations
 
 {-|
-This is the "back door" into the 'IO' monad, allowing
+This is the \"back door\" into the 'IO' monad, allowing
 'IO' computation to be performed at any time.  For
 this to be safe, the 'IO' computation should be
 free of side effects and independent of its environment.
@@ -222,9 +222,12 @@ instance Eq (MVar a) where
 
 data Handle 
   = FileHandle                         -- A normal handle to a file
+       FilePath                        -- the file (invariant)
        !(MVar Handle__)
 
   | DuplexHandle                       -- A handle to a read/write stream
+       FilePath                        -- file for a FIFO, otherwise some
+                                       --   descriptive string.
        !(MVar Handle__)                -- The read side
        !(MVar Handle__)                -- The write side
 
@@ -233,8 +236,8 @@ data Handle
 --      seekable.
 
 instance Eq Handle where
- (FileHandle h1)     == (FileHandle h2)     = h1 == h2
- (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
+ (FileHandle _ h1)     == (FileHandle _ h2)     = h1 == h2
+ (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2
  _ == _ = False 
 
 type FD = Int -- XXX ToDo: should be CInt
@@ -246,7 +249,6 @@ data Handle__
       haIsBin       :: Bool,                -- binary mode?
       haIsStream    :: Bool,                -- is this a stream handle?
       haBufferMode  :: BufferMode,          -- buffer contains read/write data?
-      haFilePath    :: FilePath,            -- file name, possibly
       haBuffer     :: !(IORef Buffer),      -- the current buffer
       haBuffers     :: !(IORef BufferList),  -- spare buffers
       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
@@ -391,7 +393,11 @@ data BufferMode
 -- IORefs
 
 -- |A mutable variable in the 'IO' monad
-newtype IORef a = IORef (STRef RealWorld a) deriving Eq
+newtype IORef a = IORef (STRef RealWorld a)
+
+-- explicit instance because Haddock can't figure out a derived one
+instance Eq (IORef a) where
+  IORef x == IORef y = x == y
 
 -- |Build a new 'IORef'
 newIORef    :: a -> IO (IORef a)
@@ -406,6 +412,46 @@ writeIORef  :: IORef a -> a -> IO ()
 writeIORef (IORef var) v = stToIO (writeSTRef var v)
 
 -- ---------------------------------------------------------------------------
+-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad.  
+-- The type arguments are as follows:
+--
+--  * @i@: the index type of the array (should be an instance of 'Ix')
+--
+--  * @e@: the element type of the array.
+--
+-- 
+
+newtype IOArray i e = IOArray (STArray RealWorld i e)
+
+-- explicit instance because Haddock can't figure out a derived one
+instance Eq (IOArray i e) where
+  IOArray x == IOArray y = x == y
+
+-- |Build a new 'IOArray'
+newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)
+{-# INLINE newIOArray #-}
+newIOArray lu init  = stToIO $ do {marr <- newSTArray lu init; return (IOArray marr)}
+
+-- | Read a value from an 'IOArray'
+unsafeReadIOArray  :: Ix i => IOArray i e -> Int -> IO e
+{-# INLINE unsafeReadIOArray #-}
+unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)
+
+-- | Write a new value into an 'IOArray'
+unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO ()
+{-# INLINE unsafeWriteIOArray #-}
+unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)
+
+-- | Read a value from an 'IOArray'
+readIOArray  :: Ix i => IOArray i e -> i -> IO e
+readIOArray (IOArray marr) i = stToIO (readSTArray marr i)
+
+-- | Write a new value into an 'IOArray'
+writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()
+writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)
+
+
+-- ---------------------------------------------------------------------------
 -- Show instance for Handles
 
 -- handle types are 'show'n when printing error msgs, so
@@ -423,46 +469,10 @@ instance Show HandleType where
       ReadWriteHandle   -> showString "read-writable"
 
 instance Show Handle where 
-  showsPrec p (FileHandle   h)   = showHandle p h False
-  showsPrec p (DuplexHandle _ h) = showHandle p h True
-   
-showHandle p h duplex =
-    let
-     -- (Big) SIGH: unfolded defn of takeMVar to avoid
-     -- an (oh-so) unfortunate module loop with GHC.Conc.
-     hdl_ = unsafePerformIO (IO $ \ s# ->
-            case h                 of { MVar h# ->
-            case takeMVar# h# s#   of { (# s2# , r #) -> 
-            case putMVar# h# r s2# of { s3# ->
-            (# s3#, r #) }}})
-
-     showType | duplex = showString "duplex (read-write)"
-             | otherwise = showsPrec p (haType hdl_)
-    in
-    showChar '{' . 
-    showHdl (haType hdl_) 
-           (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
-            showString "type=" . showType . showChar ',' .
-            showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
-            showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
-   where
-
-    showHdl :: HandleType -> ShowS -> ShowS
-    showHdl ht cont = 
-       case ht of
-        ClosedHandle  -> showsPrec p ht . showString "}"
-       _ -> cont
-       
-    showBufMode :: Buffer -> BufferMode -> ShowS
-    showBufMode buf bmo =
-      case bmo of
-        NoBuffering   -> showString "none"
-       LineBuffering -> showString "line"
-       BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
-       BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
-      where
-       def :: Int 
-       def = bufSize buf
+  showsPrec p (FileHandle   file _)   = showHandle file
+  showsPrec p (DuplexHandle file _ _) = showHandle file
+
+showHandle file = showString "{handle: " . showString file . showString "}"
 
 -- ------------------------------------------------------------------------
 -- Exception datatype and operations
@@ -502,8 +512,8 @@ data Exception
        -- argument of 'ErrorCall' is the string passed to 'error' when it was
        -- called.
   | ExitException      ExitCode
-       -- ^The 'ExitException' exception is thrown by 'System.exitWith' (and
-       -- 'System.exitFailure').  The 'ExitCode' argument is the value passed 
+       -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and
+       -- 'System.Exit.exitFailure').  The 'ExitCode' argument is the value passed 
        -- to 'System.exitWith'.  An unhandled 'ExitException' exception in the
        -- main thread will cause the program to be terminated with the given 
        -- exit code.
@@ -689,11 +699,11 @@ throw exception = raise# exception
 -- raise an exception within the 'IO' monad because it guarantees
 -- ordering with respect to other 'IO' operations, whereas 'throw'
 -- does not.
-throwIO         :: Exception -> IO a 
-throwIO err    =  IO $ \s -> throw err s
+throwIO         :: Exception -> IO a
+throwIO err    =  IO $ raiseIO# err
 
 ioException    :: IOException -> IO a
-ioException err =  IO $ \s -> throw (IOException err) s
+ioException err =  IO $ raiseIO# (IOException err)
 
 ioError         :: IOError -> IO a 
 ioError                =  ioException
@@ -715,7 +725,7 @@ data IOException
                                     -- the error.
      ioe_type     :: IOErrorType,    -- what it was.
      ioe_location :: String,        -- location.
-     ioe_descr    :: String,         -- error type specific information.
+     ioe_description :: String,      -- error type specific information.
      ioe_filename :: Maybe FilePath  -- filename the error is related to.
    }
 
@@ -751,7 +761,7 @@ instance Eq IOErrorType where
    x == y = 
      case x of
        DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
-       _ -> getTag# x ==# getTag# y
+       _ -> getTag x ==# getTag y
  
 instance Show IOErrorType where
   showsPrec _ e =
@@ -786,19 +796,18 @@ userError str     =  IOError Nothing UserError "" str Nothing
 
 instance Show IOException where
     showsPrec p (IOError hdl iot loc s fn) =
-      showsPrec p iot .
+      (case fn of
+        Nothing -> case hdl of
+                       Nothing -> id
+                       Just h  -> showsPrec p h . showString ": "
+        Just name -> showString name . showString ": ") .
       (case loc of
          "" -> id
-        _  -> showString "\nAction: " . showString loc) .
-      (case hdl of
-        Nothing -> id
-       Just h  -> showString "\nHandle: " . showsPrec p h) .
+        _  -> showString loc . showString ": ") .
+      showsPrec p iot . 
       (case s of
         "" -> id
-        _  -> showString "\nReason: " . showString s) .
-      (case fn of
-        Nothing -> id
-        Just name -> showString "\nFile: " . showString name)
+        _  -> showString " (" . showString s . showString ")")
 
 -- -----------------------------------------------------------------------------
 -- IOMode type