(* Time-stamp: <modified the 10/07/2014 (at 14:58) by Erwan Jahier> *)
(*
Le manager d'argument adapt� de celui de lutin, plus joli
N.B. solution un peu batarde : les options sont stock�es, comme avant, dans Global,
du coup, le fait de rendre un type "t" est une koketerie !
*)
open Lv6version
open Verbose
open Arg

let tool_name = Lv6version.tool
let usage_msg =  "usage: "^tool_name^" [options] <file> | "^tool_name^" -help"

type enum_mode = AsInt | AsConst | AsEnum
type t = {
  mutable opts : (string * Arg.spec * string) list; (* classical Arg option tab used by Arg.parse *)
  mutable user_man  : (string * string list) list; (* ad hoc tab for pretty prtting usage *)
  mutable hidden_man: (string * string list) list; (* ad hoc tab for pretty prtting usage *) 
  mutable others: string list;
  mutable margin : int;
  mutable outfile :  string;
  mutable infiles :  string list;
  mutable main_node :  string;
  mutable compile_all_items : bool;
  mutable run_unit_test :  bool;
  mutable print_interface :  bool;
  mutable inline_iterator :  bool;
  mutable expand_nodes :  bool;
  mutable dont_expand_nodes :  string list;
  mutable expand_arrays :  bool;
  mutable gen_autotest :  bool;
  mutable oc :  Pervasives.out_channel;
  mutable tlex :  bool;
  mutable exec :  bool;
  mutable gen_c :  bool;
  mutable rif  :  bool;
  mutable gen_ocaml :  bool;
  mutable launch_cc :  bool;
  mutable precision : int option;
  
}

(* Those are really too boring to be functionnal (used in all over the places) *)
type global_opt = {
  mutable lv4 :  bool;
  mutable ec :  bool;
  mutable expand_enums :  enum_mode;
  mutable one_op_per_equation :  bool;
  mutable no_prefix :  bool;
  mutable nonreg_test :  bool;
  mutable current_file :  string;
  mutable line_num : int;
  mutable line_start_pos : int;
}
let (global_opt:global_opt) =
  {
    lv4 =  false;
    ec =  false;
    one_op_per_equation =  true;
    no_prefix =  false;
    nonreg_test =  false;
    line_num =  1;
    line_start_pos = 0;
    current_file =  "";
    expand_enums =  AsInt;
  }
let (make_opt : unit -> t) = 
  fun () -> 
    {
      opts = [];        
      user_man  = [];   
      hidden_man  = []; 
      others = [];
      margin = 12;
      outfile =  "";
      infiles =  [];
      main_node =  "";
      compile_all_items =  true;
      run_unit_test =  false;
      print_interface =  false;
      inline_iterator =  false;
      expand_nodes =  false;
      dont_expand_nodes =  [];
      expand_arrays =  false;
      gen_autotest =  false;
      (** the output channel *)
      oc =  Pervasives.stdout;
      tlex =  false;
      exec =  false;
      gen_c =  false;
      rif  =  false;
      gen_ocaml =  false;
      precision = None;
      launch_cc = false;

    }


(** flag 'paranoid' utile pour forcer (via le mecanisme Verbose.exe)
   des v�rifs de trucs douteux ...
*)
let paranoid = (Verbose.get_flag "paranoid")

let (lexbuf_of_file_name : string -> Lexing.lexbuf) =
fun file -> 
  let inchannel = 
    Verbose.print_string ~level:1 
(*       ("Opening file " ^ (Filename.concat (Sys.getcwd ()) file) ^ "\n"); *)
      ("Opening file " ^ (file) ^ "\n");
    open_in file 
  in
    global_opt.line_num <- 1;
    global_opt.line_start_pos <- 0;
    global_opt.current_file <- file;
    Lexing.from_channel inchannel 

(* all unrecognized options are accumulated *)
let (add_other : t -> string -> unit) =
  fun opt s -> 
    opt.others <- s::opt.others

let pspec os opt (c, ml) = (
  let (m1, oth) = match ml with
	 |	h::t -> (h,t)
	 |	_ -> ("",[])
  in
  let t2 = String.make opt.margin ' ' in
  let cl = String.length c in
  let t1 = if (cl < opt.margin ) then
	 String.make (opt.margin - cl) ' '
  else
	 "\n"^t2
  in
	 Printf.fprintf os "%s%s%s" c t1 m1;
	 List.iter (function x -> Printf.fprintf os "\n%s%s" t2 x) oth ;
	 Printf.fprintf os "\n" ;
)

