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

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