source: to-imperative/trunk/compiler/rfp_asail.rf @ 694

Last change on this file since 694 was 694, checked in by orlov, 18 years ago
  • Added parentheses around t.label int the LABEL form in ASAIL.
  • Corrected Expr-variables defenitions.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.9 KB
Line 
1// $Source$
2// $Revision: 694 $
3// $Date: 2003-04-29 02:04:27 +0000 (Tue, 29 Apr 2003) $
4
5$use Apply Box Class Compare Convert StdIO Table;
6$use "rfpc";
7$use "rfp_helper";
8$use "rfp_list";
9$use "rfp_mangle";
10
11$box Module-Name;
12
13$box Func-Names;
14
15$box Current-Namespace;
16
17$box Entry;
18
19$box Entry-Name;
20
21$func ASAIL-To-CPP e.body = e.cpp-code;
22
23$func Namespace-Control e.qualifiers = e.namespace-control;
24
25$func Expr-To-CPP (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.ASAIL-Expr;
26
27$func Expr-Ref-To-CPP s.inner-call? e.ASAIL-Expr-Ref = e.CPP-Expr-Ref;
28
29$func Expr-Int-To-CPP e.ASAIL-Expr-Int = e.CPP-Expr-Int;
30
31$func Step-To-CPP e.step-operators = e.cpp-step-operators;
32
33$func Const-Expr-To-CPP e.ASAIL-const-expr = e.CPP-const-expr;
34
35$func Args-To-CPP (e.prefix) s.Arg-Res-Tag e.ASAIL-Args = e.CPP-Args;
36
37$func Symbol-To-CPP s.RFP-Symbol = e.CPP-String;
38
39$func Name-To-CPP t.name = e.CPP-Name;
40
41$func Cond-To-CPP e.cond = e.CPP-Cond;
42
43$func Infix-To-CPP s.func-for-converting-args-to-cpp s.op e.args = e.cpp-expr;
44
45$func Op-Arg-To-CPP s.op = s.func-for-converting-args-to-cpp;
46
47RFP-ASAIL-To-CPP (e.ModuleName) e.asail =
48  <Store &Module-Name e.ModuleName>,
49  <Store &Func-Names /*empty*/>,
50  <Store &Current-Namespace /*empty*/>,
51  <Store &Entry (e.ModuleName Main)>,
52  <Store &Entry-Name /*empty*/>,
53  {
54    <ASAIL-To-CPP e.asail> : v.cpp,
55      {
56        <? &Current-Namespace> : v = ('}');;  // close last namespace
57      } :: e.close-namespace,
58      <Store &Current-Namespace /*empty*/>,
59      <Box> :: s.func-decls,
60      {
61        <? &Func-Names> : e t.name e,
62          <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
63          <Put s.func-decls
64            <Namespace-Control e.qualifiers>
65            ('RF_DECL (' <Rfp2Cpp e.name> ');')
66          >, $fail;
67        <? s.func-decls> : v = <Put s.func-decls ('}')>;;
68      },
69      {
70        <? &Entry-Name> : v.name = ('rfrt::Entry rf_entry (' v.name ');');;
71      } :: e.entry,
72      ('namespace refal\n{')
73      ('using namespace rfrt;')
74      <? s.func-decls> v.cpp e.close-namespace e.entry
75      ('}');;
76  };
77
78ASAIL-To-CPP e.asail, {
79  e.asail : t.item e.rest, t.item : {
80    (FUNC t.name (e.args) (e.ress) e.body) =
81      <Put &Func-Names t.name>,
82      { <? &Entry> : t.name = <Store &Entry-Name <Rfp2Cpp t.name>>;; },
83      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
84      <Namespace-Control e.qualifiers>
85      ('RF_FUNC (' <Rfp2Cpp e.name> ', '
86        '(' <Args-To-CPP ('RF_ARG ') Vars e.args> '), '
87        '(' <Args-To-CPP ('RF_RES ') Vars e.ress> '))'
88          (<ASAIL-To-CPP e.body>)
89       'RF_END');
90    (IF (e.cond) e.body) =
91      ('if (' <Cond-To-CPP e.cond> ')')
92      ('{' (<ASAIL-To-CPP e.body>) '}');
93    (FOR (e.label) (e.cond) (e.step) e.body) =
94      {
95        e.label : t = (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');;
96      } :: e.label,
97      ('for ( ; ' <Cond-To-CPP e.cond> '; ' <Step-To-CPP e.step> ')')
98      ('{' (<ASAIL-To-CPP e.body>) e.label '}');
99    (LABEL (e.label) e.body) =
100      {
101        e.label : /*empty*/ =
102          ('{' (<ASAIL-To-CPP e.body>) '}' );
103        ('{' (<ASAIL-To-CPP e.body>) '}')
104        (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');
105      };
106    (TRY e.body) =
107      ('trap {' (<ASAIL-To-CPP e.body>) '}');
108    (CATCH-ERROR e.body) =
109      ('with {' (<ASAIL-To-CPP e.body>) '}');
110    RETURN = ('return true;');
111    RETFAIL = ('retfail;');
112    FATAL = ('error ("Unexpected fail");');
113    (LSPLIT e.expr (e.min) t.var1 t.var2) =
114      ('lsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
115      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2> ');');
116    (RSPLIT e.expr (e.min) t.var1 t.var2) =
117      ('rsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
118      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2 > ');');
119    (ASSIGN t.var e.expr) =
120      (<Rfp2Cpp t.var> ' = ' <Expr-To-CPP () e.expr> ';');
121    (DECL s.type t.var) =
122      (s.type ' ' <Rfp2Cpp t.var> ';');
123    (EXPR t.var e.expr) =
124      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ');');
125    (DEREF t.var e.expr (e.pos)) =
126      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ', '
127      <Expr-Int-To-CPP e.pos> ');');
128    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
129      ('Expr ' <Rfp2Cpp t.var> ' ('
130      <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.pos> ', '
131      <Expr-Int-To-CPP e.len> ');');
132    (DROP t.var) =
133      (<Rfp2Cpp t.var> '.drop ();');
134    (CONTINUE t.label) =
135      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
136    (BREAK t.label) =
137      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
138    (ERROR e.expr) =
139      ('error (' <Expr-Ref-To-CPP 0 e.expr> ');');
140    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
141      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
142      {
143        t.name : (STATIC e) = (<? &Module-Name>) t.name;
144        <RFP-Extract-Qualifiers t.name>;
145      } :: (e.qualifiers) e.name,
146      <Namespace-Control e.qualifiers>
147      (e.linkage 'const Expr ' <Rfp2Cpp e.name> ' = '
148        <Const-Expr-To-CPP e.expr> ';');
149    (DECL-CONST t.name) =
150      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
151      <Namespace-Control e.qualifiers>
152      ('extern const Expr ' <Rfp2Cpp e.name> ';');
153    (DECL-FUNC t.name) =
154      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
155      <Namespace-Control e.qualifiers>
156      ('RF_DECL (' <Rfp2Cpp e.name> ');');
157    /*
158     * s.call can be CALL or TAILCALL
159     */
160    (s.call t.name (e.exprs) (e.ress)) =
161      ('RF_' s.call ' (' <Name-To-CPP t.name> ', '
162      '(' <Args-To-CPP () Exprs e.exprs> '), (' <Args-To-CPP () Vars e.ress> '));');
163  } :: e.cpp-item,
164    e.cpp-item <ASAIL-To-CPP e.rest>;
165  /*empty*/;
166};
167
168/*
169 * Determine type of e.expr - int or Refal.
170 */
171Expr-To-CPP  (e.init) e.expr-all, e.expr-all : {
172  /*empty*/ = <Expr-Ref-To-CPP 0 e.init>;
173//  s.ObjectSymbol e.rest, {
174//    <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
175//    <Expr-Ref-To-CPP 0 e.expr-all>;
176//  };   
177  (PAREN e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
178  (EXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
179  (DEREF e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
180  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
181  (LENGTH e.expr) e.rest = <Expr-Int-To-CPP e.init e.expr-all> ;
182  (MAX e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;         
183  (MIN e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
184  (INFIX s.op e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
185  (s.var-tag (e.QualifiedName)) e.rest =
186    <Expr-To-CPP (e.init (s.var-tag (e.QualifiedName))) e.rest>;
187};
188
189Expr-Ref-To-CPP s.inner-call? e.expr-ref, e.expr-ref : {
190  t.item e.rest =
191    {
192      e.rest : v = ' + ';
193      /*empty*/;
194    } :: e.plus,
195    t.item : {
196//      s.ObjectSymbol = <Symbol-To-CPP s.ObjectSymbol>;
197      (PAREN e.expr) =
198        {
199          e.expr : t t e = '(' <Expr-Ref-To-CPP 0 e.expr> ') ()';
200          <Expr-Ref-To-CPP 0 e.expr> ' ()';
201        };
202      (EXPR e.expr) =
203        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ')';
204      (DEREF e.expr (e.pos)) =
205        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
206             <Expr-Int-To-CPP e.pos> ')';
207      (SUBEXPR e.expr (e.pos) (e.len)) =
208        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
209             <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
210      (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
211      ex = $error ("Illegal type ref-expr : " ex );
212    } :: e.cpp-item,
213    e.cpp-item e.plus <Expr-Ref-To-CPP 1 e.rest>;
214  /*empty*/ =
215    {
216      s.inner-call? : 1 = /*empty*/;
217      'empty';
218    };
219};
220
221Expr-Int-To-CPP {
222  t.item e.rest =
223    {
224      e.rest : v = ' + ';
225      /*empty*/;
226    } :: e.plus,
227    t.item : {
228      s.ObjectSymbol =
229        {
230          <Int? s.ObjectSymbol> = s.ObjectSymbol;
231          $error ("Illegal type int-symbol: " s.ObjectSymbol);
232        };
233      (LENGTH e.expr) =
234        '(int) ' <Expr-Ref-To-CPP 0 e.expr> '.get_len ()';
235      (MAX e.args) =
236        'pxx_max (' <Args-To-CPP () Ints e.args> ')';
237      (MIN e.args) =
238        'pxx_min (' <Args-To-CPP () Ints e.args> ')';
239      (INFIX s.op e.args) =
240        '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
241      (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
242      ex = $error ("Illegal type ref-int : " ex );
243    } :: e.cpp-item,
244    e.cpp-item e.plus <Expr-Int-To-CPP e.rest>;
245  /*empty*/ = /*empty*/;
246};
247
248Cond-To-CPP {
249  /*empty*/ = /*empty*/;
250  t.cond-term e.rest =
251    {
252      e.rest : v = ' && ';
253      /*empty*/;
254    } :: e.and,
255    t.cond-term : {
256      (CALL t.name (e.exprs) (e.ress)) =
257        'RF_CALL (' <Name-To-CPP t.name> ', '
258        '(' <Args-To-CPP () Exprs e.exprs> '), '
259        '(' <Args-To-CPP () Vars e.ress> '))';
260      (SYMBOL? e.expr (e.pos)) =
261         <Expr-Ref-To-CPP 0 e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')';
262      (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
263         <Expr-Ref-To-CPP 0 e.expr> '.flat_at ('
264          <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
265      /*
266       * EQ -> to function eq() with 6 arg.
267       */
268      (EQ (e.expr1) (e.pos1) (e.len1) (e.expr2) (e.pos2) (e.len2)) =
269        'Expr::eq ('<Expr-Ref-To-CPP 0 e.expr1> ', '
270              <Expr-Int-To-CPP e.pos1>    ', ' <Expr-Int-To-CPP e.len1> ', '
271              <Expr-Ref-To-CPP 0 e.expr2> ', '
272              <Expr-Int-To-CPP e.pos2>    ', ' <Expr-Int-To-CPP e.len2> ')';
273      /*
274       * FLAT-EQ -> to function flat_eq() with 5 arg.
275       */
276      (FLAT-EQ (e.expr1) (e.pos1) (e.expr2) (e.pos2) (e.len)) =
277        'Expr::flat_eq ('<Expr-Ref-To-CPP 0 e.expr1> ', ' <Expr-Int-To-CPP e.pos1>
278              ', ' <Expr-Ref-To-CPP 0 e.expr2> ', ' <Expr-Int-To-CPP e.pos2>
279              ', ' <Expr-Int-To-CPP e.len> ')';
280      (NOT e.cond) =
281        '!' <Cond-To-CPP e.cond>;
282      (INFIX s.op e.args) =
283        '(' <Infix-To-CPP <Op-Arg-To-CPP s.op> s.op e.args> ')';
284    } :: e.cpp-term,
285    e.cpp-term e.and <Cond-To-CPP e.rest>;
286};
287
288Infix-To-CPP s.arg2cpp s.op e.args, {
289  e.args : (e.arg) e.rest =
290    {
291      e.rest : v = ' ' s.op ' ';
292      /*empty*/;
293    } :: e.cpp-op,
294    '(' <Apply s.arg2cpp e.arg> ')' e.cpp-op <Infix-To-CPP s.arg2cpp s.op e.rest>;;
295};
296
297Op-Arg-To-CPP s.op, {
298  s.op : \{ "&&"; "||"; } = &Cond-To-CPP;
299  s.op : \{ "<"; ">"; "<="; ">="; "=="; "+"; "-"; "%"; "*"; "/"; } = &Expr-Int-To-CPP;
300};
301 
302Step-To-CPP {
303  /*empty*/ = /*empty*/;
304  (INC-ITER t.var) = 'iter(' <Rfp2Cpp t.var> ')++';
305};
306
307
308
309$func Const-Expr-Aux e.expr = e.cpp-expr;
310
311Const-Expr-To-CPP {
312  /*empty*/ = 'empty';
313  (SUBEXPR t.name s.pos s.len) = 'Expr (' <Rfp2Cpp t.name> ', ' s.pos ', ' s.len ')';
314                  //FIXME: надо проверять, что s.pos и s.len
315                  //       не превышают допустимых величин.
316                  //       Задавать эти величины опциями.
317  e.expr =
318    <Const-Expr-Aux () e.expr> : {
319      ' + ' e.cpp-expr = e.cpp-expr;
320      e.cpp-expr = e.cpp-expr;
321    };
322};
323
324Const-Expr-Aux (e.accum) e.expr, {
325  e.expr : s.sym e.rest, <Char? s.sym> =
326    <Const-Expr-Aux (e.accum <Symbol-To-CPP s.sym>) e.rest>;
327  e.accum : v =
328    ' + Char::create_expr ("' e.accum '")' <Const-Expr-Aux () e.expr>;
329  e.expr : t.item e.rest, t.item : {
330    (PAREN e.paren-expr) =
331      ' + (' <Const-Expr-To-CPP e.paren-expr> ') ()';
332    (REF (e.QualifiedName)) =
333      ' + ' <Name-To-CPP (e.QualifiedName)>;
334    (STATIC e) =
335      ' + ' <Rfp2Cpp t.item>;
336    s.sym, {
337      <Int? s.sym>, {
338        <"<" (<Abs s.sym>) (2147483648)> =              //FIXME: значение должно
339                            //       задаваться опцией.
340          ' + ShortInt::create_expr (' s.sym ')';
341        ' + Int::create_expr (' s.sym ')';
342      };
343      <Word? s.sym> =
344        ' + Word::create_expr ("' <Symbol-To-CPP s.sym> '")';
345    };
346  } :: e.cpp-item =
347    e.cpp-item <Const-Expr-Aux () e.rest>;
348  = /*empty*/;
349};
350
351Symbol-To-CPP s.ObjectSymbol, {
352  <To-Chars s.ObjectSymbol> () $iter {
353    e.symbol : s.char e.rest, s.char : {
354      '\\' = '\\\\';
355      '\n' = '\\n';
356      '\t' = '\\t';
357//        '\v' = '\\v';
358//        '\b' = '\\b';
359      '\r' = '\\r';
360//        '\f' = '\\f';
361      '\"' = '\\"';
362      '\'' = '\\\'';
363      s = s.char;
364    } :: e.cpp-char,
365    e.rest (e.cpp-symbol e.cpp-char);
366  } :: e.symbol (e.cpp-symbol),
367    e.symbol : /*empty*/ =
368    e.cpp-symbol;
369};
370
371
372
373Args-To-CPP {
374  (e.prefix) Vars /*empty*/ = /*empty*/;
375  (e.prefix) s.tag e.args =
376    e.args () $iter {
377      e.args : (e.arg) e.rest =
378        {
379          e.rest : v = ', ';
380          /*empty*/;
381        } :: e.comma,
382        s.tag : {
383          Vars = e.rest (e.cpp-args <Rfp2Cpp (e.arg)> e.comma);
384          Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP 0 e.arg> e.comma);
385          Ints = e.rest (e.cpp-args <Expr-Int-To-CPP e.arg> e.comma);
386        };
387    } :: e.args (e.cpp-args),
388    e.args : /*empty*/,
389    e.prefix e.cpp-args;
390};
391
392Name-To-CPP t.obj-name =
393  <RFP-Extract-Qualifiers t.obj-name> :: (e.qualifiers) e.name,
394  <? &Current-Namespace> :: e.namespace,
395  {
396    e.qualifiers : e.namespace e.cont = <Rfp2Cpp e.cont e.name>;
397    <Rfp2Cpp t.obj-name>;
398  };
399
400Namespace-Control e.qualifiers, {
401  <? &Current-Namespace> : e.qualifiers;
402  {
403    <? &Current-Namespace> : v = ('}');;
404  } :: e.close-namespace,
405    <Store &Current-Namespace e.qualifiers>,
406    e.close-namespace ('namespace ' <Rfp2Cpp e.qualifiers> '\n{');
407};
408
Note: See TracBrowser for help on using the repository browser.