// $Id$

$use Access Apply Arithm Box Class Compare Convert JavaMangle List StdIO Table;
$use "rfpc";
$use "rfp_helper";

$box Int;

$box Module_Name;

$box Entry;

$box Entry_Name;

$box Current_Namespace;

$box Func_Name;

$box Ress;
$table Result;
$box Res_Assigns;

$table Iter_Vars;

$func ASAIL_To_Java e.body = e.java_code;

$func Expr_Ref_To_Java e.ASAIL_Expr_Ref = e.aux_arrays (e.JAVA_Expr_Ref);

$func Expr_Int_To_Java s.acc e.ASAIL_Expr_Int = e.JAVA_Expr_Int;

$func Step_To_Java e.step_operators = e.java_step_operators;

$func Const_Expr_To_Java e.ASAIL_const_expr = e.aux_arrays (e.JAVA_const_expr);

$func Expr_Args_To_Java e.args = e.aux_arrays (e.java_args);

$func Int_Args_To_Java s.acc e.args = e.java_args;

$func Var_Args_To_Java e.args = e.java_args;

$func Symbol_To_Java s.RFP_Symbol = e.JAVA_String;

$func Name_To_Java t.name = e.JAVA_Name;

$func Var_To_Java t.var = e.java_var;

$func Cond_To_Java s.acc t.cond = e.JAVA_Cond;

$func Infix_To_Java s.acc s.func_for_converting_args_to_java s.op e.args = e.java_expr;

$func Access_Mode s.linkage = e.java_access_mode;

$box Free_Idx;

$func Free_Index = e.free_index;

$func Declare_Results (e.ress) e.acc_java_ress = e.decls (e.java_ress);



$func GetJavaName e.name = e.javaName;

GetJavaName e.name = <Concat <MapIn &ToWord (<MapIn &Rfp2Java (<Paren e.name>)>)>>;

$func GetJavaModuleName e.moduleName = e.javaModuleName;

GetJavaModuleName e.moduleName = {
    e.moduleName : "refal" "plus" e.tail = "org" "refal" "plus" "library" e.tail;
    e.moduleName;
  } :: e.moduleName,
  {
    <IsInTable &RFP_Options "IDENT-COMPATIBILITY"> = e.moduleName;
    <GetJavaName e.moduleName>;
  };

RFP_ASAIL_To_Java (MODULE (e.moduleName) e.asail) = 
  <Store &Free_Idx>,
  <ClearTable &Iter_Vars>,
  {
    <Store &Int <Lookup &RFP_Options INT>>;
    <Store &Int BigInteger>;
  },
  <Store &Current_Namespace e.moduleName>,
  {
    <Store &Entry <Lookup &RFP_Options ENTRIES>>;
    <Store &Entry (e.moduleName Main)>;
  },
  <Store &Entry_Name /*empty*/>,
  <ToWord <Intersperse ('.') e.moduleName>> :: s.refal_mod_name,
  <Store &Module_Name s.refal_mod_name>,
  <GetJavaModuleName e.moduleName> :: e.javaModuleName,
  {
    <ASAIL_To_Java e.asail> : v.java,
      e.javaModuleName : e.package s.class,
      {
        e.package : v = ('package '<Intersperse ('.') e.package>';');;
      } :: e.package,
      { 
        <Get &Entry_Name> : v.name =
          ()
          ('public static void main (java.lang.String[] args) {' (
            ('RefalRuntime.setArgs ("'s.refal_mod_name'", args);')
            ('try {' (v.name' (new Result ());') '}')
            ('catch (RefalException e) {' (
              ('java.lang.System.out.println ("$error: " + e);')
              ('java.lang.System.exit (100);')
            )'}')
          )'}');;
      } :: e.entry,
      e.package ('import org.refal.plus.*;')('public class 's.class' {' (v.java e.entry) '}');;
  } :: e.java,
  (e.javaModuleName) (e.java);

