improve performance of Integer->String conversion

[haskell-directory.git] / GHC / IOBase.lhs

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 8700128..27f7dab 100644 (file)
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -1,5 +1,5 @@
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IOBase
@@ -14,21 +14,48 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.IOBase where
-
+-- #hide
+module GHC.IOBase(
+    IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO, 
+    unsafePerformIO, unsafeInterleaveIO,
+  
+       -- To and from from ST
+    stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
+
+       -- References
+    IORef(..), newIORef, readIORef, writeIORef, 
+    IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
+    MVar(..),
+
+       -- Handles, file descriptors,
+    FilePath,  
+    Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, 
+    isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,
+  
+       -- Buffers
+    Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
+    bufferIsWritable, bufferEmpty, bufferFull, 
+
+       -- Exceptions
+    Exception(..), ArithException(..), AsyncException(..), ArrayException(..),
+    stackOverflow, heapOverflow, throw, throwIO, ioException, 
+    IOError, IOException(..), IOErrorType(..), ioError, userError,
+    ExitCode(..) 
+  ) where
+       
 import GHC.ST
 import GHC.Arr -- to derive Ix class
 import GHC.Enum -- to derive Enum class
 import GHC.STRef
 import GHC.Base
-import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude
+--  import GHC.Num     -- To get fromInteger etc, needed because of -fno-implicit-prelude
 import Data.Maybe  ( Maybe(..) )
 import GHC.Show
 import GHC.List
 import GHC.Read
 
 #ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Dynamic
+import {-# SOURCE #-} GHC.Dynamic
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -128,6 +155,9 @@ ioToST (IO m) = (ST m)
 unsafeIOToST        :: IO a -> ST s a
 unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
 
+unsafeSTToIO :: ST s a -> IO a
+unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
+
 -- ---------------------------------------------------------------------------
 -- Unsafe IO operations
 
@@ -396,6 +426,9 @@ isWritableHandleType WriteHandle     = True
 isWritableHandleType ReadWriteHandle = True
 isWritableHandleType _              = False
 
+isReadWriteHandleType ReadWriteHandle{} = True
+isReadWriteHandleType _                 = False
+
 -- | File and directory names are values of type 'String', whose precise
 -- meaning is operating system dependent. Files can be opened, yielding a
 -- handle which can then be used to operate on the contents of that file.
@@ -568,6 +601,14 @@ data Exception
        -- ^The current thread was executing a call to
        -- 'Control.Concurrent.MVar.takeMVar' that could never return,
        -- because there are no other references to this 'MVar'.
+  | BlockedIndefinitely
+       -- ^The current thread was waiting to retry an atomic memory transaction
+       -- that could never become possible to complete because there are no other
+       -- threads referring to any of teh TVars involved.
+  | NestedAtomically
+       -- ^The runtime detected an attempt to nest one STM transaction
+       -- inside another one, presumably due to the use of 
+       -- 'unsafePeformIO' with 'atomically'.
   | Deadlock
        -- ^There are no runnable threads, so the program is
        -- deadlocked.  The 'Deadlock' exception is
@@ -702,9 +743,11 @@ instance Show Exception where
   showsPrec _ (RecConError err)                 = showString err
   showsPrec _ (RecUpdError err)                 = showString err
   showsPrec _ (AssertionFailed err)      = showString err
-  showsPrec _ (DynException _err)        = showString "unknown exception"
+  showsPrec _ (DynException err)         = showString "exception :: " . showsTypeRep (dynTypeRep err)
   showsPrec _ (AsyncException e)        = shows e
   showsPrec _ (BlockedOnDeadMVar)       = showString "thread blocked indefinitely"
+  showsPrec _ (BlockedIndefinitely)     = showString "thread blocked indefinitely"
+  showsPrec _ (NestedAtomically)        = showString "Control.Concurrent.STM.atomically was nested"
   showsPrec _ (NonTermination)           = showString "<<loop>>"
   showsPrec _ (Deadlock)                 = showString "<<deadlock>>"
 
@@ -724,6 +767,7 @@ instance Eq Exception where
   AsyncException e1   == AsyncException e2   = e1 == e2
   BlockedOnDeadMVar   == BlockedOnDeadMVar   = True
   NonTermination      == NonTermination      = True
+  NestedAtomically    == NestedAtomically    = True
   Deadlock            == Deadlock            = True
   _                   == _                   = False