(**************************************************)
(*                                                *)
(*                Projet de OCAML                 *)
(*               Christophe Devaux                *)
(*                Adrien Taieb                    *)
(*                                                *)
(**************************************************)

(**************************************************)
(*            début des définitions               *)
(**************************************************)

type pile_a = {
    mutable pointeur : int;
    mutable liste : int list;
  };;

type instr_asm =
   CONST of int | ADD | SUB | MUL | DIV | EQU | NEQ
 | ALLOC of int | FREE of int
 | LOAD of int | STORE of int | PUSH
 | JNZ | JMP of int
 | CALL of int | RET
 | STOP
;;

(*fin des définitions*)

(**************************************************)
(*        début des fonctions sur les piles       *)
(**************************************************)

let estVide p = (p.pointeur = -1);;

let empiler x p = ( p.pointeur <- (p.pointeur + 1) ; p.liste <- x::p.liste );;

let depiler p = p.pointeur <- (p.pointeur - 1) ; p.liste <- (List.tl p.liste);;

let taille p = p.pointeur+1 ;;

let afficher p=
  for i=0 to p.pointeur do print_int (List.nth p.liste i);
    print_newline()
    done;;

(*fin des fonctions sur les piles*)

(**************************************************)
(*             début des exceptions               *)
(**************************************************)

exception INSTRUCTION_NON_VALIDE ;;
exception PILE_VIDE ;;
exception PB_ARGS ;;
exception DIVISE_PAR_ZERO;;
(*fin des exceptions*)

(**************************************************)
(*           début des instructions               *)
(**************************************************)

let add p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a+b in (depiler p ; ( p.liste <- res::l ))
              |_ -> raise (PB_ARGS)
;;


let sub p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a-b in (depiler p ; ( p.liste <- res::l ))
              |_ -> raise (PB_ARGS)
;;


let mul p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> let res = a*b in (depiler p ; ( p.liste <- res::l ))
              |_ -> raise (PB_ARGS)
;;

let div p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if b != 0
                         then let res = a/b in (depiler p ; ( p.liste <- res::l ))
                         else raise (DIVISE_PAR_ZERO)
              |_ -> raise (PB_ARGS)
;;

let equ p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if a = b
                         then (depiler p ; p.liste <- 1::l)
                         else (depiler p ; p.liste <- 0::l)
              |_ -> raise (PB_ARGS)
;;

let neq p =
    if estVide p
    then raise (PILE_VIDE)
    else
         if (taille p = 1)
         then raise (PB_ARGS)
         else match p.liste with
              a::b::l -> if a <> b
                         then (depiler p ; p.liste <- 1::l)
                         else (depiler p ; p.liste <- 0::l)
              |_ -> raise (PB_ARGS)
;;

let executer instr p =
    match instr with
          CONST a -> empiler a p
          | ADD -> add p
          | SUB -> sub p
          | MUL -> mul p
          | DIV -> div p
          | EQU -> equ p
          | NEQ -> neq p
          |_ -> raise (INSTRUCTION_NON_VALIDE)
;;

(*fin des instructions*)

(**************************************************)
(*                    les tests                   *)
(**************************************************)

let x = 7;;
let l = [];;
let p = { pointeur = (List.length l)-1 ; liste = l } ;;

executer (CONST 3) p;;
executer (CONST 2) p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\ntaille\n" ;;
print_int (taille p);;

print_string "\naddition\n" ;;
executer ADD p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\non empile 6\n" ;;
executer (CONST 6) p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\nequ\n" ;;
executer EQU p;;

print_string "\naffichage\n" ;;
afficher p;;

print_string "\non empile 7\n" ;;
executer (CONST 7) p;;

print_string "\ndivision\n" ;;
executer DIV p;;

print_string "\naffichage\n" ;;
afficher p;;