ASAIL_To_Java e.asail, {
  e.asail : t.item e.rest, t.item : {
    (s.tag IMPORT e) = /*empty*/;
    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
      s.tag : \{
        FUNC  = ('void') /*empty*/;
        "FUNC?" = ('boolean') ('return true;');
      } :: (e.return_type) e.return =
      <Store &Ress e.ress>,
      <ClearTable &Result>,
      { <Get &Entry> : e t.name e = <Store &Entry_Name <Rfp2Java t.name>>;; },
      <Store &Func_Name <Name_To_Java t.name>>,
      ()
      ('static '<Access_Mode s.linkage>' 'e.return_type' '
        <Get &Func_Name>' ('<Var_Args_To_Java Expr e.args Result e.ress>') throws RefalException')
        ('{' (<ASAIL_To_Java e.body> e.return) '}');
    (TRACE t.name) =
      <Bind &RFP_Trace (t.name) ()>;
    ("IF-INT-CMP" s.op (e.arg1) (e.arg2) e.body) =
      <Box> :: s.acc,
      <Expr_Int_To_Java s.acc e.arg1> ' 's.op' ' <Expr_Int_To_Java s.acc e.arg2> :: e.cond,
      <Get s.acc>
      ('if (' e.cond ')')
      ('{' (<ASAIL_To_Java e.body>) '}');
    (IF t.cond e.body) =
      <Box> :: s.acc,
      <Cond_To_Java s.acc t.cond> :: e.j_cond,
      {
        t.cond : ("CALL-FAILS" e) =
          () (<Get &Res_Assigns> <Store &Res_Assigns /*empty*/>);
        (<Get &Res_Assigns> <Store &Res_Assigns /*empty*/>) ();
      } :: (e.if_yes_assigns) (e.if_not_assigns),
      <Get s.acc>
      ('if ('e.j_cond')')
      ('{' (
        e.if_yes_assigns
        <ASAIL_To_Java e.body>
      )'}' )
      e.if_not_assigns;
    (FOR (e.cont_label) (e.break_label) () (e.step) e.body) =
      {
        e.cont_label : t = <Rfp2Java (LABEL e.cont_label)> ': ';;
      } :: e.cont,
      {
        e.break_label : t = <Rfp2Java (LABEL e.break_label)> ': ';;
      } :: e.break,
      {
        e.step : (s.d e.var), s.d : \{ "INC-ITER"; "DEC-ITER"; } =
          <Lookup &Iter_Vars e.var> : e.new_var t.var1 t.var2,
          ('Expr '<Rfp2Java t.var1>' = 'e.new_var'.getLeft();')
          ('Expr '<Rfp2Java t.var2>' = 'e.new_var'.getRight();');;
      } :: e.split_vars,
      (e.break e.cont 'for ( ; ; '<Step_To_Java e.step>')')
      ('{' (
        e.split_vars <Get &Res_Assigns> <Store &Res_Assigns /*empty*/>
        <ASAIL_To_Java e.body>
      ) '}'); 
    (LABEL (e.label) e.body) =
      (<Rfp2Java (LABEL e.label)>': {' (<ASAIL_To_Java e.body>) '}');
    (TRY e.body) =
      ('try') ('{' (
        ('if (false)'
          ('throw new RefalException ("'<Get &Module_Name>'", "'<Get &Func_Name>'", '
            '"This is for avoiding \'Unreachable code\' errors");'
        )   )
        <ASAIL_To_Java e.body>
      ) '}');
    ("CATCH-ERROR" e.body) =
      ('catch (RefalException error) {' (
        ('Expr err = error.getExpr ();')
        (<ASAIL_To_Java e.body>)
      ) '}');
    RETFAIL = ('return false;');
    FATAL =
      ('throw new RefalException ("'<Get &Module_Name>'", "'<Get &Func_Name>'", "Unexpected fail");');
    (LSPLIT t.name (e.min) t.var1 t.var2) =
      <Expr_Ref_To_Java t.name> :: e.a (e.n),
      '_va_' <Free_Index> :: e.new_var,
      <Bind &Iter_Vars (t.name) (e.new_var t.var1 t.var2)>,
      <Box> :: s.acc,
      <Expr_Int_To_Java s.acc e.min> :: e.min,
      e.a <Get s.acc>
      ('Expr.SplitIterator 'e.new_var' = 'e.n'.leftSplit('e.min');');
    (RSPLIT t.name (e.min) t.var1 t.var2) =
      <Expr_Ref_To_Java t.name> :: e.a (e.n),
      '_va_' <Free_Index> :: e.new_var,
      <Bind &Iter_Vars (t.name) (e.new_var t.var1 t.var2)>,
      <Box> :: s.acc,
      <Expr_Int_To_Java s.acc e.min> :: e.min,
      e.a <Get s.acc>
      ('Expr.SplitIterator 'e.new_var' = 'e.n'.rightSplit('e.min');');
    (DECL (INT t.var)) = ('int '<Rfp2Java t.var>';');
    (ASSIGN (INT t.var) e.expr) =
      <Box> :: s.acc,
      <Expr_Int_To_Java s.acc e.expr> :: e.expr,
      <Get s.acc> (<Rfp2Java t.var>' = 'e.expr';');
    (ASSIGN t.var e.expr) =
      <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
      {
        <Get &Ress> : e t.var e =
          e.a (<Rfp2Java t.var>'.assign ('e.j_expr');');
        e.a (<Lookup &Result t.var>'.assign ('e.j_expr');');
        e.a (<Rfp2Java t.var>' = 'e.j_expr';');
      };
    (DECL s.type t.var) =
      <Rfp2Java t.var> :: e.j_var,
      {
        s.type : Result =
          <Bind &Result (t.var) (e.j_var)>,
          ('Result 'e.j_var' = new Result ();');
        <Unbind &Result t.var>,
          ('Expr 'e.j_var' = Expr.empty;');
      };
    (DROP t.var) =
      (<Var_To_Java t.var>'.drop ();');
    (CONTINUE t.label) =
      ('continue '<Rfp2Java (LABEL t.label)>';');
    (BREAK t.label) =
      ('break '<Rfp2Java (LABEL t.label)>';');
    (ERROR e.expr) =
      <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
      e.a ('throw new RefalException ('e.j_expr');');
    (CONSTEXPR s.linkage t.name (e.comment) e.expr),
      {
        t.name : (STATIC e) = <Rfp2Java t.name>;
        <Name_To_Java t.name>;
      } :: e.n,
      <Const_Expr_To_Java e.expr> :: e.a (e.j_expr),
      e.a ('static '<Access_Mode s.linkage>' final Expr 'e.n' = 'e.j_expr';');
    (OBJ s.linkage s.tag t.name) =
      <ToChars s.tag> : s1 e2,
      'Named' s1 <ToLower e2> :: e.class_name,
      t.name :  (e s.n),
      ('static '<Access_Mode s.linkage>' final Expr '<Name_To_Java t.name>
        ' = new Expr (new org.refal.plus.library.'e.class_name' ("'s.n'"));');
    ("DECL-OBJ" t.name) = ;
    ("DECL-FUNC" t.name) = ;
    /*
     * s.call can be CALL or TAILCALL or TAILCALL?
     */
    (s.call t.name (e.args) (e.ress)) =
      <Declare_Results (e.ress)> :: e.decls (e.ress),
      <Expr_Args_To_Java e.args Result e.ress> :: e.arrays (e.args),
      <Name_To_Java t.name>' ('e.args')' :: e.c,
      {
        s.call : "TAILCALL?" =
          e.arrays e.decls ('if (!'e.c') {' ('return false;') '}');
        e.arrays e.decls (e.c';') <Get &Res_Assigns>
          <Store &Res_Assigns /*empty*/>;
      };
  } :: e.java_item,
    {
      e.java_item : ('break ' e) = e.java_item;
      e.java_item <ASAIL_To_Java e.rest>;
    };
  /*empty*/;
};

