(* I Implémentation des listes *)
type 'a liste = Vide | Corps of 'a * 'a liste ;;

let new_liste (() : unit) : 'a liste = Vide ;;

exception ListeVide ;;

let tete (l : 'a liste) : 'a =
  match l with
  | Vide -> raise ListeVide
  | Corps(t, _) -> t ;;

let cons (e : 'a) (l : 'a liste) : 'a liste =
Corps(e,l) ;; 

let queue (l : 'a liste) : 'a liste  =
  match l with
  | Vide -> raise ListeVide
  | Corps(_,q) -> q ;;

let test = new_liste () ;; 
let test2 = cons 4 test ;;
let test3 = cons 5 test2 ;;
tete test3 ;;
tete test2 ;;
queue test3 ;;
queue test2 ;;
queue test ;;
let test4 = new_liste () ;; 
let test4 = cons (-1) test4 ;;
let test4 = cons (-3) test4 ;;

let rec append (l1 : 'a liste) (l2 : 'a liste) : 'a liste =
 match l1 with
 | Vide -> l2
 | Corps(t,q) -> Corps(t,(append q l2)) ;;
 
 test3;;
append test3 test4 ;;

(* II pile persistante à l'aide d'une liste *)
exception PileVide ;;
type 'a pile = 'a list ;;
let is_empty (p : 'a pile) : bool = p = [] ;;
let create (() : unit) : 'a pile = [] ;;
let push (e : 'a) (p : 'a pile) : 'a pile = e :: p ;;
let pop (p : 'a pile) : 'a * 'a pile =
  if is_empty p
  then raise PileVide
  else (List.hd p, List.tl p) ;;
let top (p : 'a pile) : 'a = List.hd p ;;

let pile = create () ;;
push 3 pile ;;
pile ;;
let pile = push 3 pile ;;
pile ;;
let pile = push 5 pile ;;
pile ;;
pop pile ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
       
(* III pile persistante avec type somme et définition récursive *)
type 'a pile = PileVide | Pile of 'a * 'a pile ;;
let is_empty (p : 'a pile) : bool = p = PileVide ;;
let create (() : unit) : 'a pile = PileVide ;;
let push (e : 'a) (p : 'a pile) : 'a pile = Pile(e, p) ;;
let pop (p : 'a pile) : 'a * 'a pile = if p = PileVide then raise PileVide
                                       else let Pile (e, q) = p in (e, q) ;;
  
(* Ou alors avec pattern matching pour qu'il n'y ait pas de Warning *)
let pop (p : 'a pile) : 'a * 'a pile =
  match p with
    | PileVide -> raise PileVide
    | Pile (e, q) -> (e, q) ;;

let pile = create () ;;
push 3 pile ;;
pile ;;
let pile = push 3 pile ;;
pile ;;
let pile = push 5 pile ;;
pile ;;
pop pile ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
let pile = snd (pop pile) ;;
pile ;;
  
(* IV pile impérative avec un tableau *)
type 'a pile = {mutable n : int; content : 'a array } ;;
(* n est l'indice de la case correspondant au sommet de la pile *)
exception PilePleine ;;
            
let is_empty (p : 'a pile) : bool = p.n = - 1 ;;
let create (taille : int) (e : 'a) : 'a pile = {n = -1; content = Array.make taille e } ;;
let push (e : 'a) (p : 'a pile) : unit = if p.n = Array.length p.content - 1
                                         then raise PilePleine
                                         else (p.n <- p.n + 1; p.content.(p.n) <- e) ;;

let pop (p : 'a pile) : 'a  = if p.n = - 1 then raise PileVide
                              else (p.n <- p.n - 1; p.content.(p.n + 1));;

(* V Implémentation d'une file persistante à l'aide de deux listes *)
type 'a file = {tete : 'a list; queue : 'a list} ;;
exception FileVide ;;
let new_file (() : unit) : 'a file = {tete = []; queue = []} ;;
let file1 = new_file () ;;
let add (e : 'a) (file : 'a file) : 'a file = {tete = file.tete; queue = e :: file.queue} ;;

let file1 = add 4 file1 ;;
file1 ;;
let file1 = add 5 file1 ;;

let is_empty (file : ' a file) : bool = file.tete = [] && file.queue = [] ;;
  
is_empty file1 ;;

let peek (file : 'a file) : 'a =
  if file.tete <> [] then List.hd file.tete
  else if file.queue = [] then raise FileVide
  else  List.hd (List.rev file.queue) ;;

file1 ;;
peek file1 ;;
file1 ;;
(* Problème si la liste de tête est vide il sera coûteux d'appeler peek... On propose une solution, qui a pour conséquence de modifier le type de la fonction, en rendant la pile sur laquelle on a fait l'appel peek ! *)
let peek (file : 'a file) : 'a * 'a file =
  if file.tete <> [] then (List.hd file.tete, file)
  else if file.queue = [] then raise FileVide
  else let filerep = {tete = List.rev file.queue; queue = []} in
       (List.hd filerep.tete, filerep ) ;;
        
file1 ;;
let file1 = snd (peek file1) ;;
file1 ;;

let take file =
  if file.tete <> [] then List.hd file.tete , {tete = List.tl file.tete; queue = file.queue}
  else if file.queue = [] then raise FileVide
  else let tete = List.rev file.queue in
       List.hd tete, {tete = List.tl tete; queue = []} ;;


file1 ;;
let file1 = snd (take file1) ;;
file1 ;;
let file1 = add 7 file1 ;;
file1 ;;
let file1 = snd (take file1) ;;
file1 ;;
let file1 = add 9 file1 ;;
file1 ;;
let file1 = add 11 file1 ;;
file1 ;;
let file1 = snd (take file1) ;;
file1 ;;


(* VI file impérative à l'aide d'un tableau (dit circulaire) *)
exception FileVide ;;
exception FilePleine ;;
type 'a file = {taille : int ;
                tab : 'a array ;
                mutable tete : int ;
                mutable queue : int } ;;

let create (n : int) (e : 'a) : 'a file =
  {taille = n; tab = Array.make n e; tete = 0; queue = 0} ;;

let is_empty (f : 'a file) : bool =
  f.tete = f.queue ;;

let add (e : 'a) (f : 'a file) : unit =
  if f.queue - f.tete = f.taille
  then raise FilePleine
  else (f.tab.(f.queue mod f.taille) <- e ;
        f.queue <- f.queue + 1) ;;

let peek (f : 'a file) : 'a =    
  if is_empty f then raise FileVide
  else f.tab.(f.tete mod f.taille) ;;
        
let take (f : 'a file) : 'a =
  if is_empty f then raise FileVide
  else (f.tete <- f.tete + 1 ;
        f.tab.(f.tete - 1 mod f.taille)) ;;

let mafile = create 5 0. ;; (* On teste avec une file de flotttans *)
peek mafile ;;
add 5. mafile ;;
mafile ;;
add 3. mafile ;;
add 1. mafile ;;
peek mafile ;;
mafile ;;
add (-1.) mafile ;;
add 2. mafile ;;
add 4. mafile ;;
mafile ;;
add 6. mafile ;;
take mafile ;;
mafile ;;
add 6. mafile ;;
add 8. mafile ;;
mafile ;;