(********************************************************************)
(*                                                                  *)
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
(*                                                                  *)
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
(*  under the terms of the GNU Lesser General Public License        *)
(*  version 2.1.                                                    *)
(*                                                                  *)
(********************************************************************)

open Format
open Utils
open LustreSpec
open Corelang
open Machine_code


(********************************************************************************************)
(*                     Basic      Printing functions                                        *)
(********************************************************************************************)

let pp_final_char_if_non_empty c l =
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "%s" c)

let pp_newline_if_non_empty l =
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "@,")

let pp_dimension fmt d =
  Printers.pp_expr fmt (expr_of_dimension d)

let pp_type fmt t = 
  match (Types.repr t).Types.tdesc with
    | Types.Tbool -> pp_print_string fmt "boolean" 
    | Types.Treal -> pp_print_string fmt "double" 
    | _ -> Types.print_ty fmt t

let pp_var fmt id = fprintf fmt "%a %s" pp_type id.var_type id.var_id

let pp_tag fmt t =
 pp_print_string fmt t

let rec pp_const fmt c =
  match c with
    | Const_int i -> pp_print_int fmt i
    | Const_real r -> pp_print_string fmt r
    | Const_float r -> pp_print_float fmt r
    | Const_tag t -> pp_tag fmt t
    | Const_array ca -> Format.fprintf fmt "{%a}" (Utils.fprintf_list ~sep:"," pp_const) ca

let rec pp_val m fmt v =
  match v with
    | Cst c -> pp_const fmt c
    | LocalVar v ->
      if List.exists (fun o -> o.var_id = v) m.mstep.step_outputs then
	fprintf fmt "*%s" v
      else
	pp_print_string fmt v
    | StateVar v -> fprintf fmt "%s" v
    | Fun (n, vl) -> if Basic_library.is_internal_fun n then
	Basic_library.pp_java n (pp_val m) fmt vl
      else
	fprintf fmt "%s (%a)" n (Utils.fprintf_list ~sep:", " (pp_val m)) vl

let pp_add_val m fmt i =
  if List.exists (fun o -> o.var_id = i) m.mstep.step_outputs
  then
    fprintf fmt "%s" i
  else
    fprintf fmt "&%s" i

(********************************************************************************************)
(*                    Instruction Printing functions                                        *)
(********************************************************************************************)
let get_output_of_machine machines i =
  try 
    let m = List.find (fun m -> m.mname.node_id = i) machines in
    m.mstep.step_outputs
  with Not_found -> assert false

let rec pp_machine_instr m machines instance_out_list fmt instr =
  match instr with
    | MReset i -> (
      match List.assoc i m.minstances with
	| "_arrow" -> fprintf fmt "%s = true;" i
	| _ -> fprintf fmt "%s.reset();" i
    )
    | MLocalAssign (i,v) -> (
      fprintf fmt "%s = %a;" 
	i (pp_val m) v
    )
    | MStateAssign (i,v) ->
      fprintf fmt "%s = %a;" i (pp_val m) v
    | MStep ([i0], i, vl) when Basic_library.is_internal_fun i ->
      fprintf fmt "%s = %a;" i0 (Basic_library.pp_java i (pp_val m)) vl    
    | MStep ([i0], i, [init; step]) when ((List.assoc i m.minstances) = "_arrow") -> (
      fprintf fmt "@[<v 2>if (%s) {@,%s = false;@,%s = %a;@]@,@[<v 2>} else {@,%s = %a;@]@,};@,"
	    i i i0 (pp_val m) init i0 (pp_val m) step
    )
    | MStep (il, i, vl) -> (
      let out = 
	try
	  List.assoc i instance_out_list 
	with Not_found -> (eprintf "impossible to find instance %s in the list@.@?" i; 
			   assert false) 
      in 
	  fprintf fmt "%s = %s.step (%a);@,"
    	    out i
     	    (Utils.fprintf_list ~sep:", " (pp_val m)) vl;
	  Utils.fprintf_list ~sep:"@," 
	    (fun fmt (o, oname) -> fprintf fmt "%s = %s.%s;" o out oname) fmt 
	    (List.map2 
	       (fun x y -> x, y.var_id) 
	       il 
	       (get_output_of_machine machines (List.assoc i m.minstances))
	    ) 
    ) 
      	
    | MBranch (g,hl) ->
      Format.fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
	(pp_val m) g
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch m machines instance_out_list)) hl

and pp_machine_branch m machines instance_out_list fmt (t, h) =
  Format.fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr m machines instance_out_list)) h

(********************************************************************************************)
(*                         Java file Printing functions                                        *)
(********************************************************************************************)

let get_class_name n = match n with "_arrow" -> "boolean" | _ -> String.capitalize n

