COMMENT:-----------------------

Compile me with
        ghc -c -O IOSupport.lhs
-------------------------------

> module IOSupport      (  done,
>                          newLine, putLine,
>                          getLine, readIO, readLine,
>                          fixIO,
>                          Ref(..), newRef, readRef, writeRef  )
> where

> import PreludeGlaST
> import LibPosix

> done                  :: IO ()
> done                  =  return ()

> newLine               :: IO ()
> newLine               =  putChar '\n'

> putLine               :: String -> IO ()
> putLine s             =  putStr s                             >>
>                          newLine

> getLine               :: IO String
> getLine               =  getChar                              >>= \ c ->
>                          if c=='\n' then return "" else
>                              getLine                          >>= \ s ->
>                              return (c:s)

> readIO                :: Text a => String -> IO a
> readIO s              =  case [ x | (x, t) <- reads s, ("", "") <- lex t ] of
>                          [x] -> return x
>                          []  -> fail "no parse"
>                          _   -> fail "ambiguous parse"

> readLine              :: Text a => IO a
> readLine              =  getLine                              >>= \ l ->
>                          readIO l

> fixIO                 :: (val -> IO val) -> IO val
> fixIO f               =  fixPrimIO (\(~(Right val)) -> f val)

> type Ref a            =  MutableVar _RealWorld a

> newRef                :: a -> IO (Ref a)
> newRef a              =  newVar a                     `thenPrimIO` \v ->
>                          returnPrimIO (Right v)

> readRef               :: Ref a -> IO a
> readRef v             =  readVar v                    `thenPrimIO` \a ->
>                          returnPrimIO (Right a)

> writeRef              :: Ref a -> a -> IO ()
> writeRef v a          =  writeVar v a                 `seqPrimIO`
>                          returnPrimIO (Right ())