#open "instr";;
#open "gen";;
#open "am";;
#open "lambda";;
#open "expr";;
#open "divers";;
#open "eval";;
#open "typage";;
#open "types";;
#open "lexing";;
#open "lexical";;
#open "parser";;
#open "printexc";;
#open "sys";;
#open "global";;
#open "somme";;
#open "topl";;
#open "gc";;
#open "printf";;


let source = ref "";;
let print_code = ref false;;
let print_type_decl = ref false;;
let print_type_all = ref false;;
let do_execute = ref false;;
let do_eval = false;;

let traite_expr a =

  (*   affiche_expr a;
      flush std_out;
      print_string "\n>> "; *)
      (
      try
       let _ = calcule_vars [] a in
(*       affiche_expr a; print_string "\n"; *)
       let t=inferer [] a in
       if !print_type_all then 
       ( afficher_typeexpr t; pr "\n"; flush std_out );
(*     pr "eval:"; *)
       if do_eval then ( pr "  = "; afficher_valeur (evaluer a); pr "\n" );


       let lambda=lambda_of_phrase a in
(*     pr_lambda lambda; *)
       compile_topl lambda;
(*       let code=compile_phrase lambda in *)

(*     print_string "Code compilé:\n";
       flush std_out;
       print_code code;
       flush std_out; *)
(*      runpgm (linkcode code); *)

      with
      | Unification -> print_string "Erreur de typage (unification)\n"
      | TypeCirculaire -> print_string "Erreur de typage (type circulaire)\n"
      | MembreDroitLetRec -> pr "Membre droit invalide dans un let rec\n"
      | Not_found    -> print_string "Identificateur non lié\n"
      );
      flush std_out;;


let traite_decl d =
  (
  try
  let ex = exprLet (fst d,snd d, exprCst CstUnit) in
  let _ = calcule_vars [] ex in
(*  affiche_expr ex print_string "\n"; *)

  let env=typer_let [] d in
  if !print_type_decl then
    do_list (fun (x,t) -> pr x; pr ":"; afficher_typeexpr t; pr "\n") env;
  if do_eval then evaluer_letdecl d;

  let lambda=lambda_of_letdecl d in
  compile_topl lambda;
      with
      | Unification -> print_string "Erreur de typage (unification)\n"
      | TypeCirculaire -> print_string "Erreur de typage (type circulaire)\n"
      | MembreDroitLetRec -> pr "Membre droit invalide dans un let rec\n"
      | Not_found    -> print_string "Identificateur non lié\n"
  );
  flush std_out;;

let fin () =
  let code=link() in
  printf "Nombre d'instructions : %d\n" (vect_length code);
  if !print_code then print_code_vect code;
  if !do_execute then
  (
  pr "\n========== Execution ==========\n\n";
  flush std_out;
  let c=runpgm code in
  printf  "\n\nStop (code:%d)\n" c;
  );
  flush std_out;;

(*
let traite_typedecl ((vars,typ_id),constrs) =
  pr "TYPE: ";
  do_list pr vars; pr " "; pr typ_id; pr ":=";
  do_list (fun (x,t) -> pr " "; pr x; match t with None -> () |
 Some t -> pr ":"; pr_typesynt t) constrs;
   pr "\n";
   flush std_out;;
*)

let parse_cmd_line () =
  for i=1 to (vect_length command_line)-1 do
  match command_line.(i) with
  | "-c" -> print_code:=true
  | "-t" -> print_type_decl:=true
  | "-ta" -> print_type_all:=true; print_type_decl:=true
  | "-e" -> do_execute:=true
  | s -> if (!source="") && (s.[0] != `-`) then source:=s else
    (
    printf "Erreur ligne de commande : argument inconnu (%s)\n" s; 
    flush std_out;
    exit 1
    )
  done;
  if !source="" then source:="pgm.";;

let run() =
  parse_cmd_line ();
  init_codes();
  init_global();
  if do_eval then init_env_eval ();
  dico:=[];
  let lexbuf = lexing__create_lexer_channel (open_in !source)
  in
  try
   while true do
    full_major();
    match (parser__Phrase lexical__Token lexbuf) with
     Expr a -> traite_expr a
    |TypeDecl t -> traite_type_decl [t]
    |Decl d -> traite_decl d
   done
  with Eof -> fin () ;;

printexc__f run ();;