let usage os opt = (
	let l = List.rev opt.user_man in
	Printf.fprintf os "%s\n\n" usage_msg;
	List.iter (pspec os opt) l
)
let help opt ()= (
	usage stdout opt;
	exit 0
)
let full_usage os opt = (
	Printf.fprintf os "%s\n" usage_msg;
(* 	let l = List.rev opt.user_man in *)
(* 	List.iter (pspec os opt) l; *)
	let l = List.rev (opt.hidden_man) in
	List.iter (pspec os opt) l
)
let full_help opt ()= (
	full_usage stdout opt;
	exit 0
)

let unexpected s opt = (
	prerr_string ("unexpected argument \""^s^"\"");
	prerr_newline ();
	usage stderr opt;
	exit 1
)
let file_notfound f opt = (
	prerr_string ("File not found: \""^f^"\"");
	prerr_newline ();
	usage stderr opt;
	exit 1
)

let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec -> string list -> unit) =
  fun opt ol ?(hide=false) ?(arg="") se ml ->
    let treto o = opt.opts <- (o, se, "")::opt.opts in
	   List.iter treto ol ;
	   let col1 = (String.concat ", " ol)^arg in
	     if hide 
        then opt.hidden_man <- (col1, ml)::opt.hidden_man
	     else opt.user_man   <- (col1, ml)::opt.user_man
          (*
	         let tabs = String.make (col - (String.length o) - (String.length arg)) ' ' in
	       (* (o, se, arg^tabs^m) *)
	         (o, se, arg^"\n     "^m)
          *)

(* utils *)
let set_v4_options opt =
  global_opt.lv4 <- true;
  global_opt.expand_enums <- AsConst; (* only override the default *)
  opt.inline_iterator <- true;
  opt.expand_arrays <- true

let set_ec_options opt =
  set_v4_options opt;
  global_opt.ec <- true;
  global_opt.no_prefix <- true;
  opt.expand_nodes <- true