Declare_Results {
  (t.var e.r) e.ress, {
    <IsInTable &Result t.var> = <Declare_Results (e.r) e.ress (<Rfp2Java t.var>)>;
    <Get &Ress> : e t.var e     = <Declare_Results (e.r) e.ress (<Rfp2Java t.var>)>;
    '_va_' <Free_Index> :: e.new_var,
      <Put &Res_Assigns (<Rfp2Java t.var>' = 'e.new_var'.getExpr ();')> =
      ('Result 'e.new_var' = new Result ();') <Declare_Results (e.r) e.ress (e.new_var)>;
  };
  () e.ress = (e.ress);
};


$func Term_Ref_To_Java s.acc term = e.term;

Expr_Ref_To_Java {
  /*empty*/ = ('Expr.empty');
  term =
    <Box> :: s.acc,
    <Term_Ref_To_Java s.acc term> :: e.term,
    <Get s.acc> (e.term);
  t1 t2 =
    <Box> :: s.acc,
    <Term_Ref_To_Java s.acc t1> :: e.t1,
    <Term_Ref_To_Java s.acc t2> :: e.t2,
    <Get s.acc> ('new Expr ('e.t1', 'e.t2')');
  expr =
    '_va_'<Free_Index> :: e.new_var,
    <Box> :: s.acc,
    <Infix_To_Java s.acc &Term_Ref_To_Java "," <Paren expr>> :: e.arr_init,
    <Get s.acc>
    ('Expr[] 'e.new_var' = { 'e.arr_init' };')
    ('Expr.concat ('e.new_var')');
};

