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

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