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

Last change on this file since 3941 was 3941, checked in by orlov, 12 years ago
  • Fixed multi-argument function calls.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 24.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 Term_Ref_To_CPP s.tvars e = e;
43
44$func Expr_Int_To_CPP e.ASAIL_Expr_Int = e.CPP_Expr_Int;
45
46$func Step_To_CPP e.step_operators = e.cpp_step_operators;
47
48$func Const_Expr_To_CPP e.ASAIL_const_expr = e.CPP_const_expr;
49
50$func Args_To_CPP (e.prefix) s.Arg_Res_Tag e.ASAIL_Args = e.CPP_Args;
51
52$func Symbol_To_CPP s.RFP_Symbol = e.CPP_String;
53
54$func QName_To_Cpp e.name = e.cpp_name;
55
56$func Name_To_CPP s.decl_type t.name e.args = e.CPP_Name;
57
58$func Cond_To_CPP t.cond = e.CPP_Cond;
59
60$func Infix_To_CPP (e.box) s.func_for_converting_args_to_cpp s.op e.args = e.cpp_expr;
61$func Concat_To_TPP (e.box) s.func_for_converting_args_to_tpp e.args = e.tpp_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 =
98          //T/ ('rfrt::Entry rf_entry (' v.name ');');;
99          ('tfun int main (int argc, char *argv[]) {'(
100            ('for (int i = 0; i < ts::realsuperSize; i++) {'(
101              ('tct(atRank(i));')
102              ('(int)'<Get &Module_Name>'::init_();')
103            )'}')
104            ('TExpr res;')
105            (v.name'(res);')
106            ('for (int i = 0; i < ts::realsuperSize; i++) {'(
107              ('tct(atRank(i));')
108              ('(int)'<Get &Module_Name>'::cleanup_();')
109            )'}')
110            ('return 0;')
111          )'}');;
112      } :: e.entry,
113      {
114        <Get &Const_Exprs> : v.c_exprs =
115          <Namespace_Control <Get &Module_Name>> :: e.nc,
116          (/*e.init_consts*/) (/*e.decl_consts*/) v.c_exprs $iter {
117            e.c_exprs : (t.name (e.value) e.decl) e.rest =
118              {
119                <IsInTable &Used_Consts t.name> =
120                  {
121                    t.name : (STATIC e) = <Rfp2Cpp t.name>;
122                    <Name_To_CPP "DECL-OBJ" t.name>;
123                  } :: e.name,
124                  (e.init_consts
125                    (e.name' = 'e.value';')
126                  )
127                  (e.decl_consts e.decl)
128                  e.rest;
129                (e.init_consts) (e.decl_consts) e.rest;
130              };
131          } :: (e.init_consts) (e.decl_consts) e.c_exprs,
132          e.c_exprs : /*empty*/ =
133          e.nc
134          ('tfun int init_ () {' (e.init_consts ('return 0;')) '}')
135          ('tfun int cleanup_ () {' (('global_exprs.clear();') ('return 0;')) '}')
136//T/         ('static AtStart init_registrator_ (&init_);')
137          <Map &Close_Namespace (<Get &Current_Namespace>)>
138          (<Store &Current_Namespace /*empty*/>
139            <Namespace_Control <Get &Module_Name>>
140            ('static GExpr empty;')
141            e.decl_consts
142            <Map &Close_Namespace (<Get &Current_Namespace>)>
143          );
144        ();
145      } :: e.init (e.decl_consts),
146      <Store &Current_Namespace /*empty*/>,
147      ('#include "trefal.hh"')
148//T/      ('using namespace rfrt;')
149      <ASAIL_To_CPP <List.Sub (<Domain &Decls>) <Domain &Locals>>>
150      <Map &Close_Namespace (<Get &Current_Namespace>)>
151      e.decl_consts
152      v.cpp e.init ('GlobalExprs global_exprs;') e.entry;;
153  };
154
155ASAIL_To_CPP e.asail, {
156  e.asail : t.item e.rest, t.item : {
157    (s.tag UNDEF e) = ;
158    (LINENUMBER sN) = ;
159    (NATIVE s.tag t.qname (e.in) (e.out) e.native) = ;   
160    (s.linkage s.tag (e.name) (e.in) (e.out) (NATIVE e.native)) =
161        <Del_Pragmas <Gener_Var_Indices 1 (<Vars e.in>) 'arg'>> : e.rfArg s,
162        <Del_Pragmas <Gener_Var_Indices 1 (<Vars e.out>) 'res'>> : e.rfRes s,
163        <ASAIL_To_CPP (s.tag LOCAL (e.name) (e.rfArg) (e.rfRes) (ERROR e.name "Not available"))>;
164    (s.tag IMPORT (e.name) t.args t.ress e.body),
165      s.tag : \{ FUNC; "FUNC?"; },
166      e.name : "org" "refal" "plus" "wrappers" e.n =
167      <Bind &Unavailable_Imports (e.name)
168        (s.tag LOCAL (<ToWord <Intersperse ('_') e.n>>) t.args t.ress
169          (ERROR e.n "Not available"))>;
170    (TFUNC s.linkage t.name (e.args) (e.ress) e.body),
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      <MapIn &Rfp2Cpp (<Paren e.args>)> :: e.args,
185      <MapIn &Id 'TExpr ' (e.args)> :: e.args,
186      <MapIn &Rfp2Cpp (<Paren e.ress>)> :: e.ress,
187      <MapIn &Id 'tout Expr ' (e.ress)> :: e.ress,
188      <Concat <Intersperse (', ') e.args e.ress>> :: e.args,
189      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
190      <Namespace_Control e.qualifiers>
191      ('tfun int '<Name_To_CPP "DECL-FUNC" t.name TFUNC e.args>' ('e.args') {'
192        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit ('return 0;'))
193      '}');
194    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
195      s.tag : \{ FUNC; "FUNC?"; } =
196      <Store &Current_Func t.name>,
197      { <Get &Entry> : e t.name e = <Store &Entry_Name <QName_To_Cpp <Concat t.name>>>;; },
198      {
199        \{
200          <IsInTable &RFP_Options TRACEALL>;
201          <IsInTable &RFP_Trace t.name>;
202        } =
203          <Intersperse ('.') <Concat t.name>> :: e.name,
204          <Store &Current_Trace e.name (e.ress)>,
205          (<Trace_Enter e.name (e.args)>) (<Trace_Exit e.name (e.ress)>);
206        <Store &Current_Trace /*empty*/>,
207          () ();
208      } :: (e.trace_enter) (e.trace_exit),
209      <MapIn &Rfp2Cpp (<Paren e.args> <Paren e.ress>)> :: e.args,
210      <Concat <Intersperse (', ') <Replicate <Length e.args> ('TExpr&')>>> :: e.proto_args,
211      <Concat <Intersperse (', ') <MapIn &Id 'TExpr& ' (e.args)>>> :: e.args,
212      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
213      <Namespace_Control e.qualifiers>
214//T/      ('RF_FUNC (' <Name_To_CPP "DECL-FUNC" t.name> ', '
215//T/            <Args_To_CPP ('RF_ARG ') Vars e.args> ', '
216//T/            <Args_To_CPP ('RF_RES ') Vars e.ress> ')'
217//T/        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit)
218//T/       'RF_END');
219      ('int '<Name_To_CPP "DECL-FUNC" t.name FUNC e.proto_args>' ('e.args') {'
220        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit ('return 0;'))
221      '}');
222    (TRACE t.name) =
223      <Bind &RFP_Trace (t.name) ()>;
224    ("IF-INT-CMP" s.op (e.arg1) (e.arg2) e.body) =
225      ('if (' <Expr_Int_To_CPP e.arg1> ' 's.op' ' <Expr_Int_To_CPP e.arg2> ')')
226      ('{' (<ASAIL_To_CPP e.body>) '}');
227    (IF t.cond e.body) =
228      ('if (' <Cond_To_CPP t.cond> ')')
229      ('{' (<ASAIL_To_CPP e.body>) '}');
230    (FOR (e.cont_label) (e.break_label) (e.cond) (e.step) e.body) =
231      {
232        e.cont_label : t =
233          ('{'
234            ('{' (<ASAIL_To_CPP e.body>) '}')
235            (LABEL <Rfp2Cpp (LABEL e.cont_label)> ': {}')
236          '}');
237        ('{' (<ASAIL_To_CPP e.body>) '}');
238      } :: e.body,
239      {
240        e.break_label : t = (LABEL <Rfp2Cpp (LABEL e.break_label)> ': {}');;
241      } :: e.break,
242      ('for ( ; ; ' <Step_To_CPP e.step> ')') e.body e.break;
243    (LABEL (e.label) e.body) =
244      ('{' (<ASAIL_To_CPP e.body>) '}')
245      (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');
246    (TRY e.body) =
247      ('RF_TRAP') ('{' (<ASAIL_To_CPP e.body>) '}');
248    ("CATCH-ERROR" e.body) =
249      ('RF_WITH') ('{' (('RF_CLEANUP;') <ASAIL_To_CPP e.body>) '}');
250    RETFAIL =
251      {
252        <Get &Current_Trace> : e.name (e.ress) =
253          <Trace_Fail e.name>;
254        /*empty*/;
255      } :: e.trace_exit,
256      e.trace_exit ('return 1;');
257    FATAL =
258//      <? &Current-Func> : (e.name),
259      ('{' (('TExpr ex;') ('((Expr&)ex).init_str("Unexpected fail", 15);')
260           ('std::cout << "$error: " << ex << endl;')
261           ('throw ex;')) '}');
262//T/      ('RF_FUNC_ERROR (unexpected_fail);');
263    (LSPLIT e.expr (e.min) t.var1 t.var2) =
264      <Box> :: s.tvars,
265      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
266      <Get s.tvars> ('RF_lsplit ('e.expr', ' <Expr_Int_To_CPP e.min>', '
267        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2>');');
268    (RSPLIT e.expr (e.min) t.var1 t.var2) =
269      <Box> :: s.tvars,
270      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
271      <Get s.tvars> ('RF_rsplit ('e.expr', '<Expr_Int_To_CPP e.min>', '
272        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2 >');');
273    (ASSIGN t.var e.expr), t.var : (INT e)  =
274      (<Rfp2Cpp t.var> ' = ' <Expr_Int_To_CPP e.expr> ';');
275    (ASSIGN t.var e.expr) =
276      <Box> :: s.tvars,
277      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
278      <Get s.tvars> ('(Expr&)'<Rfp2Cpp t.var> ' = (Expr&)'e.expr';');
279    (DECL t.var e.expr), t.var : (INT e)  =
280      ('int ' <Rfp2Cpp t.var> ' = '<Expr_Int_To_CPP e.expr>';');
281    (DECL s.type t.var) =
282      ('TExpr ' <Rfp2Cpp t.var> ';');
283    (DECL s.type t.var (SUBEXPR e.expr (e.pos) (e.len))) =
284      <Box> :: s.tvars,
285      <Term_Ref_To_CPP s.tvars (SUBEXPR e.expr (e.pos) (e.len))> : 'TExpr ' e.constr '.get_ref()',
286      ('TExpr '<Rfp2Cpp t.var> e.constr';');
287    (DECL s.type t.var (DEREF e.expr (e.pos))) =
288      <Box> :: s.tvars,
289      ('TExpr '<Rfp2Cpp t.var>'(((Expr&)'<Expr_Ref_To_CPP s.tvars e.expr>')'
290        '['<Expr_Int_To_CPP e.pos>']);');
291    (DECL s.type t.var e.expr) =
292      <Box> :: s.tvars,
293      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
294      <Get s.tvars> ('TExpr ' <Rfp2Cpp t.var> ' ('e.expr');');
295    (DROP t.var) =
296      (<Rfp2Cpp t.var> '.drop ();');
297    (CONTINUE t.label) =
298      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
299    (BREAK t.label) =
300      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
301    (ERROR e.expr) =
302      <Box> :: s.tvars,
303      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
304      <Get s.tvars> ('RF_ERROR ('e.expr');');
305    (CONSTEXPR IMPORT (e.name) (e.comment) e.expr) =
306      e.name : "org" "refal" "plus" "wrappers" e.n,
307      <Bind &Unavailable_Imports (e.name)
308        (CONSTEXPR LOCAL (<ToWord <Intersperse ('_') e.n>>) () e.expr)>;
309    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
310      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
311      {
312        t.name : (STATIC e) = (<Get &Module_Name>) (&Rfp2Cpp t.name);
313        <Extract_Qualifiers t.name> (&Name_To_CPP "DECL-OBJ" t.name);
314      } :: (e.qualifiers) e (s.name_producer e.name_arg),
315      <Put &Const_Exprs (t.name
316        (<Const_Expr_To_CPP e.expr /*e.comment*/>)
317        /*e.qualifiers*/ (e.linkage 'GExpr ' <Apply s.name_producer e.name_arg> ';'))>;
318    (OBJ s.linkage s.tag t.name) =
319      <Bind &Locals ("DECL-OBJ" t.name) ()>,
320      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
321      <ToChars s.tag> : s1 e2,
322      <Extract_Qualifiers t.name> :: (e.qualifiers) e.n,
323      {
324        s.tag : BOX =
325          <Put &Const_Exprs (t.name
326            ('Expr::create_sym< rftype::NamedObject<rftype::BoxContents> >('
327              'L"'e.n'")'))>;
328//        s.tag : VECTOR =
329//          <Put &Const-Exprs (t.name
330//            ('Expr::create_sym< rftype::NamedObject<rftype::Vector> >('
331//              'L"'e.n'")'))>;
332        <Put &Const_Exprs (t.name
333          ('new rftype::StaticObject<rftype::' s1 <ToLower e2> '>(L"'e.n'")'))>;
334      },
335      <Namespace_Control e.qualifiers>
336      (e.linkage 'Expr ' <Name_To_CPP "DECL-OBJ" t.name> ';');
337    ("DECL-OBJ" t.name) = ;
338//T/      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
339//T/      <Namespace_Control e.qualifiers>
340//T/      ('extern Expr ' <Name_To_CPP "DECL-OBJ" t.name> ';');
341    ("DECL-FUNC" t.name) =
342      <Lookup &Decls "DECL-FUNC" t.name> : s.tag e.proto_args,
343      {
344        s.tag : TFUNC = 'tfun ';;
345      } :: e.tfun,
346      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
347      <Namespace_Control e.qualifiers>
348      (e.tfun 'int '<Name_To_CPP "DECL-FUNC" t.name>' ('e.proto_args');');
349    (EXTERN t.name) =
350      <Bind &Externs (t.name) ()>,
351      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
352      <Namespace_Control e.qualifiers>
353      ('RF_DECL (' <Name_To_CPP "DECL-FUNC" t.name> ');');
354    /*
355     * s.call can be CALL or TAILCALL or TAILCALL?
356     */
357    (s.call t.name (e.exprs) (e.ress)) =
358      {
359        # \{ s.call : CALL; }, <Get &Current_Trace> : e.full_name (e.ress) =
360          ('if (RF_CALL (' <Name_To_CPP "DECL-FUNC" t.name> ', '
361            <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> '))')
362          ('{' (<Trace_Exit e.full_name (e.ress)> ('return true;')) '}')
363          ('else RF_RETFAIL;');
364//T/        {
365//T/          s.call : "TAILCALL?" = TAILCALL;
366//T/          s.call;
367//T/        } :: s.call,
368//T/          ('RF_' s.call ' (' <Name_To_CPP "DECL-FUNC" t.name> ', '
369//T/            <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> ');');
370        <Concat <Intersperse (', ') <Replicate <Add <Length e.exprs> <Length e.ress>> ('TExpr&')>>> :: e.proto_args,
371        (<Name_To_CPP "DECL-FUNC" t.name CALL e.proto_args>'('
372          <Concat <Intersperse (', ') (<Args_To_CPP () Exprs e.exprs>) <MapIn &Rfp2Cpp (<Paren e.ress>)>>>
373        ');');
374      };
375  } :: e.cpp_item,
376    e.cpp_item <ASAIL_To_CPP e.rest>;
377  /*empty*/;
378};
379
380
381$func Term_Ref_To_Terms e.term = e;
382Term_Ref_To_Terms {
383  (STATIC t.name) =
384    <Bind &Used_Consts ((STATIC t.name)) ()>,
385    <Rfp2Cpp (STATIC t.name)>;
386  (REF t.name) =
387    <Bind &Used_Consts (t.name) ()>,
388    <Name_To_CPP "DECL-OBJ" t.name>;
389  e.term = '((Expr&)'<Term_Ref_To_CPP <Box> e.term>')';
390};
391
392//$func Term_Ref_To_TExpr e.term = e;
393//Term_Ref_To_TExpr {
394//  (STATIC t.name) = 'TExpr('<Term_Ref_To_CPP <Box> (STATIC t.name)>')';
395//  e.term = <Term_Ref_To_CPP <Box> e.term>;
396//};
397
398Expr_Ref_To_CPP s.tvars e.expr = e.expr : {
399  /*empty*/ = 'TExpr(empty)';
400  term = <Term_Ref_To_CPP s.tvars term>;
401  expr = '(' <Concat_To_TPP (<Box>) &Term_Ref_To_CPP <Paren expr>> ')';
402};
403
404Term_Ref_To_CPP s.tvars e.arg = e.arg : {
405  (PAREN e.expr) =
406    <Expr_Ref_To_CPP s.tvars e.expr> ' ().get_ref()';
407  (DEREF e.expr (e.pos)) =
408    'TExpr (' <Expr_Ref_To_CPP s.tvars e.expr> ', ' <Expr_Int_To_CPP e.pos> ').get_ref()';
409  (SUBEXPR e.expr (e.pos) (e.len)) =
410    'TExpr (' <Expr_Ref_To_CPP s.tvars e.expr> ', '
411        <Expr_Int_To_CPP e.pos>   ', ' <Expr_Int_To_CPP e.len> ').get_ref()';
412  (REF t.name) =
413    <Bind &Used_Consts (t.name) ()>,
414    'TExpr ('<Name_To_CPP "DECL-OBJ" t.name>').get_ref()';
415  "ERROR-EXPR" = 'err';
416  (STATIC t.name) =
417    <Bind &Used_Consts ((STATIC t.name)) ()>,
418    <Get &Current_Namespace> :: e.namespace,
419    {
420      <Get &Module_Name> : e.namespace = /*empty*/;
421      <Get &Module_Name>'::';
422    } :: e.prefix,
423    'TExpr ('e.prefix <Rfp2Cpp (STATIC t.name)>').get_ref()';
424  (s.var_tag e.ns t.name) = <Rfp2Cpp (s.var_tag e.ns t.name)>;
425//T/  s.sym, {
426//T/    <IsInt s.sym> =
427//T/      'Expr::create<' <Get &Int> '>("' s.sym '")';
428//T/    <IsWord s.sym> =
429//T/      'Expr::create<rftype::Word>("' <Symbol_To_CPP s.sym> '")';
430//T/  };
431};
432
433Expr_Int_To_CPP {
434  /*empty*/ = /*empty*/;
435  s.ObjectSymbol =
436    {
437      <IsInt s.ObjectSymbol> = s.ObjectSymbol;
438      $error ("Illegal type int-symbol: " s.ObjectSymbol);
439    };
440  (LENGTH e.expr) =
441    '((Expr&)'<Expr_Ref_To_CPP <Box> e.expr> ').get_len()';
442  (MAX e.args) =
443    'pxx_max (' <Args_To_CPP () Ints e.args> ')';
444  (MIN e.args) =
445    'pxx_min (' <Args_To_CPP () Ints e.args> ')';
446  (INFIX s.op e.args) =
447    '(' <Infix_To_CPP () &Expr_Int_To_CPP s.op e.args> ')';
448  (REF t.name) = <Name_To_CPP "DECL-OBJ" t.name>;
449  (s.var_tag t.name) = <Rfp2Cpp (s.var_tag t.name)>;
450  expr = '(' <Infix_To_CPP () &Expr_Int_To_CPP "+" <Paren expr>> ')';
451};
452
453Cond_To_CPP {
454  ("CALL-FAILS" (CALL t.name (e.exprs) (e.ress))) =
455    <Concat <Intersperse (', ') <Replicate <Add <Length e.exprs> <Length e.ress>> ('TExpr&')>>> :: e.proto_args,
456    '!RF_CALL (' <Name_To_CPP "DECL-FUNC" t.name CALL e.proto_args> ', '
457          <Args_To_CPP () Exprs e.exprs> ', '
458          <Args_To_CPP () Vars e.ress>   ')';
459  ("SYMBOL?" e.expr (e.pos)) =
460    '((Expr&)'<Expr_Ref_To_CPP <Box> e.expr> ').symbol_at(' <Expr_Int_To_CPP e.pos> ')';
461  ("FLAT-SUBEXPR?" e.expr (e.pos) (e.len)) =
462    <Expr_Ref_To_CPP <Box> e.expr> '.flat_at ('
463      <Expr_Int_To_CPP e.pos> ', ' <Expr_Int_To_CPP e.len> ')';
464  ("ITER-FAILS" e.expr) =
465    '!RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')';
466  (EQ e.expr1 (e.expr2) (e.pos)) =
467    <Expr_Ref_To_CPP <Box> e.expr1> '.eq ('
468      <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
469  ("TERM-EQ" e.expr1 (e.expr2) (e.pos)) =
470    '('<Term_Ref_To_Terms e.expr1>'[0] == '
471       <Term_Ref_To_Terms e.expr2>'['<Expr_Int_To_CPP e.pos>'])';
472    //T/ <Expr_Ref_To_CPP <Box> e.expr1> '.term_eq ('
473    //T/   <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
474  (NOT t.cond) =
475    '!' <Cond_To_CPP t.cond>;
476};
477
478Infix_To_CPP (e.box) s.arg2cpp s.op e.args, {
479  e.args : (e.arg) e.rest =
480    <Apply s.arg2cpp e.box e.arg> :: e.arg,
481    <Infix_To_CPP (e.box) s.arg2cpp s.op e.rest> :: e.rest,
482    {
483      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
484      e.arg e.rest;
485    };;
486};
487
488Concat_To_TPP (e.box) s.arg2cpp e.args, {
489  e.args : (e.arg) e.rest =
490    <Apply s.arg2cpp e.box e.arg> :: e.arg,
491    <Concat_To_TPP (e.box) s.arg2cpp e.rest> :: e.rest,
492    {
493      e.arg : v, e.rest : v = '('e.arg ' + ' e.rest').get_ref()';
494      e.arg e.rest;
495    };;
496};
497
498Step_To_CPP {
499  /*empty*/ = /*empty*/;
500  ("INC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')++';
501  ("DEC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')--';
502};
503
504
505
506$func Const_Expr_Aux e.expr = e.cpp_expr;
507
508Const_Expr_To_CPP {
509  /*empty*/ = 'empty';
510  (SUBEXPR t.name s.pos s.len) = <Rfp2Cpp t.name> '.subexpr(' s.pos ', ' s.len ')';
511                  //FIXME: It is needed to check that s.pos and s.len
512                  //       are in allowable bounds.
513                  //       Set this bounds by options.
514  e.expr =
515    'GExpr('<Length e.expr>')' <Const_Expr_Aux () e.expr>;
516//T/    <Const_Expr_Aux () e.expr> : {
517//T/      ' + ' e.cpp_expr = e.cpp_expr;
518//T/      e.cpp_expr = e.cpp_expr;
519//T/    };
520};
521
522Const_Expr_Aux (e.accum) e.expr, {
523  e.expr : s.sym e.rest, <IsChar s.sym> =
524    <Const_Expr_Aux (e.accum <Symbol_To_CPP s.sym>) e.rest>;
525  e.accum : v =
526    '.add("'e.accum'", '<Length e.accum>')' <Const_Expr_Aux () e.expr>;
527//T/    {
528//T/      <CharsToBytes e.accum> : e s.c e,
529//T/        <Gt (s.c) (127)> =
530//T/        ' + rftype::Char::create_expr ("' e.accum '")' <Const_Expr_Aux () e.expr>;
531//T/      //' + Expr::create_seq<Char> (L"' e.accum '")' <Const-Expr-Aux () e.expr>;
532//T/      ' + rftype::Char::create_expr (L"' e.accum '")' <Const_Expr_Aux () e.expr>;
533//T/    };
534  e.expr : t.item e.rest, t.item : {
535    (PAREN (STATIC e.name)) =
536      <Bind &Used_Consts ((STATIC e.name)) ()>,
537      '.add('<Rfp2Cpp (STATIC e.name)>')';
538    (PAREN (REF t.name)) =
539      <Bind &Used_Consts (t.name) ()>,
540      '.add('<Name_To_CPP "DECL-OBJ" t.name>')';
541    (PAREN e.paren_expr) =
542      '.add('<Const_Expr_To_CPP e.paren_expr>')';
543//T/      ' + (' <Const_Expr_To_CPP e.paren_expr> ') ()';
544    (REF t.name) =
545      <Bind &Used_Consts (t.name) ()>,
546      '.concat(' <Name_To_CPP "DECL-OBJ" t.name>')';
547//      ' + Expr::create<ObjectRef>(' <Name-To-CPP t.name> ')';
548//T/    (STATIC e) =
549//T/      <Bind &Used_Consts (t.item) ()>,
550//T/      1000 '.add('<Rfp2Cpp t.item>')';
551    (s.FUNC t.name), s.FUNC : \{ FUNC; "FUNC?"; TFUNC; } =
552      '.add(&' <Name_To_CPP "DECL-FUNC" t.name> ')';
553//T/    (s.FUNC t.name), s.FUNC : \{ FUNC; "FUNC?"; TFUNC; } =
554//T/      ' + Expr::create_sym<rftype::Func> (' <Name_To_CPP "DECL-FUNC" t.name> ')';
555    s.sym, {
556      <IsInt s.sym> =
557//T/        ' + Expr::create<' <Get &Int> '>("' s.sym '")';
558        '.add(' s.sym ')';
559      <IsWord s.sym> =
560//T/        ' + Expr::create<rftype::Word>("' <Symbol_To_CPP s.sym> '")';
561        '.add(' <Symbol_To_CPP s.sym> ')';
562    };
563  } :: e.cpp_item =
564    e.cpp_item <Const_Expr_Aux () e.rest>;
565  = ;
566};
567
568Symbol_To_CPP s.ObjectSymbol, {
569  <ToChars s.ObjectSymbol> () $iter {
570    e.symbol : s.char e.rest, s.char : {
571      '\\' = '\\\\';
572      '\n' = '\\n';
573      '\t' = '\\t';
574//        '\v' = '\\v';
575//        '\b' = '\\b';
576      '\r' = '\\r';
577//        '\f' = '\\f';
578      '\"' = '\\"';
579//      '\'' = '\\\'';
580      s = s.char;
581    } :: e.cpp_char,
582    e.rest (e.cpp_symbol e.cpp_char);
583  } :: e.symbol (e.cpp_symbol),
584    e.symbol : /*empty*/ =
585    e.cpp_symbol;
586};
587
588
589
590Args_To_CPP {
591  (v.prefix) Vars /*empty*/  = 'RF_VOID';
592  (        ) Vars /*empty*/  = '/*void*/';
593  (        ) Vars (e.arg)    = <Rfp2Cpp (e.arg)>;
594  (e.prefix) Exprs /*empty*/ = '/*void*/';
595  (e.prefix) Exprs (e.arg)   = <Expr_Ref_To_CPP <Box> e.arg>;
596  (e.prefix) s.tag e.args =
597    e.args () $iter {
598      e.args : (e.arg) e.rest =
599        {
600          e.rest : v = ', ';
601          /*empty*/;
602        } :: e.comma,
603        s.tag : {
604          Vars = e.rest (e.cpp_args <Rfp2Cpp (e.arg)> e.comma);
605          Exprs = e.rest (e.cpp_args <Expr_Ref_To_CPP <Box> e.arg> e.comma);
606          Ints = e.rest (e.cpp_args <Expr_Int_To_CPP e.arg> e.comma);
607        };
608    } :: e.args (e.cpp_args),
609    e.args : /*empty*/,
610    (e.prefix) s.tag : {
611      t   Exprs = e.cpp_args;
612      ( ) Vars  = '(' e.cpp_args ')';
613      (v) Vars  = '(' e.prefix e.cpp_args ';;)';
614      e         = e.prefix e.cpp_args;
615    };
616};
617
618Name_To_CPP s.decl_type (e.name) e.args =
619  {
620    e.name : "org" "refal" "plus" "wrappers" e.cont =
621      <Bind &Used_Unavailable_Imports (<Lookup &Unavailable_Imports e.name>) ()>,
622      <QName_To_Cpp <Get &Module_Name> <ToWord <Intersperse ('_') e.cont>>>;
623    e.name : "refal" "plus" e.cont =
624      {
625        <Lookup &Decls s.decl_type ("refal" e.cont)> : \{ FUNC e; TFUNC e; };
626        <Bind &Decls (s.decl_type ("refal" e.cont)) (e.args)>;
627      },
628      <QName_To_Cpp "" "refal" e.cont>;
629    <Get &Current_Namespace> :: e.namespace,
630      {
631        <Lookup &Decls s.decl_type (e.name)> : \{ FUNC e; TFUNC e; };
632        <Bind &Decls (s.decl_type (e.name)) (e.args)>;
633      },
634      {
635        e.name : e.namespace e.cont =
636          <QName_To_Cpp e.cont>;
637        <QName_To_Cpp e.name>;
638      };
639  };
640
641QName_To_Cpp e.name = <Intersperse ('::') e.name>;
642
643Open_Namespace e.name = ('namespace ' e.name ' {');
644Close_Namespace e.name = ('}');
645
646Namespace_Control e.qualifiers =
647  {
648    e.qualifiers : /*empty*/ = <Get &Module_Name>;
649    e.qualifiers : () = /*empty*/;
650    e.qualifiers;
651  } :: e.qualifiers,
652  {
653    <Get &Current_Namespace> : e.qualifiers;
654    <Map &Close_Namespace (<Get &Current_Namespace>)> :: e.close_namespace,
655      <Store &Current_Namespace e.qualifiers>,
656      e.close_namespace <Map &Open_Namespace (e.qualifiers)>;
657  };
658
659Trace_Enter e.name (e.args) =
660  e.args 1 () $iter {
661    e.args : t.arg e.rest =
662      {
663        \{ e.rest : v; <Gt (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
664        'printf("  : ");';
665      } :: e.num,
666      e.rest <Add s.n 1>
667      (e.pr_args ('printf ("           argument "); 'e.num' ('<Rfp2Cpp t.arg>').writeln(stdout);'));
668  } :: e.args s.n (e.pr_args),
669  e.args : /*empty*/ =
670  ('printf ("+ %5u: enter >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr_args;
671
672Trace_Exit e.name (e.args) =
673  e.args 1 () $iter {
674    e.args : t.arg e.rest =
675      {
676        \{ e.rest : v; <Gt (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
677        'printf("  : ");';
678      } :: e.num,
679      e.rest <Add s.n 1>
680      (e.pr_args
681       ('printf ("           result   "); 'e.num' ('<Rfp2Cpp t.arg>').to_Expr().writeln(stdout);'));
682  } :: e.args s.n (e.pr_args),
683  e.args : /*empty*/ =
684  ('printf ("- %5u: exit  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr_args;
685
686Trace_Fail e.name =
687  ('printf ("- %5u: fail  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());');
688
689Extract_Qualifiers t.name, {
690  <IsInTable &Externs t.name> =
691    t.name : (e.n),
692    (()) e.n;
693  <RFP_Extract_Qualifiers t.name>;
694};
695
Note: See TracBrowser for help on using the repository browser.