%{
(* parservhc.mly, Objective Caml version 3.08.1 *)
(* syntaxe avec verification des conditions de contexte,
   methode de la table des symboles *)

open Print
open Aintv

type contexte = Variable of (string * int) | Appel of (string * int * int)

exception Undefined_variable of (string * int)
exception Variable_in_body of (string * int)
exception Undefined_function of (string * int)
exception Function_call_mismatch of (string * int)
exception Double_fundef of (string * int)
exception Double_argdef of (string * int)

let filtrer_contexte_local vars liste =
let rec aux accu = function
| [] -> accu
| (Appel _ as a) :: q -> aux (a :: accu) q
| (Variable (v, pos)) :: q when List.mem (FPVAL v) vars -> aux accu q
| (Variable (v, pos)) :: _ -> raise (Undefined_variable (v, pos))
in aux [] liste

let rec verifier_contexte_global foncts = function
| [] -> ()
| (Variable v) :: _ -> raise (Variable_in_body v)
| (Appel (f, n, pos)) :: q ->
begin
 let rec mem2 = function
 | [] -> raise (Undefined_function (f, pos))
 | (g, (pf, _))::_ when f = g -> if n = List.length pf then () else raise (Function_call_mismatch (g, pos))
 | _::r -> mem2 r
 in mem2 foncts; verifier_contexte_global foncts q
end

let afficher_contexte _ = () (* List.iter (function
| Variable v -> print_string ("Variable " ^ v ^ "\n")
| Appel (f, n) -> print_string ("Appel " ^ f ^ ", "  ^ string_of_int n ^ " arg\n")
) *)
%}

%token T_LET T_EQ T_IN T_AND T_LESS T_ADD T_SUB T_MUL T_DIV T_NOT T_IF T_THEN T_ELSE T_FI T_TRUE T_FALSE
%token <string> INT
%token <string * int> IDENT
%token LPAR RPAR COMMA SEMICOLON DOUBLESEMICOLON
%start program
%type <Aintv.prog> program
%type <Aintv.prog> program_0
%type <Print.expr * contexte list> expr 
%type <Print.expr * contexte list> expr_1
%type <Print.expr * contexte list> expr_2
%type <Print.expr * contexte list> expr_3
%type <Print.expr * contexte list> expr_4
%type <Print.expr * contexte list> expr_5
%type <Print.expr * contexte list> atome
%type <Print.expr list * contexte list> liste_args
%type <Aintv.function_declaration_list * contexte list> affectations
%type <(Aintv.function_declaration * contexte list) * int> elem_aff
%type <fpar list> liste_vars

%%

/* R�gles de grammaireet actions sŽmantiques */
program:
        | program_0 DOUBLESEMICOLON { $1 }
;

program_0:
	| expr { [] , (afficher_contexte (snd $1); verifier_contexte_global [] (snd $1); fst $1) }
	| T_LET affectations T_IN expr { let (expr, vars1) = $4 and (foncts, vars0) = $2 in let vars = vars0 @ vars1 in afficher_contexte vars; verifier_contexte_global foncts vars; (foncts, expr)}
;

expr:
          expr_1 { $1 }
;

expr_1:
          expr_1 T_AND expr_2 {AND (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_2 { $1 }
;

expr_2:
          expr_2 T_LESS expr_3 { LESS (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_2 T_EQ expr_3 { EQUAL(fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_3 { $1 }
;

expr_3:
          expr_3 T_ADD expr_4 { ADD (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_3 T_SUB expr_4 { SUB (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_4 { $1 }
;

expr_4:	  
	  expr_4 T_MUL expr_5 {MULT (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_4 T_DIV expr_5 {DIV (fst $1, fst $3), snd $1 @ snd $3 }
	  | expr_5 { $1 }
;

expr_5:
	  atome { $1 }
;

atome:
	  LPAR expr RPAR { $2 }
	  | INT { CST $1, [] }
	  | T_SUB INT { CST ("-" ^ $2), [] }
	  | T_TRUE { CST "true", [] }
	  | T_FALSE { CST "false", [] }
	  | IDENT { VAR (fst $1), [Variable $1] }
	  | IDENT LPAR RPAR { CALL ((fst $1), []), [Appel (fst $1, 0, snd $1)] }
	  | IDENT LPAR liste_args RPAR { CALL (fst $1, fst $3), (Appel (fst $1, List.length (fst $3), snd $1) :: snd $3) }
          | T_NOT LPAR expr RPAR { NOT (fst $3), snd $3 }
	  | T_IF expr T_THEN expr T_ELSE expr T_FI {IF (fst $2, (fst $4, fst $6)), (snd $2 @ snd $4) @ snd $6 }
;

liste_args:
	   expr { [ fst $1 ], snd $1 }
	  | expr COMMA liste_args { (fst $1) :: (fst $3), snd $1 @ snd $3 }
;

affectations:
	   elem_aff { [ fst (fst $1) ], snd (fst $1) }
	  | elem_aff SEMICOLON { [ fst (fst $1) ], snd (fst $1) }
	  | elem_aff SEMICOLON affectations { let rec mem2 = function [] -> (fst (fst $1) :: fst $3, snd (fst $1) @ snd $3) | (a, _) :: _ when a = fst (fst (fst $1)) -> raise (Double_fundef (a, snd $1)) | _ :: q -> mem2 q in mem2 (fst $3)   }
;

elem_aff:
	  IDENT LPAR RPAR T_EQ expr { ((fst $1, ([], fst $5)), filtrer_contexte_local [] (snd $5)), snd $1 }
	  | IDENT LPAR liste_vars RPAR T_EQ expr { ((fst $1, ($3, fst $6)), filtrer_contexte_local $3 (snd $6) ), snd $1 }
;

liste_vars:
          IDENT { [FPVAL (fst $1)] }
	  | IDENT COMMA liste_vars { if List.mem (FPVAL (fst $1)) $3 then raise (Double_argdef $1) else ((FPVAL (fst $1)) :: $3) }
;

%%