source: to-imperative/trunk/compiler/rfp_asail_optim.rf @ 698

Last change on this file since 698 was 698, checked in by sveta, 18 years ago
  • Corrected t.var.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.5 KB
Line 
1// $Source$
2// $Revision: 698 $
3// $Date: 2003-04-29 18:33:17 +0000 (Tue, 29 Apr 2003) $
4
5$use Class StdIO Arithm Compare Box Table;
6
7// Stack for optimization of expr-int: (s.flag s.int)...()...
8$box Stack-Int;
9
10// table of used label (break, continue)
11$table Used-Label;
12
13$func Optim-Int  e.int = e.expr-int;
14
15$func Optim-Expr (e.init) e.rest = e.expr-optim;
16
17$func Optim-Ref e.expr = e.expr-ref;
18
19$func Optim-MAX  (e.work-int) (e.res) e.rest = e.expr-max;
20
21$func Optim-MIN e.x = e.y;
22// $func Optim-MIN (e.work-int) (e.res) e.rest = e.expr-min;
23
24$func Optim-Add (s.res) (e.expr) e.expr-int = e.add;
25
26$func Optim-Minus (e.first) (e.expr) (s.int) e.expr-int = e.res;
27
28$func Optim-Mult (s.res) (e.expr) e.expr-int = e.mult;
29
30$func Optim-Div e.expr-int = e.res;
31
32$func Optim-Rem e.rest = e.res;
33
34$func Optim-Cond-Int s.op e.args = e.res;
35
36$func Optim-Cond (e.init) e.cond = e.res;
37
38$func Optim-Cond-Log s.op e.args = e.res;
39
40$func AND-Args e.args = e.res;
41
42$func OR-Args e.args = e.res;
43
44$func Optim-Int-Args e.args = e.optim-args;
45
46// function for Stack-Int
47$func Push = ;
48
49$func Pop  = e.int;
50
51$func Add-Stack-Int s.int = ;
52
53$func Add-Stack-Flag  = ;
54
55$func Args-Paren (e.init) e.rest  = (e.res);
56
57$func Int-Paren e.init = e.res;
58
59$func Neg-Sign e.int = s.sign;
60
61$func Del-Neg  e.int = e.res;
62
63$func Neg-Optim e.int = e.optim;
64
65// Deleting of unused label on level of function
66$func Correct-Label e.func-body = e.body;
67
68// Clear of table
69$func Clear-Table s.table e.key = ;
70
71$func Label-In-Table t.label = (e.maybe-empty);
72
73ASAIL-Optim  e.asail, e.asail: {
74  /*empty*/ = /*empty*/;
75  t.item e.rest =
76  t.item : {
77    (FUNC t.name t.args t.ress e.body) =
78      <Clear-Table &Used-Label <Domain &Used-Label>>,
79      <ASAIL-Optim e.body> :: e.body,
80      <Correct-Label e.body> :: e.body,
81      (FUNC t.name t.args t.ress e.body);
82    (IF (e.cond) e.body) =
83      <Optim-Cond () e.cond> :: e.res-cond,
84        {
85          e.res-cond: 0 = /*empty*/;
86          <ASAIL-Optim e.body> :: e.body,
87            {
88              e.res-cond : 1 = e.body;
89              (IF (e.res-cond) e.body);
90            };
91        }; 
92    (FOR t.label (e.cond) t.step e.body) =
93      <ASAIL-Optim e.body> :: e.body,                   
94      (FOR t.label (e.cond) t.step e.body);
95    (LABEL t.label e.body) = <ASAIL-Optim e.body> :: e.body,
96      (LABEL t.label e.body) ;
97    (TRY e.body) = <ASAIL-Optim e.body> :: e.body,
98      (TRY e.body);
99    (CATCH-ERROR e.body) =<ASAIL-Optim e.body> :: e.body,
100      (CATCH-ERROR e.body);
101    (LSPLIT e.expr (e.min) t.var1 t.var2) =
102      <Optim-Ref e.expr> :: e.expr,
103      <Push><Optim-Int e.min> :: e.min,
104      (LSPLIT e.expr (e.min) t.var1 t.var2) ;
105    (RSPLIT e.expr (e.min) t.var1 t.var2) =
106      <Optim-Ref e.expr> :: e.expr,
107      <Push><Optim-Int e.min> :: e.min,         
108      (RSPLIT e.expr (e.min) t.var1 t.var2) ;
109    (ASSIGN t.var e.expr) =
110      <Optim-Expr () e.expr> :: e.expr,
111      (ASSIGN t.var e.expr);
112    (EXPR t.var e.expr) = <Optim-Ref e.expr> :: e.expr,
113      (EXPR t.var e.expr);
114    (DEREF t.var e.expr (e.pos)) =
115      (DEREF t.var <Optim-Ref e.expr >
116      (<Push> <Optim-Int e.pos>) );
117    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
118      (SUBEXPR t.var <Optim-Ref e.expr >
119      (<Push> <Optim-Int e.pos>)
120      (<Push> <Optim-Int e.len> ) ) ;
121//  RETURN=RETURN;
122//  RETFAIL=RETFAIL;
123//  FATAL=FATAL;
124//  (DECL e1) = (DECL e1);
125//  (DROP e1) = (DROP e1);
126    (CONTINUE t.label) = 
127      <Bind &Used-Label (t.label) ()>
128      (CONTINUE t.label ) ;
129    (BREAK t.label ) = 
130      <Bind &Used-Label (t.label) ()>
131      (BREAK t.label ) ;
132//  (ERROR e1) = (ERROR e1);
133//  (CONSTEXPR e1) = (CONSTEXPR e1);
134//  (DECL-CONST t.name) = (DECL-CONST t.name);
135//  (DECL-FUNC e1) = (DECL-FUNC e1);
136//  (s.call t.name (e.exprs) (e.ress)) = (s.call t.name (e.exprs)(e.ress));
137    t.item = t.item ;
138    } :: e.cpp-item,
139  e.cpp-item <ASAIL-Optim e.rest>;
140};
141
142Optim-Expr  (e.init) e.expr-all, e.expr-all : {
143  /*empty*/ = e.init;
144  s.ObjectSymbol e.rest,
145    {
146      <Int? s.ObjectSymbol> = <Push>
147        <Optim-Int e.init e.expr-all>;
148      <Optim-Ref e.init  e.expr-all> ;
149    };   
150  (LENGTH e.expr) e.rest = <Push> <Optim-Int e.init e.expr-all> ;
151  (MAX e.args) e.rest = <Push> <Optim-Int e.init e.expr-all>;       
152  (MIN e.args) e.rest = <Push> <Optim-Int e.init e.expr-all>;
153  (INFIX s.op e.args) e.rest = <Push> <Optim-Int e.init e.expr-all>;
154  (PAREN e.expr) e.rest = <Optim-Ref e.init e.expr-all>;
155  (EXPR e.expr) e.rest = <Optim-Ref e.init e.expr-all>;
156  (DEREF e.expr) e.rest = <Optim-Ref e.init  e.expr-all>;
157  (SUBEXPR e.expr) e.rest = <Optim-Ref e.init e.expr-all>;
158  t.var e.rest = <Optim-Expr (e.init t.var) e.rest>;
159};
160
161Optim-Ref  { 
162  /*empty*/ = /*empty*/;
163  t.item e.rest = t.item : {
164    s.ObjectSymbol = s.ObjectSymbol;
165    (PAREN e.expr) = (PAREN <Optim-Ref e.expr> );
166    (EXPR e.expr) = (EXPR <Optim-Ref e.expr> );
167    (DEREF e.expr (e.pos)) =
168      (DEREF <Optim-Ref e.expr> (<Push> <Optim-Int e.pos>));
169    (SUBEXPR e.expr (e.pos) (e.len)) =
170      (SUBEXPR <Optim-Ref e.expr> (<Push> <Optim-Int e.pos>)
171        (<Push> <Optim-Int e.len>)) ;
172    t.var  = t.var ;
173    } :: e.cpp-item,
174  e.cpp-item  <Optim-Ref e.rest>;
175};
176
177Optim-Int  {
178  /*empty*/ = <Pop>;
179  t.item e.rest = t.item : {
180    s.ObjectSymbol = s.ObjectSymbol;
181    (LENGTH e.expr) = (LENGTH <Optim-Ref e.expr>);
182    (MAX e.args) = <Optim-Int-Args e.args> :: e.args,
183      <Optim-MAX () () e.args>;
184    (MIN e.args) = <Optim-Int-Args e.args> :: e.args,
185      <Optim-MIN () () e.args> ;
186    (INFIX s.op e.args ) = s.op: {
187      "+" = <Optim-Int-Args e.args> :: e.args,
188        <Optim-Add (0) () e.args>;
189      "-" = <Optim-Int-Args e.args> :: e.args,
190        <Optim-Minus () () (0) e.args>;
191      "*" = <Optim-Int-Args e.args> :: e.args,
192        <Optim-Mult (1) () e.args> ;
193      "/" = <Optim-Int-Args e.args> :: e.args,
194        <Optim-Div e.args > ;
195      "%" = <Optim-Int-Args e.args> :: e.args,
196        <Optim-Rem e.args>;
197      };
198    t.var = t.var;
199  } :: e.int-item,
200  {
201    e.int-item : s.numb = <Add-Stack-Int s.numb> <Optim-Int e.rest>;
202    <Add-Stack-Flag> e.int-item <Optim-Int e.rest>;
203  };
204};
205
206Optim-Int-Args  {
207  /*empty*/ = /*empty*/;
208  (e.arg) e.rest = <Push>,
209    <Optim-Int e.arg> :: e.res,
210    <Args-Paren () e.res> <Optim-Int-Args e.rest>;
211};
212
213Args-Paren {
214  (e.init ) ((e.expr)) = (e.init (e.expr));
215  (e.init ) t.expr = (e.init t.expr);
216  (e.init ) ((e.expr)) e.rest = <Args-Paren (e.init (e.expr)) e.rest>;
217  (e.init) t.expr e.rest = <Args-Paren (e.init t.expr) e.rest>;
218};
219
220Optim-MAX (e.work) (e.res) e.rest, e.rest: {
221  /*empty*/ =   {
222    e.work : 0  =  {   
223      e.res: /*empty*/ =  0;
224      <Neg-Sign e.res> :: s.sign, s.sign : {
225        1 = 0;
226        0 = (MAX (e.work) <Del-Neg e.res>);
227        };
228      };
229    e.work : /*empty*/ = <Neg-Optim e.res> :: e.arg, e.arg : {
230      (e.max) = (e.max);
231      e.max = (MAX e.max);
232      };
233    (MAX (e.work) <Neg-Optim e.res> ) ;
234    };
235  (t.item) e.args = {
236    t.item : s.IntSymbol = e.work :  {
237      /*empty*/ = <Optim-MAX (s.IntSymbol) (e.res) e.args>;
238      s.Int = {
239        <">" (s.IntSymbol) (s.Int)> =
240          <Optim-MAX (s.IntSymbol) (e.res) e.args >;
241        <Optim-MAX (s.Int) (e.res) e.args >;
242        };
243      };
244    e.res : e.1 (t.item) e.2 = <Optim-MAX (e.work) (e.res) e.args>;
245    <Optim-MAX (e.work) (e.res (t.item)) e.args>;
246    };
247};
248
249Neg-Sign 
250{
251  /*empty*/ = 1;
252  ((INFIX "-" (0) e.int)) e.rest = <Neg-Sign e.rest>;
253  e.int =  0;
254};
255
256Del-Neg {
257  /*empty*/ = /*empty*/;
258  ((INFIX "-" (0) e.int)) e.rest = <Del-Neg e.rest>;
259  t.int e.rest = t.int <Del-Neg e.rest>;
260};
261
262Neg-Optim e.int = <Neg-Sign e.int> :: s.sign, {
263  s.sign : 1 = e.int;
264  <Del-Neg e.int>;
265};
266
267Optim-MIN (e.work) (e.res) e.rest, e.rest: {
268  /*empty*/ = e.work : {
269    /*empty*/ = (MIN e.res);
270    s.int = (MIN (s.int) e.res ) ;
271    };
272  (t.item) e.args,  t.item : {
273    s.IntSymbol = e.work : {
274      /*empty*/ = <Optim-MIN (s.IntSymbol) (e.res) e.args>;
275      s.Int =
276        {
277          <"<" (s.IntSymbol) (s.Int)> =
278            <Optim-MIN (s.IntSymbol) (e.res) e.args >;
279          <Optim-MIN (s.Int) (e.res) e.args >;
280        };
281      };
282    t.item =
283      {
284        e.res : e.1 (t.item) e.2 = <Optim-MIN (e.work) (e.res) e.args>;
285        <Optim-MIN (e.work) (e.res (t.item)) e.args>;
286      };
287    };
288};
289
290Optim-Add (s.res) (e.expr) e.expr-int,  e.expr-int  : {
291  /*empty*/ = {
292    e.expr :  /*empty*/ = s.res ;
293    s.res : 0 = <Int-Paren e.expr>;
294    (INFIX "+" ( s.res e.expr) ) ;
295    };
296  (0) e.rest = <Optim-Add (s.res) (e.expr) e.rest>;
297  (s.Int) e.rest =  <Optim-Add  ( <"+" s.Int s.res>) (e.expr) e.rest>;
298  t.int e.rest = <Optim-Add (s.res) (e.expr t.int) e.rest>;
299};
300
301Optim-Minus {
302  ( )(e.expr)(s.int) = /*empty*/;
303  ( )(e.expr)(s.int) t.term-int e.rest =
304    <Optim-Minus (t.term-int)(e.expr)(s.int) e.rest>;
305  ((e.first)) (e.expr) (s.int) e.expr-int  = e.expr-int : {
306    /*empty*/ = {
307      e.first  :  s.first-int  = {
308        s.int : 0 = (INFIX "-" (s.first-int) e.expr);
309        (INFIX "-" ( <"-" s.first-int s.int>) e.expr);
310        };
311      e.expr : /*empty*/ = {
312        s.int : 0 = <Int-Paren e.first> ;
313        (INFIX "-" (e.first) (s.int) );
314        };
315      s.int : 0 = (INFIX "-"  (e.first) e.expr);
316      (INFIX "-"  (e.first) e.expr (s.int) );
317      };
318    e.first e.rest = <Optim-Minus ((0)) (e.expr)(s.int) e.rest>;
319    (e.1 e.first e.2) e.rest = <Optim-Minus ((0))(e.expr (e.1 e.2))(s.int) e.rest>;
320    (0) e.rest = <Optim-Minus ((e.first)) (e.expr)(s.int) e.rest>;
321    (s.new) e.rest = <Optim-Minus ((e.first)) (e.expr)
322      ( <"+" s.int s.new> ) e.rest>;
323    t.new e.rest = <Optim-Minus ((e.first)) (e.expr t.new)(s.int) e.rest>;
324    };
325};
326
327Optim-Mult (s.res) (e.expr) e.expr-int,  e.expr-int  : {
328  /*empty*/ = {
329    e.expr :  /*empty*/ = s.res ;
330    s.res : 1 = <Int-Paren e.expr> ;
331    (INFIX "*" ( s.res) e.expr ) ;
332    };
333  (0) e.rest = 0 ;
334  (1) e.rest = <Optim-Mult (s.res) (e.expr) e.rest >;
335  (s.Int) e.rest =  <Optim-Mult  ( <"*" s.Int s.res>) (e.expr) e.rest>;
336  t.int e.rest = <Optim-Mult (s.res) (e.expr t.int) e.rest>;
337};
338
339Optim-Div  {
340  /*empty*/ = /*empty*/;
341  (0) e.expr = 0;
342  t.int e.expr = <Optim-Mult (1) () e.expr> :: e.znam, e.znam: {
343    1 = <Int-Paren t.int> ;
344    1 e.rest = (INFIX "/" t.int e.rest  );
345    e.znam = (INFIX "/" e.znam );
346    };
347};
348
349Optim-Rem  {
350  (0) e.int = 0;
351  e.expr1 (0) e.expr2 = $error ("Int-operation Mod for zero");
352  t.int t.int e.expr = 0;
353  t.int e.expr1 (1) e.expr2 = 0;
354  (s.int1) (s.int2) e.expr = <Rem s.int1 s.int2> :: s.res, {
355    s.res : 0 = 0;
356    <Optim-Rem (s.res) e.expr >;
357    };
358  e.expr = (INFIX "%"  e.expr);
359};
360   
361Optim-Cond (e.init) e.cond, e.cond: {
362  /*empty*/ =  {
363    e.init : /*empty*/ = 1;
364    e.init;
365    };
366  e.cond1  0 e.cond2 = 0;
367  e.cond1  1  e.cond2 = <Optim-Cond (e.init) e.cond1 e.cond2 >;
368  t.cond-term e.rest = t.cond-term : {
369    (CALL e.call) = <Optim-Cond (e.init (CALL e.call)) e.rest>;
370    (SYMBOL? e.expr (e.pos)) = <Optim-Ref e.expr> :: e.expr,
371      <Push> <Optim-Int e.pos> :: e.pos,
372      <Optim-Cond (e.init (SYMBOL? e.expr (e.pos))) e.rest>;     
373    (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
374       <Optim-Ref e.expr> :: e.expr,
375       <Push> <Optim-Int e.pos> :: e.pos,
376       <Push> <Optim-Int e.len> :: e.len,
377       <Optim-Cond (e.init (FLAT-SUBEXPR? e.expr
378         (e.pos)(e.len))) e.rest>;
379    (EQ (e.expr1) (e.pos1) (e.len1) (e.expr2) (e.pos2) (e.len2)) =
380      <Optim-Ref e.expr1> :: e.expr1,
381      <Push> <Optim-Int e.pos1> :: e.pos1,
382      <Push> <Optim-Int e.len1> :: e.len1,     
383      <Optim-Ref e.expr2> :: e.expr2,
384      <Push> <Optim-Int e.pos2> :: e.pos2,
385      <Push> <Optim-Int e.len2> :: e.len2,
386      <Optim-Cond (e.init (EQ (e.expr1)
387        (e.pos1)(e.len1)(e.expr2)(e.pos2)(e.len2)))e.rest>;
388    (FLAT-EQ (e.expr1) (e.pos1) (e.expr2) (e.pos2) (e.len)) =
389      <Optim-Ref e.expr1> :: e.expr1,
390      <Push> <Optim-Int e.pos1> :: e.pos1,
391      <Optim-Ref e.expr2> :: e.expr2,
392      <Push> <Optim-Int e.pos2> :: e.pos2,
393      <Push> <Optim-Int e.len> :: e.len,
394      <Optim-Cond (e.init (FLAT-EQ (e.expr1)
395        (e.pos1)(e.expr2)(e.pos2)(e.len))) e.rest>;
396    (NOT e.cond-new) = <Optim-Cond () e.cond-new> :: e.res,
397      e.res: {
398        0 = <Optim-Cond (e.init) e.rest>;
399        1 = 0;
400        e.res = <Optim-Cond (e.init (NOT e.res)) e.rest>;
401        };
402    (INFIX s.op e.args) =  {
403      s.op : \{ "&&"; "||"; } =
404        <Optim-Cond () e.args> :: e.args,
405          <Optim-Cond-Log s.op e.args>;
406      s.op : \{ "<"; ">"; "<="; ">="; "=="; } =
407        <Optim-Int-Args e.args> :: e.args,
408          <Optim-Cond-Int s.op e.args>;
409      };
410    };
411};
412
413Optim-Cond-Log s.op e.args,
414  <Optim-Cond () e.args> :: e.res,
415  s.op: {
416    "&&" = {
417      e.res : e.log1 0 e.log2 = 0;
418      <AND-Args e.res> :: e.log, {
419        e.log: /*empty*/ = 1;
420        (INFIX "&&" e.log);
421        };
422      };
423    "||" = {
424      e.res : e.log1 1 e.log2 = 1;
425      <OR-Args e.res> :: e.log, {
426        e.log: {
427          /*empty*/ = 0;
428          e.log1 s.int e.log2 = 1;
429          };
430        (INFIX "||" e.log);
431        };
432      };
433};
434
435AND-Args  {
436  /*empty*/ = /*empty*/;
437  s.log e.args = <AND-Args e.args>;
438  t.log e.args = t.log <AND-Args e.args>;
439};
440
441OR-Args  {
442  /*empty*/ = /*empty*/;
443  0  e.args = <OR-Args e.args>;
444  s.log e.args = 1;
445  t.log e.args = t.log <OR-Args e.args>;
446};
447
448Optim-Cond-Int s.op e.args, {
449  e.args : (s.1)  (s.2) = s.op : {
450    "==" = {
451      <"=" (s.1) (s.2) > = 1;
452      0;
453      };
454    "<" = {
455      <"<" (s.1) (s.2)> = 1;
456      0;
457      };
458    ">" = {
459      <">" (s.1) (s.2)> = 1;
460      0;
461      };
462    ">=" = {
463      <">=" (s.1) (s.2)> = 1;
464      0;
465      };
466    "<=" = {
467      <"<=" (s.1) (s.2)> = 1;
468      0;
469      };
470    };
471// e.args : (0)  (e.arg2) = s.op : {
472//  "<=" = 1;
473//  ">" = 0;
474//  s.op =      (INFIX s.op e.args);
475//  };
476// e.args : (e.arg1) (0) = s.op : {
477//  "<" = 0;
478//  ">=" = 1;
479//  s.op =      (INFIX s.op e.args);
480//  };
481  e.args : (e.arg1)(e.arg1) = s.op:{
482    "==" = 1;
483    "<=" = 1;
484    ">=" = 1;
485    "<" = 0;
486    ">" = 0;
487    };
488  (INFIX s.op e.args);
489};
490
491Push /*empty*/ = <Store &Stack-Int (0) <? &Stack-Int> >;
492
493Pop  /*empty*/ =
494  <? &Stack-Int> :: e.stack,
495    e.stack : (s.flag e.int) e.rest,
496    <Store &Stack-Int e.rest>,
497    e.int : {
498      /*empty*/ = ;
499      0 = s.flag : {
500        0 = 0;
501        1 = ;
502        };
503      s.res = s.res;
504};
505
506Add-Stack-Int s.int =
507  <? &Stack-Int> :: e.stack,
508    e.stack : (s.flag e.res) e.rest,
509    e.res : {
510      /*empty*/ = <Store &Stack-Int (s.flag s.int) e.rest>;
511      s.old = <Store &Stack-Int (s.flag <"+" s.old s.int>) e.rest>;
512      };
513
514Add-Stack-Flag /*empty*/ = 
515  <? &Stack-Int> :: e.stack,
516    e.stack : (s.flag e.res) e.rest,
517    <Store &Stack-Int (1 e.res) e.rest>;       
518
519Int-Paren  {
520  /*empty*/ = /*empty*/;
521  ((e.int)) e.tail = (e.int) <Int-Paren e.tail>;
522  t.int  e.tail = t.int <Int-Paren e.tail>;     
523};
524
525Clear-Table {
526  s.table = ;
527  s.table (e.key) e.rest =  <Unbind s.table e.key>
528    <Clear-Table s.table e.rest>;
529};
530
531Correct-Label  e.asail, e.asail: {
532  /*empty*/ = /*empty*/;
533  t.item e.rest =
534  t.item : {
535    (IF (e.cond) e.body) =
536      <Correct-Label e.body> :: e.body,
537      (IF (e.cond) e.body);
538    (FOR (t.label) (e.cond) t.step e.body) =
539      <Label-In-Table t.label> :: (e.maybe-empty),
540      <Correct-Label e.body> :: e.body,                                                                 
541      (FOR (e.maybe-empty) (e.cond) t.step e.body);
542    (LABEL (t.label) e.body) =
543      <Label-In-Table t.label> :: (e.maybe-empty),
544      <Correct-Label e.body> :: e.body,
545      (LABEL (e.maybe-empty) e.body) ;
546    (TRY e.body) = <Correct-Label e.body> :: e.body,
547      (TRY e.body);
548    (CATCH-ERROR e.body) =<Correct-Label e.body> :: e.body,
549      (CATCH-ERROR e.body);
550    t.item = t.item ;
551    } :: e.cpp-item,
552  e.cpp-item <Correct-Label e.rest>;
553};
554
555Label-In-Table t.label = {
556  <In-Table? &Used-Label  t.label> = (t.label);
557   ();
558};
Note: See TracBrowser for help on using the repository browser.