// $Source$
// $Revision$
// $Date$

$use Apply Box Class Convert StdIO Table;
$use "rfpc";
$use "rfp_helper";

$box Func-Names;
$table Func-Table;
$box Var-Names;
$table Var-Table;

$func ASAIL-To-CPP e.body = e.cpp-code;

// Constructs legal C++ name from e.Name and stores it in the appropriate box
// and table
$func Name-To-CPP t.Name = e.legal-cpp-name;

$func Build-CPP-Name e.words = e.cpp-chars;

$func Find-Unused-Name (e.used-names) e.name = e.unused-name;

$func Word-To-CPP-Chars s.word = e.cpp-chars;

$func Chars-To-CPP-Chars e.chars = e.cpp-chars;

$func Expr-To-CPP (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.ASAIL-Expr;

$func Expr-Ref-To-CPP s.inner-call? 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.Arg-Res-Tag) e.ASAIL-Args = e.CPP-Args;

$func Symbol-To-CPP s.RFP-Symbol = e.CPP-String;

$func Chars-To-CPP e.expr = e.CPP-String;

$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;

RFP-ASAIL-To-CPP e.asail =
  <Store &Func-Names /*empty*/>,
  <RFP-Clear-Table &Func-Table>,
  <ASAIL-To-CPP e.asail>;

ASAIL-To-CPP e.asail, {
  e.asail : t.item e.rest, t.item : {
    (FUNC t.name (e.args) (e.ress) e.body) =
      <Store &Var-Names /*empty*/>,
      <RFP-Clear-Table &Var-Table>,
      ('RF_FUNC (' <Name-To-CPP t.name> ', '
        '(' <Args-To-CPP ('RF_ARG ') Vars e.args> '), '
        '(' <Args-To-CPP ('RF_RES ') Vars e.ress> '))'
          (<ASAIL-To-CPP e.body>)
       'RF_END');
    (IF (e.cond) e.body) =
      ('if (' <Cond-To-CPP e.cond> ')')
      ('{' (<ASAIL-To-CPP e.body>) '}');
    (FOR (e.label) (e.cond) (e.step) e.body) =
      {
        e.label : t = (LABEL <Name-To-CPP (LABEL e.label)> ': {}');;
      } :: e.label,
      ('for ( ; ' <Cond-To-CPP e.cond> '; ' <Step-To-CPP e.step> ')')
      ('{' (<ASAIL-To-CPP e.body>) e.label '}');
    (LABEL t.label e.body) =
      ('{' (<ASAIL-To-CPP e.body>) '}')
      (LABEL <Name-To-CPP (LABEL t.label)> ': {}');
    (TRY e.body) =
      ('try {' (<ASAIL-To-CPP e.body>) '}');
    (CATCH-ERROR e.body) =
      ('with {' (<ASAIL-To-CPP e.body>) '}');
    RETURN = ('return true;');
    RETFAIL = ('retfail;');
    FATAL = ('error ("Unexpected fail");');
    (LSPLIT e.expr (e.min) t.var1 t.var2) =
      ('lsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
      <Name-To-CPP t.var1> ', ' <Name-To-CPP t.var2> ');');
    (RSPLIT e.expr (e.min) t.var1 t.var2) =
      ('rsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
      <Name-To-CPP t.var1> ', ' <Name-To-CPP t.var2 > ');');
    (ASSIGN t.var e.expr) =
      (<Name-To-CPP t.var> ' = ' <Expr-To-CPP () e.expr> ';');
    (DECL s.type t.var) =
      (s.type ' ' <Name-To-CPP t.var> ';');
    (EXPR t.var e.expr) =
      ('Expr ' <Name-To-CPP t.var> ' (' <Chars-To-CPP e.expr> ');');
    (DEREF t.var e.expr (e.pos)) =
      ('Expr ' <Name-To-CPP t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ', '
      <Expr-Int-To-CPP e.pos> ');');
    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
      ('Expr ' <Name-To-CPP t.var> ' ('
      <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.pos> ', ' 
      <Expr-Int-To-CPP e.len> ');');
    (DROP t.var) =
      (<Name-To-CPP t.var> '.drop ();');
    (CONTINUE t.label) =
      ('goto ' <Name-To-CPP (LABEL t.label)> ';');
    (BREAK t.label) =
      ('goto ' <Name-To-CPP (LABEL t.label)> ';');
    (ERROR e.expr) =
      ('error (' <Expr-Ref-To-CPP 0 e.expr> ');');
    (CONSTEXPR t.name e.expr) =
      ('const Expr ' <Name-To-CPP t.name> ' = ' <Const-Expr-To-CPP e.expr> ';');
    (DECL-FUNC t.name) =
      ('RF_DECL (' <Name-To-CPP t.name> ');');
    /*
     * s.call can be CALL or TAILCALL
     */
    (s.call t.name (e.exprs) (e.ress)) =
      ('RF_' s.call ' (' <Name-To-CPP t.name> ', '
      '(' <Args-To-CPP () Exprs e.exprs> '), (' <Args-To-CPP () Vars e.ress> '));');
  } :: e.cpp-item,
    e.cpp-item <ASAIL-To-CPP e.rest>;
  /*empty*/;
};

