source: to-imperative/trunk/compiler/src/org/refal/plus/compiler/rfp_vars.rf @ 3589

Last change on this file since 3589 was 3589, checked in by yura, 13 years ago
  • Compiler files are moved into package org.refal.plus.compiler.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.3 KB
Line 
1$use Arithm Box Class Convert Dos List StdIO Table;
2
3$use "org.refal.plus.compiler.rfpc";
4$use "org.refal.plus.compiler.rfp_asail";
5
6IsVar (s.tag t.name), s.tag : \{ SVAR; TVAR; VVAR; EVAR; VAR; "Len-Var"; };
7
8//***************************** Free indices. ******************************
9//
10//$table Free-Indices;
11//
12//
13//$func Free-Index e.key = s.idx;
14//
15//Free-Index e.key, {
16//  <Lookup &Free-Indices e.key> : s.idx = s.idx;
17//  1;
18//};
19//
20//
21//$func Set-Index (e.key) s.idx = ;
22//
23//Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
24
25
26//************** Functions to deal with sets of variables. ****************
27
28$box State;
29
30Vars_Copy_State = <Box <Get &State>>;
31
32Vars_Set_State s.state = <Store &State <Get s.state>>;
33
34
35Init_Vars =
36  <Store &State /*empty*/>;
37//  <Clear-Table &Free-Indices>;
38
39
40
41$func Normalize_Info e.info t.var = ;
42
43Normalize_Info e.info t.var =
44  /*
45   * О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫ О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫.
46   */
47  {
48    e.info : e (Length e.len) e =
49      {
50        e.info : e1 (Min e.min) e2 =
51          {
52            e.min : e.len = e.info;
53            (Min e.len) e1 e2;
54          };
55        (Min e.len) e.info;
56      } :: e.info,
57      {
58        e.info : e1 (Max e.max) e2 =
59          {
60            e.max : e.len = e.info;
61            e1 e2 (Max e.len);
62          };
63        e.info (Max e.len);
64      };
65    e.info;
66  } :: e.info,
67  /*
68   * О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫ О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫.
69   */
70  {
71    e.info : e (Min e) e = e.info;
72    t.var : {
73      (SVAR e) = 1;
74      (TVAR e) = 1;
75      (VVAR e) = 1;
76      (EVAR e) = 0;
77      ( VAR e) = 0;
78    } :: s.min =
79      e.info (Min s.min);
80  } :: e.info,
81  /*
82   * О©╫О©╫О©╫ s- О©╫ t-О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫ О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫.
83   * О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫.
84   */
85  {
86    t.var : \{ (SVAR e); (TVAR e); } =
87      {
88        e.info : e (Max e) e = e.info;
89        e.info (Max 1);
90      };
91    {
92      e.info : e (MaxBounds e) e = e.info;
93      e.info (MaxBounds <Table>) (MinBounds <Table>);
94    };
95  } :: e.info,
96  /*
97   * О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫.
98   * FIXME: О©╫О©╫ О©╫О©╫О©╫О©╫О©╫ О©╫О©╫ О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫?
99   */
100  {
101    e.info : e (Length e) e = e.info;
102    e.info : e (Max s.max) e, e.info : e (Min s.max) e = e.info (Length s.max);
103    e.info;
104  } :: e.info,
105  /*
106   * О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫ О©╫О©╫О©╫О©╫О©╫ её О©╫О©╫ О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫О©╫
107   * О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ LENGTH О©╫ О©╫О©╫О©╫-О©╫О©╫О©╫О©╫.
108   */
109  {
110    e.info : e (Length e) e = e.info;
111    e.info : e ("Instantiated?" True) e = e.info (Length (LENGTH t.var));
112    e.info;
113  } :: e.info,
114  <Put &State (t.var e.info)>;
115
116Set_Var e.info t.var, {
117  <Get &State> : $r e1 (t.var e.old_info) e2 =
118    e.old_info (e.info) (/*e.new-info*/) $iter {
119      e.old_info : (t.key e.val) e.rest, {
120        e.info : e3 (t.key e.new_val) e4 = e3 e4 (t.key e.new_val);
121        e.info (t.key e.val);
122      } :: e.info t.item =
123        e.rest (e.info) (e.new_info t.item);
124    } :: e.old_info (e.info) (e.new_info),
125    e.old_info : /*empty*/ =
126    <Store &State e1 e2>,
127    e.info e.new_info t.var;
128  e.info t.var;
129} :: e.info t.var =
130  <Normalize_Info e.info t.var>;
131
132Get_Var t.key t.var,
133  <Get &State> : $r e1 (t.var e.info) e2 =
134  {
135    e.info : e (t.key e.val) e = e.val;
136    /*empty*/;
137  };
138
139
140Set_Var_MaxBound t.var s.idx e.bound =
141  <Get_Var MaxBounds t.var> : s.tab,
142  <Bind s.tab (s.idx) (e.bound)>;
143
144Set_Var_MinBound t.var s.idx e.bound =
145  <Get_Var MinBounds t.var> : s.tab,
146  <Bind s.tab (s.idx) (e.bound)>;
147
148Get_Var_Max t.var =
149  <Get_Var MaxBounds t.var> : s.tab,
150  <ASAIL_MIN <Get_Var Max t.var> <Concat <Values s.tab>>>;
151
152Get_Var_Min t.var =
153  <Get_Var MinBounds t.var> : s.tab,
154  <ASAIL_MAX <Get_Var Min t.var> <Concat <Values s.tab>>>;
155
156
157$func Reset_Var e = e;
158
159Vars_Reset e.vars = <Map &Reset_Var (e.vars)> : e;
160
161
162Reset_Var t.var =
163  {
164    <Get &State> : $r e1 (t.var e.info) e2 =
165      <Store &State e1 e2>,
166      e.info;
167    /*empty*/;
168  } :   {
169    e (Decl s.decl) e = (Decl s.decl);
170    e = /*empty*/;
171  } :: e.decl,
172  <Normalize_Info ("Instantiated?" True) e.decl t.var>;
173
174
175
176Gener_Len_Var t.var =
177  <Get &State> : $r e1 (t.var e.info) e2,
178  <Set_Var e.info ("Len-Var" t.var)>,
179  ("Len-Var" t.var);
180
181
182
183$func Print_Var e = e;
184
185//Vars-Print e.vars = <Map &Print-Var (e.vars)>;
186Vars_Print e.vars = e.vars;
187
188Print_Var {
189  t1 = t1;
190//  (s.tag (e.name)) = (s.tag (<To-Word e.name>));
191  (s.tag s.box)    = (s.tag s.box);
192};
193
194
195
196$func Decl_Var e = e;
197
198Vars_Decl s.type e.vars = <Map &Decl_Var s.type (e.vars)>;
199
200
201Decl_Var s.type t.var, {
202  <Get_Var Decl t.var> : s.box;
203  <Box (DECL s.type <Print_Var t.var>)> :: s.decl,
204    <Set_Var (Decl s.decl) t.var>,
205    (Declare s.decl);
206
207//!     <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
208//!             {
209//!                     <Box? s.decl> = s.decl;
210//!                     <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
211//!                             <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
212//!                             s.decl;
213//!             } :: s.decl,
214//!             (Declare s.decl);
215//!
216//!     <Create-Var t.var> : e, <Decl-Var t.var>;
217};
218
219
220
221Create_Int_Var (e.prefix) t.var e.expr, {
222  t.var : Aux = (VAR <Box 0 e.prefix>);
223  (VAR <Box 1 e.prefix t.var>);
224} :: t.int_var =
225  (INT t.int_var) (DECL (INT t.int_var) e.expr);
226
227
228
229
230/*
231 */
232Gener_Vars (e.format) e.prefix =
233  {
234    e.format : (s.tag) e.Fe, {
235      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
236        (s.tag <Box 0 e.prefix>) <Gener_Vars (e.Fe) e.prefix>;
237      (s.tag <Box 1 e.prefix>) <Gener_Vars (e.Fe) e.prefix>;
238    };
239    e.format : (PAREN v1) e2 =
240      (PAREN <Gener_Vars (v1) e.prefix>) <Gener_Vars (e2) e.prefix>;
241    e.format : t.Ft e.Fe =
242      t.Ft <Gener_Vars (e.Fe) e.prefix>;
243    /*empty*/;
244  };
245
246Gener_Err_Var = (EVAR <Box 2>);
247
248
249Gener_Subst_Vars (e.format) e.prefix = <Gener_Vars (e.format) (Subst) e.prefix>;
250
251
252IsSubstitutable_Var (s.tag s.box) =
253  s.tag : \{ EVAR; VVAR; TVAR; SVAR; },
254  <Get s.box> : 0 (Subst) e;
255
256
257
258/*
259 * (s.tag s.box) -- О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫.
260 * О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ её О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ t.var, О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫
261 * t.var О©╫О©╫ О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫ О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ (s.tag s.box).  О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫,
262 * t.var О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫ О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫
263 * (s.tag s.box).
264 * О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ t.var О©╫О©╫О©╫ О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫
265 * О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫, О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫ (s.tag s.box) О©╫О©╫О©╫О©╫О©╫О©╫.
266 * О©╫О©╫О©╫О©╫ О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ t.var -- О©╫О©╫О©╫О©╫О©╫, О©╫О©╫ её О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫ О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫О©╫
267 * (s.tag s.box).
268 */
269Gener_Var_Assign t.var (s.tag s.box) =
270  <Store s.box <Print_Var t.var>>,
271  {
272    <Get_Var Decl t.var> : s =
273      <Get_Var Decl (s.tag s.box)> : s.decl_box,
274      <Store s.decl_box /*empty*/>;
275    <Set_Var (Decl <Get_Var Decl (s.tag s.box)>) t.var>;
276  };
277
278
279$box Var_Names;
280
281$table Var_Indices;
282
283$func Boxes_To_Vars e.expr_with_boxes = e.expr_with_var_names;
284
285$func Gener_Name s.Isform_one s.name = s.unique_name;
286
287
288Gener_Var_Names expr =
289  <Store &Var_Names /*empty*/>,
290  <ClearTable &Var_Indices>,
291  <Boxes_To_Vars expr>;
292
293
294Boxes_To_Vars {
295  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
296    <Get s.box> : {
297      0 e.name =
298        { e.name : (Subst) e.n = e.n; e.name; } :: e.name,
299        (VAR (<Gener_Name "From-One" <ToWord e.name>>)) :: t.var,
300        <Store s.box t.var>,
301        t.var <Boxes_To_Vars expr>;
302      1 e.prefix t.var =
303        <Boxes_To_Vars t.var> : {
304          (REF (e s.name)) = s.name;
305          (s (e.name)) = e.name;
306        } :: e.name,
307        (VAR (<Gener_Name "From-Two" <ToWord e.prefix e.name>>)) :: t.var,
308        <Store s.box t.var>,
309        t.var <Boxes_To_Vars expr>;
310      2 =
311        "ERROR-EXPR" <Boxes_To_Vars expr>;
312      t.var = <Boxes_To_Vars t.var expr>;
313    };
314  (Declare s.decl) expr = <Boxes_To_Vars <Get s.decl> expr>;
315  (e1) e2   = (<Boxes_To_Vars e1>) <Boxes_To_Vars e2>;
316  term expr = term <Boxes_To_Vars expr>;
317  /*empty*/ = /*empty*/;
318};
319
320
321Gener_Name s.Isform_one s.name =
322  {
323    <Lookup &Var_Indices s.name>;
324    0;
325  } : s.idx,
326  <Arithm.Add s.idx 1> :: s.idx,
327  <Bind &Var_Indices (s.name) (s.idx)>,
328  {
329    # \{ s.Isform_one : "From-One"; }, s.idx : 1 = /*empty*/;
330    s.idx;
331  } :: e.idx,
332  <ToWord s.name e.idx> :: s.n,
333  {
334    <Get &Var_Names> : $r e s.n e = <Gener_Name s.Isform_one s.name>;
335    <Put &Var_Names s.n>, s.n;
336  };
337
338
339
340/*
341 * Generates indexes for all variables in e.Format and returns e.Format with all
342 * (?VAR) changed to (?VAR (e.Name)) and s.max.
343 * e.Name is all words from e.prefix plus unical number. Numbers are generated
344 * sequentially starting with s.num.
345 * s.max is the maximum of all generated numbers plus one.
346 * All normal variables from e.Format are returned as they are.
347 */
348Gener_Var_Indices s.num (e.Format) e.prefix, {
349  e.Format : t.Ft e.rest, t.Ft : {
350    s.ObjectSymbol = t.Ft <Gener_Var_Indices s.num (e.rest) e.prefix>;
351    (REF e) = t.Ft <Gener_Var_Indices s.num (e.rest) e.prefix>;
352    (CONST e.name) = (REF e.name) <Gener_Var_Indices s.num (e.rest) e.prefix>;
353    (PAREN e.Fe) =
354      <Gener_Var_Indices s.num (e.Fe) e.prefix> :: expr s.num,
355      (PAREN expr) <Gener_Var_Indices s.num (e.rest) e.prefix>;
356    (s.VariableTag) =
357      (s.VariableTag (PRAGMA) (e.prefix s.num)) :: t.var,
358      <Arithm.Add s.num 1> :: s.num,
359      t.var <Gener_Var_Indices s.num (e.rest) e.prefix>;
360    (s.VariableTag e.Name) = t.Ft <Gener_Var_Indices s.num (e.rest) e.prefix>;
361  };
362  /*
363   * e.Format is empty, so return s.num -- the last term in the answer.
364   */
365  s.num;
366};
367
368
369
370Vars e.expr =
371  e.expr () $iter {
372    e.expr : t.first e.rest,
373      t.first : {
374        s.ObjectSymbol = /*empty*/;
375        (REF t.Name) = /*empty*/;
376        (CONST t.Name) = /*empty*/;
377        (STATIC t.Name) = /*empty*/;
378        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
379        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
380          <Vars e.ResultExpression>;
381        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
382        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
383                //         | (TVAR t.Name) | (SVAR t.Name)
384      } :: e.var =
385      e.rest (e.vars e.var);
386  } :: e.expr (e.vars),
387  e.expr : /*empty*/ =
388  e.vars;
389
Note: See TracBrowser for help on using the repository browser.