source: to-imperative/trunk/compiler/src/org/refal/plus/compiler/rfp_asail_tpp.rf @ 3596

Last change on this file since 3596 was 3596, checked in by orlov, 13 years ago
  • Some advances in compiling to T++.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.8 KB
Line 
1$use Access Apply Arithm Box Class Compare Convert CppMangle List StdIO Table;
2
3$use "org.refal.plus.compiler.rfpc";
4$use "org.refal.plus.compiler.rfp_helper";
5$use "org.refal.plus.compiler.rfp_vars";
6
7$box Int;
8
9$box Module_Name;
10
11$box Current_Namespace;
12
13$box Current_Func;
14
15$box Current_Trace;
16
17$box Entry;
18
19$box Entry_Name;
20
21$box Const_Exprs;
22
23$table Externs;
24
25$table Unavailable_Imports;
26$table Used_Unavailable_Imports;
27
28$table Decls;
29$table Locals;
30
31$table Used_Consts;
32
33$func ASAIL_To_CPP e.body = e.cpp_code;
34
35$func Open_Namespace e.name = e;
36$func Close_Namespace e.name = e;
37
38$func Namespace_Control e.qualifiers = e.namespace_control;
39
40$func Expr_Ref_To_CPP s.tvars_box e.ASAIL_Expr_Ref = e.CPP_Expr_Ref;
41
42$func Expr_Int_To_CPP e.ASAIL_Expr_Int = e.CPP_Expr_Int;
43
44$func Step_To_CPP e.step_operators = e.cpp_step_operators;
45
46$func Const_Expr_To_CPP e.ASAIL_const_expr = e.CPP_const_expr;
47
48$func Args_To_CPP (e.prefix) s.Arg_Res_Tag e.ASAIL_Args = e.CPP_Args;
49
50$func Symbol_To_CPP s.RFP_Symbol = e.CPP_String;
51
52$func QName_To_Cpp e.name = e.cpp_name;
53
54$func Name_To_CPP s.decl_type t.name = e.CPP_Name;
55
56$func Cond_To_CPP t.cond = e.CPP_Cond;
57
58$func Infix_To_CPP (e.box) s.func_for_converting_args_to_cpp s.op e.args = e.cpp_expr;
59
60$func Trace_Enter e.name (e.args) = e.trace;
61$func Trace_Exit  e.name (e.ress) = e.trace;
62$func Trace_Fail  e.name          = e.trace;
63
64$func Extract_Qualifiers t.name = (e.qualifiers) e.name;
65
66
67RFP_ASAIL_To_TPP (MODULE (e.ModuleName) e.asail) =
68  {
69    <Store &Int <Lookup &RFP_Options INT>>;
70    <Store &Int "rftype::Integer">;
71  },
72  <Store &Module_Name e.ModuleName>,
73  <Store &Current_Namespace /*empty*/>,
74  {
75    <Store &Entry <Lookup &RFP_Options ENTRIES>>;
76    <Store &Entry (e.ModuleName Main)>;
77  },
78  <Store &Entry_Name /*empty*/>,
79  <Store &Const_Exprs /*empty*/>,
80  <ClearTable &Externs>,
81  <ClearTable &Unavailable_Imports>,
82  <ClearTable &Used_Unavailable_Imports>,
83  <ClearTable &Decls>,
84  <ClearTable &Locals>,
85  <ClearTable &Used_Consts>,
86  {
87    <ASAIL_To_CPP e.asail> : v.cpp,
88      v.cpp <Map &Close_Namespace (<Get &Current_Namespace>)> :: v.cpp,
89      <Store &Current_Namespace /*empty*/>,
90      <ASAIL_To_CPP <Domain &Used_Unavailable_Imports>> :: e.imp,
91      e.imp <Map &Close_Namespace (<Get &Current_Namespace>)> v.cpp :: v.cpp,
92      <Store &Current_Namespace /*empty*/>,
93      {
94        <Get &Entry_Name> : v.name = ('rfrt::Entry rf_entry (' v.name ');');;
95      } :: e.entry,
96      {
97        <Get &Const_Exprs> : v.c_exprs =
98          <Namespace_Control <Get &Module_Name>> :: e.nc,
99          (/*e.init_consts*/) (/*e.decl_consts*/) v.c_exprs $iter {
100            e.c_exprs : (t.name (e.value) e.decl) e.rest =
101              {
102                <IsInTable &Used_Consts t.name> =
103                  {
104                    t.name : (STATIC e) = <Rfp2Cpp t.name>;
105                    <Name_To_CPP "DECL-OBJ" t.name>;
106                  } :: e.name,
107                  (e.init_consts (e.name ' = new TExpr;') (e.value ';')) (e.decl_consts e.decl) e.rest;
108                (e.init_consts) (e.decl_consts) e.rest;
109              };
110          } :: (e.init_consts) (e.decl_consts) e.c_exprs,
111          e.c_exprs : /*empty*/ =
112          e.nc
113          ('static void init_ () {' (e.init_consts) '}')
114          ('static AtStart init_registrator_ (&init_);')
115          <Map &Close_Namespace (<Get &Current_Namespace>)>
116          (<Store &Current_Namespace /*empty*/>
117            <Namespace_Control <Get &Module_Name>>
118            e.decl_consts
119            <Map &Close_Namespace (<Get &Current_Namespace>)>
120          );
121        ();
122      } :: e.init (e.decl_consts),
123      <Store &Current_Namespace /*empty*/>,
124      ('#include <rf_core.hh>')
125      ('using namespace rfrt;')
126      <ASAIL_To_CPP <List.Sub (<Domain &Decls>) <Domain &Locals>>>
127      <Map &Close_Namespace (<Get &Current_Namespace>)>
128      e.decl_consts
129      v.cpp e.init e.entry;;
130  };
131
132ASAIL_To_CPP e.asail, {
133  e.asail : t.item e.rest, t.item : {
134    (s.tag UNDEF e) = ;
135    (LINENUMBER sN) = ;
136    (NATIVE s.linkage s.tag (e.name) (e.in) (e.out) e.native) =
137        <Del_Pragmas <Gener_Var_Indices 1 (<Vars e.in>) 'arg'>> : e.rfArg s,
138        <Del_Pragmas <Gener_Var_Indices 1 (<Vars e.out>) 'res'>> : e.rfRes s,
139        <ASAIL_To_CPP (s.tag LOCAL (e.name) (e.rfArg) (e.rfRes) (ERROR e.name "Not available"))>;
140    (s.tag IMPORT (e.name) t.args t.ress e.body),
141      s.tag : \{ FUNC; "FUNC?"; },
142      e.name : "org" "refal" "plus" "wrappers" e.n =
143      <Bind &Unavailable_Imports (e.name)
144        (s.tag LOCAL (<ToWord <Intersperse ('_') e.n>>) t.args t.ress
145          (ERROR e.n "Not available"))>;
146    (TFUNC s.linkage t.name (e.args) (e.ress) e.body),
147      <Store &Current_Func t.name>,
148      { <Get &Entry> : e t.name e = <Store &Entry_Name <QName_To_Cpp <Concat t.name>>>;; },
149      {
150        \{
151          <IsInTable &RFP_Options TRACEALL>;
152          <IsInTable &RFP_Trace t.name>;
153        } =
154          <Intersperse ('.') <Concat t.name>> :: e.name,
155          <Store &Current_Trace e.name (e.ress)>,
156          (<Trace_Enter e.name (e.args)>) (<Trace_Exit e.name (e.ress)>);
157        <Store &Current_Trace /*empty*/>,
158          () ();
159      } :: (e.trace_enter) (e.trace_exit),
160      <MapIn &Rfp2Cpp (<Paren e.args>)> :: e.args,
161      <MapIn &Id 'TExpr ' (e.args)> :: e.args,
162      <MapIn &Rfp2Cpp (<Paren e.ress>)> :: e.ress,
163      <MapIn &Id 'tout Expr ' (e.ress)> :: e.ress,
164      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
165      <Namespace_Control e.qualifiers>
166      ('tfun int '<Name_To_CPP "DECL-FUNC" t.name>' ('<Concat <Intersperse (', ') e.args e.ress>>') {'
167        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit ('return 0;'))
168      '}');
169    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
170      s.tag : \{ FUNC; "FUNC?"; } =
171      <Store &Current_Func t.name>,
172      { <Get &Entry> : e t.name e = <Store &Entry_Name <QName_To_Cpp <Concat t.name>>>;; },
173      {
174        \{
175          <IsInTable &RFP_Options TRACEALL>;
176          <IsInTable &RFP_Trace t.name>;
177        } =
178          <Intersperse ('.') <Concat t.name>> :: e.name,
179          <Store &Current_Trace e.name (e.ress)>,
180          (<Trace_Enter e.name (e.args)>) (<Trace_Exit e.name (e.ress)>);
181        <Store &Current_Trace /*empty*/>,
182          () ();
183      } :: (e.trace_enter) (e.trace_exit),
184      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
185      <Namespace_Control e.qualifiers>
186      ('RF_FUNC (' <Name_To_CPP "DECL-FUNC" t.name> ', '
187            <Args_To_CPP ('RF_ARG ') Vars e.args> ', '
188            <Args_To_CPP ('RF_RES ') Vars e.ress> ')'
189        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit)
190       'RF_END');
191    (TRACE t.name) =
192      <Bind &RFP_Trace (t.name) ()>;
193    ("IF-INT-CMP" s.op (e.arg1) (e.arg2) e.body) =
194      ('if (' <Expr_Int_To_CPP e.arg1> ' 's.op' ' <Expr_Int_To_CPP e.arg2> ')')
195      ('{' (<ASAIL_To_CPP e.body>) '}');
196    (IF t.cond e.body) =
197      ('if (' <Cond_To_CPP t.cond> ')')
198      ('{' (<ASAIL_To_CPP e.body>) '}');
199    (FOR (e.cont_label) (e.break_label) (e.cond) (e.step) e.body) =
200      {
201        e.cont_label : t =
202          ('{'
203            ('{' (<ASAIL_To_CPP e.body>) '}')
204            (LABEL <Rfp2Cpp (LABEL e.cont_label)> ': {}')
205          '}');
206        ('{' (<ASAIL_To_CPP e.body>) '}');
207      } :: e.body,
208      {
209        e.break_label : t = (LABEL <Rfp2Cpp (LABEL e.break_label)> ': {}');;
210      } :: e.break,
211      ('for ( ; ; ' <Step_To_CPP e.step> ')') e.body e.break;
212    (LABEL (e.label) e.body) =
213      ('{' (<ASAIL_To_CPP e.body>) '}')
214      (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');
215    (TRY e.body) =
216      ('RF_TRAP') ('{' (<ASAIL_To_CPP e.body>) '}');
217    ("CATCH-ERROR" e.body) =
218      ('RF_WITH') ('{' (('RF_CLEANUP;') <ASAIL_To_CPP e.body>) '}');
219    RETFAIL =
220      {
221        <Get &Current_Trace> : e.name (e.ress) =
222          <Trace_Fail e.name>;
223        /*empty*/;
224      } :: e.trace_exit,
225      e.trace_exit ('RF_RETFAIL;');
226    FATAL =
227//      <? &Current-Func> : (e.name),
228      ('RF_FUNC_ERROR (unexpected_fail);');
229    (LSPLIT e.expr (e.min) t.var1 t.var2) =
230      <Box> :: s.tvars,
231      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
232      <Get s.tvars> ('RF_lsplit ('e.expr', ' <Expr_Int_To_CPP e.min>', '
233        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2>');');
234    (RSPLIT e.expr (e.min) t.var1 t.var2) =
235      <Box> :: s.tvars,
236      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
237      <Get s.tvars> ('RF_rsplit ('e.expr', '<Expr_Int_To_CPP e.min>', '
238        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2 >');');
239    (ASSIGN t.var e.expr), t.var : (INT e)  =
240      (<Rfp2Cpp t.var> ' = ' <Expr_Int_To_CPP e.expr> ';');
241    (ASSIGN t.var e.expr) =
242      <Box> :: s.tvars,
243      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
244      <Get s.tvars> (<Rfp2Cpp t.var> ' = 'e.expr';');
245    (DECL t.var e.expr), t.var : (INT e)  =
246      ('int ' <Rfp2Cpp t.var> ' = '<Expr_Int_To_CPP e.expr>';');
247    (DECL s.type t.var) =
248      ('TExpr ' <Rfp2Cpp t.var> ';');
249    (DECL s.type t.var e.expr) =
250      <Box> :: s.tvars,
251      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
252      <Get s.tvars> ('Expr ' <Rfp2Cpp t.var> ' ('e.expr');');
253    (DROP t.var) =
254      (<Rfp2Cpp t.var> '.drop ();');
255    (CONTINUE t.label) =
256      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
257    (BREAK t.label) =
258      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
259    (ERROR e.expr) =
260      <Box> :: s.tvars,
261      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
262      <Get s.tvars> ('RF_ERROR ('e.expr');');
263    (CONSTEXPR IMPORT (e.name) (e.comment) e.expr) =
264      e.name : "org" "refal" "plus" "wrappers" e.n,
265      <Bind &Unavailable_Imports (e.name)
266        (CONSTEXPR LOCAL (<ToWord <Intersperse ('_') e.n>>) () e.expr)>;
267    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
268      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
269      {
270        t.name : (STATIC e) = (<Get &Module_Name>) (&Rfp2Cpp t.name);
271        <Extract_Qualifiers t.name> (&Name_To_CPP "DECL-OBJ" t.name);
272      } :: (e.qualifiers) e (s.name_producer e.name_arg),
273      <Put &Const_Exprs (t.name
274        (<Const_Expr_To_CPP /*e.expr*/ e.comment>)
275        /*e.qualifiers*/ (e.linkage 'TExpr* ' <Apply s.name_producer e.name_arg> ';'))>;
276    (OBJ s.linkage s.tag t.name) =
277      <Bind &Locals ("DECL-OBJ" t.name) ()>,
278      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
279      <ToChars s.tag> : s1 e2,
280      <Extract_Qualifiers t.name> :: (e.qualifiers) e.n,
281      {
282        s.tag : BOX =
283          <Put &Const_Exprs (t.name
284            ('Expr::create_sym< rftype::NamedObject<rftype::BoxContents> >('
285              'L"'e.n'")'))>;
286//        s.tag : VECTOR =
287//          <Put &Const-Exprs (t.name
288//            ('Expr::create_sym< rftype::NamedObject<rftype::Vector> >('
289//              'L"'e.n'")'))>;
290        <Put &Const_Exprs (t.name
291          ('new rftype::StaticObject<rftype::' s1 <ToLower e2> '>(L"'e.n'")'))>;
292      },
293      <Namespace_Control e.qualifiers>
294      (e.linkage 'Expr ' <Name_To_CPP "DECL-OBJ" t.name> ';');
295    ("DECL-OBJ" t.name) =
296      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
297      <Namespace_Control e.qualifiers>
298      ('extern Expr ' <Name_To_CPP "DECL-OBJ" t.name> ';');
299    ("DECL-FUNC" t.name) =
300      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
301      <Namespace_Control e.qualifiers>
302      ('RF_DECL (' <Name_To_CPP "DECL-FUNC" t.name> ');');
303    (EXTERN t.name) =
304      <Bind &Externs (t.name) ()>,
305      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
306      <Namespace_Control e.qualifiers>
307      ('RF_DECL (' <Name_To_CPP "DECL-FUNC" t.name> ');');
308    /*
309     * s.call can be CALL or TAILCALL or TAILCALL?
310     */
311    (s.call t.name (e.exprs) (e.ress)) =
312      {
313        # \{ s.call : CALL; }, <Get &Current_Trace> : e.full_name (e.ress) =
314          ('if (RF_CALL (' <Name_To_CPP "DECL-FUNC" t.name> ', '
315            <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> '))')
316          ('{' (<Trace_Exit e.full_name (e.ress)> ('return true;')) '}')
317          ('else RF_RETFAIL;');
318//T/        {
319//T/          s.call : "TAILCALL?" = TAILCALL;
320//T/          s.call;
321//T/        } :: s.call,
322//T/          ('RF_' s.call ' (' <Name_To_CPP "DECL-FUNC" t.name> ', '
323//T/            <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> ');');
324        (<Name_To_CPP "DECL-FUNC" t.name>'('
325          <Concat <Intersperse (', ') (<Args_To_CPP () Exprs e.exprs>) <MapIn &Rfp2Cpp (<Paren e.ress>)>>>
326        ');');
327      };
328  } :: e.cpp_item,
329    e.cpp_item <ASAIL_To_CPP e.rest>;
330  /*empty*/;
331};
332
333
334$func Term_Ref_To_CPP s.tvars e = e;
335
336Expr_Ref_To_CPP s.tvars e.expr = e.expr : {
337  /*empty*/ = 'empty';
338  term = <Term_Ref_To_CPP s.tvars term>;
339  expr = '(' <Infix_To_CPP (s.tvars) &Term_Ref_To_CPP "+" <Paren expr>> ')';
340};
341
342Term_Ref_To_CPP s.tvars e.arg = e.arg : {
343  (PAREN e.expr) =
344    <Expr_Ref_To_CPP s.tvars e.expr> ' ()';
345  (DEREF e.expr (e.pos)) =
346    'Expr (' <Expr_Ref_To_CPP s.tvars e.expr> ', ' <Expr_Int_To_CPP e.pos> ')';
347  (SUBEXPR e.expr (e.pos) (e.len)) =
348    'Expr (' <Expr_Ref_To_CPP s.tvars e.expr> ', '
349        <Expr_Int_To_CPP e.pos>   ', ' <Expr_Int_To_CPP e.len> ')';
350  (REF t.name) = <Name_To_CPP "DECL-OBJ" t.name>;
351  "ERROR-EXPR" = 'err';
352  (STATIC t.name) =
353    <Bind &Used_Consts ((STATIC t.name)) ()>,
354    <Get &Current_Namespace> :: e.namespace,
355    {
356      <Get &Module_Name> : e.namespace = /*empty*/;
357      <Get &Module_Name>'::';
358    } :: e.prefix,
359    '*' e.prefix <Rfp2Cpp (STATIC t.name)>;
360  (s.var_tag e.ns t.name) = <Rfp2Cpp (s.var_tag e.ns t.name)>;
361  s.sym, {
362    <IsInt s.sym> =
363      'Expr::create<' <Get &Int> '>("' s.sym '")';
364    <IsWord s.sym> =
365      'Expr::create<rftype::Word>("' <Symbol_To_CPP s.sym> '")';
366  };
367};
368
369Expr_Int_To_CPP {
370  /*empty*/ = /*empty*/;
371  s.ObjectSymbol =
372    {
373      <IsInt s.ObjectSymbol> = s.ObjectSymbol;
374      $error ("Illegal type int-symbol: " s.ObjectSymbol);
375    };
376  (LENGTH e.expr) =
377    <Expr_Ref_To_CPP <Box> e.expr> '.get_len ()';
378  (MAX e.args) =
379    'pxx_max (' <Args_To_CPP () Ints e.args> ')';
380  (MIN e.args) =
381    'pxx_min (' <Args_To_CPP () Ints e.args> ')';
382  (INFIX s.op e.args) =
383    '(' <Infix_To_CPP () &Expr_Int_To_CPP s.op e.args> ')';
384  (REF t.name) = <Name_To_CPP "DECL-OBJ" t.name>;
385  (s.var_tag t.name) = <Rfp2Cpp (s.var_tag t.name)>;
386  expr = '(' <Infix_To_CPP () &Expr_Int_To_CPP "+" <Paren expr>> ')';
387};
388
389Cond_To_CPP {
390  ("CALL-FAILS" (CALL t.name (e.exprs) (e.ress))) =
391    '!RF_CALL (' <Name_To_CPP "DECL-FUNC" t.name> ', '
392          <Args_To_CPP () Exprs e.exprs> ', '
393          <Args_To_CPP () Vars e.ress>   ')';
394  ("SYMBOL?" e.expr (e.pos)) =
395    <Expr_Ref_To_CPP <Box> e.expr> '.symbol_at (' <Expr_Int_To_CPP e.pos> ')';
396  ("FLAT-SUBEXPR?" e.expr (e.pos) (e.len)) =
397    <Expr_Ref_To_CPP <Box> e.expr> '.flat_at ('
398      <Expr_Int_To_CPP e.pos> ', ' <Expr_Int_To_CPP e.len> ')';
399  ("ITER-FAILS" e.expr) =
400    '!RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')';
401  (EQ e.expr1 (e.expr2) (e.pos)) =
402    <Expr_Ref_To_CPP <Box> e.expr1> '.eq ('
403      <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
404  ("TERM-EQ" e.expr1 (e.expr2) (e.pos)) =
405    '((Expr&)'<Term_Ref_To_CPP <Box> e.expr1>')[0] == '
406    '((Expr&)'<Term_Ref_To_CPP <Box> e.expr2>')['<Expr_Int_To_CPP e.pos>']';
407    //T/ <Expr_Ref_To_CPP <Box> e.expr1> '.term_eq ('
408    //T/   <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
409  (NOT t.cond) =
410    '!' <Cond_To_CPP t.cond>;
411};
412
413Infix_To_CPP (e.box) s.arg2cpp s.op e.args, {
414  e.args : (e.arg) e.rest =
415    <Apply s.arg2cpp e.box e.arg> :: e.arg,
416    <Infix_To_CPP (e.box) s.arg2cpp s.op e.rest> :: e.rest,
417    {
418      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
419      e.arg e.rest;
420    };;
421};
422
423Step_To_CPP {
424  /*empty*/ = /*empty*/;
425  ("INC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')++';
426  ("DEC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')--';
427};
428
429
430
431$func Const_Expr_Aux e.expr = e.cpp_expr;
432
433Const_Expr_To_CPP {
434  /*empty*/ = 'empty';
435  (SUBEXPR t.name s.pos s.len) = 'Expr (' <Rfp2Cpp t.name> ', ' s.pos ', ' s.len ')';
436                  //FIXME: It is needed to check that s.pos and s.len
437                  //       are in allowable bounds.
438                  //       Set this bounds by options.
439  e.expr =
440    <Const_Expr_Aux () e.expr> : {
441      ' + ' e.cpp_expr = e.cpp_expr;
442      e.cpp_expr = e.cpp_expr;
443    };
444};
445
446Const_Expr_Aux (e.accum) e.expr, {
447  e.expr : s.sym e.rest, <IsChar s.sym> =
448    <Const_Expr_Aux (e.accum <Symbol_To_CPP s.sym>) e.rest>;
449  e.accum : v =
450    '"'e.accum'"' <Const_Expr_Aux () e.expr>;
451//T/    {
452//T/      <CharsToBytes e.accum> : e s.c e,
453//T/        <Gt (s.c) (127)> =
454//T/        ' + rftype::Char::create_expr ("' e.accum '")' <Const_Expr_Aux () e.expr>;
455//T/      //' + Expr::create_seq<Char> (L"' e.accum '")' <Const-Expr-Aux () e.expr>;
456//T/      ' + rftype::Char::create_expr (L"' e.accum '")' <Const_Expr_Aux () e.expr>;
457//T/    };
458  e.expr : t.item e.rest, t.item : {
459    (PAREN e.paren_expr) =
460      ' + (' <Const_Expr_To_CPP e.paren_expr> ') ()';
461    (REF t.name) =
462      ' + ' <Name_To_CPP "DECL-OBJ" t.name>;
463//      ' + Expr::create<ObjectRef>(' <Name-To-CPP t.name> ')';
464    (STATIC e) =
465      <Bind &Used_Consts (t.item) ()>,
466      ' + ' '*' <Rfp2Cpp t.item>;
467    (s.FUNC t.name), s.FUNC : \{ FUNC; "FUNC?"; TFUNC; } =
468      ' + Expr::create_sym<rftype::Func> (' <Name_To_CPP "DECL-FUNC" t.name> ')';
469    s.sym, {
470      <IsInt s.sym> =
471        ' + Expr::create<' <Get &Int> '>("' s.sym '")';
472      <IsWord s.sym> =
473        ' + Expr::create<rftype::Word>("' <Symbol_To_CPP s.sym> '")';
474    };
475  } :: e.cpp_item =
476    e.cpp_item <Const_Expr_Aux () e.rest>;
477  = /*empty*/;
478};
479
480Symbol_To_CPP s.ObjectSymbol, {
481  <ToChars s.ObjectSymbol> () $iter {
482    e.symbol : s.char e.rest, s.char : {
483      '\\' = '\\\\';
484      '\n' = '\\n';
485      '\t' = '\\t';
486//        '\v' = '\\v';
487//        '\b' = '\\b';
488      '\r' = '\\r';
489//        '\f' = '\\f';
490      '\"' = '\\"';
491//      '\'' = '\\\'';
492      s = s.char;
493    } :: e.cpp_char,
494    e.rest (e.cpp_symbol e.cpp_char);
495  } :: e.symbol (e.cpp_symbol),
496    e.symbol : /*empty*/ =
497    e.cpp_symbol;
498};
499
500
501
502Args_To_CPP {
503  (v.prefix) Vars /*empty*/  = 'RF_VOID';
504  (        ) Vars /*empty*/  = '/*void*/';
505  (        ) Vars (e.arg)    = <Rfp2Cpp (e.arg)>;
506  (e.prefix) Exprs /*empty*/ = '/*void*/';
507  (e.prefix) Exprs (e.arg)   = <Expr_Ref_To_CPP <Box> e.arg>;
508  (e.prefix) s.tag e.args =
509    e.args () $iter {
510      e.args : (e.arg) e.rest =
511        {
512          e.rest : v = ', ';
513          /*empty*/;
514        } :: e.comma,
515        s.tag : {
516          Vars = e.rest (e.cpp_args <Rfp2Cpp (e.arg)> e.comma);
517          Exprs = e.rest (e.cpp_args <Expr_Ref_To_CPP <Box> e.arg> e.comma);
518          Ints = e.rest (e.cpp_args <Expr_Int_To_CPP e.arg> e.comma);
519        };
520    } :: e.args (e.cpp_args),
521    e.args : /*empty*/,
522    (e.prefix) s.tag : {
523      t   Exprs = '(' e.cpp_args ')';
524      ( ) Vars  = '(' e.cpp_args ')';
525      (v) Vars  = '(' e.prefix e.cpp_args ';;)';
526      e         = e.prefix e.cpp_args;
527    };
528};
529
530Name_To_CPP s.decl_type (e.name) =
531  {
532    e.name : "org" "refal" "plus" "wrappers" e.cont =
533      <Bind &Used_Unavailable_Imports (<Lookup &Unavailable_Imports e.name>) ()>,
534      <QName_To_Cpp <Get &Module_Name> <ToWord <Intersperse ('_') e.cont>>>;
535    e.name : "refal" "plus" e.cont =
536      <Bind &Decls (s.decl_type ("refal" e.cont)) ()>,
537      <QName_To_Cpp "refal" e.cont>;
538    <Get &Current_Namespace> :: e.namespace,
539      <Bind &Decls (s.decl_type (e.name)) ()>,
540      {
541        e.name : e.namespace e.cont =
542          <QName_To_Cpp e.cont>;
543        <QName_To_Cpp e.name>;
544      };
545  };
546
547QName_To_Cpp e.name = <Intersperse ('::') e.name>;
548
549Open_Namespace e.name = ('namespace ' e.name ' {');
550Close_Namespace e.name = ('}');
551
552Namespace_Control e.qualifiers =
553  {
554    e.qualifiers : /*empty*/ = <Get &Module_Name>;
555    e.qualifiers : () = /*empty*/;
556    e.qualifiers;
557  } :: e.qualifiers,
558  {
559    <Get &Current_Namespace> : e.qualifiers;
560    <Map &Close_Namespace (<Get &Current_Namespace>)> :: e.close_namespace,
561      <Store &Current_Namespace e.qualifiers>,
562      e.close_namespace <Map &Open_Namespace (e.qualifiers)>;
563  };
564
565Trace_Enter e.name (e.args) =
566  e.args 1 () $iter {
567    e.args : t.arg e.rest =
568      {
569        \{ e.rest : v; <Gt (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
570        'printf("  : ");';
571      } :: e.num,
572      e.rest <Add s.n 1>
573      (e.pr_args ('printf ("           argument "); 'e.num' ('<Rfp2Cpp t.arg>').writeln(stdout);'));
574  } :: e.args s.n (e.pr_args),
575  e.args : /*empty*/ =
576  ('printf ("+ %5u: enter >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr_args;
577
578Trace_Exit e.name (e.args) =
579  e.args 1 () $iter {
580    e.args : t.arg e.rest =
581      {
582        \{ e.rest : v; <Gt (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
583        'printf("  : ");';
584      } :: e.num,
585      e.rest <Add s.n 1>
586      (e.pr_args
587       ('printf ("           result   "); 'e.num' ('<Rfp2Cpp t.arg>').to_Expr().writeln(stdout);'));
588  } :: e.args s.n (e.pr_args),
589  e.args : /*empty*/ =
590  ('printf ("- %5u: exit  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr_args;
591
592Trace_Fail e.name =
593  ('printf ("- %5u: fail  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());');
594
595Extract_Qualifiers t.name, {
596  <IsInTable &Externs t.name> =
597    t.name : (e.n),
598    (()) e.n;
599  <RFP_Extract_Qualifiers t.name>;
600};
601
Note: See TracBrowser for help on using the repository browser.