let pp_local_fields visibility = 
  fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "%s %a;" visibility pp_var v) 

let pp_local_field_instances = 
  fprintf_list ~sep:"@," 
    (fun fmt (node_inst, node_type) -> fprintf fmt "protected %s %s;" 
      (get_class_name node_type) 
      node_inst
    ) 

let pp_output_constructor fmt outputs =
  fprintf fmt "@[<v 2>public Output(%a) {@,%a@]@,}"
    (fprintf_list ~sep:"; " pp_var) outputs
    (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "this.%s = %s;" v.var_id v.var_id)) outputs

let pp_output_class fmt step = 
  fprintf fmt "@[<v 2>public class Output {@,%a@,@,%a@]@,}@,"
    (pp_local_fields "public") step.step_outputs
    pp_output_constructor step.step_outputs

let pp_constructor fmt (name, instances) = 
  fprintf fmt "@[<v 2>public %s () {@,%a@]@,}@,"
    (String.capitalize name)
    (
      fprintf_list ~sep:"@," 
	(fun fmt (node_inst, node_type) -> 
	  match node_type with
	      "_arrow" -> fprintf fmt "%s = true;" node_inst
	    | _ -> fprintf fmt "%s = new %s();" node_inst (get_class_name node_type) 
	) 
    ) 
    instances

let pp_reset machines fmt m = 
  fprintf fmt "@[<v 2>public void reset () {@,%a@]@,}@,"
    (fprintf_list ~sep:"@," (pp_machine_instr m machines [])) m.minit

