// $Id$

//$module Stream : IStream;

$use Access Apply Arithm Box Class Compare StdIO;

//** $func Stream s.func e.args = stream;

Stream s.func e.args, {
  # <IsFunc s.func> =
    $error "refal.plus.Stream.Stream" "Invalid argument" 1 "Not a function" s.func;
  <Box () (s.func e.args)>;
};


$func? Read_Expr s.box = v.expr;

Read_Expr s.box =
  <Get s.box> : v.expr,
  <Store s.box /*empty*/>,
  v.expr;

//** $func Expr-Open expr = stream;

Expr_Open expr =
  <Box expr> :: s.box,
  <Stream &Read_Expr s.box>;


//** $func File-Open  e.filename = stream;
//** $func File-Close stream     = ;

File_Open e.filename =
  <Channel> :: s.channel,
  <PrimOpenFile s.channel e.filename R>,
  <Stream &PrimRead s.channel &ReadChunkSize>;

File_Close stream, {
  <Get stream> : (e.buf) (s.func e.args), {
    e.args : s.ch e.rest, <IsChannel s.ch> =
      <PrimCloseChannel s.ch>;
    $error "refal.plus.Stream.File_Close" "Invalid argument" 1 "Not a streamed file";
  };
  $error "refal.plus.Stream.File_Close" "Invalid argument" 1 "Not a stream" stream;
};


//** $func StdIStream = stream;

$box StdIStream_Box;

StdIStream, {
  <Get &StdIStream_Box> : stream = stream;
  <Stream &PrimRead &StdIn 1> :: stream,
    <Store &StdIStream_Box stream>,
    stream;
};


//** $func? Getc   stream      = term;

Getc stream, {
  <Get stream> : (e.buf) (s.func e.args) =
    e.buf $iter {
      <Apply s.func e.args>;
      <Store stream () (s.func e.args)> = $fail;
    } :: e.buf, e.buf : t.head e.tail =
    <Store stream (e.tail) (s.func e.args)>,
    t.head;
  $error "refal.plus.Stream.Getc" "Invalid argument" 1 "Not a stream" stream;
};

//** $func? Gets   stream s.n  = expr;

Gets stream s.n, {
  <Get stream> : (e.buf) (s.func e.args) =
    e.buf $iter {
      e.buf <Apply s.func e.args>;
      <Store stream (e.buf) (s.func e.args)> = $fail;
    } :: e.buf,
    <Store stream (<Middle s.n 0 e.buf>) (s.func e.args)>,
    <Left 0 s.n e.buf>;
  $error "refal.plus.Stream.Gets" "Invalid argument" 1 "Not a stream" stream;
};


//** $func  Ungets stream expr = ;

Ungets stream expr, {
  <Get stream> : (e.buf) (s.func e.args) =
    <Store stream (expr e.buf) (s.func e.args)>;
  $error "refal.plus.Stream.Ungets" "Invalid argument" 1 "Not a stream" stream;
};


//** $func  Scanc  stream t1   = empty-or-t1;

Scanc stream t1, {
  <Getc stream> : {
    t1 = t1;
    t2 = <Ungets stream t2>;
  };
  /*empty*/;
};

Scans stream e1, {
  <Gets stream <Length e1>> : {
    e1 = e1;
    e2 = <Ungets stream e2>;
  };
  /*empty*/;
};

//** $func Get-Delim stream t.delim = expr;

Get_Delims stream v.delim, <Sub <Length v.delim> 1> :: s.delimLength, {
  <Get stream> : (e.buf) (s.func e.args) =
    (/*e.str*/) (e.buf) $iter {
      e.buf : e1 v.delim e2 = (e.str e1 v.delim) (e2) Stop;
      <Apply s.func e.args> :: e.newBuf = {
        (e.str <Middle 0 s.delimLength e.buf>) (<Right 0 s.delimLength e.buf> e.newBuf);        
        (e.str) (e.buf e.newBuf);        
      };
      (e.str e.buf) () Stop;
    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
    <Store stream (e.buf) (s.func e.args)>,
    e.str;
  $error "refal.plus.Stream.Get_Delims" "Invalid argument" 1 "Not a stream" stream;
};

//** $func Get-Delim stream t.delim = expr;

Get_Delim stream t.delim, {
  <Get stream> : (e.buf) (s.func e.args) =
    (/*e.str*/) (e.buf) $iter {
      e.buf : e1 t.delim e2 = (e.str e1 t.delim) (e2) Stop;
      (e.str e.buf) (<Apply s.func e.args>);
      (e.str e.buf) () Stop;
    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
    <Store stream (e.buf) (s.func e.args)>,
    e.str;
  $error "refal.plus.Stream.Get_Delim" "Invalid argument" 1 "Not a stream" stream;
};


//** $func Get-Line stream = expr;

//Get-Line stream = <Get-Delim stream '\n'>;

$func? Not_EOL t1 = ;
Not_EOL t1 = # t1 : \{ '\n'; '\r'; };

Get_Line stream =
  <Get_While stream &Not_EOL> <Scanc stream '\r'> <Scanc stream '\n'>;


//** $func Get-While stream s.pred = expr;

Get_While stream s.pred e.predArgs, {
  <Get stream> : (e.buf) (s.func e.args) =
    (/*e.str*/) (e.buf) $iter {
      e.buf : e.head t1 e.tail, # \{ <Apply s.pred e.predArgs t1> : e; } = (e.str e.head) (t1 e.tail) Stop; 
      (e.str e.buf) (<Apply s.func e.args>);
      (e.str e.buf) () Stop;
    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
    <Store stream (e.buf) (s.func e.args)>,
    e.str;
  $error "refal.plus.Stream.Get_While" "Invalid argument" 1 "Not a stream" stream;
};

Get_Until stream s.pred e.predArgs, {
  <Get stream> : (e.buf) (s.func e.args) =
    (/*e.str*/) (e.buf) $iter {
      e.buf : e.head t1 e.tail, <Apply s.pred e.predArgs t1> : e = (e.str e.head) (t1 e.tail) Stop; 
      (e.str e.buf) (<Apply s.func e.args>);
      (e.str e.buf) () Stop;
    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
    <Store stream (e.buf) (s.func e.args)>,
    e.str;
  $error "refal.plus.Stream.Get_Until" "Invalid argument" 1 "Not a stream" stream;
};

//** $func? End-of-Stream? stream = ;

IsEnd_of_Stream stream, {
  <Get stream> : (e.buf) (s.func e.args) =
    {
      e.buf $iter
        <Apply s.func e.args>
      :: e.buf,
        e.buf : v =
        <Store stream (e.buf) (s.func e.args)>,
        $fail;
      /*We are at the end of the stream*/;
    };
  $error "refal.plus.Stream.IsEnd_of_Stream" "Invalid argument" 1 "Not a stream" stream;
};