Ignore:
Timestamp:
Mar 28, 2008, 6:06:07 PM (13 years ago)
Author:
orlov
Message:
  • Some advances in compiling to T++.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • to-imperative/trunk/compiler/src/org/refal/plus/compiler/rfp_asail_tpp.rf

    r3591 r3596  
    3838$func Namespace_Control e.qualifiers = e.namespace_control;
    3939
    40 $func Expr_Ref_To_CPP e.ASAIL_Expr_Ref = e.CPP_Expr_Ref;
     40$func Expr_Ref_To_CPP s.tvars_box e.ASAIL_Expr_Ref = e.CPP_Expr_Ref;
    4141
    4242$func Expr_Int_To_CPP e.ASAIL_Expr_Int = e.CPP_Expr_Int;
    … …  
    5656$func Cond_To_CPP t.cond = e.CPP_Cond;
    5757
    58 $func Infix_To_CPP s.func_for_converting_args_to_cpp s.op e.args = e.cpp_expr;
     58$func Infix_To_CPP (e.box) s.func_for_converting_args_to_cpp s.op e.args = e.cpp_expr;
    5959
    6060$func Trace_Enter e.name (e.args) = e.trace;
    … …  
    162162      <MapIn &Rfp2Cpp (<Paren e.ress>)> :: e.ress,
    163163      <MapIn &Id 'tout Expr ' (e.ress)> :: e.ress,
    164       <ASAIL_To_CPP e.body> :: e.body,
    165164      <Extract_Qualifiers t.name> :: (e.qualifiers) e,
    166165      <Namespace_Control e.qualifiers>
    167166      ('tfun int '<Name_To_CPP "DECL-FUNC" t.name>' ('<Concat <Intersperse (', ') e.args e.ress>>') {'
    168         (e.trace_enter e.body e.trace_exit ('return 0;'))
     167        (e.trace_enter <ASAIL_To_CPP e.body> e.trace_exit ('return 0;'))
    169168      '}');
    170169    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
    … …  
    229228      ('RF_FUNC_ERROR (unexpected_fail);');
    230229    (LSPLIT e.expr (e.min) t.var1 t.var2) =
    231       ('RF_lsplit (' <Expr_Ref_To_CPP e.expr> ', ' <Expr_Int_To_CPP e.min> ', '
    232       <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2> ');');
     230      <Box> :: s.tvars,
     231      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
     232      <Get s.tvars> ('RF_lsplit ('e.expr', ' <Expr_Int_To_CPP e.min>', '
     233        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2>');');
    233234    (RSPLIT e.expr (e.min) t.var1 t.var2) =
    234       ('RF_rsplit (' <Expr_Ref_To_CPP e.expr> ', ' <Expr_Int_To_CPP e.min> ', '
    235       <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2 > ');');
     235      <Box> :: s.tvars,
     236      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
     237      <Get s.tvars> ('RF_rsplit ('e.expr', '<Expr_Int_To_CPP e.min>', '
     238        <Rfp2Cpp t.var1>', '<Rfp2Cpp t.var2 >');');
    236239    (ASSIGN t.var e.expr), t.var : (INT e)  =
    237240      (<Rfp2Cpp t.var> ' = ' <Expr_Int_To_CPP e.expr> ';');
    238241    (ASSIGN t.var e.expr) =
    239       (<Rfp2Cpp t.var> ' = ' <Expr_Ref_To_CPP e.expr> ';');
     242      <Box> :: s.tvars,
     243      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
     244      <Get s.tvars> (<Rfp2Cpp t.var> ' = 'e.expr';');
    240245    (DECL t.var e.expr), t.var : (INT e)  =
    241246      ('int ' <Rfp2Cpp t.var> ' = '<Expr_Int_To_CPP e.expr>';');
    242247    (DECL s.type t.var) =
    243       ('Expr ' <Rfp2Cpp t.var> ';');
     248      ('TExpr ' <Rfp2Cpp t.var> ';');
    244249    (DECL s.type t.var e.expr) =
    245       ('Expr ' <Rfp2Cpp t.var> ' ('<Expr_Ref_To_CPP e.expr>');');
     250      <Box> :: s.tvars,
     251      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
     252      <Get s.tvars> ('Expr ' <Rfp2Cpp t.var> ' ('e.expr');');
    246253    (DROP t.var) =
    247254      (<Rfp2Cpp t.var> '.drop ();');
    … …  
    251258      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
    252259    (ERROR e.expr) =
    253       ('RF_ERROR (' <Expr_Ref_To_CPP e.expr> ');');
     260      <Box> :: s.tvars,
     261      <Expr_Ref_To_CPP s.tvars e.expr> :: e.expr,
     262      <Get s.tvars> ('RF_ERROR ('e.expr');');
    254263    (CONSTEXPR IMPORT (e.name) (e.comment) e.expr) =
    255264      e.name : "org" "refal" "plus" "wrappers" e.n,
    … …  
    307316          ('{' (<Trace_Exit e.full_name (e.ress)> ('return true;')) '}')
    308317          ('else RF_RETFAIL;');
    309         {
    310           s.call : "TAILCALL?" = TAILCALL;
    311           s.call;
    312         } :: s.call,
    313           ('RF_' s.call ' (' <Name_To_CPP "DECL-FUNC" t.name> ', '
    314             <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> ');');
     318//T/        {
     319//T/          s.call : "TAILCALL?" = TAILCALL;
     320//T/          s.call;
     321//T/        } :: s.call,
     322//T/          ('RF_' s.call ' (' <Name_To_CPP "DECL-FUNC" t.name> ', '
     323//T/            <Args_To_CPP () Exprs e.exprs> ', ' <Args_To_CPP () Vars e.ress> ');');
     324        (<Name_To_CPP "DECL-FUNC" t.name>'('
     325          <Concat <Intersperse (', ') (<Args_To_CPP () Exprs e.exprs>) <MapIn &Rfp2Cpp (<Paren e.ress>)>>>
     326        ');');
    315327      };
    316328  } :: e.cpp_item,
    … …  
    320332
    321333
    322 $func Term_Ref_To_CPP e = e;
    323 
    324 Expr_Ref_To_CPP {
     334$func Term_Ref_To_CPP s.tvars e = e;
     335
     336Expr_Ref_To_CPP s.tvars e.expr = e.expr : {
    325337  /*empty*/ = 'empty';
    326   term = <Term_Ref_To_CPP term>;
    327   expr = '(' <Infix_To_CPP &Term_Ref_To_CPP "+" <Paren expr>> ')';
    328 };
    329 
    330 Term_Ref_To_CPP {
     338  term = <Term_Ref_To_CPP s.tvars term>;
     339  expr = '(' <Infix_To_CPP (s.tvars) &Term_Ref_To_CPP "+" <Paren expr>> ')';
     340};
     341
     342Term_Ref_To_CPP s.tvars e.arg = e.arg : {
    331343  (PAREN e.expr) =
    332     <Expr_Ref_To_CPP e.expr> ' ()';
     344    <Expr_Ref_To_CPP s.tvars e.expr> ' ()';
    333345  (DEREF e.expr (e.pos)) =
    334     'Expr (' <Expr_Ref_To_CPP e.expr> ', ' <Expr_Int_To_CPP e.pos> ')';
     346    'Expr (' <Expr_Ref_To_CPP s.tvars e.expr> ', ' <Expr_Int_To_CPP e.pos> ')';
    335347  (SUBEXPR e.expr (e.pos) (e.len)) =
    336     'Expr (' <Expr_Ref_To_CPP e.expr> ', '
     348    'Expr (' <Expr_Ref_To_CPP s.tvars e.expr> ', '
    337349        <Expr_Int_To_CPP e.pos>   ', ' <Expr_Int_To_CPP e.len> ')';
    338350  (REF t.name) = <Name_To_CPP "DECL-OBJ" t.name>;
    … …  
    363375    };
    364376  (LENGTH e.expr) =
    365     <Expr_Ref_To_CPP e.expr> '.get_len ()';
     377    <Expr_Ref_To_CPP <Box> e.expr> '.get_len ()';
    366378  (MAX e.args) =
    367379    'pxx_max (' <Args_To_CPP () Ints e.args> ')';
    … …  
    369381    'pxx_min (' <Args_To_CPP () Ints e.args> ')';
    370382  (INFIX s.op e.args) =
    371     '(' <Infix_To_CPP &Expr_Int_To_CPP s.op e.args> ')';
     383    '(' <Infix_To_CPP () &Expr_Int_To_CPP s.op e.args> ')';
    372384  (REF t.name) = <Name_To_CPP "DECL-OBJ" t.name>;
    373385  (s.var_tag t.name) = <Rfp2Cpp (s.var_tag t.name)>;
    374   expr = '(' <Infix_To_CPP &Expr_Int_To_CPP "+" <Paren expr>> ')';
     386  expr = '(' <Infix_To_CPP () &Expr_Int_To_CPP "+" <Paren expr>> ')';
    375387};
    376388
    … …  
    381393          <Args_To_CPP () Vars e.ress>   ')';
    382394  ("SYMBOL?" e.expr (e.pos)) =
    383     <Expr_Ref_To_CPP e.expr> '.symbol_at (' <Expr_Int_To_CPP e.pos> ')';
     395    <Expr_Ref_To_CPP <Box> e.expr> '.symbol_at (' <Expr_Int_To_CPP e.pos> ')';
    384396  ("FLAT-SUBEXPR?" e.expr (e.pos) (e.len)) =
    385     <Expr_Ref_To_CPP e.expr> '.flat_at ('
     397    <Expr_Ref_To_CPP <Box> e.expr> '.flat_at ('
    386398      <Expr_Int_To_CPP e.pos> ', ' <Expr_Int_To_CPP e.len> ')';
    387399  ("ITER-FAILS" e.expr) =
    388     '!RF_iter(' <Expr_Ref_To_CPP e.expr> ')';
     400    '!RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')';
    389401  (EQ e.expr1 (e.expr2) (e.pos)) =
    390     <Expr_Ref_To_CPP e.expr1> '.eq ('
    391       <Expr_Ref_To_CPP e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
     402    <Expr_Ref_To_CPP <Box> e.expr1> '.eq ('
     403      <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
    392404  ("TERM-EQ" e.expr1 (e.expr2) (e.pos)) =
    393     <Expr_Ref_To_CPP e.expr1> '.term_eq ('
    394       <Expr_Ref_To_CPP e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
     405    '((Expr&)'<Term_Ref_To_CPP <Box> e.expr1>')[0] == '
     406    '((Expr&)'<Term_Ref_To_CPP <Box> e.expr2>')['<Expr_Int_To_CPP e.pos>']';
     407    //T/ <Expr_Ref_To_CPP <Box> e.expr1> '.term_eq ('
     408    //T/   <Expr_Ref_To_CPP <Box> e.expr2> ', ' <Expr_Int_To_CPP e.pos> ')';
    395409  (NOT t.cond) =
    396410    '!' <Cond_To_CPP t.cond>;
    397411};
    398412
    399 Infix_To_CPP s.arg2cpp s.op e.args, {
     413Infix_To_CPP (e.box) s.arg2cpp s.op e.args, {
    400414  e.args : (e.arg) e.rest =
    401     <Apply s.arg2cpp e.arg> :: e.arg,
    402     <Infix_To_CPP s.arg2cpp s.op e.rest> :: e.rest,
     415    <Apply s.arg2cpp e.box e.arg> :: e.arg,
     416    <Infix_To_CPP (e.box) s.arg2cpp s.op e.rest> :: e.rest,
    403417    {
    404418      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
    … …  
    409423Step_To_CPP {
    410424  /*empty*/ = /*empty*/;
    411   ("INC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP e.expr> ')++';
    412   ("DEC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP e.expr> ')--';
     425  ("INC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')++';
     426  ("DEC-ITER" e.expr) = 'RF_iter(' <Expr_Ref_To_CPP <Box> e.expr> ')--';
    413427};
    414428
    … …  
    491505  (        ) Vars (e.arg)    = <Rfp2Cpp (e.arg)>;
    492506  (e.prefix) Exprs /*empty*/ = '/*void*/';
    493   (e.prefix) Exprs (e.arg)   = <Expr_Ref_To_CPP e.arg>;
     507  (e.prefix) Exprs (e.arg)   = <Expr_Ref_To_CPP <Box> e.arg>;
    494508  (e.prefix) s.tag e.args =
    495509    e.args () $iter {
    … …  
    501515        s.tag : {
    502516          Vars = e.rest (e.cpp_args <Rfp2Cpp (e.arg)> e.comma);
    503           Exprs = e.rest (e.cpp_args <Expr_Ref_To_CPP e.arg> e.comma);
     517          Exprs = e.rest (e.cpp_args <Expr_Ref_To_CPP <Box> e.arg> e.comma);
    504518          Ints = e.rest (e.cpp_args <Expr_Int_To_CPP e.arg> e.comma);
    505519        };
Note: See TracChangeset for help on using the changeset viewer.