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

Last change on this file since 1146 was 1146, checked in by orlov, 17 years ago
  • Support for references to functions. Including ones with formats other then

e = e.

  • Support for iterative splitting from the right.
  • Composition of clashes left hand side is corrected.
  • Renaming of variables is corrected.
  • Some other small bugs are fixed.
  • A lot of unused code is throwed away, some code is cleaned up, some comments

are added.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.5 KB
Line 
1// $Source$
2// $Revision: 1146 $
3// $Date: 2003-08-10 22:36:28 +0000 (Sun, 10 Aug 2003) $
4
5$use Arithm Box Class Convert Dos StdIO Table;
6
7$use "rfp_helper";
8$use "rfp_list";
9$use "rfpc";
10
11
12
13Var? (s.tag t.name), s.tag : \{ SVAR; TVAR; VVAR; EVAR; VAR; };
14
15
16//***************************** Free indices. ******************************
17//
18//$table Free-Indices;
19//
20//
21//$func Free-Index e.key = s.idx;
22//
23//Free-Index e.key, {
24//  <Lookup &Free-Indices e.key> : s.idx = s.idx;
25//  1;
26//};
27//
28//
29//$func Set-Index (e.key) s.idx = ;
30//
31//Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
32
33
34*************** Functions to deal with sets of variables. ****************
35
36$box State;
37
38Vars-Copy-State = <Box <? &State>>;
39
40Vars-Set-State s.state = <Store &State <? s.state>>;
41
42
43Init-Vars =
44  <Store &State /*empty*/>;
45//  <RFP-Clear-Table &Free-Indices>;
46
47
48
49$func Normalize-Info e.info t.var = ;
50
51Normalize-Info e.info t.var =
52  /*
53   * Если дана длина, приравнять к ней минимум и максимум.
54   */
55  {
56    e.info : e (Length e.len) e =
57      {
58        e.info : e1 (Min e.min) e2 =
59          {
60            e.min : e.len = e.info;
61            (Min e.len) e1 e2;
62          };
63        (Min e.len) e.info;
64      } :: e.info,
65      {
66        e.info : e1 (Max e.max) e2 =
67          {
68            e.max : e.len = e.info;
69            e1 e2 (Max e.len);
70          };
71        e.info (Max e.len);
72      };
73    e.info;
74  } :: e.info,
75  /*
76   * Если минимум не установлен, установить его, исходя из типа переменной.
77   */
78  {
79    e.info : e (Min e) e = e.info;
80    t.var : {
81      (SVAR e) = 1;
82      (TVAR e) = 1;
83      (VVAR e) = 1;
84      (EVAR e) = 0;
85      ( VAR e) = 0;
86    } :: s.min =
87      e.info (Min s.min);
88  } :: e.info,
89  /*
90   * Для s- и t-переменных установить максимум, если не установлен.
91   */
92  {
93    t.var : \{ (SVAR e); (TVAR e); } =
94      {
95        e.info : e (Max e) e = e.info;
96        e.info (Max 1);
97      };
98    e.info;
99  } :: e.info,
100  /*
101   * Если минимум совпадает с максимумом, то установить длину.
102   * FIXME: не нужно ли здесь упрощать выражения для минимума и максимума?
103   */
104  {
105    e.info : e (Length e) e = e.info;
106    e.info : e (Max s.max) e, e.info : e (Min s.max) e = e.info (Length s.max);
107    e.info;
108  } :: e.info,
109  /*
110   * Если переменная получила значение, а длина её не была известна, значит
111   * она будет считаться функцией LENGTH в ран-тайм.
112   */
113  {
114    e.info : e (Length e) e = e.info;
115    e.info : e (Instantiated? True) e = e.info (Length (LENGTH t.var));
116    e.info;
117  } :: e.info,
118  <Put &State (t.var e.info)>;
119
120Set-Var e.info t.var, {
121  <? &State> : $r e1 (t.var e.old-info) e2 =
122    e.old-info (e.info) (/*e.new-info*/) $iter {
123      e.old-info : (t.key e.val) e.rest, {
124        e.info : e3 (t.key e.new-val) e4 = e3 e4 (t.key e.new-val);
125        e.info (t.key e.val);
126      } :: e.info t.item =
127        e.rest (e.info) (e.new-info t.item);
128    } :: e.old-info (e.info) (e.new-info),
129    e.old-info : /*empty*/ =
130    <Store &State e1 e2>,
131    e.info e.new-info t.var;
132  e.info t.var;
133} :: e.info t.var =
134  <Normalize-Info e.info t.var>;
135
136Get-Var t.key t.var,
137  <? &State> : $r e1 (t.var e.info) e2 =
138  {
139    e.info : e (t.key e.val) e = e.val;
140    /*empty*/;
141  };
142
143Set-Var- e.info t.var = <Set-Var e.info t.var>;
144
145
146$func Print-Var e = e;
147
148Vars-Print e.vars = <Map &Print-Var (e.vars)>;
149
150Print-Var {
151  (s.tag (e.name)) = (s.tag (<To-Word e.name>));
152  (s.tag s.box)    = (s.tag s.box);
153};
154
155
156
157$func Decl-Var e = e;
158
159Vars-Decl e.vars = <Map &Decl-Var (e.vars)>;
160
161
162Decl-Var t.var, {
163  <Get-Var Decl t.var> : s.box;
164  <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
165    <Set-Var (Decl s.decl) t.var>,
166    (Declare s.decl);
167
168//!     <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
169//!             {
170//!                     <Box? s.decl> = s.decl;
171//!                     <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
172//!                             <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
173//!                             s.decl;
174//!             } :: s.decl,
175//!             (Declare s.decl);
176//!
177//!     <Create-Var t.var> : e, <Decl-Var t.var>;
178};
179
180
181
182Create-Int-Var (e.prefix) t.var e.expr, {
183  t.var : Aux = (VAR <Box 0 e.prefix>);
184  (VAR <Box 1 e.prefix t.var>);
185} :: t.int-var =
186  t.int-var (INT t.int-var e.expr);
187
188
189
190//!Declared? t.var =
191//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;
192
193
194//!$func? Decl-Box t.var = s.box;
195
196//!Decl-Box t.var =
197//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;
198
199
200//!Instantiated? t.var =
201//! <Var? t.var>,
202//! <? &State> : $r e (t.var tag t.min t.max s.decl s.inst) e = s.inst : Instantiated;
203
204
205/*
206 */
207Gener-Vars (e.format) e.prefix =
208  {
209    e.format : (s.tag) e.Fe, {
210      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
211        (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
212      (s.tag <Box 1 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
213    };
214    e.format : (PAREN v1) e2 =
215      (PAREN <Gener-Vars (v1) e.prefix>) <Gener-Vars (e2) e.prefix>;
216    e.format : t.Ft e.Fe =
217      t.Ft <Gener-Vars (e.Fe) e.prefix>;
218    /*empty*/;
219  };
220
221Gener-Err-Var = (EVAR <Box 2>);
222
223
224Gener-Subst-Vars (e.format) e.prefix = <Gener-Vars (e.format) (Subst) e.prefix>;
225
226
227Substitutable-Var? (s.tag s.box) =
228  s.tag : \{ EVAR; VVAR; TVAR; SVAR; },
229  <? s.box> : 0 (Subst) e;
230
231
232/*
233 * (s.tag s.box) -- сгенерированная ранее переменная.
234 * Вместо того, чтобы присвоить её значение переменной t.var, мы подставляем
235 * t.var во все места, гда была использована (s.tag s.box).  Таким образом,
236 * t.var получит нужное значение в тот момент, когда выполняется присваивание в
237 * (s.tag s.box).
238 * Если переменная t.var уже была ранее декларирована, чтобы избежать повторной
239 * декларации, делаем декларацию для (s.tag s.box) пустой.
240 * Если же переменная t.var -- новая, то её декларацией становится декларация
241 * (s.tag s.box).
242 */
243Gener-Var-Assign t.var (s.tag s.box) =
244  <Store s.box <Print-Var t.var>>,
245  {
246    <Get-Var Decl t.var> : s =
247      <Get-Var Decl (s.tag s.box)> : s.decl-box,
248      <Store s.decl-box /*empty*/>;
249    <Set-Var (Decl <Get-Var Decl (s.tag s.box)>) t.var>;
250  };
251
252
253$box Var-Names;
254
255$table Var-Indices;
256
257$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;
258
259$func Gener-Name s.form-one? s.name = s.unique-name;
260
261
262Gener-Var-Names expr =
263  <Store &Var-Names /*empty*/>,
264  <RFP-Clear-Table &Var-Indices>,
265  <Boxes-To-Vars expr>;
266
267
268Boxes-To-Vars {
269  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
270    <? s.box> : {
271      0 e.name =
272        { e.name : (Subst) e.n = e.n; e.name; } :: e.name,
273        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
274        <Store s.box t.var>,
275        t.var <Boxes-To-Vars expr>;
276      1 e.prefix t.var =
277        <Boxes-To-Vars t.var> : (s (e.name)),
278        (VAR (<Gener-Name From-Two <To-Word e.prefix e.name>>)) :: t.var,
279        <Store s.box t.var>,
280        t.var <Boxes-To-Vars expr>;
281      2 =
282        ERROR-EXPR <Boxes-To-Vars expr>;
283      t.var = <Boxes-To-Vars t.var expr>;
284    };
285  (Declare s.decl) expr = <Boxes-To-Vars <? s.decl> expr>;
286  (e1) e2   = (<Boxes-To-Vars e1>) <Boxes-To-Vars e2>;
287  term expr = term <Boxes-To-Vars expr>;
288  /*empty*/ = /*empty*/;
289};
290
291
292Gener-Name s.form-one? s.name =
293  {
294    <Lookup &Var-Indices s.name>;
295    0;
296  } : s.idx,
297  <"+" s.idx 1> :: s.idx,
298  <Bind &Var-Indices (s.name) (s.idx)>,
299  {
300    # \{ s.form-one? : From-One; }, s.idx : 1 = /*empty*/;
301    s.idx;
302  } :: e.idx,
303  <To-Word s.name e.idx> :: s.n,
304  {
305    <? &Var-Names> : $r e s.n e = <Gener-Name s.form-one? s.name>;
306    <Put &Var-Names s.n>, s.n;
307  };
308
309
310
311/*
312 * Generates indexes for all variables in e.Format and returns e.Format with all
313 * (?VAR) changed to (?VAR (e.Name)) and s.max.
314 * e.Name is all words from e.prefix plus unical number. Numbers are generated
315 * sequentially starting with s.num.
316 * s.max is the maximum of all generated numbers plus one.
317 * All normal variables from e.Format are returned as they are.
318 */
319Gener-Var-Indices s.num (e.Format) e.prefix, {
320  e.Format : t.Ft e.rest, t.Ft : {
321    s.ObjectSymbol = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
322    (REF e) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
323    (PAREN e.Fe) =
324      <Gener-Var-Indices s.num (e.Fe) e.prefix> :: expr s.num,
325      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
326    (s.VariableTag) =
327      (s.VariableTag (PRAGMA) (e.prefix s.num)) :: t.var,
328      <"+" s.num 1> :: s.num,
329      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
330    (s.VariableTag e.Name) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
331  };
332  /*
333   * e.Format is empty, so return s.num -- the last term in the answer.
334   */
335  s.num;
336};
337
338
339
340Strip-STVE expr = <Subst (SVAR TVAR VVAR EVAR) ((VAR) (VAR) (VAR) (VAR)) expr>;
341
342Vars e.expr =
343  e.expr () $iter {
344    e.expr : t.first e.rest,
345      t.first : {
346        s.ObjectSymbol = /*empty*/;
347        (REF t.Name) = /*empty*/;
348        (STATIC t.Name) = /*empty*/;
349        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
350        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
351          <Vars e.ResultExpression>;
352        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
353        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
354                //         | (TVAR t.Name) | (SVAR t.Name)
355      } :: e.var =
356      e.rest (e.vars e.var);
357  } :: e.expr (e.vars),
358  e.expr : /*empty*/ =
359  e.vars;
360
361Norm-Vars (e.vars) e.Snt =
362  /*
363   * Store all new variables in the &Vars-Tab table and return the list with
364   * all variables in the (VAR t.name) form.
365   */
366  <Store-Vars e.vars> :: e.new-vars,
367  /*
368   * Rename all new variables in e.Snt. Never mind multiple occurences.
369   */
370  (e.vars) (e.new-vars) e.Snt $iter {
371    e.vars : t.var e.rest, e.tmp-vars : t.new-var e.new-rest, {
372      t.var : t.new-var =
373        (e.rest) (e.new-rest) e.Snt;
374      t.var : (s.tag e) =
375        (e.rest) (e.new-rest) <Subst (t.var) ((t.new-var)) e.Snt>;
376    };
377  } :: (e.vars) (e.tmp-vars) e.Snt,
378  e.vars : /*empty*/ =
379  (e.new-vars) e.Snt;
380
381
382$table Vars-Tab;
383
384Store-Vars e.vars =
385//  <WriteLN Store-Vars e.vars>,
386  e.vars () $iter {
387    e.vars : (s.var-tag (e.QualifiedName s.last)) e.rest,
388      {
389        s.last : 0 = (e.QualifiedName);
390        <Int? s.last> = (e.QualifiedName s.last);
391        /*empty*/ =
392          s.var-tag : {
393            SVAR = "s";
394            TVAR = "t";
395            VVAR = "v";
396            EVAR = "e";
397            VAR = /*empty*/;
398          } :: e.var-sym,
399          (e.var-sym e.QualifiedName s.last);
400      } :: t.name,
401      {
402        <In-Table? &Vars-Tab t.name>; // do nothing
403        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
404          s.var-tag : {
405            SVAR =
406              <Set-Var t.name (Min) (1)>,
407              <Set-Var t.name (Max) (1)>,
408              <Set-Var t.name (Length) (1)>,
409              <Set-Var t.name (Flat) (True)>;
410            TVAR =
411              <Set-Var t.name (Min) (1)>,
412              <Set-Var t.name (Max) (1)>,
413              <Set-Var t.name (Length) (1)>;
414            VVAR =
415              <Set-Var t.name (Min) (1)>;
416//              <Set-Var t.name (Max) ()>;
417            EVAR =
418              <Set-Var t.name (Min) (0)>;
419//              <Set-Var t.name (Max) ()>;
420            e = <WriteLN !-!-!-! t.name>,
421              <Exit -1>;
422          },
423          <Set-Var t.name (Left-compare) ()>,
424          <Set-Var t.name (Right-compare) ()>,
425          <Set-Var t.name (Left-checks) ()>,
426          <Set-Var t.name (Right-checks) ()>,
427          <Set-Var t.name (Format) ((s.var-tag))>;
428      },
429      e.rest (e.new-vars (VAR t.name));
430  } :: e.vars (e.new-vars),
431  e.vars : /*empty*/ =
432  e.new-vars;
433
434Declare-Vars s.type e.vars =
435  e.vars () $iter {
436    e.vars : (VAR t.name) e.rest, {
437      <?? t.name Declared> : True;  // do nothing
438      {
439        <In-Table? &Vars-Tab t.name>; // do nothing
440        { s.type : Expr = <WriteLN Decl-Format t.name>;; },
441        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
442          <Set-Var t.name (Left-compare) ()>,
443          <Set-Var t.name (Right-compare) ()>,
444          <Set-Var t.name (Left-checks) ()>,
445          <Set-Var t.name (Right-checks) ()>,
446//          <Set-Var t.name (Format) ((VAR t.name))>,
447          <Set-Var t.name (Format) ((EVAR))>,
448          <Set-Var t.name (Min) (0)>;
449      },
450        <Set-Var t.name (Declared) (True)>,
451        (DECL s.type (VAR t.name));
452    } :: e.new-decl,
453    e.rest (e.decls e.new-decl);
454  } :: e.vars (e.decls),
455  e.vars : /*empty*/ =
456  e.decls;
457
458Instantiate-Vars e.vars =
459  e.vars $iter {
460    e.vars : (VAR t.name) e.rest,
461      <Set-Var t.name (Instantiated) (True)>,
462      e.rest;
463  } :: e.vars,
464  e.vars : /*empty*/;
465
466?? t.name e.key =
467  <Lookup &Vars-Tab t.name> : s.tab,
468  <Lookup s.tab e.key>;
469
470//!Set-Var t.name (e.key) (e.val) =
471//  <WriteLN Set-Var t.name (e.key)>,
472//!     <Lookup &Vars-Tab t.name> : s.tab,
473//!     <Bind s.tab (e.key) (e.val)>;
474
475
Note: See TracBrowser for help on using the repository browser.