ghc/lib/glaExts/Stdio.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1994
   3 %
   4 \section[Stdio]{Wrappers for C standard-IO library}
   5
   6 \begin{code}
   7 module Stdio where
   8
   9 import Cls
  10 import Core
  11 import IInt
  12 import IList
  13 import List             ( (++), foldr )
  14 import PS               -- ( _PackedString )
  15 import TyArray
  16 import PreludeGlaST
  17 import Text
  18
  19 data _FILE = _FILE Addr#
  20 instance _CCallable   _FILE
  21 instance _CReturnable _FILE
  22
  23 instance Eq _FILE where
  24     (_FILE a) == (_FILE b) = a `eqAddr#` b
  25     (_FILE a) /= (_FILE b) = if a `eqAddr#` b then False else True
  26
  27 type FILE_DESCRIPTOR = Int
  28
  29 fopen   :: String               -- as w/ C fopen, name
  30         -> String               -- type of open (as w/ C)
  31         -> PrimIO _FILE         -- FILE* returned; will be ``NULL''
  32                                 -- if things go wrong...
  33
  34 -- similarly...
  35 freopen :: String -> String -> _FILE -> PrimIO _FILE
  36 fdopen  :: FILE_DESCRIPTOR -> String -> PrimIO _FILE
  37
  38 fopen name descr
  39   = _casm_ ``%r = (A_) fopen((char *) %0, (char *) %1);'' name descr
  40
  41 freopen name descr file
  42   = _casm_ ``%r = (A_) freopen((char *) %0, (char *) %1, (FILE *) %2);''
  43         name descr file
  44
  45 fdopen fd descr
  46   = _casm_ ``%r = (A_) fdopen((int) %0, (char *) %1);'' fd descr
  47
  48 ---------------------------------------------------------------
  49 fclose, fflush :: _FILE -> PrimIO Int
  50
  51 fclose file
  52   = _casm_ ``%r = fclose((FILE *) %0);'' file
  53
  54 fflush file
  55   = _casm_ ``%r = fflush((FILE *) %0);'' file
  56
  57 fread :: Int -> Int -> _FILE -> PrimIO (Int, _ByteArray Int)
  58
  59 fread size nitems file
  60   = let
  61         barr_end = size * nitems - 1
  62     in
  63     newCharArray (0::Int, barr_end){-malloc!?-} `thenStrictlyST` \ barr ->
  64
  65     _ccall_ fread barr size nitems file `thenPrimIO` \ num_read ->
  66
  67     unsafeFreezeByteArray barr  `thenStrictlyST` \ frozen ->
  68
  69     returnPrimIO (num_read, frozen)
  70
  71 fwrite :: _ByteArray Int -> Int -> Int -> _FILE -> PrimIO Int
  72
  73 fwrite barr size nitems file
  74   = _ccall_ fwrite barr size nitems file `thenPrimIO` \ num_written ->
  75     returnPrimIO num_written
  76
  77 --fgetc :: _FILE -> B Char
  78 --fputc :: Char -> _FILE -> B Char
  79
  80 -- ===============================================================
  81 {- LATER
  82
  83 -- in Haskell, these are just synonyms for getc and putc
  84
  85 gets    :: B [Char]
  86 fgets   :: C_FILE -> Int -> B [Char]
  87 puts    :: [Char] -> B Bool     -- ??? ToDo: better error indicator
  88 fputs   :: [Char] -> C_FILE -> B Bool
  89
  90 -- getw, putw omitted
  91
  92 feof    :: C_FILE -> B Int -- ToDo: Bool?
  93 ferror  :: C_FILE -> B Int -- ToDo: something else?
  94 fileno  :: C_FILE -> B Int
  95 clearerr :: C_FILE -> B ()
  96
  97 popen   :: [Char] -> [Char] -> B C_FILE
  98 pclose  :: C_FILE -> B Int -- exit status
  99
 100 tmpfile :: B C_FILE     -- B (Maybe C_FILE) ???
 101 tmpnam  :: [Char] -> B [Char]
 102 tempnam :: [Char] -> [Char] -> B [Char]
 103
 104 lseek   :: C_FileDes -> C_off_t -> Int -> B C_off_t
 105
 106 ctermid :: B [Char]
 107 cuserid :: B [Char]
 108
 109 -- nothing yet:
 110 --  printf
 111 --  fprintf
 112 --  sprintf
 113 --  scanf
 114 --  fscanf
 115 -}
 116 \end{code}