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

Last change on this file since 1146 was 1146, checked in by orlov, 17 years ago
  • Support for references to functions. Including ones with formats other then

e = e.

  • Support for iterative splitting from the right.
  • Composition of clashes left hand side is corrected.
  • Renaming of variables is corrected.
  • Some other small bugs are fixed.
  • A lot of unused code is throwed away, some code is cleaned up, some comments

are added.

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