source: to-imperative/trunk/compiler/rfp_vars.rf @ 2043

Last change on this file since 2043 was 2043, checked in by orlov, 14 years ago
  • Improved block extraction from result expressions.
  • Use asail2asail when converting to C++.
  • Remove duplicate declarations after cleanup of blocks

(rfp_asail2asail.Remove-Dupl-Decl).

  • Proper generation of debug info for $iter.
  • Fixed pragma-generation when comments are used.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.1 KB
Line 
1// $Source$
2// $Revision: 2043 $
3// $Date: 2006-08-01 17:25:13 +0000 (Tue, 01 Aug 2006) $
4
5$use Arithm Box Class Convert Dos List StdIO Table;
6
7$use "rfp_helper";
8$use "rfpc";
9
10
11
12Var? (s.tag t.name), s.tag : \{ SVAR; TVAR; VVAR; EVAR; VAR; Len-Var; };
13
14
15//***************************** Free indices. ******************************
16//
17//$table Free-Indices;
18//
19//
20//$func Free-Index e.key = s.idx;
21//
22//Free-Index e.key, {
23//  <Lookup &Free-Indices e.key> : s.idx = s.idx;
24//  1;
25//};
26//
27//
28//$func Set-Index (e.key) s.idx = ;
29//
30//Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
31
32
33*************** Functions to deal with sets of variables. ****************
34
35$box State;
36
37Vars-Copy-State = <Box <? &State>>;
38
39Vars-Set-State s.state = <Store &State <? s.state>>;
40
41
42Init-Vars =
43  <Store &State /*empty*/>;
44//  <RFP-Clear-Table &Free-Indices>;
45
46
47
48$func Normalize-Info e.info t.var = ;
49
50Normalize-Info e.info t.var =
51  /*
52   * Если дана длина, приравнять к ней минимум и максимум.
53   */
54  {
55    e.info : e (Length e.len) e =
56      {
57        e.info : e1 (Min e.min) e2 =
58          {
59            e.min : e.len = e.info;
60            (Min e.len) e1 e2;
61          };
62        (Min e.len) e.info;
63      } :: e.info,
64      {
65        e.info : e1 (Max e.max) e2 =
66          {
67            e.max : e.len = e.info;
68            e1 e2 (Max e.len);
69          };
70        e.info (Max e.len);
71      };
72    e.info;
73  } :: e.info,
74  /*
75   * Если минимум не установлен, установить его, исходя из типа переменной.
76   */
77  {
78    e.info : e (Min e) e = e.info;
79    t.var : {
80      (SVAR e) = 1;
81      (TVAR e) = 1;
82      (VVAR e) = 1;
83      (EVAR e) = 0;
84      ( VAR e) = 0;
85    } :: s.min =
86      e.info (Min s.min);
87  } :: e.info,
88  /*
89   * Для s- и t-переменных установить максимум, если не установлен.
90   */
91  {
92    t.var : \{ (SVAR e); (TVAR e); } =
93      {
94        e.info : e (Max e) e = e.info;
95        e.info (Max 1);
96      };
97    e.info;
98  } :: e.info,
99  /*
100   * Если минимум совпадает с максимумом, то установить длину.
101   * FIXME: не нужно ли здесь упрощать выражения для минимума и максимума?
102   */
103  {
104    e.info : e (Length e) e = e.info;
105    e.info : e (Max s.max) e, e.info : e (Min s.max) e = e.info (Length s.max);
106    e.info;
107  } :: e.info,
108  /*
109   * Если переменная получила значение, а длина её не была известна, значит
110   * она будет считаться функцией LENGTH в ран-тайм.
111   */
112  {
113    e.info : e (Length e) e = e.info;
114    e.info : e (Instantiated? True) e = e.info (Length (LENGTH t.var));
115    e.info;
116  } :: e.info,
117  <Put &State (t.var e.info)>;
118
119Set-Var e.info t.var, {
120  <? &State> : $r e1 (t.var e.old-info) e2 =
121    e.old-info (e.info) (/*e.new-info*/) $iter {
122      e.old-info : (t.key e.val) e.rest, {
123        e.info : e3 (t.key e.new-val) e4 = e3 e4 (t.key e.new-val);
124        e.info (t.key e.val);
125      } :: e.info t.item =
126        e.rest (e.info) (e.new-info t.item);
127    } :: e.old-info (e.info) (e.new-info),
128    e.old-info : /*empty*/ =
129    <Store &State e1 e2>,
130    e.info e.new-info t.var;
131  e.info t.var;
132} :: e.info t.var =
133  <Normalize-Info e.info t.var>;
134
135Get-Var t.key t.var,
136  <? &State> : $r e1 (t.var e.info) e2 =
137  {
138    e.info : e (t.key e.val) e = e.val;
139    /*empty*/;
140  };
141
142
143$func Reset-Var e = e;
144
145Vars-Reset e.vars = <Map &Reset-Var (e.vars)> : e;
146
147
148Reset-Var t.var =
149  {
150    <? &State> : $r e1 (t.var e.info) e2 =
151      <Store &State e1 e2>,
152      e.info;
153    /*empty*/;
154  } :   {
155    e (Decl s.decl) e = (Decl s.decl);
156    e = /*empty*/;
157  } :: e.decl,
158  <Normalize-Info (Instantiated? True) e.decl t.var>;
159
160
161
162Gener-Len-Var t.var =
163  <? &State> : $r e1 (t.var e.info) e2,
164  <Set-Var e.info (Len-Var t.var)>,
165  (Len-Var t.var);
166
167
168
169$func Print-Var e = e;
170
171Vars-Print e.vars = <Map &Print-Var (e.vars)>;
172
173Print-Var {
174  (s.tag (e.name)) = (s.tag (<To-Word e.name>));
175  (s.tag s.box)    = (s.tag s.box);
176};
177
178
179
180$func Decl-Var e = e;
181
182Vars-Decl s.type e.vars = <Map &Decl-Var s.type (e.vars)>;
183
184
185Decl-Var s.type t.var, {
186  <Get-Var Decl t.var> : s.box;
187  <Box (DECL s.type <Print-Var t.var>)> :: s.decl,
188    <Set-Var (Decl s.decl) t.var>,
189    (Declare s.decl);
190
191//!     <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
192//!             {
193//!                     <Box? s.decl> = s.decl;
194//!                     <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
195//!                             <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
196//!                             s.decl;
197//!             } :: s.decl,
198//!             (Declare s.decl);
199//!
200//!     <Create-Var t.var> : e, <Decl-Var t.var>;
201};
202
203
204
205Create-Int-Var (e.prefix) t.var e.expr, {
206  t.var : Aux = (VAR <Box 0 e.prefix>);
207  (VAR <Box 1 e.prefix t.var>);
208} :: t.int-var =
209  t.int-var (INT t.int-var e.expr);
210
211
212
213
214/*
215 */
216Gener-Vars (e.format) e.prefix =
217  {
218    e.format : (s.tag) e.Fe, {
219      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
220        (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
221      (s.tag <Box 1 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
222    };
223    e.format : (PAREN v1) e2 =
224      (PAREN <Gener-Vars (v1) e.prefix>) <Gener-Vars (e2) e.prefix>;
225    e.format : t.Ft e.Fe =
226      t.Ft <Gener-Vars (e.Fe) e.prefix>;
227    /*empty*/;
228  };
229
230Gener-Err-Var = (EVAR <Box 2>);
231
232
233Gener-Subst-Vars (e.format) e.prefix = <Gener-Vars (e.format) (Subst) e.prefix>;
234
235
236Substitutable-Var? (s.tag s.box) =
237  s.tag : \{ EVAR; VVAR; TVAR; SVAR; },
238  <? s.box> : 0 (Subst) e;
239
240
241
242/*
243 * (s.tag s.box) -- сгенерированная ранее переменная.
244 * Вместо того, чтобы присвоить её значение переменной t.var, мы подставляем
245 * t.var во все места, гда была использована (s.tag s.box).  Таким образом,
246 * t.var получит нужное значение в тот момент, когда выполняется присваивание в
247 * (s.tag s.box).
248 * Если переменная t.var уже была ранее декларирована, чтобы избежать повторной
249 * декларации, делаем декларацию для (s.tag s.box) пустой.
250 * Если же переменная t.var -- новая, то её декларацией становится декларация
251 * (s.tag s.box).
252 */
253Gener-Var-Assign t.var (s.tag s.box) =
254  <Store s.box <Print-Var t.var>>,
255  {
256    <Get-Var Decl t.var> : s =
257      <Get-Var Decl (s.tag s.box)> : s.decl-box,
258      <Store s.decl-box /*empty*/>;
259    <Set-Var (Decl <Get-Var Decl (s.tag s.box)>) t.var>;
260  };
261
262
263$box Var-Names;
264
265$table Var-Indices;
266
267$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;
268
269$func Gener-Name s.form-one? s.name = s.unique-name;
270
271
272Gener-Var-Names expr =
273  <Store &Var-Names /*empty*/>,
274  <RFP-Clear-Table &Var-Indices>,
275  <Boxes-To-Vars expr>;
276
277
278Boxes-To-Vars {
279  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
280    <? s.box> : {
281      0 e.name =
282        { e.name : (Subst) e.n = e.n; e.name; } :: e.name,
283        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
284        <Store s.box t.var>,
285        t.var <Boxes-To-Vars expr>;
286      1 e.prefix t.var =
287        <Boxes-To-Vars t.var> : {
288          (REF (e s.name)) = s.name;
289          (s (e.name)) = e.name;
290        } :: e.name,
291        (VAR (<Gener-Name From-Two <To-Word e.prefix e.name>>)) :: t.var,
292        <Store s.box t.var>,
293        t.var <Boxes-To-Vars expr>;
294      2 =
295        ERROR-EXPR <Boxes-To-Vars expr>;
296      t.var = <Boxes-To-Vars t.var expr>;
297    };
298  (Declare s.decl) expr = <Boxes-To-Vars <? s.decl> expr>;
299  (e1) e2   = (<Boxes-To-Vars e1>) <Boxes-To-Vars e2>;
300  term expr = term <Boxes-To-Vars expr>;
301  /*empty*/ = /*empty*/;
302};
303
304
305Gener-Name s.form-one? s.name =
306  {
307    <Lookup &Var-Indices s.name>;
308    0;
309  } : s.idx,
310  <"+" s.idx 1> :: s.idx,
311  <Bind &Var-Indices (s.name) (s.idx)>,
312  {
313    # \{ s.form-one? : From-One; }, s.idx : 1 = /*empty*/;
314    s.idx;
315  } :: e.idx,
316  <To-Word s.name e.idx> :: s.n,
317  {
318    <? &Var-Names> : $r e s.n e = <Gener-Name s.form-one? s.name>;
319    <Put &Var-Names s.n>, s.n;
320  };
321
322
323
324/*
325 * Generates indexes for all variables in e.Format and returns e.Format with all
326 * (?VAR) changed to (?VAR (e.Name)) and s.max.
327 * e.Name is all words from e.prefix plus unical number. Numbers are generated
328 * sequentially starting with s.num.
329 * s.max is the maximum of all generated numbers plus one.
330 * All normal variables from e.Format are returned as they are.
331 */
332Gener-Var-Indices s.num (e.Format) e.prefix, {
333  e.Format : t.Ft e.rest, t.Ft : {
334    s.ObjectSymbol = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
335    (REF e) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
336    (PAREN e.Fe) =
337      <Gener-Var-Indices s.num (e.Fe) e.prefix> :: expr s.num,
338      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
339    (s.VariableTag) =
340      (s.VariableTag (PRAGMA) (e.prefix s.num)) :: t.var,
341      <"+" s.num 1> :: s.num,
342      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
343    (s.VariableTag e.Name) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
344  };
345  /*
346   * e.Format is empty, so return s.num -- the last term in the answer.
347   */
348  s.num;
349};
350
351
352
353Vars e.expr =
354  e.expr () $iter {
355    e.expr : t.first e.rest,
356      t.first : {
357        s.ObjectSymbol = /*empty*/;
358        (REF t.Name) = /*empty*/;
359        (STATIC t.Name) = /*empty*/;
360        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
361        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
362          <Vars e.ResultExpression>;
363        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
364        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
365                //         | (TVAR t.Name) | (SVAR t.Name)
366      } :: e.var =
367      e.rest (e.vars e.var);
368  } :: e.expr (e.vars),
369  e.expr : /*empty*/ =
370  e.vars;
371
Note: See TracBrowser for help on using the repository browser.