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         ) where
  57
  58 \end{code}
  59
  60 \begin{code}
  61 #ifdef __HUGS__
  62 import PreludeBuiltin
  63 import ST
  64 #else
  65 import PrelBase
  66 import PrelIOBase
  67 import PrelHandle ( openFileEx, IOModeEx(..),
  68                     hSetEcho, hGetEcho, getHandleFd
  69                   )
  70 import PrelST
  71 import PrelArr
  72 import PrelGHC
  73 import PrelHandle
  74 import PrelErr
  75 import IO       ( hPutStr, hPutChar )
  76 #endif
  77 import Ix
  78
  79 unsafePtrEq :: a -> a -> Bool
  80
  81 #ifdef __HUGS__
  82 unsafePtrEq = primReallyUnsafePtrEquality
  83 #else
  84 unsafePtrEq a b =
  85     case reallyUnsafePtrEquality# a b of
  86          0# -> False
  87          _  -> True
  88 #endif
  89 \end{code}
  90
  91 \begin{code}
  92 newIORef   :: a -> IO (IORef a)
  93 readIORef  :: IORef a -> IO a
  94 writeIORef :: IORef a -> a -> IO ()
  95
  96 #ifdef __HUGS__
  97 type IORef a = STRef RealWorld a
  98 newIORef   = newSTRef
  99 readIORef  = readSTRef
 100 writeIORef = writeSTRef
 101 #else
 102 newtype IORef a = IORef (MutableVar RealWorld a)
 103     deriving Eq
 104
 105 newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
 106 readIORef  (IORef var) = stToIO (readVar var)
 107 writeIORef (IORef var) v = stToIO (writeVar var v)
 108 #endif
 109 \end{code}
 110
 111 \begin{code}
 112 newIOArray          :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt)
 113 boundsIOArray       :: Ix ix => IOArray ix elt -> (ix, ix)
 114 readIOArray         :: Ix ix => IOArray ix elt -> ix -> IO elt
 115 writeIOArray        :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
 116 freezeIOArray       :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 117 thawIOArray         :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 118 #ifndef __HUGS__
 119 unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 120 unsafeThawIOArray   :: Ix ix => Array ix elt -> IO (IOArray ix elt)
 121 #endif
 122
 123 #ifdef __HUGS__
 124 type IOArray ix elt = STArray RealWorld ix elt
 125 newIOArray    = newSTArray
 126 boundsIOArray = boundsSTArray
 127 readIOArray   = readSTArray
 128 writeIOArray  = writeSTArray
 129 freezeIOArray = freezeSTArray
 130 thawIOArray   = thawSTArray
 131 #else
 132 newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
 133     deriving Eq
 134
 135 newIOArray ixs elt =
 136     stToIO (newArray ixs elt) >>= \arr ->
 137     return (IOArray arr)
 138
 139 boundsIOArray (IOArray arr) = boundsOfArray arr
 140
 141 readIOArray (IOArray arr) ix = stToIO (readArray arr ix)
 142
 143 writeIOArray (IOArray arr) ix elt = stToIO (writeArray arr ix elt)
 144
 145 freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
 146
 147 thawIOArray arr = do
 148         marr <- stToIO (thawArray arr)
 149         return (IOArray marr)
 150
 151 unsafeFreezeIOArray (IOArray arr) = stToIO (unsafeFreezeArray arr)
 152 unsafeThawIOArray   arr = do
 153         marr <- stToIO (unsafeThawArray arr)
 154         return (IOArray marr)
 155 #endif
 156 \end{code}
 157
 158 \begin{code}
 159 {-# NOINLINE trace #-}
 160 trace :: String -> a -> a
 161 #ifdef __HUGS__
 162 trace string expr = unsafePerformIO $ do
 163     putStrLn string
 164     return expr
 165 #else
 166 trace string expr = unsafePerformIO $ do
 167     fd <- getHandleFd stderr
 168     hPutStr stderr string
 169     hPutChar stderr '\n'
 170     _ccall_ PostTraceHook fd
 171     return expr
 172 #endif
 173 \end{code}
 174
 175 Not something you want to call normally, but useful
 176 in the cases where you do want to flush stuff out of
 177 the heap or make sure you've got room enough
 178
 179 \begin{code}
 180 #ifdef __HUGS__
 181 #else
 182 performGC :: IO ()
 183 performGC = _ccall_GC_ performGC
 184 #endif
 185 \end{code}
 186