(*** USER OPTIONS TAB **)
let mkoptab (opt:t) : unit = (
    mkopt opt
      ["-n";"-node"]  ~arg:" <string>"
      (Arg.String(function x -> 
         opt.main_node <- x;
         opt.compile_all_items <- false))
      ["Set the main node (all items are compiled if unset)"]
    ;
    mkopt opt  ["-o";"--output-file"]  ~arg:" <string>"
      (Arg.String(function x -> opt.outfile <- x))
      ["Set the output file name"]
    ;
    mkopt opt
      ["-exec"]
      (Arg.Unit (fun _ ->
        opt.exec <- true))
      ["interpret the program using RIF conventions for I/O (experimental)."]
    ;
    mkopt opt
      ["--to-c"; "-2c"]
      (Arg.Unit (fun _ ->
        opt.gen_c <- true))
      ["generate C code (work in progress)."]
    ;
    mkopt opt
      ["-rif"]
      (Arg.Unit(function s -> opt.rif <- true))
      ["behave as a rif input file (meaningless without -exec)"]
    ;
    mkopt opt
      ["-ocaml"]
      (Arg.Unit(function s -> opt.gen_ocaml <- true))
      ["generate ocaml glue code that makes it possible to call the lus2lic interpreter ";
       "from ocaml with the current set of arguments (with Lus2licRun.make)."]
    ;

    mkopt opt
      ["-knc"; "--keep-nested-calls"]
      (Arg.Unit (fun _ -> global_opt.one_op_per_equation <- false))
      ["Keep nested calls (inhibited by -en). By default, only one node ";
       "per equation is generated."]
    ;
    mkopt opt
      ["-ei"; "--expand-iterators"]
      (Arg.Unit (fun _ -> opt.inline_iterator <- true))
      ["Expand array iterators (i.e., generate iterator-free code)."]
    ;
    mkopt opt
      ["-ee"; "--expand-enums"]
      (Arg.Unit (fun _ -> global_opt.expand_enums <- AsConst))
      [" Translate enums using extern types and consts (for lv4 and ec)."]
    ;
    mkopt opt
      ["-eei"; "--expand-enums-as-int"]
      (Arg.Unit (fun _ -> global_opt.expand_enums <- AsInt))
      [" Translate enums using integers (to be kind with data plotters)."]
    ;
    mkopt opt
      ["-esa"; "--expand-structs-and-arrays"]
      (Arg.Unit (fun _ ->
         opt.expand_arrays <- true;
         opt.inline_iterator <- true))
      ["Expand structures and arrays using as many variables as necessary (automatically impose '-ei')"]
    ;
    mkopt opt
      ["-en"; "--expand-nodes"]
      (Arg.Unit (fun _ -> opt.expand_nodes <- true))
      ["Expand the main node (use the first node if no one is specified)."]
    ;
    mkopt opt
      ["-den"; "--do_not-expand-nodes"]
      ~arg:" <string>"
      (Arg.String (fun str ->
         opt.dont_expand_nodes <- str::opt.dont_expand_nodes
      ))
      ["Do not expand the specified node (meaningful with -en only of course)."]
    ;
    mkopt opt
      ["-lv4"; "--lustre-v4"]
      (Arg.Unit (fun _ -> set_v4_options opt))
      ["Use Lustre V4 syntax (automatically impose '-ei -ee -esa')."]
    ;
    mkopt opt
      ["-ec"; "--expanded-code"]
      (Arg.Unit (fun _ -> set_ec_options opt))
      ["Generate ec (actually just an alias for '-en -lv4 --no-prefix')."]
    ;
    mkopt opt
      ["-np"; "--no-prefix"]
      (Arg.Unit (fun () -> global_opt.no_prefix <- true))
      ["Do not prefix variable names by their module (beware: variable names may clash with this option)."]
    ;

    mkopt opt
      ["-version"; "--version"]
      (Arg.Unit(function _ -> Printf.fprintf stdout "%s\n" Lv6version.str; exit 0))
      ["Print the current version and exit"]
    ;
    (* verbose *)
    mkopt opt
      ["-v"; "--verbose"]
      (Arg.Unit(function _ -> Verbose.on () ))
      ["Set the verbose level to 1"]
    ;
    mkopt opt
      ["-vl"]
      ~arg:" <int>"
      (Arg.Int(function i -> Verbose.set i))
      ["Set the verbose level"]
    ;
    mkopt opt
      ["-h";"-help";"--help"]
      (Arg.Unit (help opt))
      ["Display this message."]
    ;
    (* to show Hidden opt *)
    mkopt opt
      ["-more"]
      (* (Arg.Unit(fun _ -> opt.see_all_options <- true)) *)
      (Arg.Unit (full_help opt))
      ["Show hidden options (for dev purposes)"];
    (* HIDDEN *)

    (* test lexical *)
    mkopt opt ~hide:true
      ["-tlex"; "--test-lexer"]
      (Arg.Unit (fun () -> opt.tlex <- true))
      ["Test the lexical analysis"]
    ;
    (* test syntaxique
    mkopt opt ~hide:true
      ["-tparse"]
      (Arg.Unit(function _ -> opt.gen_mode <- GenLuc ; opt.test_parse <- true ; ()))
      ["Test the syntactic analysis"]
    ;
    *)
    mkopt opt ~hide:true
      ["-interface"]
      (Arg.Unit (fun () -> opt.print_interface<-true))
      ["Print the node interface"]
    ;
    mkopt opt ~hide:true
      ["-unit"]
      (Arg.Unit (fun () -> opt.run_unit_test<-true))
      ["Run embedded unit tests"]
    ;
    mkopt opt ~hide:true
      ["--precision"]
      (Arg.Int (fun i -> opt.precision <- Some i))
      ["Number of digits after ther dot used to print floats"]
    ;
    mkopt opt ~hide:true
      ["-cc"]
      (Arg.Unit (fun i -> opt.launch_cc <- true))
      ["Try to compile the generated C files (requires -2c)"]
    ;
    mkopt opt ~hide:true
      ["--nonreg-test"]
      (Arg.Unit (fun () -> global_opt.nonreg_test <- true))
      ["Avoid printing full path error msgs to ease non-reg test decision"]
    ;
    mkopt opt ~hide:true
      ["--gen-autotest"]
      (Arg.Unit (fun () -> opt.gen_autotest <- true))
      ["Generate a Lutin file and an oracle Lustre file suitable to compare the result of 2 Lustre compilers"]
    ;
    (* misc debug flag *)
    mkopt opt ~hide:true
      ["-dbg"; "--debug"]	
      (Arg.Symbol
         ( Verbose.flag_list (), fun s -> let f = Verbose.get_flag s in Verbose.set_flag f))
      [ "<dbg_flag>"; 
        "Possible dbg_flag are: " ^(String.concat ", " (Verbose.flag_list())) ]
)


let first_line b = (
	try (
		let f = String.index b '\n' in
		String.sub b 0 f
	) with Not_found -> b
)


let current = ref 0;;

(* La ``m�thode'' principale *)
let parse argv = (
  let opt = make_opt() in
  let save_current = !current in
    try (
      mkoptab opt;
	   Arg.parse_argv ~current:current argv opt.opts (add_other opt) usage_msg;
      (List.iter 
         (fun f -> 
            if (String.sub f 0 1 = "-") then
              unexpected f opt
            else if not (Sys.file_exists f) then
              file_notfound f opt
            else ()
         ) 
         opt.others
      );
      opt.infiles <- (List.rev opt.others);
      current := save_current;
      opt
    ) with
	     (* only 1rst line is interesting ! *)
	   | Bad  msg -> Printf.fprintf stderr "%s\n" (first_line msg); usage stderr opt; exit 2; 
	   | Help msg -> help opt ();
)