Term_Ref_To_Java s.acc term = term : {
  (PAREN e.expr) =
    <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
    <Put s.acc e.a>,
    'new Expr('e.j_expr')';
  (DEREF e.expr (e.pos)) =
    <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
    <Put s.acc e.a>,
    <Expr_Int_To_Java s.acc e.pos> :: e.pos,
    '(Expr) 'e.j_expr'.at ('e.pos')';
  (SUBEXPR e.expr (e.pos) (e.len)) =
    <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
    <Put s.acc e.a>,
    <Expr_Int_To_Java s.acc e.pos> :: e.pos,
    <Expr_Int_To_Java s.acc e.len> :: e.len,
    'new Expr ('e.j_expr', 'e.pos', 'e.len')';
  (REF t.name) = <Name_To_Java t.name>;
  "ERROR-EXPR" = 'err';
  (s.var_tag e.ns t.name) = <Var_To_Java term>;
};

Expr_Int_To_Java s.acc expr = expr : {
//  /*empty*/ = /*empty*/;
  s.ObjectSymbol = 
    {
      <IsInt s.ObjectSymbol> = s.ObjectSymbol;
      $error ("Illegal int-symbol: " s.ObjectSymbol);
        //FIXME: It is needed to check that 
        //       s.ObjectSymbol is less than 2^31 or another limit.
        //	     Set this limit in option.
    };
  (LENGTH e.expr) =
    <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
    <Put s.acc e.a>,
    e.j_expr'.getLen ()';
  (MAX e.args) =
    'java.lang.Math.max ('<Int_Args_To_Java s.acc e.args>')';
  (MIN e.args) =
    'java.lang.Math.min ('<Int_Args_To_Java s.acc e.args>')';
  (INFIX s.op e.args) =
    '(' <Infix_To_Java s.acc &Expr_Int_To_Java s.op e.args> ')';
//  (REF t.name) = <Name-To-Java t.name>;
  (INT t.var) = <Rfp2Java t.var>;
  expr = '(' <Infix_To_Java s.acc &Expr_Int_To_Java "+" <Paren expr>> ')';
};

