// $Source$ // $Revision$ // $Date$ $use Apply Arithm Box Class Compare Convert CppMangle List StdIO Table; $use "rfpc"; $use "rfp_helper"; $box Int; $box Module-Name; $box Current-Namespace; $box Current-Func; $box Current-Trace; $box Entry; $box Entry-Name; $box Const-Exprs; $table Externs; $func ASAIL-To-CPP e.body = e.cpp-code; $func Namespace-Control e.qualifiers = e.namespace-control; $func Expr-To-CPP (e.ASAIL-Expr-init) e.ASAIL-Expr-rest = e.ASAIL-Expr; $func Expr-Ref-To-CPP e.ASAIL-Expr-Ref = e.CPP-Expr-Ref; $func Expr-Int-To-CPP e.ASAIL-Expr-Int = e.CPP-Expr-Int; $func Step-To-CPP e.step-operators = e.cpp-step-operators; $func Const-Expr-To-CPP e.ASAIL-const-expr = e.CPP-const-expr; $func Args-To-CPP (e.prefix) s.Arg-Res-Tag e.ASAIL-Args = e.CPP-Args; $func Symbol-To-CPP s.RFP-Symbol = e.CPP-String; $func Name-To-CPP t.name = e.CPP-Name; $func Cond-To-CPP e.cond = e.CPP-Cond; $func Infix-To-CPP s.func-for-converting-args-to-cpp s.op e.args = e.cpp-expr; $func Op-Arg-To-CPP s.op = s.func-for-converting-args-to-cpp; $func Trace-Enter e.name (e.args) = e.trace; $func Trace-Exit e.name (e.ress) = e.trace; $func Trace-Fail e.name = e.trace; $func Extract-Qualifiers t.name = (e.qualifiers) e.name; RFP-ASAIL-To-CPP (e.ModuleName) e.asail = { >; ; }, , , { >; ; }, , , , { : v.cpp, { : v = ('}');; // close last namespace } :: e.close-namespace, , { : v.name = ('rfrt::Entry rf_entry (' v.name ');');; } :: e.entry, { : v.c-exprs = (/*e.init-consts*/) $iter { e.c-exprs : (e.cpp-name (e.value)) e.rest = (e.init-consts (e.cpp-name ' = ' e.value ';')) e.rest; } :: (e.init-consts) e.c-exprs, e.c-exprs : /*empty*/ = > ('static void init_ ()\n{' (e.init-consts) '}') ('static AtStart init_registrator_ (&init_);') ('}');; } :: e.init, ('namespace refal\n{') ('using namespace rfrt;') v.cpp e.close-namespace e.init e.entry ('}');; }; ASAIL-To-CPP e.asail, { e.asail : t.item e.rest, t.item : { (s.tag t.name (e.args) (e.ress) e.body), s.tag : \{ FUNC = ('void') /*empty*/; FUNC? = ('boolean') ('return true;'); } :: (e.return-type) e.return = , { : e t.name e = >;; }, { \{ ; ; } = > :: e.name, , () (); , () (); } :: (e.trace-enter) (e.trace-exit), :: (e.qualifiers) e.name, ('RF_FUNC (' ', ' ', ' ')' (e.trace-enter e.trace-exit) 'RF_END'); (TRACE t.name) = ; (IF (e.cond) e.body) = ('if (' ')') ('{' () '}'); (FOR (e.cont-label) (e.break-label) (e.cond) (e.step) e.body) = { e.cont-label : t = ('{' ('{' () '}') (LABEL ': {}') '}'); ('{' () '}'); } :: e.body, { e.break-label : t = (LABEL ': {}');; } :: e.break, ('for ( ; ' '; ' ')') e.body e.break; (LABEL (e.label) e.body) = // { // e.label : /*empty*/ = // ('{' () '}' ); ('{' () '}') (LABEL ': {}'); // }; (TRY e.body) = ('RF_TRAP') ('{' () '}'); (CATCH-ERROR e.body) = ('RF_WITH') ('{' (('RF_CLEANUP;') ) '}'); RETURN = { : e.name (e.ress) = ; /*empty*/; } :: e.trace-exit, e.trace-exit ('return true;'); RETFAIL = { : e.name (e.ress) = ; /*empty*/; } :: e.trace-exit, e.trace-exit ('RF_RETFAIL;'); FATAL = // : (e.name), ('RF_FUNC_ERROR (unexpected_fail);'); (LSPLIT e.expr (e.min) t.var1 t.var2) = ('RF_lsplit (' ', ' ', ' ', ' ');'); (RSPLIT e.expr (e.min) t.var1 t.var2) = ('RF_rsplit (' ', ' ', ' ', ' ');'); (ASSIGN t.var e.expr) = ( ' = ' ';'); (DECL s.type t.var) = ('Expr ' ';'); (INT t.var e.expr) = ('uintptr_t ' ' = ' ';'); (EXPR t.var e.expr) = ('Expr ' ' (' ');'); (DEREF t.var e.expr (e.pos)) = ('Expr ' ' (' ', ' ');'); (SUBEXPR t.var e.expr (e.pos) (e.len)) = ('Expr ' ' (' ', ' ', ' ');'); (DROP t.var) = ( '.drop ();'); (CONTINUE t.label) = ('goto ' ';'); (BREAK t.label) = ('goto ' ';'); (ERROR e.expr) = ('RF_ERROR (' ');'); (CONSTEXPR s.linkage t.name (e.comment) e.expr) = { s.linkage : LOCAL = 'static ';; } :: e.linkage, { t.name : (STATIC e) = () t.name; ; } :: (e.qualifiers) e.name, :: e.cpp-name, ))>, (e.linkage 'Expr ' e.cpp-name ';'); (OBJ s.linkage s.tag t.name) = { s.linkage : LOCAL = 'static ';; } :: e.linkage, : s1 e2, :: (e.qualifiers) e.name, :: e.cpp-name, { s.tag : BOX = >(' 'L"'e.name'")'))>; // s.tag : VECTOR = // >(' // 'L"'e.name'")'))>; '>(L"'e.name'")'))>; }, (e.linkage 'Expr ' e.cpp-name ';'); (DECL-OBJ t.name) = :: (e.qualifiers) e.name, ('extern Expr ' ';'); (DECL-FUNC t.name) = :: (e.qualifiers) e.name, ('RF_DECL (' ');'); (EXTERN t.name) = , :: (e.qualifiers) e.name, ('RF_DECL (' ');'); /* * s.call can be CALL or TAILCALL or TAILCALL? */ (s.call t.name (e.exprs) (e.ress)) = { # \{ s.call : CALL; }, : e.full-name (e.ress) = ('if (RF_CALL (' ', ' ', ' '))') ('{' ( ('return true;')) '}') ('else RF_RETFAIL;'); { s.call : TAILCALL? = TAILCALL; s.call; } :: s.call, ('RF_' s.call ' (' ', ' ', ' ');'); }; } :: e.cpp-item, e.cpp-item ; /*empty*/; }; /* * Determine type of e.expr - int or Refal. */ Expr-To-CPP (e.init) e.expr-all, e.expr-all : { /*empty*/ = ; // s.ObjectSymbol e.rest, { // = ; // ; // }; (PAREN e.expr) e.rest = ; (EXPR e.expr) e.rest = ; (DEREF e.expr) e.rest = ; (SUBEXPR e.expr) e.rest = ; (LENGTH e.expr) e.rest = ; (MAX e.args) e.rest = ; (MIN e.args) e.rest = ; (INFIX s.op e.args) e.rest = ; (s.var-tag (e.QualifiedName)) e.rest = ; }; $func Term-Ref-To-CPP e = e; Expr-Ref-To-CPP { /*empty*/ = 'empty'; term = ; expr = '(' > ')'; }; Term-Ref-To-CPP { (PAREN e.expr) = ' ()'; (EXPR e.expr) = 'Expr (' ')'; (DEREF e.expr (e.pos)) = 'Expr (' ', ' ')'; (SUBEXPR e.expr (e.pos) (e.len)) = 'Expr (' ', ' ', ' ')'; (REF t.name) = ; ERROR-EXPR = 'err'; (STATIC t.name) = :: e.namespace, { : e.namespace = /*empty*/; '::'; } :: e.prefix, e.prefix ; (s.var-tag e.ns t.name) = ; }; Expr-Int-To-CPP { /*empty*/ = /*empty*/; s.ObjectSymbol = { = s.ObjectSymbol; $error ("Illegal type int-symbol: " s.ObjectSymbol); }; (LENGTH e.expr) = '.get_len ()'; (MAX e.args) = 'pxx_max (' ')'; (MIN e.args) = 'pxx_min (' ')'; (INFIX s.op e.args) = '(' ')'; (REF t.name) = ; (s.var-tag t.name) = ; expr = '(' > ')'; }; Cond-To-CPP { /*empty*/ = /*empty*/; (CALL t.name (e.exprs) (e.ress)) = 'RF_CALL (' ', ' ', ' ')'; (SYMBOL? e.expr (e.pos)) = '.symbol_at (' ')'; (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) = '.flat_at (' ', ' ')'; (CHECK-ITER e.expr) = 'RF_iter(' ')'; (EQ e.expr1 (e.expr2) (e.pos)) = '.eq (' ', ' ')'; (TERM-EQ e.expr1 (e.expr2) (e.pos)) = '.term_eq (' ', ' ')'; (NOT e.cond) = '!' ; (INFIX s.op e.args) = '(' s.op e.args> ')'; expr = '(' > ')'; }; Infix-To-CPP s.arg2cpp s.op e.args, { e.args : (e.arg) e.rest = :: e.arg, :: e.rest, { e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest; e.arg e.rest; };; }; Op-Arg-To-CPP s.op, { s.op : \{ "&&"; "||"; } = &Cond-To-CPP; s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } = &Expr-Int-To-CPP; }; Step-To-CPP { /*empty*/ = /*empty*/; (INC-ITER e.expr) = 'RF_iter(' ')++'; (DEC-ITER e.expr) = 'RF_iter(' ')--'; }; $func Const-Expr-Aux e.expr = e.cpp-expr; Const-Expr-To-CPP { /*empty*/ = 'empty'; (SUBEXPR t.name s.pos s.len) = 'Expr (' ', ' s.pos ', ' s.len ')'; //FIXME: надо проверять, что s.pos и s.len // не превышают допустимых величин. // Задавать эти величины опциями. e.expr = : { ' + ' e.cpp-expr = e.cpp-expr; e.cpp-expr = e.cpp-expr; }; }; Const-Expr-Aux (e.accum) e.expr, { e.expr : s.sym e.rest, = ) e.rest>; e.accum : v = { : e s.c e, <">" (s.c) (127)> = ' + Char::create_expr ("' e.accum '")' ; //' + Expr::create_seq (L"' e.accum '")' ; ' + Char::create_expr (L"' e.accum '")' ; }; e.expr : t.item e.rest, t.item : { (PAREN e.paren-expr) = ' + (' ') ()'; (REF t.name) = ' + ' ; // ' + Expr::create(' ')'; (STATIC e) = ' + ' ; (s.FUNC t.name), s.FUNC : \{ FUNC; FUNC?; } = ' + Expr::create_sym (' ')'; s.sym, { = ' + Expr::create<' '>("' s.sym '")'; = ' + Expr::create("' '")'; }; } :: e.cpp-item = e.cpp-item ; = /*empty*/; }; Symbol-To-CPP s.ObjectSymbol, { () $iter { e.symbol : s.char e.rest, s.char : { '\\' = '\\\\'; '\n' = '\\n'; '\t' = '\\t'; // '\v' = '\\v'; // '\b' = '\\b'; '\r' = '\\r'; // '\f' = '\\f'; '\"' = '\\"'; // '\'' = '\\\''; s = s.char; } :: e.cpp-char, e.rest (e.cpp-symbol e.cpp-char); } :: e.symbol (e.cpp-symbol), e.symbol : /*empty*/ = e.cpp-symbol; }; Args-To-CPP { (v.prefix) Vars /*empty*/ = 'RF_VOID'; ( ) Vars /*empty*/ = '/*void*/'; ( ) Vars (e.arg) = ; (e.prefix) Exprs /*empty*/ = '/*void*/'; (e.prefix) Exprs (e.arg) = ; (e.prefix) s.tag e.args = e.args () $iter { e.args : (e.arg) e.rest = { e.rest : v = ', '; /*empty*/; } :: e.comma, s.tag : { Vars = e.rest (e.cpp-args e.comma); Exprs = e.rest (e.cpp-args e.comma); Ints = e.rest (e.cpp-args e.comma); }; } :: e.args (e.cpp-args), e.args : /*empty*/, (e.prefix) s.tag : { t Exprs = '(' e.cpp-args ')'; ( ) Vars = '(' e.cpp-args ')'; (v) Vars = '(' e.prefix e.cpp-args ';;)'; e = e.prefix e.cpp-args; }; }; Name-To-CPP t.obj-name = :: (e.qualifiers) e.name, :: e.namespace, { e.qualifiers : e.namespace e.cont = ; ; }; Namespace-Control e.qualifiers = { e.qualifiers : /*empty*/ = ; e.qualifiers : () = /*empty*/; e.qualifiers; } :: e.qualifiers, { : e.qualifiers; { : v = ('}');; } :: e.close-namespace, , { e.qualifiers : v = ('namespace ' '\n{');; } :: e.open-namespace, e.close-namespace e.open-namespace; }; Trace-Enter e.name (e.args) = e.args 1 () $iter { e.args : t.arg e.rest = { \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');'; 'printf(" : ");'; } :: e.num, e.rest <"+" s.n 1> (e.pr-args ('printf (" argument "); 'e.num' ('').writeln(stdout);')); } :: e.args s.n (e.pr-args), e.args : /*empty*/ = ('printf ("+ %5u: enter >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args; Trace-Exit e.name (e.args) = e.args 1 () $iter { e.args : t.arg e.rest = { \{ e.rest : v; <">" (s.n) (1)>; } = 'printf("%2d: ", 's.n');'; 'printf(" : ");'; } :: e.num, e.rest <"+" s.n 1> (e.pr-args ('printf (" result "); 'e.num' ('').to_Expr().writeln(stdout);')); } :: e.args s.n (e.pr-args), e.args : /*empty*/ = ('printf ("- %5u: exit >>> 'e.name' <<<\\n", rfrt::stack->get_depth());') e.pr-args; Trace-Fail e.name = ('printf ("- %5u: fail >>> 'e.name' <<<\\n", rfrt::stack->get_depth());'); Extract-Qualifiers t.name, { = t.name : (e.n), (()) e.n; ; };