source: to-imperative/trunk/java/refal/refal/plus/Stream.rf @ 3989

Last change on this file since 3989 was 3974, checked in by yura, 12 years ago
  • Refactoring.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
Line 
1// $Id: Stream.rf 3974 2008-10-17 11:52:59Z orlov $
2
3//$module Stream : IStream;
4
5$use Access Apply Arithm Box Class Compare Error StdIO;
6
7//** $func Stream s.func e.args = stream;
8
9Stream s.func e.args, {
10  # <IsFunc 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  <Get 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  <PrimOpenFile s.channel e.filename R>,
36  <Stream &PrimRead s.channel &ReadChunkSize>;
37
38File_Close stream, {
39  <Get stream> : (e.buf) (s.func e.args), {
40    e.args : s.ch e.rest, <IsChannel s.ch> =
41      <PrimCloseChannel 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  <Get &StdIStream_Box> : stream = stream;
54  <Stream &PrimRead &StdIn 1> :: stream,
55    <Store &StdIStream_Box stream>,
56    stream;
57};
58
59
60//** $func? Getc   stream      = term;
61
62Getc stream, {
63  <Get stream> : (e.buf) (s.func e.args) =
64    e.buf $iter {
65      <Apply s.func e.args>;
66      <Store stream () (s.func e.args)> = $fail;
67    } :: e.buf, e.buf : t.head e.tail =
68    <Store stream (e.tail) (s.func e.args)>,
69    t.head;
70  <Lib_Error (Stream Getc) "Arg 1 is not a Stream"> = $fail;
71};
72
73//** $func? Gets   stream s.n  = expr;
74
75Gets stream s.n, {
76  <Get stream> : (e.buf) (s.func e.args) =
77    e.buf $iter {
78      e.buf <Apply s.func e.args>;
79      <Store stream (e.buf) (s.func e.args)> = $fail;
80    } :: e.buf,
81    <Store stream (<Middle s.n 0 e.buf>) (s.func e.args)>,
82    <Left 0 s.n e.buf>;
83  <Lib_Error (Stream Gets) "Arg 1 is not a Stream"> = $fail;
84};
85
86
87//** $func  Ungets stream expr = ;
88
89Ungets stream expr, {
90  <Get stream> : (e.buf) (s.func e.args) =
91    <Store stream (expr e.buf) (s.func e.args)>;
92  <Lib_Error (Stream Ungets) "Arg 1 is not a Stream"> = $fail;
93};
94
95
96//** $func  Scanc  stream t1   = empty-or-t1;
97
98Scanc stream t1, {
99  <Getc stream> : {
100    t1 = t1;
101    t2 = <Ungets stream t2>;
102  };
103  /*empty*/;
104};
105
106Scans stream e1, {
107  <Gets stream <Length e1>> : {
108    e1 = e1;
109    e2 = <Ungets stream e2>;
110  };
111  /*empty*/;
112};
113
114//** $func Get-Delim stream t.delim = expr;
115
116Get_Delims stream v.delim, <Sub <Length v.delim> 1> :: s.delimLength, {
117  <Get stream> : (e.buf) (s.func e.args) =
118    (/*e.str*/) (e.buf) $iter {
119      e.buf : e1 v.delim e2 = (e.str e1 v.delim) (e2) Stop;
120      <Apply s.func e.args> :: e.newBuf = {
121        (e.str <Middle 0 s.delimLength e.buf>) (<Right 0 s.delimLength e.buf> e.newBuf);       
122        (e.str) (e.buf e.newBuf);       
123      };
124      (e.str e.buf) () Stop;
125    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
126    <Store stream (e.buf) (s.func e.args)>,
127    e.str;
128  <Lib_Error (Stream "Get_Delims") "Arg 1 is not a Stream"> = $fail;
129};
130
131//** $func Get-Delim stream t.delim = expr;
132
133Get_Delim stream t.delim, {
134  <Get stream> : (e.buf) (s.func e.args) =
135    (/*e.str*/) (e.buf) $iter {
136      e.buf : e1 t.delim e2 = (e.str e1 t.delim) (e2) Stop;
137      (e.str e.buf) (<Apply s.func e.args>);
138      (e.str e.buf) () Stop;
139    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
140    <Store stream (e.buf) (s.func e.args)>,
141    e.str;
142  <Lib_Error (Stream "Get_Delim") "Arg 1 is not a Stream"> = $fail;
143};
144
145
146//** $func Get-Line stream = expr;
147
148//Get-Line stream = <Get-Delim stream '\n'>;
149
150$func? Not_EOL t1 = ;
151Not_EOL t1 = # t1 : \{ '\n'; '\r'; };
152
153Get_Line stream =
154  <Get_While stream &Not_EOL> <Scanc stream '\r'> <Scanc stream '\n'>;
155
156
157//** $func Get-While stream s.pred = expr;
158
159Get_While stream s.pred e.predArgs, {
160  <Get stream> : (e.buf) (s.func e.args) =
161    (/*e.str*/) (e.buf) $iter {
162      e.buf : e.head t1 e.tail, # \{ <Apply s.pred e.predArgs t1> : e; } = (e.str e.head) (t1 e.tail) Stop;
163      (e.str e.buf) (<Apply s.func e.args>);
164      (e.str e.buf) () Stop;
165    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
166    <Store stream (e.buf) (s.func e.args)>,
167    e.str;
168  <Lib_Error (Stream "Get_While") "Arg 1 is not a Stream"> = $fail;
169};
170
171Get_Until stream s.pred e.predArgs, {
172  <Get stream> : (e.buf) (s.func e.args) =
173    (/*e.str*/) (e.buf) $iter {
174      e.buf : e.head t1 e.tail, <Apply s.pred e.predArgs t1> : e = (e.str e.head) (t1 e.tail) Stop;
175      (e.str e.buf) (<Apply s.func e.args>);
176      (e.str e.buf) () Stop;
177    } :: (e.str) (e.buf) e.isStop, e.isStop : v =
178    <Store stream (e.buf) (s.func e.args)>,
179    e.str;
180  <Lib_Error (Stream "Get_Until") "Arg 1 is not a Stream"> = $fail;
181};
182
183//** $func? End-of-Stream? stream = ;
184
185IsEnd_of_Stream stream, {
186  <Get stream> : (e.buf) (s.func e.args) =
187    {
188      e.buf $iter
189        <Apply s.func e.args>
190      :: e.buf,
191        e.buf : v =
192        <Store stream (e.buf) (s.func e.args)>,
193        $fail;
194      /*We are at the end of the stream*/;
195    };
196  <Lib_Error (Stream "IsEnd_of_Stream") "Arg 1 is not a Stream"> = $fail;
197};
198
Note: See TracBrowser for help on using the repository browser.