/*
 * Determine type of e.expr - int or Refal.
 */
Expr-To-CPP  (e.init) e.expr-all, e.expr-all : {
  /*empty*/ = <Expr-Ref-To-CPP 0 e.init>;
  (VAR (e.QualifiedName)) e.rest =
    <Expr-To-CPP (e.init (VAR (e.QualifiedName))) e.rest>;
  s.ObjectSymbol e.rest, {
    <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
    <Expr-Ref-To-CPP 0 e.expr-all>;
  };   
  (PAREN e.expr) e.rest = <Expr-Ref-To-CPP 0 e.expr-all>;
  (EXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.expr-all>;
  (DEREF e.expr) e.rest = <Expr-Ref-To-CPP 0 e.expr-all>;
  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.expr-all>;
  (LENGTH e.expr) e.rest = <Expr-Int-To-CPP e.init e.expr-all> ;
  (MAX e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;       
  (MIN e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
  (INFIX s.op e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
};

Expr-Ref-To-CPP s.inner-call? e.expr-ref, e.expr-ref : {
  t.item e.rest =
    {
      e.rest : v = ' + ';
      /*empty*/;
    } :: e.plus,
    t.item : {
      s.ObjectSymbol = <Symbol-To-CPP s.ObjectSymbol>;
      (PAREN e.expr) = <Expr-Ref-To-CPP 0 e.expr> ' ()';
      (EXPR e.expr) =
        'Expr (' <Chars-To-CPP e.expr> ')';
      (DEREF e.expr (e.pos)) =
        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
             <Expr-Int-To-CPP e.pos> ')';
      (SUBEXPR e.expr (e.pos) (e.len)) =
        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
             <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
      (VAR (e.QualifiedName)) = <Name-To-CPP (VAR (e.QualifiedName))>;
      ex = $error ("Illegal type ref-expr : " ex );
    } :: e.cpp-item,
    e.cpp-item e.plus <Expr-Ref-To-CPP 1 e.rest>;
  /*empty*/ =
    {
      s.inner-call? : 1 = /*empty*/;
      'empty';
    };
};

Expr-Int-To-CPP {
  t.item e.rest =
    {
      e.rest : v = ' + ';
      /*empty*/;
    } :: e.plus,
    t.item : {
      s.ObjectSymbol = 
        {
          <Int? s.ObjectSymbol> = <Symbol-To-CPP s.ObjectSymbol>;
          $error ("Illegal type int-symbol: " s.ObjectSymbol);
        };
      (LENGTH e.expr) =
        '(int) ' <Expr-Ref-To-CPP 0 e.expr> '.get_len ()';
      (MAX e.args) =
        'max (' <Args-To-CPP () Ints e.args> ')';
      (MIN e.args) =
        'min (' <Args-To-CPP () Ints e.args> ')';
      (INFIX s.op e.args) =
        '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
      (VAR (e.QualifiedName)) = <Name-To-CPP (VAR (e.QualifiedName))>;
      ex = $error ("Illegal type ref-int : " ex );
    } :: e.cpp-item,
    e.cpp-item e.plus <Expr-Int-To-CPP e.rest>;
  /*empty*/ = /*empty*/;
};

Cond-To-CPP {
  /*empty*/ = /*empty*/;
  t.cond-term e.rest =
    {
      e.rest : v = ' && ';
      /*empty*/;
    } :: e.and,
    t.cond-term : {
      (CALL t.name (e.exprs) (e.ress)) = 
        'RF_CALL (' <Name-To-CPP t.name> ', '
        '(' <Args-To-CPP () Exprs e.exprs> '), '
        '(' <Args-To-CPP () Vars e.ress> '))';
      (SYMBOL? e.expr (e.pos)) =
         <Expr-Ref-To-CPP 0 e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')';
      (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
         <Expr-Ref-To-CPP 0 e.expr> '.flat_at ('
          <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
      /*
       * EQ -> to function eq() with 6 arg.
       */
      (EQ (e.expr1) (e.pos1) (e.len1) (e.expr2) (e.pos2) (e.len2)) =
        'eq ('  <Expr-Ref-To-CPP 0 e.expr1> ', '
            <Expr-Int-To-CPP e.pos1> ', ' <Expr-Int-To-CPP e.len1> ', ' 
            <Expr-Ref-To-CPP 0 e.expr2> ', '
            <Expr-Int-To-CPP e.pos2> ', ' <Expr-Int-To-CPP e.len2> ')'; 
      /*
       * FLAT-EQ -> to function flat_eq() with 5 arg.
       */
      (FLAT-EQ (e.expr1) (e.pos1) (e.expr2) (e.pos2) (e.len)) =
        'flat_eq (' <Expr-Ref-To-CPP 0 e.expr1> ', ' <Expr-Int-To-CPP e.pos1> ', '
              <Expr-Ref-To-CPP 0 e.expr2> ', ' <Expr-Int-To-CPP e.pos2> ', '
              <Expr-Int-To-CPP e.len> ')'; 
      (NOT e.cond) =
        '!' <Cond-To-CPP e.cond>;
      (INFIX s.op e.args) =
        '(' <Infix-To-CPP <Op-Arg-To-CPP s.op> s.op e.args> ')';
    } :: e.cpp-term,
    e.cpp-term e.and <Cond-To-CPP e.rest>;
}; 

Infix-To-CPP s.arg2cpp s.op e.args, {
  e.args : (e.arg) e.rest =
    {
      e.rest : v = ' ' s.op ' ';
      /*empty*/;
    } :: e.cpp-op,
    <Apply s.arg2cpp e.arg> e.cpp-op <Infix-To-CPP s.arg2cpp s.op 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 t.var) = 'iter(' <Name-To-CPP t.var> ')++';
};

Const-Expr-To-CPP {
  /*empty*/ = 'empty';
  e.expr =
    {
      e.expr : (e) e = /*empty*/;
      '(Expr) ';
    } :: e.cpp-expr,
    e.expr (e.cpp-expr) $iter {
      e.expr : t.item e.rest,
      {
        e.rest : v = ' + ';
        /*empty*/;
      } :: e.plus,
        t.item : \{
          (PAREN e.paren-expr) =
            '(' <Const-Expr-To-CPP e.paren-expr> ') ()';
          (REF (e.QualifiedName s.name)) =
            <Name-To-CPP (e.QualifiedName "r" s.name)>;
        } :: e.cpp-item =
        e.rest (e.cpp-expr e.cpp-item e.plus);
      e.expr : e.chars (e1) e2 =
        (e1) e2 (e.cpp-expr <Chars-To-CPP e.chars> ' + ');
      /*empty*/ (e.cpp-expr <Chars-To-CPP e.expr>);
    } :: e.expr (e.cpp-expr),
    e.expr : /*empty*/ =
    e.cpp-expr;
};

/*
 * Gets function name or variable and returns legal C++ name corresponding to
 * it. If is called with such parameter at the first time then stores C++ name
 * in the appropriate table for further using. Also put new name in the
 * appropriate box. Box and table for variables is updated for each new
 * function and box and table for functions is updated for each new module.
 */
Name-To-CPP term =
  term : {
    (VAR (e.QualifiedName)) = e.QualifiedName &Var-Names &Var-Table;
    (LABEL (e.QualifiedName)) = e.QualifiedName &Var-Names &Var-Table;
    (e.QualifiedName) = e.QualifiedName &Func-Names &Func-Table;  // function name
  } :: e.QualifiedName s.used-names s.table,
  {
    <Lookup s.table e.QualifiedName>;
    e.QualifiedName : s.first e.last,
      <Word-To-CPP-Chars s.first> :: e.first,
      {
        e.first : s.char e,
          <Letter? s.char>, # \{ s.char : '?'; } =
          (e.first) e.last;
        ('R_' e.first) e.last;
      } :: (e.first) e.last,
      e.first <Build-CPP-Name e.last> :: e.name,
      <Find-Unused-Name (<? s.used-names>) e.name> :: e.name,
      <Put s.used-names (e.name)>,
      <Bind s.table (e.QualifiedName) (e.name)>,
      e.name;
  };

Build-CPP-Name {
  s.word e.rest = '_' <Word-To-CPP-Chars s.word> <Build-CPP-Name e.rest>;
  /*empty*/ = /*empty*/;
};

Find-Unused-Name (e.used-names) e.name, {
  e.used-names : e1 (e.name) e2 = <Find-Unused-Name (e2) e.name '_'>;
  e.name;
};

Word-To-CPP-Chars {
  "+" = '__add__';
  "-" = '__sub__';
  "*" = '__mult__';
  s.word = <Chars-To-CPP-Chars <To-Chars s.word>>;
};

Chars-To-CPP-Chars {
  s.sym e.chars, {
    s.sym : '?' = '_';
    \{ <Letter? s.sym>; <Digit? s.sym>; } = s.sym;
    '_';
  } :: s.sym =
    s.sym <Chars-To-CPP-Chars e.chars>;
  /*empty*/ = /*empty*/;
};

Args-To-CPP {
  (e.prefix) Vars /*empty*/ = /*empty*/;
  (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 <Name-To-CPP (e.arg)> e.comma);
          Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP 0 e.arg> e.comma);
          Ints = e.rest (e.cpp-args <Expr-Int-To-CPP e.arg> e.comma);
        };
    } :: e.args (e.cpp-args),
    e.args : /*empty*/,
    e.prefix e.cpp-args;
};

Symbol-To-CPP s.ObjectSymbol, {
  <Int? s.ObjectSymbol> = s.ObjectSymbol;
  <To-Chars 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 '\"';
};

Chars-To-CPP e.expr = <Symbol-To-CPP <To-Word e.expr>>;