Cond_To_Java s.acc t.cond = t.cond : {
  ("CALL-FAILS" (CALL t.name (e.exprs) (e.ress))) =
    <Declare_Results (e.ress)> :: e.decls (e.ress),
    <Expr_Args_To_Java e.exprs Result e.ress> :: e.arrays (e.args),
    <Put s.acc e.arrays e.decls>,
    '!'<Name_To_Java t.name>' ('e.args')';
  ("ITER-FAILS" e.expr) =
    '!'<Middle 0 2 <Lookup &Iter_Vars e.expr>>'.isValid ()';
  ("SYMBOL?" e.expr (e.pos)) =
    <Expr_Ref_To_Java e.expr> :: e.a (e.j_expr),
    <Put s.acc e.a>,
    e.j_expr'.symbolAt ('<Expr_Int_To_Java s.acc e.pos>')';
  (EQ e.expr1 (e.expr2) (e.pos)) =
    <Expr_Ref_To_Java e.expr1> :: e.a1 (e.j_expr1),
    <Expr_Ref_To_Java e.expr2> :: e.a2 (e.j_expr2),
    <Put s.acc e.a1 e.a2>,
    e.j_expr1'.eq ('e.j_expr2', '<Expr_Int_To_Java s.acc e.pos>')'; 
  ("TERM-EQ" e.expr1 (e.expr2) (e.pos)) =
    <Expr_Ref_To_Java e.expr1> :: e.a1 (e.j_expr1),
    <Expr_Ref_To_Java e.expr2> :: e.a2 (e.j_expr2),
    <Put s.acc e.a1 e.a2>,
    e.j_expr1'.termEq ('e.j_expr2', '<Expr_Int_To_Java s.acc e.pos> ')'; 
  (NOT t.not_cond) =
    '!' <Cond_To_Java s.acc t.not_cond>;
}; 

Infix_To_Java s.acc s.arg2java s.op e.args, {
  e.args : (e.arg) e.rest =
    <Apply s.arg2java s.acc e.arg> :: e.arg,
    <Infix_To_Java s.acc s.arg2java s.op e.rest> :: e.rest,
    { 
      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
      e.arg e.rest;
    };;
};

Step_To_Java {
  /*empty*/ = /*empty*/;
  ("INC-ITER" e.expr) = <Middle 0 2 <Lookup &Iter_Vars e.expr>>'.next ()';
  ("DEC-ITER" e.expr) = <Middle 0 2 <Lookup &Iter_Vars e.expr>>'.prev ()';
};

$func Const_Expr_Aux (e.accum) e.expr = (e.arrays) e.java_expr;

Const_Expr_To_Java {
  /*empty*/ = ('Expr.empty');
  (SUBEXPR t.name s.pos s.len) = ('new Expr ('<Rfp2Java t.name>', 's.pos', 's.len')');
                  //FIXME: It is needed to check that 
                  //       s.pos и s.len is less than 2^31 or another limit.
                  //	     Set this limit in option.
  e.expr =
    <Const_Expr_Aux () e.expr> : {
      (e.arrays) (e1)      = e.arrays (e1);
      (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')');
      (e.arrays) e.concat  =
        '_va_'<Free_Index> :: e.new_var,
        e.arrays 
        ('static private final Expr[] 'e.new_var' = { '<Concat <Intersperse (', ') e.concat>>' };')
        ('Expr.concat ('e.new_var')');
    };
};