let pp_step machines fmt m : unit = 
  let out_assoc_list = 
    List.map (fun (node_inst, _) -> node_inst, "out_" ^ node_inst) m.minstances
  in
  fprintf fmt 
    "@[<v 2>public Output step (%a) {@,%a%t@,%a%a%t@,%a@,%t@]@,}@,"
    (Utils.fprintf_list ~sep:",@ " pp_var) m.mstep.step_inputs
    (* locals *)
    (Utils.fprintf_list ~sep:";@," pp_var) m.mstep.step_locals
    (pp_final_char_if_non_empty ";" m.mstep.step_locals) 
    (* declare out variables of subnode instances + out of this node *)
    (fprintf_list ~sep:"" 
       (fun fmt (ninst, ntype) -> fprintf fmt "%s.Output out_%s;@," (get_class_name ntype) ninst )) 
    (List.filter (fun (_,ntyp) -> not (ntyp = "_arrow")) m.minstances)
    (fprintf_list ~sep:";@," pp_var) m.mstep.step_outputs
    (pp_final_char_if_non_empty ";" m.mstep.step_outputs) 
    (* instructions *)
    (fprintf_list ~sep:"@," (pp_machine_instr m machines out_assoc_list)) m.mstep.step_instrs     
    (* create out object and return it *)
    (fun fmt -> fprintf fmt "return new Output(%a);" 
      (fprintf_list ~sep:"," (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_outputs 
    )
  


let print_machine machines fmt m =
  if m.mname.node_id = "_arrow" then () else ( (* We don't print arrow function *)
    fprintf fmt "@[<v 2>class %s {@,%a%t%a%t%t%a@,%a@,%a@,%a@]@,}@.@.@."
      (String.capitalize m.mname.node_id) (* class name *)
      (pp_local_fields "protected") m.mmemory                      (* fields *)
      (pp_newline_if_non_empty m.mmemory)            
      pp_local_field_instances m.minstances          (* object fields *)
      (pp_newline_if_non_empty m.minstances)         
      (pp_newline_if_non_empty m.minstances)         
      pp_output_class m.mstep                        (* class for output of step method *)
      pp_constructor (m.mname.node_id, m.minstances) (* constructor to instanciate object fields *)
      (pp_reset machines) m                               (* reset method *)
      (pp_step machines) m             (* step method *)

  )

(********************************************************************************************)
(*                         Main related functions                                           *)
(********************************************************************************************)

(* let print_get_input fmt v = *)
(*   match v.var_type.Types.tdesc with *)
(*     | Types.Tint -> fprintf fmt "_get_int(\"%s\")" v.var_id *)
(*     | Types.Tbool -> fprintf fmt "_get_bool(\"%s\")" v.var_id *)
(*     | Types.Treal -> fprintf fmt "_get_double(\"%s\")" v.var_id *)
(*     | _ -> assert false *)

(* let print_put_outputs fmt ol =  *)
(*   let po fmt o = *)
(*     match o.var_type.Types.tdesc with *)
(*     | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id *)
(*     | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id *)
(*     | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id *)
(*     | _ -> assert false *)
(*   in *)
(*   List.iter (fprintf fmt "@ %a;" po) ol *)

let read_input fmt typ = match typ.Types.tdesc with
  | Types.Treal -> fprintf fmt "StdIn.readDouble()"
  | Types.Tint ->  fprintf fmt "StdIn.readInt()"
  | Types.Tbool ->  fprintf fmt "StdIn.readBoolean()"
  | _ -> assert false

let print_main_fun basename machines m fmt =
  let m_class = String.capitalize m.mname.node_id in
  fprintf fmt "@[<v 2>class %s {@,@,@[<v 2>%s {@,%t@,%t@]@,}@,@]@,}@."
    (String.capitalize basename)
    "public static void main (String[] args)"
    (fun fmt -> fprintf fmt "%s main_node = new %s();"  m_class m_class)
    (fun fmt -> fprintf fmt "@[<v 2>while (true) {@,%a@,%t@,%a@]@,}@,"  
      (fprintf_list ~sep:"@," 
	 (fun fmt v -> fprintf fmt "System.out.println(\"%s?\");@,%a = %a;" 
	   v.var_id pp_var v read_input v.var_type))
      m.mstep.step_inputs
      (fun fmt -> fprintf fmt "%s.Output out = main_node.step(%a);" 
	m_class  
	(fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs
      )
      (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "System.out.println(\"%s = \" + out.%s);" v.var_id v.var_id))
      m.mstep.step_outputs
    )
    
    
(* let print_main_fun machines m fmt = *)
(*   let mname = m.mname.node_id in *)
(*   let main_mem = *)
(*     if (!Options.static_mem && !Options.main_node <> "") *)
(*     then "&main_mem" *)
(*     else "main_mem" in *)
(*   fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; *)
(*   fprintf fmt "/* Declaration of inputs/outputs variables */@ "; *)
(*   List.iter  *)
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
(*     ) m.mstep.step_inputs; *)
(*   List.iter  *)
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
(*     ) m.mstep.step_outputs; *)
(*   fprintf fmt "@ /* Main memory allocation */@ "; *)
(*   if (!Options.static_mem && !Options.main_node <> "") *)
(*   then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname) *)
(*   else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); *)
(*   fprintf fmt "@ /* Initialize the main memory */@ "; *)
(*   fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; *)
(*   fprintf fmt "@ ISATTY = isatty(0);@ "; *)
(*   fprintf fmt "@ /* Infinite loop */@ "; *)
(*   fprintf fmt "@[<v 2>while(1){@ "; *)
(*   fprintf fmt  "fflush(stdout);@ "; *)
(*   List.iter  *)
(*     (fun v -> fprintf fmt "%s = %a;@ " *)
(*       v.var_id *)
(*       print_get_input v *)
(*     ) m.mstep.step_inputs; *)
(*   (match m.mstep.step_outputs with *)
(*     | [] -> ( *)
(*       fprintf fmt "%a(%a%t%s);@ "  *)
(* 	pp_machine_step_name mname *)
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
(* 	main_mem *)
(*     ) *)
(*     | [o] -> ( *)
(*       fprintf fmt "%s = %a(%a%t%a, %s);%a" *)
(* 	o.var_id *)
(* 	pp_machine_step_name mname *)
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
(* 	main_mem *)
(* 	print_put_outputs [o]) *)
(*     | _ -> ( *)
(*       fprintf fmt "%a(%a%t%a, %s);%a" *)
(* 	pp_machine_step_name mname *)
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
(* 	main_mem *)
(* 	print_put_outputs m.mstep.step_outputs) *)
(*   ); *)
(*   fprintf fmt "@]@ }@ "; *)
(*   fprintf fmt "return 1;"; *)
(*   fprintf fmt "@]@ }@."        *)

(* let print_main_header fmt = *)
(*   fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"io_frontend.h\"@." *)
  
      
(********************************************************************************************)
(*                         Translation function                                             *)
(********************************************************************************************)

let translate_to_java source_fmt basename prog machines =

  
  (* If a main node is identified, generate a main function for it *)
  let main_print =
    match !Options.main_node with
      | "" -> (fun _ -> ())
      | main_node -> (
  	let main_node_opt =
  	  List.fold_left
  	    (fun res m ->
  	      match res with
  		| Some _ -> res
  		| None -> if m.mname.node_id = main_node then Some m else None)
  	    None machines
	in
	match main_node_opt with
  	  | None -> eprintf "Unable to find a main node named %s@.@?" main_node; (fun _ -> ())
  	  | Some m -> print_main_fun basename machines m
      )
  in
  
  (* Print nodes one by one (in the previous order) *)
  List.iter ((print_machine machines) source_fmt) machines;
  main_print source_fmt 




(* Local Variables: *)
(* compile-command:"make -C .." *)
(* End: *)
