open Options
open Misc.Timed

(** Parse the command line. *)
let input_files = 
  if not (Options.is_web_mode ()) then
    OptionsParsing.results ()
  else 
    []

(** For each input file of the source language: 

    1. Parse.

    2. Add runtime functions.

    3. Labelize.

    4. Compile to the target language. 
       (And keep track of annotations if required). 
  
    5. Annotate the input program with collected costs. 

    6. Save the annotated input program.

    Optionnally, we can interpret the intermediate programs
    if {!Options.interpretation_requested}. 
*)
let process ?(step=fun step over -> ()) source = 
  (** Set source and target languages. *)
  let src_language = Options.get_source_language () in
  let tgt_language = Options.get_target_language () in

  let next_step = 
    let nb_step = 10 in
    let c = ref 0 in
    fun () -> incr c; step !c nb_step
  in

  (** These variables are related to the lustre mode of the compiler. *)
  let is_lustre_file = Options.is_lustre_file () in
  let remove_lustre_externals = Options.is_remove_lustre_externals () in

  (** Parse. *)
  let input_ast =
    profile "Parsing" 
      (Languages.parse ~is_lustre_file ~remove_lustre_externals src_language)
      source 
  in

  next_step ();

  (** Embed the runtime functions in the abstract syntax tree. *)
  let input_ast = Languages.add_runtime input_ast in 

  (** Labelling pass. *)
  let input_ast = 
    profile "Labelling"
    Languages.labelize input_ast 
  in 

  next_step ();

  (** Compilation. *)
  let target_asts =
    (** If debugging is enabled, the compilation function returns all
	the intermediate programs. *)
    profile "Compilation"
      (Languages.compile 
	 (Options.is_debug_enabled ()) 
	 src_language tgt_language)
      input_ast
  in

  next_step ();

  let final_ast, intermediate_asts = Misc.ListExt.cut_last target_asts in

  (** Instrument the source file with cost annotations. *)
  let (annotated_input_ast, cost_id, cost_incr, extern_cost_variables) =
    profile "Annotation"
      (Languages.annotate input_ast) 
      final_ast 
  in

  (** Instrument the source file with cost annotations. *)
  let (annotated_input_ast, stack_id, stack_max_id,
       stack_incr, extern_stack_variables) =
    profile "Annotation Stack"
      Languages.annotate_stack_size cost_incr annotated_input_ast
  in

  next_step ();

  (** Combine the output asts. *)
  let output = (target_asts, annotated_input_ast) in

  (** Finally save these output if we are not in a web mode. *)
  let _ = 
    if not (Options.is_web_mode ()) then 
      let filename = match source with `Filename f -> f | _ -> assert false in
      let (exact_output, output_filename) = match Options.get_output_files () with
	| None -> (false, filename)
	| Some filename' -> (true, filename') in
      let save ?(suffix="") ast = 
	Languages.save
	  (Options.is_asm_pretty ()) exact_output output_filename suffix ast 
      in
      begin
	save final_ast;
	save ~suffix:"-instrumented" annotated_input_ast;
	Languages.save_cost exact_output output_filename cost_id cost_incr
	  extern_cost_variables;
	Languages.save_stack
          exact_output output_filename
          stack_id stack_max_id stack_incr extern_stack_variables;
	if Options.is_debug_enabled () then 
	  List.iter save intermediate_asts;
      end;

      (** Interpret all the intermediate ASTs if requested. *)
      if Options.interpretations_requested () then
	begin
	  Printf.printf "Interpret\n%!" ;
	  let asts = target_asts in
	  let debug = Options.is_debug_enabled () in
	  let label_traces = List.map (Languages.interpret debug) asts in
	  Misc.IOExt.eprintf "Checking execution traces...%!";
	  Checker.same_traces (List.combine asts label_traces);
	  Misc.IOExt.eprintf "OK.\n%!";
	end;

      (** Interpret the final AST if requested. *)
      if Options.interpretation_requested () then
	ignore (Languages.interpret (Options.is_debug_enabled ()) final_ast)
  in
  (** Return the output ASTs. *)
  output

let lustre_test (filename : string) =
  let lustre_test       = match Options.get_lustre_test () with
    | None -> assert false (* do not use on this argument *)
    | Some lustre_test -> lustre_test in
  let lustre_test_cases = Options.get_lustre_test_cases () in
  let lustre_test_cycles = Options.get_lustre_test_cycles () in
  let lustre_test_min_int = Options.get_lustre_test_min_int () in
  let lustre_test_max_int = Options.get_lustre_test_max_int () in
  let src_language      = Languages.Clight in
  let tgt_language      = Languages.Clight in
  let input_ast         = Languages.parse src_language (`Filename filename) in
  let input_ast         =
    Languages.add_lustre_main lustre_test lustre_test_cases lustre_test_cycles
      lustre_test_min_int lustre_test_max_int input_ast in 
  let (exact_output, output_filename) = match Options.get_output_files () with
    | None -> (false, filename)
    | Some filename' -> (true, filename') 
  in
  let save ast =
    Languages.save
      (Options.is_asm_pretty ()) exact_output output_filename "" ast in
  let target_asts = 
    Languages.compile false src_language tgt_language input_ast
  in
  let final_ast, _ = Misc.ListExt.cut_last target_asts in
  save input_ast ;
  save final_ast

let _ =
  Misc.Timed.set_profiling_flag (Options.is_debug_enabled () || Options.is_web_mode ());
  if not (Options.is_web_mode ()) then 
    begin
      set_now (fun () -> 0.); (* Unix.gettimeofday () *. 1000.); *)
      if Options.is_dev_test_enabled () then 
	Dev_test.do_dev_test input_files
      else
	if Options.get_lustre_test () <> None then 
	  List.iter lustre_test input_files
	else 
	  ignore (List.map process (List.map (fun f -> `Filename f) input_files))
    end