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