source: to-imperative/trunk/compiler/src/rfp_asail_tpp.rf @ 3587

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