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

Last change on this file since 683 was 683, checked in by orlov, 18 years ago
  • Main compiler loop has been rewritten in a much more clear way with a lot of

comments.

  • Variable uses analysis is temporarily removed to reappear in the as2as

transformations phase.

  • Constant expressions are compiled into static objects rather then variables

as was before.

  • Difference between R+ and R6 notions for = is supported on the level of AS.

R6 = should be parsed in NOFAIL. For supplying R+ = abstract syntax terms
BLOCK, BLOCK?, and CUTALL are provided.

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