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

Last change on this file since 744 was 744, checked in by orlov, 18 years ago
  • Work towards clashes compilation.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.4 KB
Line 
1// $Source$
2// $Revision: 744 $
3// $Date: 2003-05-21 12:43:54 +0000 (Wed, 21 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  t.var : Aux = (VAR <Box 0 e.prefix>);
187  (VAR <Box 1 e.prefix t.var>);
188} :: t.int-var =
189  t.int-var (INT t.int-var e.expr);
190
191
192
193//!Declared? t.var =
194//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;
195
196
197//!$func? Decl-Box t.var = s.box;
198
199//!Decl-Box t.var =
200//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;
201
202
203//!Instantiated? t.var =
204//! <Var? t.var>,
205//! <? &State> : $r e (t.var tag t.min t.max s.decl s.inst) e = s.inst : Instantiated;
206
207
208/*
209 * Convert FORMAT to RESULT expression by giving a name to each format
210 * variable. In FORMAT may meet normal variables, they are not changed.
211 * Resulting expression is generated without pragmas, so it can't be used in
212 * the abstract syntax.
213 * Return all variables from generated expression and the expression.
214 */
215Gener-Vars (e.format) e.prefix =
216*       <Gener-Var-Indices <Free-Index e.prefix> (e.format) e.prefix> :: e.Re s.max-index,
217*       <Set-Index (e.prefix) s.max-index>,
218*       <Del-Pragmas e.Re> :: e.Re,
219  {
220    e.format : (s.tag) e.Fe, {
221      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
222        (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
223      (s.tag <Box 1 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
224    };
225    e.format : (e1) e2 =
226      (<Gener-Vars (e1) e.prefix>) <Gener-Vars (e2) e.prefix>;
227    e.format : t.Ft e.Fe =
228      t.Ft <Gener-Vars (e.Fe) e.prefix>;
229    /*empty*/;
230  };
231*       <Vars e.Re> :: e.vars,
232*       <New-Vars e.vars>,
233*       (e.vars) e.Re;
234
235
236Generated-Var? (s.tag s.box), s.tag : \{ EVAR; VVAR; TVAR; SVAR; };
237
238
239Gener-Var-Assign t.var (s.tag s.box) =
240  <Store s.box <Print-Var t.var>>,
241  {
242    <Get-Var Decl t.var> : s =
243      <Get-Var Decl (s.tag s.box)> : s.decl-box,
244      <Store s.decl-box /*empty*/>;;
245  };
246
247
248$box Var-Names;
249
250$table Var-Indices;
251
252$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;
253
254$func Gener-Name s.form-one? s.name = s.unique-name;
255
256
257Gener-Var-Names expr =
258  <Store &Var-Names /*empty*/>,
259  <RFP-Clear-Table &Var-Indices>,
260  <Boxes-To-Vars expr>;
261
262
263Boxes-To-Vars {
264  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
265    <? s.box> : {
266      0 e.name =
267        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
268        <Store s.box t.var>,
269        t.var <Boxes-To-Vars expr>;
270      1 e.prefix t.var =
271        <Boxes-To-Vars t.var> : (s (e.name)),
272        (VAR (<Gener-Name From-Two <To-Word e.prefix e.name>>)) :: t.var,
273        <Store s.box t.var>,
274        t.var <Boxes-To-Vars expr>;
275      t.var = <Boxes-To-Vars t.var expr>;
276    };
277  (Declare s.decl) expr = <Boxes-To-Vars <? s.decl> expr>;
278  (e1) e2   = (<Boxes-To-Vars e1>) <Boxes-To-Vars e2>;
279  term expr = term <Boxes-To-Vars expr>;
280  /*empty*/ = /*empty*/;
281};
282
283
284Gener-Name s.form-one? s.name =
285  {
286    <Lookup &Var-Indices s.name>;
287    0;
288  } : s.idx,
289  <"+" s.idx 1> :: s.idx,
290  <Bind &Var-Indices (s.name) (s.idx)>,
291  {
292    # \{ s.form-one? : From-One; }, s.idx : 1 = /*empty*/;
293    s.idx;
294  } :: e.idx,
295  <To-Word s.name e.idx> :: s.n,
296  {
297    <? &Var-Names> : $r e s.n e = <Gener-Name s.form-one? s.name>;
298    <Put &Var-Names s.n>, s.n;
299  };
300
301
302
303/*
304 * Generates indexes for all variables in e.Format and returns e.Format with all
305 * (?VAR) changed to (?VAR (e.Name)) and s.max.
306 * e.Name is all words from e.prefix plus unical number. Numbers are generated
307 * sequentially starting with s.num.
308 * s.max is the maximum of all generated numbers plus one.
309 * All normal variables from e.Format are returned as they are.
310 */
311Gener-Var-Indices s.num (e.Format) e.prefix, {
312  e.Format : t.Ft e.rest, t.Ft : {
313    s.ObjectSymbol = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
314    (REF e) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
315    (PAREN e.Fe) =
316      <Gener-Var-Indices s.num (e.Fe) e.prefix> :: expr s.num,
317      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
318    (s.VariableTag) =
319      (VAR (PRAGMA) (e.prefix s.num)) :: t.var,
320      <"+" s.num 1> :: s.num,
321      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
322    (s.VariableTag e.Name) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
323  };
324  /*
325   * e.Format is empty, so return s.num -- the last term in the answer.
326   */
327  s.num;
328};
329
330
331
332Strip-STVE expr = <Subst (SVAR TVAR VVAR EVAR) ((VAR) (VAR) (VAR) (VAR)) expr>;
333
334Vars e.expr =
335  e.expr () $iter {
336    e.expr : t.first e.rest,
337      t.first : {
338        s.ObjectSymbol = /*empty*/;
339        (REF t.Name) = /*empty*/;
340        (STATIC t.Name) = /*empty*/;
341        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
342        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
343          <Vars e.ResultExpression>;
344        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
345        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
346                //         | (TVAR t.Name) | (SVAR t.Name)
347      } :: e.var =
348      e.rest (e.vars e.var);
349  } :: e.expr (e.vars),
350  e.expr : /*empty*/ =
351  e.vars;
352
353Norm-Vars (e.vars) e.Snt =
354  /*
355   * Store all new variables in the &Vars-Tab table and return the list with
356   * all variables in the (VAR t.name) form.
357   */
358  <Store-Vars e.vars> :: e.new-vars,
359  /*
360   * Rename all new variables in e.Snt. Never mind multiple occurences.
361   */
362  (e.vars) (e.new-vars) e.Snt $iter {
363    e.vars : t.var e.rest, e.tmp-vars : t.new-var e.new-rest, {
364      t.var : t.new-var =
365        (e.rest) (e.new-rest) e.Snt;
366      t.var : (s.tag e) =
367        (e.rest) (e.new-rest) <Subst (t.var) ((t.new-var)) e.Snt>;
368    };
369  } :: (e.vars) (e.tmp-vars) e.Snt,
370  e.vars : /*empty*/ =
371  (e.new-vars) e.Snt;
372
373
374$table Vars-Tab;
375
376Store-Vars e.vars =
377//  <WriteLN Store-Vars e.vars>,
378  e.vars () $iter {
379    e.vars : (s.var-tag (e.QualifiedName s.last)) e.rest,
380      {
381        s.last : 0 = (e.QualifiedName);
382        <Int? s.last> = (e.QualifiedName s.last);
383        /*empty*/ =
384          s.var-tag : {
385            SVAR = "s";
386            TVAR = "t";
387            VVAR = "v";
388            EVAR = "e";
389            VAR = /*empty*/;
390          } :: e.var-sym,
391          (e.var-sym e.QualifiedName s.last);
392      } :: t.name,
393      {
394        <In-Table? &Vars-Tab t.name>; // do nothing
395        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
396          s.var-tag : {
397            SVAR =
398              <Set-Var t.name (Min) (1)>,
399              <Set-Var t.name (Max) (1)>,
400              <Set-Var t.name (Length) (1)>,
401              <Set-Var t.name (Flat) (True)>;
402            TVAR =
403              <Set-Var t.name (Min) (1)>,
404              <Set-Var t.name (Max) (1)>,
405              <Set-Var t.name (Length) (1)>;
406            VVAR =
407              <Set-Var t.name (Min) (1)>;
408//              <Set-Var t.name (Max) ()>;
409            EVAR =
410              <Set-Var t.name (Min) (0)>;
411//              <Set-Var t.name (Max) ()>;
412            e = <WriteLN !-!-!-! t.name>,
413              <Exit -1>;
414          },
415          <Set-Var t.name (Left-compare) ()>,
416          <Set-Var t.name (Right-compare) ()>,
417          <Set-Var t.name (Left-checks) ()>,
418          <Set-Var t.name (Right-checks) ()>,
419          <Set-Var t.name (Format) ((s.var-tag))>;
420      },
421      e.rest (e.new-vars (VAR t.name));
422  } :: e.vars (e.new-vars),
423  e.vars : /*empty*/ =
424  e.new-vars;
425
426Declare-Vars s.type e.vars =
427  e.vars () $iter {
428    e.vars : (VAR t.name) e.rest, {
429      <?? t.name Declared> : True;  // do nothing
430      {
431        <In-Table? &Vars-Tab t.name>; // do nothing
432        { s.type : Expr = <WriteLN Decl-Format t.name>;; },
433        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
434          <Set-Var t.name (Left-compare) ()>,
435          <Set-Var t.name (Right-compare) ()>,
436          <Set-Var t.name (Left-checks) ()>,
437          <Set-Var t.name (Right-checks) ()>,
438//          <Set-Var t.name (Format) ((VAR t.name))>,
439          <Set-Var t.name (Format) ((EVAR))>,
440          <Set-Var t.name (Min) (0)>;
441      },
442        <Set-Var t.name (Declared) (True)>,
443        (DECL s.type (VAR t.name));
444    } :: e.new-decl,
445    e.rest (e.decls e.new-decl);
446  } :: e.vars (e.decls),
447  e.vars : /*empty*/ =
448  e.decls;
449
450Instantiate-Vars e.vars =
451  e.vars $iter {
452    e.vars : (VAR t.name) e.rest,
453      <Set-Var t.name (Instantiated) (True)>,
454      e.rest;
455  } :: e.vars,
456  e.vars : /*empty*/;
457
458?? t.name e.key =
459  <Lookup &Vars-Tab t.name> : s.tab,
460  <Lookup s.tab e.key>;
461
462//!Set-Var t.name (e.key) (e.val) =
463//  <WriteLN Set-Var t.name (e.key)>,
464//!     <Lookup &Vars-Tab t.name> : s.tab,
465//!     <Bind s.tab (e.key) (e.val)>;
466
467
Note: See TracBrowser for help on using the repository browser.