(* Analyse syntaxique et évaluation d'expression algébrique infixée avec priorité et parenthésage *)

#open "genlex";;

(* Types pour la table de valeurs des variables *)
type valeur = NoVal | Value of int ;;
type variable = {Nom: string; Valeur: valeur} ;;

(* Type pour l'arbre d'évaluation *)
type Elt = Egal | Plus | Moins | Mult | Div | Val of int | Var of string ;;
type arbre = 
    Nil
  | Noeud of arbre * Elt * arbre
;;

(* Opérations sur les listes de variables *)
let rec cherche x = function
  |[] -> raise Not_found
  |t::q -> 
     if t.Nom = x
     then t.Valeur
     else cherche x q
;;

let rec change_val x new_val = function
  | [] -> raise Not_found
  | t::q ->
     if t.Nom = x
     then {Nom = x; Valeur=Value(new_val)}::q
     else t::(change_val x new_val q)
;;

let rec affiche_liste = function
    [] -> () ;
  | t::q -> 
     begin
       print_string (t.Nom^" = ") ;
       (
	      match t.Valeur with 
	          NoVal -> print_string "non initialisé"
	        | (Value n) -> print_int n
       ) ;
       print_newline() ;
       affiche_liste q ;
     end
;;

(* Evaluation d'un arbre représentant une expression algébrique *)
exception Uninit_Var;;
exception Undef_Var;;

let eval_arbre liste_var = 
  let rec eval = function
      Nil -> 0 
    | Noeud(fg, Plus, fd) -> (eval fg) + (eval fd)
    | Noeud(fg, Moins, fd) -> (eval fg) - (eval fd)
    | Noeud(fg, Mult, fd) -> (eval fg) * (eval fd)
    | Noeud(fg, Div, fd) -> (eval fg) / (eval fd)
    | Noeud(Nil, (Val n), Nil) -> n
    | Noeud(Nil, (Var x), Nil) -> 
	     (
          match (try cherche x liste_var with Not_found -> raise Undef_Var) with
              NoVal -> raise Uninit_Var
            | (Value n) -> n
	     )       
    | _ -> failwith "Erreur non prévue"
  in function
        Nil -> failwith "Arbre vide"
    | Noeud(Noeud(Nil, Var x, Nil), Egal, fg) -> 
	     let val_x = eval fg in (val_x, change_val x val_x liste_var)
    | _ -> failwith "Erreur non prévue"
;;

(* Transformation d'un flux en liste *)
let rec list_of_stream = function
	| [< 't; list_of_stream q >] -> t::q
	| [< >] -> []
;;

(* Agrégation des identificateur *)
let rec agreg_ident = function
    [] -> []
  | (Ident a)::(Ident b)::q -> agreg_ident ((Ident (a^b))::q)
  | t::q -> t::(agreg_ident q)
;;

(* Transformation d'un liste de tokens en une chaîne *)
let rec string_of_toklist = function
  | [] -> ""
  | [Kwd "#"] -> ""
  | (Kwd s)::q -> s^" "^(string_of_toklist q)
  | (Ident s)::q -> s^" "^(string_of_toklist q)
  | (Int n)::q -> (string_of_int n)^" "^(string_of_toklist q)
  | (Float f)::q -> (string_of_float f)^" "^(string_of_toklist q)
  | (String s)::q -> s^" "^(string_of_toklist q)
  | (Char c)::q -> (char_for_read c)^" "^(string_of_toklist q)
;;

(* Function d'analyse syntaxique et de construction de l'arbre syntaxique pour une future
   évaluation. Elle suit la structure donnée par la grammaire. La seule chose un peu pénible est de
   porter une grande attention au cas terminaux. *)
let rec lit_ligne liste_var = function
  | [] -> false, liste_var, Nil, []
  | [Kwd "#"] -> true, liste_var, Nil, []
  | l -> let (test, l_var, arb, reste) = lit_instr liste_var l in
      (test && (reste = [Kwd "#"]), l_var, arb, reste)

and lit_instr liste_var = function
  | [] -> false, liste_var, Nil, []
  | (Ident x)::(Kwd "=")::r -> let (test, fd, reste) = lit_expr r in
      (test, ({Nom=x; Valeur=NoVal}::liste_var), Noeud(Noeud(Nil,(Var x),Nil),Egal,fd), reste)
  | l -> false, liste_var, Nil, l

and lit_expr = function
  | [] -> false, Nil, []
  | l -> 
      match lit_terme l with
        | false, fg, r -> false, fg, r
        | true, fg, [] -> false, fg, []
        | true, fg, ((Kwd "+")::r) -> 
            let (test, fd, reste) = lit_expr r in (test, Noeud(fg, Plus, fd), reste)
        | true, fg, ((Kwd "-")::r) -> 
            let (test, fd, reste) = lit_expr r in (test, Noeud(fg, Moins, fd), reste)
        | _ as result -> result

and lit_terme = function 
  | [] -> false, Nil, []
  | l -> 
      match lit_fact l with
        | false, fg, r -> false, fg, r
        | true, fg, [] -> false, fg, []
        | true, fg, ((Kwd "*")::r) -> 
            let (test, fd, reste) = lit_terme r in (test, Noeud(fg, Mult, fd), reste)
        | true, fg, ((Kwd "/")::r) -> 
            let (test, fd, reste) = lit_terme r in (test, Noeud(fg, Div, fd), reste)
        | _ as result -> result

and lit_fact = function
  | [] -> false, Nil, []
  | (Kwd "(")::r -> let (test, a, reste) = lit_expr r in 
      if (hd reste = (Kwd ")") && test)
      then (true, a, tl reste)
      else (false, a, reste)
  | l -> lit_cste_or_var l

and lit_cste_or_var = function
  | (Int n)::q -> true, Noeud(Nil, Val n, Nil), q
  | (Ident x)::q -> true, Noeud(Nil, Var x, Nil), q
  | l -> false, Nil, l
;;

(* Lit les expressions dans un fichier et leur applique la fonction d'analyse syntaxique qui doit
   être du type (an_syn: token list -> bool * token list). *)
let analyse_file (an_syn: variable list -> token list -> bool * variable list * arbre * token list) fichier =
  let canal = open_in fichier
  and raccourci s = agreg_ident (list_of_stream (make_lexer ["=";"+";"-";"*";"/";"(";")";"#"] (stream_of_string s)))
  and ligne = ref [] and result = ref (true, [], Nil, []) and test = ref true and liste_var = ref []
  in 
    while !test do
      (try ligne := raccourci ((input_line canal)^" #") with End_of_file -> test := false) ;
      if (!test) then
        begin
          result := an_syn (!liste_var) !ligne ;
          print_string (string_of_toklist !ligne); print_newline();
	       begin
            match !result with
	           | false, _, _, r -> 
		            print_string ("L'expression est incorrecte à partir de "^(string_of_toklist r))
	           | true, l_var, arb, _ -> 
		            print_string "L'expression est correcte et vaut " ;
		            try let (val_x, tmp) = eval_arbre l_var arb in
		              begin
			             print_int val_x ; print_char `.` ;
			             liste_var := tmp
		              end;
		            with 
		                Uninit_Var -> print_string "... Variable non initialisée"
		              | Undef_Var ->  print_string "... Variable non définie"
	       end;
          print_newline(); 
        end;
    done;
    affiche_liste !liste_var ;
    close_in canal
;;

analyse_file lit_ligne "C:\Documents and Settings\Mathieu\Mes documents\Colles_CaML\Colle06\validat1.don";;