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         , mkWeakIORef
  27
  28         , IOArray       -- instance of: Eq
  29         , newIOArray
  30         , boundsIOArray
  31         , readIOArray
  32         , writeIOArray
  33         , freezeIOArray
  34         , thawIOArray
  35 #ifndef __HUGS__
  36         , unsafeFreezeIOArray
  37         , unsafeThawIOArray
  38 #endif
  39
  40 #ifdef __HUGS__
  41 #else
  42         , openFileEx
  43         , IOModeEx(..)
  44
  45         , hSetEcho
  46         , hGetEcho
  47         , hIsTerminalDevice
  48         , hConnectTo
  49         , withHandleFor
  50         , withStdout
  51         , withStdin
  52         , withStderr
  53 #endif
  54         , trace
  55 #ifdef __HUGS__
  56 #else
  57         , performGC
  58 #endif
  59
  60         , unsafePtrEq
  61
  62         , freeHaskellFunctionPtr
  63
  64         ) where
  65
  66 \end{code}
  67
  68 \begin{code}
  69 #ifdef __HUGS__
  70 import PreludeBuiltin
  71 import ST
  72 #else
  73 import PrelBase
  74 import PrelIOBase
  75 import IO
  76 import PrelHandle ( openFileEx, IOModeEx(..),
  77                     hSetEcho, hGetEcho, getHandleFd
  78                   )
  79 import PrelST
  80 import PrelArr
  81 import PrelWeak
  82 import PrelGHC
  83 import PrelHandle
  84 import PrelErr
  85 import IO       ( hPutStr, hPutChar )
  86 import PrelAddr ( Addr )
  87 #endif
  88 import Ix
  89
  90 unsafePtrEq :: a -> a -> Bool
  91
  92 #ifdef __HUGS__
  93 unsafePtrEq = primReallyUnsafePtrEquality
  94 #else
  95 unsafePtrEq a b =
  96     case reallyUnsafePtrEquality# a b of
  97          0# -> False
  98          _  -> True
  99 #endif
 100 \end{code}
 101
 102 \begin{code}
 103 newIORef   :: a -> IO (IORef a)
 104 readIORef  :: IORef a -> IO a
 105 writeIORef :: IORef a -> a -> IO ()
 106
 107 #ifdef __HUGS__
 108 type IORef a = STRef RealWorld a
 109 newIORef   = newSTRef
 110 readIORef  = readSTRef
 111 writeIORef = writeSTRef
 112 #else
 113 newtype IORef a = IORef (MutableVar RealWorld a)
 114     deriving Eq
 115
 116 newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
 117 readIORef  (IORef var) = stToIO (readVar var)
 118 writeIORef (IORef var) v = stToIO (writeVar var v)
 119 #endif
 120
 121 mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
 122 mkWeakIORef r@(IORef (MutableVar r#)) f = IO $ \s ->
 123   case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
 124 \end{code}
 125
 126 \begin{code}
 127 newIOArray          :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt)
 128 boundsIOArray       :: Ix ix => IOArray ix elt -> (ix, ix)
 129 readIOArray         :: Ix ix => IOArray ix elt -> ix -> IO elt
 130 writeIOArray        :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
 131 freezeIOArray       :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 132 thawIOArray         :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 133 #ifndef __HUGS__
 134 unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 135 unsafeThawIOArray   :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 136 #endif
 137
 138 #ifdef __HUGS__
 139 type IOArray ix elt = STArray RealWorld ix elt
 140 newIOArray    = newSTArray
 141 boundsIOArray = boundsSTArray
 142 readIOArray   = readSTArray
 143 writeIOArray  = writeSTArray
 144 freezeIOArray = freezeSTArray
 145 thawIOArray   = thawSTArray
 146 #else
 147 newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
 148     deriving Eq
 149
 150 newIOArray ixs elt =
 151     stToIO (newArray ixs elt) >>= \arr ->
 152     return (IOArray arr)
 153
 154 boundsIOArray (IOArray arr) = boundsOfArray arr
 155
 156 readIOArray (IOArray arr) ix = stToIO (readArray arr ix)
 157
 158 writeIOArray (IOArray arr) ix elt = stToIO (writeArray arr ix elt)
 159
 160 freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
 161
 162 thawIOArray arr = do
 163         marr <- stToIO (thawArray arr)
 164         return (IOArray marr)
 165
 166 unsafeFreezeIOArray (IOArray arr) = stToIO (unsafeFreezeArray arr)
 167 unsafeThawIOArray   arr = do
 168         marr <- stToIO (unsafeThawArray arr)
 169         return (IOArray marr)
 170 #endif
 171 \end{code}
 172
 173 \begin{code}
 174 {-# NOINLINE trace #-}
 175 trace :: String -> a -> a
 176 #ifdef __HUGS__
 177 trace string expr = unsafePerformIO $ do
 178     putStrLn string
 179     return expr
 180 #else
 181 trace string expr = unsafePerformIO $ do
 182     fd <- getHandleFd stderr
 183     hPutStr stderr string
 184     hPutChar stderr '\n'
 185     _ccall_ PostTraceHook fd
 186     return expr
 187 #endif
 188 \end{code}
 189
 190 Not something you want to call normally, but useful
 191 in the cases where you do want to flush stuff out of
 192 the heap or make sure you've got room enough
 193
 194 \begin{code}
 195 #ifdef __HUGS__
 196 #else
 197 performGC :: IO ()
 198 performGC = _ccall_GC_ performGC
 199 #endif
 200 \end{code}
 201
 202 When using 'foreign export dynamic' to dress up a Haskell
 203 IO action to look like a C function pointer, a little bit
 204 of memory is allocated (along with a stable pointer to
 205 the Haskell IO action). When done with the C function
 206 pointer, you'll need to call @freeHaskellFunctionPtr()@ to
 207 let go of these resources - here's the Haskell wrapper for
 208 that RTS entry point, should you want to free it from
 209 within Haskell.
 210
 211 \begin{code}
 212 foreign import ccall "freeHaskellFunctionPtr"
 213   freeHaskellFunctionPtr :: Addr -> IO ()
 214
 215 \end{code}
 216
 217 (Experimental)
 218
 219 Support for redirecting I/O on a handle to another for the
 220 duration of an IO action. To re-route a handle, it is first
 221 flushed, followed by replacing its innards (i.e., FILE_OBJECT)
 222 with that of the other. This happens before and after the
 223 action is executed.
 224
 225 If the action raises an exception, the handle is replaced back
 226 to its old contents, but without flushing it first - as this
 227 may provoke exceptions. Notice that the action may perform
 228 I/O on either Handle, with the result that the I/O is interleaved.
 229 (Why you would want to do this, is a completely different matter.)
 230
 231 ToDo: probably want to restrict what kind of handles can be
 232 replaced with another - i.e., don't want to be able to replace
 233 a writeable handle with a readable one.
 234
 235 \begin{code}
 236 withHandleFor :: Handle
 237               -> Handle
 238               -> IO a
 239               -> IO a
 240 withHandleFor h1 h2 act = do
 241    h1_fo <- getFO h1
 242    plugIn h1_fo
 243  where
 244   plugIn h1_fo = do
 245     hFlush h2
 246     h2_fo <- withHandle h2 $ \ h2_ -> return (h2_{haFO__=h1_fo}, haFO__ h2_)
 247     catch (act >>= \ x -> hFlush h2 >> setFO h2 h2_fo >> return x)
 248           (\ err -> setFO h2 h2_fo >> ioError err)
 249
 250   setFO h fo =
 251     withHandle h $ \ h_ -> return (h_{haFO__=fo}, ())
 252
 253   getFO h =
 254     wantRWHandle "withHandleFor" h $ \ h_ ->
 255     return (haFO__ h_)
 256
 257 \end{code}
 258
 259 Derived @withHandleFor@ combinators and, at the moment, these
 260 are exported from @IOExts@ and not @withHandleFor@ itself.
 261
 262 \begin{code}
 263 withStdin  h a = withHandleFor h stdin  a
 264 withStdout h a = withHandleFor h stdout a
 265 withStderr h a = withHandleFor h stderr a
 266 \end{code}