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 #endif
  50         , trace
  51 #ifdef __HUGS__
  52 #else
  53         , performGC
  54 #endif
  55
  56         , unsafePtrEq
  57
  58         , freeHaskellFunctionPtr
  59
  60         ) where
  61
  62 \end{code}
  63
  64 \begin{code}
  65 #ifdef __HUGS__
  66 import PreludeBuiltin
  67 import ST
  68 #else
  69 import PrelBase
  70 import PrelIOBase
  71 import PrelHandle ( openFileEx, IOModeEx(..),
  72                     hSetEcho, hGetEcho, getHandleFd
  73                   )
  74 import PrelST
  75 import PrelArr
  76 import PrelWeak
  77 import PrelGHC
  78 import PrelHandle
  79 import PrelErr
  80 import IO       ( hPutStr, hPutChar )
  81 import PrelAddr ( Addr )
  82 #endif
  83 import Ix
  84
  85 unsafePtrEq :: a -> a -> Bool
  86
  87 #ifdef __HUGS__
  88 unsafePtrEq = primReallyUnsafePtrEquality
  89 #else
  90 unsafePtrEq a b =
  91     case reallyUnsafePtrEquality# a b of
  92          0# -> False
  93          _  -> True
  94 #endif
  95 \end{code}
  96
  97 \begin{code}
  98 newIORef   :: a -> IO (IORef a)
  99 readIORef  :: IORef a -> IO a
 100 writeIORef :: IORef a -> a -> IO ()
 101
 102 #ifdef __HUGS__
 103 type IORef a = STRef RealWorld a
 104 newIORef   = newSTRef
 105 readIORef  = readSTRef
 106 writeIORef = writeSTRef
 107 #else
 108 newtype IORef a = IORef (MutableVar RealWorld a)
 109     deriving Eq
 110
 111 newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
 112 readIORef  (IORef var) = stToIO (readVar var)
 113 writeIORef (IORef var) v = stToIO (writeVar var v)
 114 #endif
 115
 116 mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
 117 mkWeakIORef r@(IORef (MutableVar r#)) f = IO $ \s ->
 118   case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
 119 \end{code}
 120
 121 \begin{code}
 122 newIOArray          :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt)
 123 boundsIOArray       :: Ix ix => IOArray ix elt -> (ix, ix)
 124 readIOArray         :: Ix ix => IOArray ix elt -> ix -> IO elt
 125 writeIOArray        :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
 126 freezeIOArray       :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 127 thawIOArray         :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 128 #ifndef __HUGS__
 129 unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 130 unsafeThawIOArray   :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 131 #endif
 132
 133 #ifdef __HUGS__
 134 type IOArray ix elt = STArray RealWorld ix elt
 135 newIOArray    = newSTArray
 136 boundsIOArray = boundsSTArray
 137 readIOArray   = readSTArray
 138 writeIOArray  = writeSTArray
 139 freezeIOArray = freezeSTArray
 140 thawIOArray   = thawSTArray
 141 #else
 142 newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
 143     deriving Eq
 144
 145 newIOArray ixs elt =
 146     stToIO (newArray ixs elt) >>= \arr ->
 147     return (IOArray arr)
 148
 149 boundsIOArray (IOArray arr) = boundsOfArray arr
 150
 151 readIOArray (IOArray arr) ix = stToIO (readArray arr ix)
 152
 153 writeIOArray (IOArray arr) ix elt = stToIO (writeArray arr ix elt)
 154
 155 freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
 156
 157 thawIOArray arr = do
 158         marr <- stToIO (thawArray arr)
 159         return (IOArray marr)
 160
 161 unsafeFreezeIOArray (IOArray arr) = stToIO (unsafeFreezeArray arr)
 162 unsafeThawIOArray   arr = do
 163         marr <- stToIO (unsafeThawArray arr)
 164         return (IOArray marr)
 165 #endif
 166 \end{code}
 167
 168 \begin{code}
 169 {-# NOINLINE trace #-}
 170 trace :: String -> a -> a
 171 #ifdef __HUGS__
 172 trace string expr = unsafePerformIO $ do
 173     putStrLn string
 174     return expr
 175 #else
 176 trace string expr = unsafePerformIO $ do
 177     fd <- getHandleFd stderr
 178     hPutStr stderr string
 179     hPutChar stderr '\n'
 180     _ccall_ PostTraceHook fd
 181     return expr
 182 #endif
 183 \end{code}
 184
 185 Not something you want to call normally, but useful
 186 in the cases where you do want to flush stuff out of
 187 the heap or make sure you've got room enough
 188
 189 \begin{code}
 190 #ifdef __HUGS__
 191 #else
 192 performGC :: IO ()
 193 performGC = _ccall_GC_ performGC
 194 #endif
 195 \end{code}
 196
 197 When using 'foreign export dynamic' to dress up a Haskell
 198 IO action to look like a C function pointer, a little bit
 199 of memory is allocated (along with a stable pointer to
 200 the Haskell IO action). When done with the C function
 201 pointer, you'll need to call @freeHaskellFunctionPtr()@ to
 202 let go of these resources - here's the Haskell wrapper for
 203 that RTS entry point, should you want to free it from
 204 within Haskell.
 205
 206 \begin{code}
 207 foreign import ccall "freeHaskellFunctionPtr"
 208   freeHaskellFunctionPtr :: Addr -> IO ()
 209
 210 \end{code}
 211