ghc/lib/exts/IOExts.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4 \section[IOExts]{Module @IOExts@}
   5
   6 @IOExts@ provides useful functionality that fall outside the
   7 standard Haskell IO interface. Expect the contents of IOExts
   8 to be the same for Hugs and GHC (same goes for any other
   9 Hugs/GHC extension libraries, unless a function/type is
  10 explicitly flagged as being implementation specific
  11 extension.)
  12
  13 \begin{code}
  14 {-# OPTIONS -fno-implicit-prelude #-}
  15
  16 module IOExts
  17         ( fixIO
  18         , unsafePerformIO
  19         , unsafeInterleaveIO
  20
  21         , IORef             -- instance of: Eq
  22         , newIORef
  23         , readIORef
  24         , writeIORef
  25
  26         , IOArray       -- instance of: Eq
  27         , newIOArray
  28         , boundsIOArray
  29         , readIOArray
  30         , writeIOArray
  31         , freezeIOArray
  32
  33         , openFileEx
  34         , IOModeEx(..)
  35
  36         , hSetEcho
  37         , hGetEcho
  38         , hIsTerminalDevice
  39         , hConnectTo
  40
  41         , trace
  42         , performGC
  43
  44         , reallyUnsafePtrEq
  45         , unsafeIOToST
  46
  47         ) where
  48
  49 \end{code}
  50
  51 \begin{code}
  52 import PrelBase
  53 import PrelIOBase
  54 import PrelHandle ( openFileEx, IOModeEx(..),
  55                     hSetEcho, hGetEcho, getHandleFd
  56                   )
  57 import PrelST
  58 import PrelArr
  59 import PrelGHC
  60 import Ix
  61 import IO
  62 import PrelHandle
  63 import PrelErr
  64
  65 reallyUnsafePtrEq :: a -> a -> Bool
  66 reallyUnsafePtrEq a b =
  67     case reallyUnsafePtrEquality# a b of
  68          0# -> False
  69          _  -> True
  70 \end{code}
  71
  72 \begin{code}
  73 newtype IORef a = IORef (MutableVar RealWorld a)
  74     deriving Eq
  75
  76 newIORef :: a -> IO (IORef a)
  77 newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
  78
  79 readIORef :: IORef a -> IO a
  80 readIORef (IORef var) = stToIO (readVar var)
  81
  82 writeIORef :: IORef a -> a -> IO ()
  83 writeIORef (IORef var) v = stToIO (writeVar var v)
  84 \end{code}
  85
  86 \begin{code}
  87 newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
  88     deriving Eq
  89
  90 newIOArray          :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt)
  91 boundsIOArray       :: Ix ix => IOArray ix elt -> (ix, ix)
  92 readIOArray         :: Ix ix => IOArray ix elt -> ix -> IO elt
  93 writeIOArray        :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
  94 freezeIOArray       :: Ix ix => IOArray ix elt -> IO (Array ix elt)
  95
  96 newIOArray ixs elt =
  97     stToIO (newArray ixs elt) >>= \arr ->
  98     return (IOArray arr)
  99
 100 boundsIOArray (IOArray arr) = boundsOfArray arr
 101
 102 readIOArray (IOArray arr) ix = stToIO (readArray arr ix)
 103
 104 writeIOArray (IOArray arr) ix elt = stToIO (writeArray arr ix elt)
 105
 106 freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
 107 \end{code}
 108
 109 \begin{code}
 110 {-# NOINLINE trace #-}
 111 trace :: String -> a -> a
 112 trace string expr = unsafePerformIO $ do
 113     fd <- getHandleFd stderr
 114     hPutStrLn stderr string
 115     _ccall_ PostTraceHook fd
 116     return expr
 117
 118 \end{code}
 119
 120 \begin{code}
 121 unsafeIOToST       :: IO a -> ST s a
 122 unsafeIOToST (IO io) = ST $ \ s ->
 123     case ((unsafeCoerce# io) s) of
 124       IOok   new_s a -> unsafeCoerce# (STret new_s a)
 125       IOfail new_s e -> error ("I/O Error (unsafeIOToST): " ++ showsPrec 0 e "\n")
 126 \end{code}
 127
 128 Not something you want to call normally, but useful
 129 in the cases where you do want to flush stuff out of
 130 the heap or make sure you've got room enough
 131
 132 \begin{code}
 133 performGC :: IO ()
 134 performGC = _ccall_GC_ StgPerformGarbageCollection
 135 \end{code}