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