source: to-imperative/trunk/compiler/rfp_asail_cpp.rf @ 2474

Last change on this file since 2474 was 2474, checked in by orlov, 14 years ago
  • No variable declarations with DEREF and SUBEXPR in ASAIL.
  • Typo fixed: EXPORTS -> EXPORT in asail_java and asail_jbc.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.3 KB
Line 
1// $Source$
2// $Revision: 2474 $
3// $Date: 2007-02-26 21:51:18 +0000 (Mon, 26 Feb 2007) $
4
5$use Apply Arithm Box Class Compare Convert CppMangle List StdIO Table;
6$use "rfpc";
7$use "rfp_helper";
8
9$box Int;
10
11$box Module-Name;
12
13$box Current-Namespace;
14
15$box Current-Func;
16
17$box Current-Trace;
18
19$box Entry;
20
21$box Entry-Name;
22
23$box Const-Exprs;
24
25$table Externs;
26
27$table Unavailable-Imports;
28$table Used-Unavailable-Imports;
29
30$table Decls;
31$table Locals;
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-To-CPP (e.ASAIL-Expr-init) e.ASAIL-Expr-rest = e.ASAIL-Expr;
41
42$func Expr-Ref-To-CPP e.ASAIL-Expr-Ref = e.CPP-Expr-Ref;
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 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 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-CPP (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  <Clear-Table &Externs>,
81  <Clear-Table &Unavailable-Imports>,
82  <Clear-Table &Used-Unavailable-Imports>,
83  <Clear-Table &Decls>,
84  <Clear-Table &Locals>,
85  {
86    <ASAIL-To-CPP e.asail> : v.cpp,
87      v.cpp <Map &Close-Namespace (<? &Current-Namespace>)> :: v.cpp,
88      <Store &Current-Namespace /*empty*/>,
89      <ASAIL-To-CPP <Domain &Used-Unavailable-Imports>> :: e.imp,
90      e.imp <Map &Close-Namespace (<? &Current-Namespace>)> v.cpp :: v.cpp,
91      <Store &Current-Namespace /*empty*/>,
92      {
93        <? &Entry-Name> : v.name = ('rfrt::Entry rf_entry (' v.name ');');;
94      } :: e.entry,
95      {
96        <? &Const-Exprs> : v.c-exprs =
97          <Namespace-Control <? &Module-Name>> :: e.nc,
98          (/*e.init-consts*/) <? &Const-Exprs> $iter {
99            e.c-exprs : (t.name (e.value)) e.rest =
100              (e.init-consts (<Name-To-CPP DECL-OBJ t.name> ' = ' e.value ';')) e.rest;
101          } :: (e.init-consts) e.c-exprs,
102          e.c-exprs : /*empty*/ =
103          e.nc
104          ('static void init_ () {' (e.init-consts) '}')
105          ('static AtStart init_registrator_ (&init_);')
106          <Map &Close-Namespace (<? &Current-Namespace>)>;;
107      } :: e.init,
108      <Store &Current-Namespace /*empty*/>,
109      ('#include <rf_core.hh>')
110      ('using namespace rfrt;')
111      <ASAIL-To-CPP <Sub (<Domain &Decls>) <Domain &Locals>>>
112      <Map &Close-Namespace (<? &Current-Namespace>)>
113      v.cpp e.init e.entry;;
114  };
115
116ASAIL-To-CPP e.asail, {
117  e.asail : t.item e.rest, t.item : {
118    (s.tag IMPORT (e.name) t.args t.ress e.body),
119      s.tag : \{ FUNC; FUNC?; },
120      e.name : "org" "refal" "plus" "wrappers" e.n =
121      <Bind &Unavailable-Imports (e.name)
122        (s.tag LOCAL (<To-Word <Intersperse ('_') e.n>>) t.args t.ress
123          (ERROR e.n "Not available"))>;
124    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
125      s.tag : \{ FUNC; FUNC?; },
126      <Store &Current-Func t.name>,
127      { <? &Entry> : e t.name e = <Store &Entry-Name <Rfp2Cpp t.name>>;; },
128      {
129        \{
130          <In-Table? &RFP-Options TRACEALL>;
131          <In-Table? &RFP-Trace t.name>;
132        } =
133          <Intersperse ('.') <Concat t.name>> :: e.name,
134          <Store &Current-Trace e.name (e.ress)>,
135          (<Trace-Enter e.name (e.args)>) (<Trace-Exit e.name (e.ress)>);
136        <Store &Current-Trace /*empty*/>,
137          () ();
138      } :: (e.trace-enter) (e.trace-exit),
139      <Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
140      <Namespace-Control e.qualifiers>
141      ('RF_FUNC (' <Rfp2Cpp e.name> ', '
142            <Args-To-CPP ('RF_ARG ') Vars e.args> ', '
143            <Args-To-CPP ('RF_RES ') Vars e.ress> ')'
144        (e.trace-enter <ASAIL-To-CPP e.body> e.trace-exit)
145       'RF_END');
146    (TRACE t.name) =
147      <Bind &RFP-Trace (t.name) ()>;
148    (IF-INT-CMP s.op (e.arg1) (e.arg2) e.body) =
149      ('if (' <Expr-Int-To-CPP e.arg1> ' 's.op' ' <Expr-Int-To-CPP e.arg2> ')')
150      ('{' (<ASAIL-To-CPP e.body>) '}');
151    (IF t.cond e.body) =
152      ('if (' <Cond-To-CPP t.cond> ')')
153      ('{' (<ASAIL-To-CPP e.body>) '}');
154    (FOR (e.cont-label) (e.break-label) (e.cond) (e.step) e.body) =
155      {
156        e.cont-label : t =
157          ('{'
158            ('{' (<ASAIL-To-CPP e.body>) '}')
159            (LABEL <Rfp2Cpp (LABEL e.cont-label)> ': {}')
160          '}');
161        ('{' (<ASAIL-To-CPP e.body>) '}');
162      } :: e.body,
163      {
164        e.break-label : t = (LABEL <Rfp2Cpp (LABEL e.break-label)> ': {}');;
165      } :: e.break,
166      ('for ( ; ; ' <Step-To-CPP e.step> ')') e.body e.break;
167    (LABEL (e.label) e.body) =
168      ('{' (<ASAIL-To-CPP e.body>) '}')
169      (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');
170    (TRY e.body) =
171      ('RF_TRAP') ('{' (<ASAIL-To-CPP e.body>) '}');
172    (CATCH-ERROR e.body) =
173      ('RF_WITH') ('{' (('RF_CLEANUP;') <ASAIL-To-CPP e.body>) '}');
174    RETFAIL =
175      {
176        <? &Current-Trace> : e.name (e.ress) =
177          <Trace-Fail e.name>;
178        /*empty*/;
179      } :: e.trace-exit,
180      e.trace-exit ('RF_RETFAIL;');
181    FATAL =
182//      <? &Current-Func> : (e.name),
183      ('RF_FUNC_ERROR (unexpected_fail);');
184    (LSPLIT e.expr (e.min) t.var1 t.var2) =
185      ('RF_lsplit (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
186      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2> ');');
187    (RSPLIT e.expr (e.min) t.var1 t.var2) =
188      ('RF_rsplit (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
189      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2 > ');');
190    (ASSIGN t.var e.expr) =
191      (<Rfp2Cpp t.var> ' = ' <Expr-To-CPP () e.expr> ';');
192    (DECL s.type t.var) =
193      ('Expr ' <Rfp2Cpp t.var> ';');
194    (INT  t.var e.expr) =
195      ('uintptr_t ' <Rfp2Cpp t.var> ' = ' <Expr-Int-To-CPP e.expr> ';');
196    (EXPR t.var e.expr) =
197      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP e.expr> ');');
198    (DROP t.var) =
199      (<Rfp2Cpp t.var> '.drop ();');
200    (CONTINUE t.label) =
201      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
202    (BREAK t.label) =
203      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
204    (ERROR e.expr) =
205      ('RF_ERROR (' <Expr-Ref-To-CPP e.expr> ');');
206    (CONSTEXPR IMPORT (e.name) (e.comment) e.expr) =
207      e.name : "org" "refal" "plus" "wrappers" e.n,
208      <Bind &Unavailable-Imports (e.name)
209        (CONSTEXPR LOCAL (<To-Word <Intersperse ('_') e.n>>) () e.expr)>;
210    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
211      <Bind &Locals (DECL-OBJ t.name) ()>,
212      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
213      {
214        t.name : (STATIC e) = (<? &Module-Name>) t.name;
215        <Extract-Qualifiers t.name>;
216      } :: (e.qualifiers) e.n,
217      <Put &Const-Exprs (t.name (<Const-Expr-To-CPP e.expr>))>,
218      <Namespace-Control e.qualifiers>
219      (e.linkage 'Expr ' <Rfp2Cpp e.n> ';');
220    (OBJ s.linkage s.tag t.name) =
221      <Bind &Locals (DECL-OBJ t.name) ()>,
222      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
223      <To-Chars s.tag> : s1 e2,
224      <Extract-Qualifiers t.name> :: (e.qualifiers) e.n,
225      {
226        s.tag : BOX =
227          <Put &Const-Exprs (t.name
228            ('Expr::create_sym< rftype::NamedObject<rftype::BoxContents> >('
229              'L"'e.n'")'))>;
230//        s.tag : VECTOR =
231//          <Put &Const-Exprs (t.name
232//            ('Expr::create_sym< rftype::NamedObject<rftype::Vector> >('
233//              'L"'e.n'")'))>;
234        <Put &Const-Exprs (t.name
235          ('new rftype::StaticObject<rftype::' s1 <To-Lower e2> '>(L"'e.n'")'))>;
236      },
237      <Namespace-Control e.qualifiers>
238      (e.linkage 'Expr ' <Rfp2Cpp e.n> ';');
239    (DECL-OBJ t.name) =
240      <Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
241      <Namespace-Control e.qualifiers>
242      ('extern Expr ' <Rfp2Cpp e.name> ';');
243    (DECL-FUNC t.name) =
244      <Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
245      <Namespace-Control e.qualifiers>
246      ('RF_DECL (' <Rfp2Cpp e.name> ');');
247    (EXTERN t.name) =
248      <Bind &Externs (t.name) ()>,
249      <Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
250      <Namespace-Control e.qualifiers>
251      ('RF_DECL (' <Rfp2Cpp e.name> ');');
252    /*
253     * s.call can be CALL or TAILCALL or TAILCALL?
254     */
255    (s.call t.name (e.exprs) (e.ress)) =
256      {
257        # \{ s.call : CALL; }, <? &Current-Trace> : e.full-name (e.ress) =
258          ('if (RF_CALL (' <Name-To-CPP DECL-FUNC t.name> ', '
259            <Args-To-CPP () Exprs e.exprs> ', ' <Args-To-CPP () Vars e.ress> '))')
260          ('{' (<Trace-Exit e.full-name (e.ress)> ('return true;')) '}')
261          ('else RF_RETFAIL;');
262        {
263          s.call : TAILCALL? = TAILCALL;
264          s.call;
265        } :: s.call,
266          ('RF_' s.call ' (' <Name-To-CPP DECL-FUNC t.name> ', '
267            <Args-To-CPP () Exprs e.exprs> ', ' <Args-To-CPP () Vars e.ress> ');');
268      };
269  } :: e.cpp-item,
270    e.cpp-item <ASAIL-To-CPP e.rest>;
271  /*empty*/;
272};
273
274/*
275 * Determine type of e.expr - int or Refal.
276 */
277Expr-To-CPP  (e.init) e.expr-all, e.expr-all : {
278  /*empty*/ = <Expr-Ref-To-CPP e.init>;
279//  s.ObjectSymbol e.rest, {
280//    <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
281//    <Expr-Ref-To-CPP e.expr-all>;
282//  };   
283  (PAREN e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
284  (EXPR e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
285  (DEREF e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
286  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
287  (LENGTH e.expr) e.rest = <Expr-Int-To-CPP e.init e.expr-all> ;
288  (MAX e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;         
289  (MIN e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
290  (INFIX s.op e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
291  (s.var-tag (e.QualifiedName)) e.rest =
292    <Expr-To-CPP (e.init (s.var-tag (e.QualifiedName))) e.rest>;
293};
294
295
296$func Term-Ref-To-CPP e = e;
297
298Expr-Ref-To-CPP {
299  /*empty*/ = 'empty';
300  term = <Term-Ref-To-CPP term>;
301  expr = '(' <Infix-To-CPP &Term-Ref-To-CPP "+" <Paren expr>> ')';
302};
303
304Term-Ref-To-CPP {
305  (PAREN e.expr) =
306    <Expr-Ref-To-CPP e.expr> ' ()';
307  (EXPR e.expr) =
308    'Expr (' <Expr-Ref-To-CPP e.expr> ')';
309  (DEREF e.expr (e.pos)) =
310    'Expr (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.pos> ')';
311  (SUBEXPR e.expr (e.pos) (e.len)) =
312    'Expr (' <Expr-Ref-To-CPP e.expr> ', '
313        <Expr-Int-To-CPP e.pos>   ', ' <Expr-Int-To-CPP e.len> ')';
314  (REF t.name) = <Name-To-CPP DECL-OBJ t.name>;
315  ERROR-EXPR = 'err';
316  (STATIC t.name) =
317    <? &Current-Namespace> :: e.namespace,
318    {
319      <? &Module-Name> : e.namespace = /*empty*/;
320      <? &Module-Name>'::';
321    } :: e.prefix,
322    e.prefix <Rfp2Cpp (STATIC t.name)>;
323  (s.var-tag e.ns t.name) = <Rfp2Cpp (s.var-tag e.ns t.name)>;
324  s.sym, {
325    <Int? s.sym> =
326      'Expr::create<' <? &Int> '>("' s.sym '")';
327    <Word? s.sym> =
328      'Expr::create<rftype::Word>("' <Symbol-To-CPP s.sym> '")';
329  };
330};
331
332Expr-Int-To-CPP {
333  /*empty*/ = /*empty*/;
334  s.ObjectSymbol =
335    {
336      <Int? s.ObjectSymbol> = s.ObjectSymbol;
337      $error ("Illegal type int-symbol: " s.ObjectSymbol);
338    };
339  (LENGTH e.expr) =
340    <Expr-Ref-To-CPP e.expr> '.get_len ()';
341  (MAX e.args) =
342    'pxx_max (' <Args-To-CPP () Ints e.args> ')';
343  (MIN e.args) =
344    'pxx_min (' <Args-To-CPP () Ints e.args> ')';
345  (INFIX s.op e.args) =
346    '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
347  (REF t.name) = <Name-To-CPP DECL-OBJ t.name>;
348  (s.var-tag t.name) = <Rfp2Cpp (s.var-tag t.name)>;
349  expr = '(' <Infix-To-CPP &Expr-Int-To-CPP "+" <Paren expr>> ')';
350};
351
352Cond-To-CPP {
353  (CALL-FAILS (CALL t.name (e.exprs) (e.ress))) =
354    '!RF_CALL (' <Name-To-CPP DECL-FUNC t.name> ', '
355          <Args-To-CPP () Exprs e.exprs> ', '
356          <Args-To-CPP () Vars e.ress>   ')';
357  (SYMBOL? e.expr (e.pos)) =
358    <Expr-Ref-To-CPP e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')';
359  (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
360    <Expr-Ref-To-CPP e.expr> '.flat_at ('
361      <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
362  (ITER-FAILS e.expr) =
363    '!RF_iter(' <Expr-Ref-To-CPP e.expr> ')';
364  (EQ e.expr1 (e.expr2) (e.pos)) =
365    <Expr-Ref-To-CPP e.expr1> '.eq ('
366      <Expr-Ref-To-CPP e.expr2> ', ' <Expr-Int-To-CPP e.pos> ')';
367  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
368    <Expr-Ref-To-CPP e.expr1> '.term_eq ('
369      <Expr-Ref-To-CPP e.expr2> ', ' <Expr-Int-To-CPP e.pos> ')';
370  (NOT t.cond) =
371    '!' <Cond-To-CPP t.cond>;
372};
373
374Infix-To-CPP s.arg2cpp s.op e.args, {
375  e.args : (e.arg) e.rest =
376    <Apply s.arg2cpp e.arg> :: e.arg,
377    <Infix-To-CPP s.arg2cpp s.op e.rest> :: e.rest,
378    {
379      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
380      e.arg e.rest;
381    };;
382};
383
384Step-To-CPP {
385  /*empty*/ = /*empty*/;
386  (INC-ITER e.expr) = 'RF_iter(' <Expr-Ref-To-CPP e.expr> ')++';
387  (DEC-ITER e.expr) = 'RF_iter(' <Expr-Ref-To-CPP e.expr> ')--';
388};
389
390
391
392$func Const-Expr-Aux e.expr = e.cpp-expr;
393
394Const-Expr-To-CPP {
395  /*empty*/ = 'empty';
396  (SUBEXPR t.name s.pos s.len) = 'Expr (' <Rfp2Cpp t.name> ', ' s.pos ', ' s.len ')';
397                  //FIXME: надо проверять, что s.pos и s.len
398                  //       не превышают допустимых величин.
399                  //       Задавать эти величины опциями.
400  e.expr =
401    <Const-Expr-Aux () e.expr> : {
402      ' + ' e.cpp-expr = e.cpp-expr;
403      e.cpp-expr = e.cpp-expr;
404    };
405};
406
407Const-Expr-Aux (e.accum) e.expr, {
408  e.expr : s.sym e.rest, <Char? s.sym> =
409    <Const-Expr-Aux (e.accum <Symbol-To-CPP s.sym>) e.rest>;
410  e.accum : v =
411    {
412      <Chars-To-Bytes e.accum> : e s.c e,
413        <">" (s.c) (127)> =
414        ' + rftype::Char::create_expr ("' e.accum '")' <Const-Expr-Aux () e.expr>;
415      //' + Expr::create_seq<Char> (L"' e.accum '")' <Const-Expr-Aux () e.expr>;
416      ' + rftype::Char::create_expr (L"' e.accum '")' <Const-Expr-Aux () e.expr>;
417    };
418  e.expr : t.item e.rest, t.item : {
419    (PAREN e.paren-expr) =
420      ' + (' <Const-Expr-To-CPP e.paren-expr> ') ()';
421    (REF t.name) =
422      ' + ' <Name-To-CPP DECL-OBJ t.name>;
423//      ' + Expr::create<ObjectRef>(' <Name-To-CPP t.name> ')';
424    (STATIC e) =
425      ' + ' <Rfp2Cpp t.item>;
426    (s.FUNC t.name), s.FUNC : \{ FUNC; FUNC?; } =
427      ' + Expr::create_sym<rftype::Func> (' <Name-To-CPP DECL-FUNC t.name> ')';
428    s.sym, {
429      <Int? s.sym> =
430        ' + Expr::create<' <? &Int> '>("' s.sym '")';
431      <Word? s.sym> =
432        ' + Expr::create<rftype::Word>("' <Symbol-To-CPP s.sym> '")';
433    };
434  } :: e.cpp-item =
435    e.cpp-item <Const-Expr-Aux () e.rest>;
436  = /*empty*/;
437};
438
439Symbol-To-CPP s.ObjectSymbol, {
440  <To-Chars s.ObjectSymbol> () $iter {
441    e.symbol : s.char e.rest, s.char : {
442      '\\' = '\\\\';
443      '\n' = '\\n';
444      '\t' = '\\t';
445//        '\v' = '\\v';
446//        '\b' = '\\b';
447      '\r' = '\\r';
448//        '\f' = '\\f';
449      '\"' = '\\"';
450//      '\'' = '\\\'';
451      s = s.char;
452    } :: e.cpp-char,
453    e.rest (e.cpp-symbol e.cpp-char);
454  } :: e.symbol (e.cpp-symbol),
455    e.symbol : /*empty*/ =
456    e.cpp-symbol;
457};
458
459
460
461Args-To-CPP {
462  (v.prefix) Vars /*empty*/  = 'RF_VOID';
463  (        ) Vars /*empty*/  = '/*void*/';
464  (        ) Vars (e.arg)    = <Rfp2Cpp (e.arg)>;
465  (e.prefix) Exprs /*empty*/ = '/*void*/';
466  (e.prefix) Exprs (e.arg)   = <Expr-Ref-To-CPP e.arg>;
467  (e.prefix) s.tag e.args =
468    e.args () $iter {
469      e.args : (e.arg) e.rest =
470        {
471          e.rest : v = ', ';
472          /*empty*/;
473        } :: e.comma,
474        s.tag : {
475          Vars = e.rest (e.cpp-args <Rfp2Cpp (e.arg)> e.comma);
476          Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP e.arg> e.comma);
477          Ints = e.rest (e.cpp-args <Expr-Int-To-CPP e.arg> e.comma);
478        };
479    } :: e.args (e.cpp-args),
480    e.args : /*empty*/,
481    (e.prefix) s.tag : {
482      t   Exprs = '(' e.cpp-args ')';
483      ( ) Vars  = '(' e.cpp-args ')';
484      (v) Vars  = '(' e.prefix e.cpp-args ';;)';
485      e         = e.prefix e.cpp-args;
486    };
487};
488
489Name-To-CPP s.decl-type (e.name) =
490  {
491    e.name : "org" "refal" "plus" "wrappers" e.cont =
492      <Bind &Used-Unavailable-Imports (<Lookup &Unavailable-Imports e.name>) ()>,
493      <Rfp2Cpp <? &Module-Name> <To-Word <Intersperse ('_') e.cont>>>;
494    e.name : "refal" "plus" e.cont =
495      <Bind &Decls (s.decl-type ("refal" e.cont)) ()>,
496      <Rfp2Cpp "refal" e.cont>;
497    <? &Current-Namespace> :: e.namespace,
498      <Bind &Decls (s.decl-type (e.name)) ()>,
499      {
500        e.name : e.namespace e.cont =
501          <Rfp2Cpp e.cont>;
502        <Rfp2Cpp (e.name)>;
503      };
504  };
505
506Open-Namespace e.name = ('namespace ' <Rfp2Cpp e.name> ' {');
507Close-Namespace e.name = ('}');
508
509Namespace-Control e.qualifiers =
510  {
511    e.qualifiers : /*empty*/ = <? &Module-Name>;
512    e.qualifiers : () = /*empty*/;
513    e.qualifiers;
514  } :: e.qualifiers,
515  {
516    <? &Current-Namespace> : e.qualifiers;
517    <Map &Close-Namespace (<? &Current-Namespace>)> :: e.close-namespace,
518      <Store &Current-Namespace e.qualifiers>,
519      e.close-namespace <Map &Open-Namespace (e.qualifiers)>;
520  };
521
522Trace-Enter e.name (e.args) =
523  e.args 1 () $iter {
524    e.args : t.arg e.rest =
525      {
526        \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
527        'printf("  : ");';
528      } :: e.num,
529      e.rest <"+" s.n 1>
530      (e.pr-args ('printf ("           argument "); 'e.num' ('<Rfp2Cpp t.arg>').writeln(stdout);'));
531  } :: e.args s.n (e.pr-args),
532  e.args : /*empty*/ =
533  ('printf ("+ %5u: enter >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args;
534
535Trace-Exit e.name (e.args) =
536  e.args 1 () $iter {
537    e.args : t.arg e.rest =
538      {
539        \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');';
540        'printf("  : ");';
541      } :: e.num,
542      e.rest <"+" s.n 1>
543      (e.pr-args
544       ('printf ("           result   "); 'e.num' ('<Rfp2Cpp t.arg>').to_Expr().writeln(stdout);'));
545  } :: e.args s.n (e.pr-args),
546  e.args : /*empty*/ =
547  ('printf ("- %5u: exit  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args;
548
549Trace-Fail e.name =
550  ('printf ("- %5u: fail  >>> 'e.name' <<<\\n", rfrt::stack->get_depth());');
551
552Extract-Qualifiers t.name, {
553  <In-Table? &Externs t.name> =
554    t.name : (e.n),
555    (()) e.n;
556  <RFP-Extract-Qualifiers t.name>;
557};
558
Note: See TracBrowser for help on using the repository browser.