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

#open "genlex";;

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

(* Transformation d'une 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 : 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 = function
  | [] -> false, []
  | [Kwd "#"] -> true, []
  | l -> let (test, reste) = lit_expr l in (test && (reste = [Kwd "#"]), reste)

and lit_expr = function
  | [] -> false, []
  | l -> 
      match lit_terme l with
        | false, r -> false, r
        | true, [] -> false, []
        | true, r -> 
            if (hd r = (Kwd "+") || hd r = (Kwd "-"))
            then lit_expr (tl r)
            else (true, r)

and lit_terme = function 
  | [] -> false, []
  | l -> 
      match lit_fact l with
        | false, r -> false, r
        | true, [] -> false, []
        | true, r ->
            if (hd r = (Kwd "*") || hd r = (Kwd "/"))
            then lit_terme (tl r)
            else (true, r)

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

and lit_cste = function
  | (Int n)::q -> true, q
  | (Float f)::q -> true, q
  | l -> false, 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: token list -> bool * token list) fichier =
  let canal = open_in fichier
  and raccourci s = list_of_stream (make_lexer ["+";"-";"*";"/";"(";")";"#"] (stream_of_string s))
  and ligne = ref [] and result = ref (true, []) and test = ref true
  in 
    while !test do
      (try ligne := raccourci ((input_line canal)^" #") with End_of_file -> test := false) ;
      if (!test) then
        begin
          result := an_syn !ligne ;
          print_string (string_of_toklist !ligne); print_newline();
          if (fst !result)
          then print_string "L'expression est correcte."
          else print_string ("L'expression est incorrecte à partir de "^(string_of_toklist (snd !result)));
          print_newline(); 
        end;
    done;
    close_in canal
;;

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