1 | // $Source$ |
---|
2 | // $Revision: 2488 $ |
---|
3 | // $Date: 2007-02-27 18:34:33 +0000 (Tue, 27 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-Ref-To-CPP 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 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 | |
---|
67 | RFP-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 | |
---|
116 | ASAIL-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 <QName-To-Cpp <Concat 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), t.var : (INT e) = |
---|
191 | (<Rfp2Cpp t.var> ' = ' <Expr-Int-To-CPP e.expr> ';'); |
---|
192 | (ASSIGN t.var e.expr) = |
---|
193 | (<Rfp2Cpp t.var> ' = ' <Expr-Ref-To-CPP e.expr> ';'); |
---|
194 | (DECL t.var), t.var : (INT e) = |
---|
195 | ('int ' <Rfp2Cpp t.var> ';'); |
---|
196 | (DECL s.type t.var) = |
---|
197 | ('Expr ' <Rfp2Cpp t.var> ';'); |
---|
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 | { s.linkage : LOCAL = 'static ';; } :: e.linkage, |
---|
212 | { |
---|
213 | t.name : (STATIC e) = (<? &Module-Name>) t.name (t.name); |
---|
214 | <Extract-Qualifiers t.name> t.name; |
---|
215 | } :: (e.qualifiers) e.n t.name, |
---|
216 | <Bind &Locals (DECL-OBJ t.name) ()>, |
---|
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 | $func Term-Ref-To-CPP e = e; |
---|
276 | |
---|
277 | Expr-Ref-To-CPP { |
---|
278 | /*empty*/ = 'empty'; |
---|
279 | term = <Term-Ref-To-CPP term>; |
---|
280 | expr = '(' <Infix-To-CPP &Term-Ref-To-CPP "+" <Paren expr>> ')'; |
---|
281 | }; |
---|
282 | |
---|
283 | Term-Ref-To-CPP { |
---|
284 | (PAREN e.expr) = |
---|
285 | <Expr-Ref-To-CPP e.expr> ' ()'; |
---|
286 | (DEREF e.expr (e.pos)) = |
---|
287 | 'Expr (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.pos> ')'; |
---|
288 | (SUBEXPR e.expr (e.pos) (e.len)) = |
---|
289 | 'Expr (' <Expr-Ref-To-CPP e.expr> ', ' |
---|
290 | <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')'; |
---|
291 | (REF t.name) = <Name-To-CPP DECL-OBJ t.name>; |
---|
292 | ERROR-EXPR = 'err'; |
---|
293 | (STATIC t.name) = |
---|
294 | <? &Current-Namespace> :: e.namespace, |
---|
295 | { |
---|
296 | <? &Module-Name> : e.namespace = /*empty*/; |
---|
297 | <? &Module-Name>'::'; |
---|
298 | } :: e.prefix, |
---|
299 | e.prefix <Rfp2Cpp (STATIC t.name)>; |
---|
300 | (s.var-tag e.ns t.name) = <Rfp2Cpp (s.var-tag e.ns t.name)>; |
---|
301 | s.sym, { |
---|
302 | <Int? s.sym> = |
---|
303 | 'Expr::create<' <? &Int> '>("' s.sym '")'; |
---|
304 | <Word? s.sym> = |
---|
305 | 'Expr::create<rftype::Word>("' <Symbol-To-CPP s.sym> '")'; |
---|
306 | }; |
---|
307 | }; |
---|
308 | |
---|
309 | Expr-Int-To-CPP { |
---|
310 | /*empty*/ = /*empty*/; |
---|
311 | s.ObjectSymbol = |
---|
312 | { |
---|
313 | <Int? s.ObjectSymbol> = s.ObjectSymbol; |
---|
314 | $error ("Illegal type int-symbol: " s.ObjectSymbol); |
---|
315 | }; |
---|
316 | (LENGTH e.expr) = |
---|
317 | <Expr-Ref-To-CPP e.expr> '.get_len ()'; |
---|
318 | (MAX e.args) = |
---|
319 | 'pxx_max (' <Args-To-CPP () Ints e.args> ')'; |
---|
320 | (MIN e.args) = |
---|
321 | 'pxx_min (' <Args-To-CPP () Ints e.args> ')'; |
---|
322 | (INFIX s.op e.args) = |
---|
323 | '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')'; |
---|
324 | (REF t.name) = <Name-To-CPP DECL-OBJ t.name>; |
---|
325 | (s.var-tag t.name) = <Rfp2Cpp (s.var-tag t.name)>; |
---|
326 | expr = '(' <Infix-To-CPP &Expr-Int-To-CPP "+" <Paren expr>> ')'; |
---|
327 | }; |
---|
328 | |
---|
329 | Cond-To-CPP { |
---|
330 | (CALL-FAILS (CALL t.name (e.exprs) (e.ress))) = |
---|
331 | '!RF_CALL (' <Name-To-CPP DECL-FUNC t.name> ', ' |
---|
332 | <Args-To-CPP () Exprs e.exprs> ', ' |
---|
333 | <Args-To-CPP () Vars e.ress> ')'; |
---|
334 | (SYMBOL? e.expr (e.pos)) = |
---|
335 | <Expr-Ref-To-CPP e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')'; |
---|
336 | (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) = |
---|
337 | <Expr-Ref-To-CPP e.expr> '.flat_at (' |
---|
338 | <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')'; |
---|
339 | (ITER-FAILS e.expr) = |
---|
340 | '!RF_iter(' <Expr-Ref-To-CPP e.expr> ')'; |
---|
341 | (EQ e.expr1 (e.expr2) (e.pos)) = |
---|
342 | <Expr-Ref-To-CPP e.expr1> '.eq (' |
---|
343 | <Expr-Ref-To-CPP e.expr2> ', ' <Expr-Int-To-CPP e.pos> ')'; |
---|
344 | (TERM-EQ e.expr1 (e.expr2) (e.pos)) = |
---|
345 | <Expr-Ref-To-CPP e.expr1> '.term_eq (' |
---|
346 | <Expr-Ref-To-CPP e.expr2> ', ' <Expr-Int-To-CPP e.pos> ')'; |
---|
347 | (NOT t.cond) = |
---|
348 | '!' <Cond-To-CPP t.cond>; |
---|
349 | }; |
---|
350 | |
---|
351 | Infix-To-CPP s.arg2cpp s.op e.args, { |
---|
352 | e.args : (e.arg) e.rest = |
---|
353 | <Apply s.arg2cpp e.arg> :: e.arg, |
---|
354 | <Infix-To-CPP s.arg2cpp s.op e.rest> :: e.rest, |
---|
355 | { |
---|
356 | e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest; |
---|
357 | e.arg e.rest; |
---|
358 | };; |
---|
359 | }; |
---|
360 | |
---|
361 | Step-To-CPP { |
---|
362 | /*empty*/ = /*empty*/; |
---|
363 | (INC-ITER e.expr) = 'RF_iter(' <Expr-Ref-To-CPP e.expr> ')++'; |
---|
364 | (DEC-ITER e.expr) = 'RF_iter(' <Expr-Ref-To-CPP e.expr> ')--'; |
---|
365 | }; |
---|
366 | |
---|
367 | |
---|
368 | |
---|
369 | $func Const-Expr-Aux e.expr = e.cpp-expr; |
---|
370 | |
---|
371 | Const-Expr-To-CPP { |
---|
372 | /*empty*/ = 'empty'; |
---|
373 | (SUBEXPR t.name s.pos s.len) = 'Expr (' <Rfp2Cpp t.name> ', ' s.pos ', ' s.len ')'; |
---|
374 | //FIXME: надо проверять, что s.pos и s.len |
---|
375 | // не превышают допустимых величин. |
---|
376 | // Задавать эти величины опциями. |
---|
377 | e.expr = |
---|
378 | <Const-Expr-Aux () e.expr> : { |
---|
379 | ' + ' e.cpp-expr = e.cpp-expr; |
---|
380 | e.cpp-expr = e.cpp-expr; |
---|
381 | }; |
---|
382 | }; |
---|
383 | |
---|
384 | Const-Expr-Aux (e.accum) e.expr, { |
---|
385 | e.expr : s.sym e.rest, <Char? s.sym> = |
---|
386 | <Const-Expr-Aux (e.accum <Symbol-To-CPP s.sym>) e.rest>; |
---|
387 | e.accum : v = |
---|
388 | { |
---|
389 | <Chars-To-Bytes e.accum> : e s.c e, |
---|
390 | <">" (s.c) (127)> = |
---|
391 | ' + rftype::Char::create_expr ("' e.accum '")' <Const-Expr-Aux () e.expr>; |
---|
392 | //' + Expr::create_seq<Char> (L"' e.accum '")' <Const-Expr-Aux () e.expr>; |
---|
393 | ' + rftype::Char::create_expr (L"' e.accum '")' <Const-Expr-Aux () e.expr>; |
---|
394 | }; |
---|
395 | e.expr : t.item e.rest, t.item : { |
---|
396 | (PAREN e.paren-expr) = |
---|
397 | ' + (' <Const-Expr-To-CPP e.paren-expr> ') ()'; |
---|
398 | (REF t.name) = |
---|
399 | ' + ' <Name-To-CPP DECL-OBJ t.name>; |
---|
400 | // ' + Expr::create<ObjectRef>(' <Name-To-CPP t.name> ')'; |
---|
401 | (STATIC e) = |
---|
402 | ' + ' <Rfp2Cpp t.item>; |
---|
403 | (s.FUNC t.name), s.FUNC : \{ FUNC; FUNC?; } = |
---|
404 | ' + Expr::create_sym<rftype::Func> (' <Name-To-CPP DECL-FUNC t.name> ')'; |
---|
405 | s.sym, { |
---|
406 | <Int? s.sym> = |
---|
407 | ' + Expr::create<' <? &Int> '>("' s.sym '")'; |
---|
408 | <Word? s.sym> = |
---|
409 | ' + Expr::create<rftype::Word>("' <Symbol-To-CPP s.sym> '")'; |
---|
410 | }; |
---|
411 | } :: e.cpp-item = |
---|
412 | e.cpp-item <Const-Expr-Aux () e.rest>; |
---|
413 | = /*empty*/; |
---|
414 | }; |
---|
415 | |
---|
416 | Symbol-To-CPP s.ObjectSymbol, { |
---|
417 | <To-Chars s.ObjectSymbol> () $iter { |
---|
418 | e.symbol : s.char e.rest, s.char : { |
---|
419 | '\\' = '\\\\'; |
---|
420 | '\n' = '\\n'; |
---|
421 | '\t' = '\\t'; |
---|
422 | // '\v' = '\\v'; |
---|
423 | // '\b' = '\\b'; |
---|
424 | '\r' = '\\r'; |
---|
425 | // '\f' = '\\f'; |
---|
426 | '\"' = '\\"'; |
---|
427 | // '\'' = '\\\''; |
---|
428 | s = s.char; |
---|
429 | } :: e.cpp-char, |
---|
430 | e.rest (e.cpp-symbol e.cpp-char); |
---|
431 | } :: e.symbol (e.cpp-symbol), |
---|
432 | e.symbol : /*empty*/ = |
---|
433 | e.cpp-symbol; |
---|
434 | }; |
---|
435 | |
---|
436 | |
---|
437 | |
---|
438 | Args-To-CPP { |
---|
439 | (v.prefix) Vars /*empty*/ = 'RF_VOID'; |
---|
440 | ( ) Vars /*empty*/ = '/*void*/'; |
---|
441 | ( ) Vars (e.arg) = <Rfp2Cpp (e.arg)>; |
---|
442 | (e.prefix) Exprs /*empty*/ = '/*void*/'; |
---|
443 | (e.prefix) Exprs (e.arg) = <Expr-Ref-To-CPP e.arg>; |
---|
444 | (e.prefix) s.tag e.args = |
---|
445 | e.args () $iter { |
---|
446 | e.args : (e.arg) e.rest = |
---|
447 | { |
---|
448 | e.rest : v = ', '; |
---|
449 | /*empty*/; |
---|
450 | } :: e.comma, |
---|
451 | s.tag : { |
---|
452 | Vars = e.rest (e.cpp-args <Rfp2Cpp (e.arg)> e.comma); |
---|
453 | Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP e.arg> e.comma); |
---|
454 | Ints = e.rest (e.cpp-args <Expr-Int-To-CPP e.arg> e.comma); |
---|
455 | }; |
---|
456 | } :: e.args (e.cpp-args), |
---|
457 | e.args : /*empty*/, |
---|
458 | (e.prefix) s.tag : { |
---|
459 | t Exprs = '(' e.cpp-args ')'; |
---|
460 | ( ) Vars = '(' e.cpp-args ')'; |
---|
461 | (v) Vars = '(' e.prefix e.cpp-args ';;)'; |
---|
462 | e = e.prefix e.cpp-args; |
---|
463 | }; |
---|
464 | }; |
---|
465 | |
---|
466 | Name-To-CPP s.decl-type (e.name) = |
---|
467 | { |
---|
468 | e.name : "org" "refal" "plus" "wrappers" e.cont = |
---|
469 | <Bind &Used-Unavailable-Imports (<Lookup &Unavailable-Imports e.name>) ()>, |
---|
470 | <QName-To-Cpp <? &Module-Name> <To-Word <Intersperse ('_') e.cont>>>; |
---|
471 | e.name : "refal" "plus" e.cont = |
---|
472 | <Bind &Decls (s.decl-type ("refal" e.cont)) ()>, |
---|
473 | <QName-To-Cpp "refal" e.cont>; |
---|
474 | <? &Current-Namespace> :: e.namespace, |
---|
475 | <Bind &Decls (s.decl-type (e.name)) ()>, |
---|
476 | { |
---|
477 | e.name : e.namespace e.cont = |
---|
478 | <QName-To-Cpp e.cont>; |
---|
479 | <QName-To-Cpp e.name>; |
---|
480 | }; |
---|
481 | }; |
---|
482 | |
---|
483 | QName-To-Cpp e.name = <Concat <Intersperse ('::') <Map! &Rfp2Cpp (<Paren e.name>)>>>; |
---|
484 | |
---|
485 | Open-Namespace e.name = ('namespace ' <Rfp2Cpp e.name> ' {'); |
---|
486 | Close-Namespace e.name = ('}'); |
---|
487 | |
---|
488 | Namespace-Control e.qualifiers = |
---|
489 | { |
---|
490 | e.qualifiers : /*empty*/ = <? &Module-Name>; |
---|
491 | e.qualifiers : () = /*empty*/; |
---|
492 | e.qualifiers; |
---|
493 | } :: e.qualifiers, |
---|
494 | { |
---|
495 | <? &Current-Namespace> : e.qualifiers; |
---|
496 | <Map &Close-Namespace (<? &Current-Namespace>)> :: e.close-namespace, |
---|
497 | <Store &Current-Namespace e.qualifiers>, |
---|
498 | e.close-namespace <Map &Open-Namespace (e.qualifiers)>; |
---|
499 | }; |
---|
500 | |
---|
501 | Trace-Enter e.name (e.args) = |
---|
502 | e.args 1 () $iter { |
---|
503 | e.args : t.arg e.rest = |
---|
504 | { |
---|
505 | \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');'; |
---|
506 | 'printf(" : ");'; |
---|
507 | } :: e.num, |
---|
508 | e.rest <"+" s.n 1> |
---|
509 | (e.pr-args ('printf (" argument "); 'e.num' ('<Rfp2Cpp t.arg>').writeln(stdout);')); |
---|
510 | } :: e.args s.n (e.pr-args), |
---|
511 | e.args : /*empty*/ = |
---|
512 | ('printf ("+ %5u: enter >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args; |
---|
513 | |
---|
514 | Trace-Exit e.name (e.args) = |
---|
515 | e.args 1 () $iter { |
---|
516 | e.args : t.arg e.rest = |
---|
517 | { |
---|
518 | \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');'; |
---|
519 | 'printf(" : ");'; |
---|
520 | } :: e.num, |
---|
521 | e.rest <"+" s.n 1> |
---|
522 | (e.pr-args |
---|
523 | ('printf (" result "); 'e.num' ('<Rfp2Cpp t.arg>').to_Expr().writeln(stdout);')); |
---|
524 | } :: e.args s.n (e.pr-args), |
---|
525 | e.args : /*empty*/ = |
---|
526 | ('printf ("- %5u: exit >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args; |
---|
527 | |
---|
528 | Trace-Fail e.name = |
---|
529 | ('printf ("- %5u: fail >>> 'e.name' <<<\\n", rfrt::stack->get_depth());'); |
---|
530 | |
---|
531 | Extract-Qualifiers t.name, { |
---|
532 | <In-Table? &Externs t.name> = |
---|
533 | t.name : (e.n), |
---|
534 | (()) e.n; |
---|
535 | <RFP-Extract-Qualifiers t.name>; |
---|
536 | }; |
---|
537 | |
---|