source: to-imperative/trunk/library/Stream/refal/Stream.rf @ 1643

Last change on this file since 1643 was 1643, checked in by orlov, 16 years ago
  • Some parts of the library written in Refal.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 KB
Line 
1// $Id: Stream.rf 1643 2004-12-10 02:51:39Z orlov $
2
3//$module Stream : IStream;
4
5$use Access Apply Box Class Compare Error StdIO;
6
7*** $func Stream s.func e.args = stream;
8
9Stream s.func e.args, {
10  # <Func? s.func> =
11    <Lib-Error (Stream Stream) "Arg 1 is not a Function">, $fail;
12  <Box () (s.func e.args)>;
13};
14
15
16$func? Read-Expr s.box = v.expr;
17
18Read-Expr s.box =
19  <? s.box> : v.expr,
20  <Store s.box /*empty*/>,
21  v.expr;
22
23*** $func Expr-Open expr = stream;
24
25Expr-Open expr =
26  <Box expr> :: s.box,
27  <Stream &Read-Expr s.box>;
28
29
30*** $func File-Open  e.filename = stream;
31*** $func File-Close stream     = ;
32
33File-Open e.filename =
34  <Channel> :: s.channel,
35  <Prim-Open-File s.channel e.filename R>,
36  <Stream &Prim-Read s.channel &Read-Chunk-Size>;
37
38File-Close stream, {
39  <? stream> : (e.buf) (s.func e.args), {
40    e.args : s.ch e.rest, <Channel? s.ch> =
41      <Prim-Close-Channel s.ch>;
42    <Lib-Error (Stream File-Close) "Arg 1 is not a Streamed File"> = $fail;
43  };
44  <Lib-Error (Stream File-Close) "Arg 1 is not a Stream"> = $fail;
45};
46
47
48*** $func StdIStream = stream;
49
50$box StdIStream-Box;
51
52StdIStream, {
53  <? &StdIStream-Box> : stream = stream;
54  <Stream &Prim-Read &StdIn 1> :: stream,
55    <Store &StdIStream-Box stream>,
56    stream;
57};
58
59
60*** $func? Getc   stream      = term;
61
62Getc stream = <Gets stream 1> : term, term;
63
64
65*** $func? Gets   stream s.n  = expr;
66
67Gets stream s.n, {
68  <? stream> : (e.buf) (s.func e.args) =
69    e.buf $iter {
70      e.buf <Apply s.func e.args>;
71      <Store stream (e.buf) (s.func e.args)> = $fail;
72    } :: e.buf,
73    <">=" (<Length e.buf>) (s.n)> =
74    <Store stream (<Middle s.n 0 e.buf>) (s.func e.args)>,
75    <Left 0 s.n e.buf>;
76  <Lib-Error (Stream Gets) "Arg 1 is not a Stream"> = $fail;
77};
78
79
80*** $func  Ungets stream expr = ;
81
82Ungets stream expr, {
83  <? stream> : (e.buf) (s.func e.args) =
84    <Store stream (expr e.buf) (s.func e.args)>;
85  <Lib-Error (Stream Ungets) "Arg 1 is not a Stream"> = $fail;
86};
87
88
89*** $func Get-Delim stream t.delim = expr;
90
91Get-Delim stream t.delim, {
92  <? stream> : (e.buf) (s.func e.args) =
93    (/*e.str*/) (e.buf) $iter {
94      e.buf : e1 t.delim e2 =
95        (e.str e1 t.delim) (e2) Stop;
96      (e.str e.buf) (<Apply s.func e.args>);
97      (e.str e.buf) () Stop;
98    } :: (e.str) (e.buf) e.stop?,
99    e.stop? : Stop =
100    <Store stream (e.buf) (s.func e.args)>,
101    e.str;
102  <Lib-Error (Stream Get-Delim) "Arg 1 is not a Stream"> = $fail;
103};
104
105
106*** $func Get-Line stream = expr;
107
108Get-Line stream = <Get-Delim stream '\n'>;
109
110
111*** $func Get-While stream s.pred = expr;
112
113Get-While stream s.pred, {
114  <? stream> : (e.buf) (s.func e.args) =
115    (/*e.str*/) (e.buf) $iter {
116      e.buf : t1 e2, {
117        <Apply s.pred t1> : e = (e.str t1) (e2);
118        (e.str) (e.buf) Stop;
119      };
120      (e.str) (<Apply s.func e.args>);
121      (e.str) (e.buf) Stop;
122    } :: (e.str) (e.buf) e.stop?,
123    e.stop? : Stop =
124    <Store stream (e.buf) (s.func e.args)>,
125    e.str;
126  <Lib-Error (Stream Get-While) "Arg 1 is not a Stream"> = $fail;
127};
128
129
130*** $func? End-of-Stream? stream = ;
131
132End-of-Stream? stream, {
133  <? stream> : (e.buf) (s.func e.args) =
134    {
135      e.buf $iter
136        <Apply s.func e.args>
137      :: e.buf,
138        e.buf : v =
139        <Store stream (e.buf) (s.func e.args)>,
140        $fail;
141      /*We are at the end of the stream*/;
142    };
143  <Lib-Error (Stream End-of-Stream?) "Arg 1 is not a Stream"> = $fail;
144};
145
Note: See TracBrowser for help on using the repository browser.