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

Last change on this file since 694 was 694, checked in by orlov, 18 years ago
  • Added parentheses around t.label int the LABEL form in ASAIL.
  • Corrected Expr-variables defenitions.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.2 KB
Line 
1// $Source$
2// $Revision: 694 $
3// $Date: 2003-04-29 02:04:27 +0000 (Tue, 29 Apr 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
13***************************** Free indices. ******************************
14
15$table Free-Indices;
16
17
18$func Free-Index e.key = s.idx;
19
20Free-Index e.key, {
21  <Lookup &Free-Indices e.key> : s.idx = s.idx;
22  1;
23};
24
25
26$func Set-Index (e.key) s.idx = ;
27
28Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
29
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  <RFP-Clear-Table &Free-Indices>;
44
45
46
47$func Create-Var e = e;
48
49New-Vars e.vars = <Map &Create-Var (e.vars)> : e;
50
51Create-Var t.var, t.var : {
52  (SVAR t.name) = <Put &State (t.var (SVAR) (1) (1) Non-Declared)>;
53  (TVAR t.name) = <Put &State (t.var (TVAR) (1) (1) Non-Declared)>;
54  (VVAR t.name) = <Put &State (t.var (VVAR) (1) ( ) Non-Declared)>;
55  (EVAR t.name) = <Put &State (t.var (EVAR) (0) ( ) Non-Declared)>;
56  ( VAR t.name) = <Put &State (t.var (VAR)  (0) ( ) Non-Declared)>;
57};
58
59
60$func Print-Var e = e;
61
62Vars-Print e.vars = <Map &Print-Var (e.vars)>;
63
64Print-Var {
65  (s.tag (e.name)) = (s.tag (<To-Word e.name>));
66  (s.tag s.box)    = (s.tag s.box);
67};
68
69
70$func Decl-Var e = e;
71
72Vars-Decl e.vars = <Map &Decl-Var (e.vars)>;
73
74
75Decl-Var t.var, {
76 
77  <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
78    {
79      <Box? s.decl> = s.decl;
80      <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
81        <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
82        s.decl;
83    } :: s.decl,
84    (Declare s.decl);
85 
86  <Create-Var t.var> : e, <Decl-Var t.var>;
87};
88
89
90Declared? t.var =
91  <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;
92
93
94$func? Decl-Box t.var = s.box;
95
96Decl-Box t.var =
97  <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;
98
99
100/*
101 * Convert FORMAT to RESULT expression by giving a name to each format
102 * variable. In FORMAT may meet normal variables, they are not changed.
103 * Resulting expression is generated without pragmas, so it can't be used in
104 * the abstract syntax.
105 * Return all variables from generated expression and the expression.
106 */
107Gener-Vars (e.format) e.prefix =
108*       <Gener-Var-Indices <Free-Index e.prefix> (e.format) e.prefix> :: e.Re s.max-index,
109*       <Set-Index (e.prefix) s.max-index>,
110*       <Del-Pragmas e.Re> :: e.Re,
111  {
112    e.format : (s.tag) e.Fe, s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
113      (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
114    e.format : (e1) e2 =
115      (<Gener-Vars (e1) e.prefix>) <Gener-Vars (e2) e.prefix>;
116    e.format : t.Ft e.Fe =
117      t.Ft <Gener-Vars (e.Fe) e.prefix>;
118    /*empty*/;
119  };
120*       <Vars e.Re> :: e.vars,
121*       <New-Vars e.vars>,
122*       (e.vars) e.Re;
123
124
125Generated-Var? (s.tag s.box), s.tag : \{ EVAR; VVAR; TVAR; SVAR; };
126
127
128Gener-Var-Assign t.var (s.tag s.box) =
129  <Store s.box <Print-Var t.var>>,
130  {
131    <Declared? t.var>, <Store <Decl-Box (s.tag s.box)> /*empty*/>;;
132  };
133
134
135$box Var-Names;
136
137$table Var-Indices;
138
139$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;
140
141$func Gener-Name s.name = s.unique-name;
142
143
144Gener-Var-Names expr =
145  <Store &Var-Names /*empty*/>,
146  <RFP-Clear-Table &Var-Indices>,
147  <Boxes-To-Vars expr>;
148
149
150Boxes-To-Vars {
151  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
152    <? s.box> : {
153      0 e.name =
154        (VAR (<Gener-Name <To-Word e.name>>)) :: t.var,
155        <Store s.box t.var>,
156        t.var <Boxes-To-Vars expr>;
157      t.var = <Boxes-To-Vars t.var expr>;
158    };
159  (Declare s.decl) expr = <Boxes-To-Vars <? s.decl> expr>;
160  (e1) e2   = (<Boxes-To-Vars e1>) <Boxes-To-Vars e2>;
161  term expr = term <Boxes-To-Vars expr>;
162  /*empty*/ = /*empty*/;
163};
164
165
166Gener-Name s.name =
167  {
168    <Lookup &Var-Indices s.name>;
169    0;
170  } : s.idx,
171  <"+" s.idx 1> :: s.idx,
172  <Bind &Var-Indices (s.name) (s.idx)>,
173  <To-Word s.name s.idx> :: s.n,
174  {
175    <? &Var-Names> : $r e s.n e = <Gener-Name s.name>;
176    <Put &Var-Names s.n>, s.n;
177  };
178
179
180
181/*
182 * Generates indexes for all variables in e.Format and returns e.Format with all
183 * (?VAR) changed to (?VAR (e.Name)) and s.max.
184 * e.Name is all words from e.prefix plus unical number. Numbers are generated
185 * sequentially starting with s.num.
186 * s.max is the maximum of all generated numbers plus one.
187 * All normal variables from e.Format are returned as they are.
188 */
189Gener-Var-Indices s.num (e.Format) e.prefix, {
190  e.Format : t.Ft e.rest, t.Ft : {
191    s.ObjectSymbol = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
192    (REF e) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
193    (PAREN e.Fe) =
194      <Gener-Var-Indices s.num (e.Fe) e.prefix> :: expr s.num,
195      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
196    (s.VariableTag) =
197      (VAR (PRAGMA) (e.prefix s.num)) :: t.var,
198      <"+" s.num 1> :: s.num,
199      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
200    (s.VariableTag e.Name) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
201  };
202  /*
203   * e.Format is empty, so return s.num -- the last term in the answer.
204   */
205  s.num;
206};
207
208
209
210Strip-STVE expr = <Subst (SVAR TVAR VVAR EVAR) ((VAR) (VAR) (VAR) (VAR)) expr>;
211
212Vars e.expr =
213  e.expr () $iter {
214    e.expr : t.first e.rest,
215      t.first : {
216        s.ObjectSymbol = /*empty*/;
217        (REF t.Name) = /*empty*/;
218        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
219        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
220          <Vars e.ResultExpression>;
221        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
222//        (STATIC t.Name) = /*empty*/;
223        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
224                //         | (TVAR t.Name) | (SVAR t.Name)
225      } :: e.var =
226      e.rest (e.vars e.var);
227  } :: e.expr (e.vars),
228  e.expr : /*empty*/ =
229  e.vars;
230
231Norm-Vars (e.vars) e.Snt =
232  /*
233   * Store all new variables in the &Vars-Tab table and return the list with
234   * all variables in the (VAR t.name) form.
235   */
236  <Store-Vars e.vars> :: e.new-vars,
237  /*
238   * Rename all new variables in e.Snt. Never mind multiple occurences.
239   */
240  (e.vars) (e.new-vars) e.Snt $iter {
241    e.vars : t.var e.rest, e.tmp-vars : t.new-var e.new-rest, {
242      t.var : t.new-var =
243        (e.rest) (e.new-rest) e.Snt;
244      t.var : (s.tag e) =
245        (e.rest) (e.new-rest) <Subst (t.var) ((t.new-var)) e.Snt>;
246    };
247  } :: (e.vars) (e.tmp-vars) e.Snt,
248  e.vars : /*empty*/ =
249  (e.new-vars) e.Snt;
250
251
252$table Vars-Tab;
253
254Store-Vars e.vars =
255//  <WriteLN Store-Vars e.vars>,
256  e.vars () $iter {
257    e.vars : (s.var-tag (e.QualifiedName s.last)) e.rest,
258      {
259        s.last : 0 = (e.QualifiedName);
260        <Int? s.last> = (e.QualifiedName s.last);
261        /*empty*/ =
262          s.var-tag : {
263            SVAR = "s";
264            TVAR = "t";
265            VVAR = "v";
266            EVAR = "e";
267            VAR = /*empty*/;
268          } :: e.var-sym,
269          (e.var-sym e.QualifiedName s.last);
270      } :: t.name,
271      {
272        <In-Table? &Vars-Tab t.name>; // do nothing
273        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
274          s.var-tag : {
275            SVAR =
276              <Set-Var t.name (Min) (1)>,
277              <Set-Var t.name (Max) (1)>,
278              <Set-Var t.name (Length) (1)>,
279              <Set-Var t.name (Flat) (True)>;
280            TVAR =
281              <Set-Var t.name (Min) (1)>,
282              <Set-Var t.name (Max) (1)>,
283              <Set-Var t.name (Length) (1)>;
284            VVAR =
285              <Set-Var t.name (Min) (1)>;
286//              <Set-Var t.name (Max) ()>;
287            EVAR =
288              <Set-Var t.name (Min) (0)>;
289//              <Set-Var t.name (Max) ()>;
290            e = <WriteLN !-!-!-! t.name>,
291              <Exit -1>;
292          },
293          <Set-Var t.name (Left-compare) ()>,
294          <Set-Var t.name (Right-compare) ()>,
295          <Set-Var t.name (Left-checks) ()>,
296          <Set-Var t.name (Right-checks) ()>,
297          <Set-Var t.name (Format) ((s.var-tag))>;
298      },
299      e.rest (e.new-vars (VAR t.name));
300  } :: e.vars (e.new-vars),
301  e.vars : /*empty*/ =
302  e.new-vars;
303
304Declare-Vars s.type e.vars =
305  e.vars () $iter {
306    e.vars : (VAR t.name) e.rest, {
307      <?? t.name Declared> : True;  // do nothing
308      {
309        <In-Table? &Vars-Tab t.name>; // do nothing
310        { s.type : Expr = <WriteLN Decl-Format t.name>;; },
311        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
312          <Set-Var t.name (Left-compare) ()>,
313          <Set-Var t.name (Right-compare) ()>,
314          <Set-Var t.name (Left-checks) ()>,
315          <Set-Var t.name (Right-checks) ()>,
316//          <Set-Var t.name (Format) ((VAR t.name))>,
317          <Set-Var t.name (Format) ((EVAR))>,
318          <Set-Var t.name (Min) (0)>;
319      },
320        <Set-Var t.name (Declared) (True)>,
321        (DECL s.type (VAR t.name));
322    } :: e.new-decl,
323    e.rest (e.decls e.new-decl);
324  } :: e.vars (e.decls),
325  e.vars : /*empty*/ =
326  e.decls;
327
328Instantiate-Vars e.vars =
329  e.vars $iter {
330    e.vars : (VAR t.name) e.rest,
331      <Set-Var t.name (Instantiated) (True)>,
332      e.rest;
333  } :: e.vars,
334  e.vars : /*empty*/;
335
336?? t.name e.key =
337  <Lookup &Vars-Tab t.name> : s.tab,
338  <Lookup s.tab e.key>;
339
340Set-Var t.name (e.key) (e.val) =
341//  <WriteLN Set-Var t.name (e.key)>,
342  <Lookup &Vars-Tab t.name> : s.tab,
343  <Bind s.tab (e.key) (e.val)>;
344
345
Note: See TracBrowser for help on using the repository browser.