#open "aintv";;
#open "print";;
#open "ci";;

let rec numero a = function
	    [] -> raise Compilation_Necessite
	  | t::q when t=a -> 1
	  | t::q (*t<>a*) -> 1+(numero a q);;

let produit_code n lfonc lpar e =
  let rec produit i = function
    | CST "true" -> ([Valeur 1;EmpilerSuiv],i+2)
    | CST "false" -> ([Valeur 0;EmpilerSuiv],i+2)
    | CST n ->
	(try ([Valeur (int_of_string n);EmpilerSuiv],i+2)
	with Failure "int_of_string" -> raise Production_code)
    | VAR x ->
	([Charger;Add;Valeur (numero (FPVAL x) lpar);EmpilerSuiv;EmpilerLD],i+5)
    | ADD (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Add::(p2@p1),i2+1)
    | SUB (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Sub::(p2@p1),i2+1)
    | MULT (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Mult::(p2@p1),i2+1)
    | DIV (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Div::(p2@p1),i2+1)
    | LESS (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Ifless::(p2@p1),i2+1)
    | EQUAL (e1,e2) ->
	let (p1,i1)=produit i e1 in
	let (p2,i2)=produit i1 e2 in
	(Ifeq::(p2@p1),i2+1)
    | NOT e ->
	produit i (SUB (CST "1",e))
    | AND (e1,e2) ->
	produit i (MULT (e1,e2))
    | IF (t,(v,f)) -> 
	let (p0,i0)=produit i t in
	let (p1,i1)=produit (i0+3) v in
	let (p2,i2)=produit (i1+3) f in
	(p2@[Goto;Valeur i2;EmpilerSuiv]@p1@[BrZero;Valeur (i1+3);EmpilerSuiv]@p0,i2)
    | CALL (f,l) ->
	let rec empile_arg n = function
	  | [] -> ([],n)
	  | t::q ->
	      let (c1,n1)=produit n t in
	      let (c2,n2)=empile_arg n1 q in
	      (c2@c1,n2)
	in
	let (c_arg,n')=empile_arg (i+3) l in
	let code_appel_fonction=[Goto;EmpilerCode;Valeur (numero f lfonc+1);EmpilerSuiv;DepilerLD;Sub;Valeur (list_length l);EmpilerSuiv;EmpilerSP]@c_arg@[EmpilerLD;Valeur (9+n');EmpilerSuiv] in
	let code_retour_fonction=[DepilerLD;DepilerSP;EmpilerLD;Ranger;Sub;Valeur 1;EmpilerSuiv;EmpilerLD] in
	(code_retour_fonction@code_appel_fonction,n'+17)
  in
  let (code,k)=produit n e in
  (rev code,k);;

let (produit_code_programme:prog->TypeInstruction vect) =
  let produit_code_fonction i lfonc = function (f,(lpar,e)) ->
    let (code,n)=produit_code i lfonc lpar e in
    (code@[EmpilerLD;EmpilerSuiv;Valeur 1;Sub;Charger;Goto],n+6)
  in let rec produit_code_liste_fonctions i lfonc = function
      [] -> ([],i,[])
    | t::q -> 
	let (code1,i')=produit_code_fonction i lfonc t in
	let (code2,i'',lcodefonc)=produit_code_liste_fonctions i' lfonc q in
	(code1@code2,i'',i::lcodefonc)
  in function (lfonctions,e) ->
  let lfonc=map fst lfonctions in
  let nbfonc=list_length lfonc in
  let (codefonc,i,lcodefonc)=produit_code_liste_fonctions (nbfonc+2) lfonc lfonctions in
  let v=vect_of_list ([Valeur i;Goto]@(list_of_vect (make_vect nbfonc (Valeur 0)))@codefonc@(fst (produit_code i lfonc [] e))@[Stop;Fin]) in
  let rec modifie_tableau k = function
    | [] -> ()
    | t::q -> v.(k)<-Valeur t;modifie_tableau (k+1) q
  in modifie_tableau 2 lcodefonc;
  v;;