source: to-imperative/trunk/library/StdIO/refal/StdIO.rf @ 2027

// $Id: StdIO.rf 2027 2006-07-17 17:40:42Z orlov $

$use Arithm Box Class Compare Convert Error Table;

//X/$use Lexer(Stream FakeStreamIndex);
$use "../../Lexer/refal/Lexer";
$use "../../Stream/refal/Stream";
$use "../../Stream/refal/StreamErr";


$table Buffers;
/*
 * For the moment the format is:
 *   s.channel  -->  stream
 */


Open-File s.channel e.file s.mode, \{
  # <Channel? s.channel> =
    <Lib-Error (StdIO Open-File) "Arg 1 is not a Channel">;
  # <Word? s.mode> =
    <Lib-Error (StdIO Open-File) "Arg 3 is not a Word">;
  <Prim-Open-File s.channel e.file s.mode>,
    <Bind &Buffers (s.channel) (<Stream &Prim-Read s.channel &Read-Chunk-Size>)>;
};

/*
 * FIXME:
 * Should open &StdIn, &StdOut, and &StdErr like this:
 *   <Bind &Buffers (&StdIn) (<Stream &Prim-Read &StdIn 1>)>;
 */


//FIXME: probably shouldn't close &StdIn, &StdOut, and &StdErr?
Close-Channel s.channel, {
  # <Channel? s.channel> =
    <Lib-Error (StdIO Close-Channel) "Arg 1 is not a Channel">;
  <Prim-Close-Channel s.channel>,
    <Unbind &Buffers s.channel>;
};


EOF? s.channel, {
  <Lookup &Buffers s.channel> : stream =
    <End-of-Stream? stream>;
  <Lib-Error (StdIO EOF?) "Channel is not open">;
};


Read-Char! s.channel, {
  <Lookup &Buffers s.channel> : stream =
    <Getc stream> : s.char, s.char;
  <Lib-Error (StdIO Read-Char!) "Channel is not open"> = $fail;
};

Read-Char = <Read-Char! &StdIn>;


Read-Line! s.channel, {
  <Lookup &Buffers s.channel> : stream =
    <Get-Line stream> : \{
      e.line '\r\n' = e.line;
      e.line '\n'   = e.line;
      e.line '\r'   = e.line;
      v.line        = v.line;
    };
  <Lib-Error (StdIO Read-Line!) "Channel is not open"> = $fail;
};

Read-Line = <Read-Line! &StdIn>;


$func? Read-Main s.fname s.channel = term;

Read! s.channel = <Read-Main Read! s.channel>;

Read = <Read-Main Read &StdIn>;

Read-Main s.fname s.channel, {
  <Lookup &Buffers s.channel> : stream =
    {
      <Read-Term? stream>;
      /*empty*/;
    } :: e.result,
    {
      <Errors> : (t.name t.pos (e.message)) e =
        <Lib-Error (StdIO s.fname) e.message>, $fail;;
    },
    e.result : term = term;
  <Lib-Error (StdIO s.fname) "Channel is not open"> = $fail;
};