Const_Expr_Aux (e.accum) e.expr, {
  e.expr : s.sym e.rest, <IsChar s.sym> =
    <Const_Expr_Aux (e.accum <Symbol_To_Java s.sym>) e.rest>;
  e.accum : v =
    <Const_Expr_Aux () e.expr> :: (e.arrays) e.j_expr,
    (e.arrays) ('Expr.fromSequence ("'e.accum'")') e.j_expr;
  e.expr : t.item e.rest, t.item : {
    (PAREN e.paren_expr) =
      <Const_Expr_To_Java e.paren_expr> :: e.arrays (e.j_expr),
      (e.arrays) ('new Expr ('e.j_expr')');
    (REF t.name) =
      () (<Name_To_Java t.name>);
    (STATIC e) =
      () (<Rfp2Java t.item>);
    ("FUNC?" t.name) = () ('new Expr (new Func () {'
      ('public boolean eval (Expr arg, Result res) throws RefalException {'
        ('return '<Name_To_Java t.name>' (arg, res);')
      '}') '})');
    (FUNC t.name) = () ('new Expr (new Func () {'
      ('public boolean eval (Expr arg, Result res) throws RefalException {'
        ((<Name_To_Java t.name>' (arg, res);')
         ('return true;'))
      '}') '})');
    s.sym, {
      <IsInt s.sym> = 
        {
          <Get &Int> : BigInteger = 'java.math.BigInteger';
          <Get &Int>;
        } :: e.class,
        () ('new Expr (new 'e.class' ("'s.sym'"))');
      <IsWord s.sym> =
        () ('new Expr (new Word ("'<Symbol_To_Java s.sym>'"))');
    };
  } :: (e.arrays) e.java_item =
    <Const_Expr_Aux () e.rest> :: (e.new_arrays) e.java_rest,
    (e.arrays e.new_arrays) e.java_item e.java_rest;
  = () /*empty*/;
};

Symbol_To_Java s.ObjectSymbol, {
  <ToChars 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.java_char,
    e.rest (e.java_symbol e.java_char);
  } :: e.symbol (e.java_symbol),
    e.symbol : /*empty*/ =
    e.java_symbol;
};

Int_Args_To_Java s.acc e.args =
  e.args (/*e.java-args*/) $iter {
    e.args : (e.arg) e.rest =
      {
        e.rest : v = ', ';
        /*empty*/;
      } :: e.comma,
      e.rest (e.java_args <Expr_Int_To_Java s.acc e.arg> e.comma);
    } :: e.args (e.java_args),
  e.args : /*empty*/ =
  e.java_args;

Var_Args_To_Java e.args =
  e.args (/*e.type*/) (/*e.java-args*/) $iter {
    e.args : s.t e.rest =
      e.rest (s.t) (e.java_args);
    e.args : t.arg e.rest =
      {
        e.rest : e (e) e = ', ';
        /*empty*/;
      } :: e.comma,
      e.rest (e.type) (e.java_args e.type' '<Rfp2Java t.arg> e.comma);
    } :: e.args (e.type) (e.java_args),
  e.args : /*empty*/ =
  e.java_args;

Expr_Args_To_Java e.args =
  e.args (/*e.type*/) (/*e.java-args*/) (/*e.arrays*/) $iter {
    e.args : s.t e.rest =
      e.rest (s.t) (e.java_args) (e.arrays);
    e.args : (e.arg) e.rest =
      {
        e.rest : e (e) e = ', ';
        /*empty*/;
      } :: e.comma,
      {
        e.type : /*empty*/ =
          <Expr_Ref_To_Java e.arg> :: e.a (e.j_arg),
          e.rest (e.type) (e.java_args e.j_arg e.comma) (e.arrays e.a);
        e.rest (e.type) (e.java_args e.arg e.comma) (e.arrays);
      };
  } :: e.args (e.type) (e.java_args) (e.arrays),
  e.args : /*empty*/ =
  e.arrays (e.java_args);

Name_To_Java (e.obj_name) =
  <Get &Current_Namespace> :: e.namespace,
  {
    e.obj_name : e.namespace e.cont = e.cont;
    e.obj_name;
  } :: e.name,
  <ToWord <Intersperse ('.') <GetJavaModuleName e.name>>>;

Var_To_Java t.var = {
  <Lookup &Result t.var>'.getExpr ()';
  <Rfp2Java t.var>;
};

Access_Mode {
  EXPORT = 'public';
  s = ;
};

Free_Index =
  <Get &Free_Idx> : {
    /*empty*/ = 1;
    s.idx     = <Add s.idx 1>;
  } :: s.idx,
  <Store &Free_Idx s.idx>,
  s.idx;