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

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