(* Cours numero 4: les aspets imperatifs et le systeme de modules*)

(* les exceptions *)

(* un type somme ouvert *)

exception Liste_zero;;

let multlist_eff l = 
  let rec aux = function [] -> 1
                |    (a::r) -> if a=0 then raise Liste_zero
                                      else a*(aux r)
  in try aux l with Liste_zero -> 0;;

(* vecteurs *)

let v = [|"a"|];;

(* acces de 0 a n-1 *)

v.(0);;

(* affectation *)

v.(0)<- "aa";;

v.(0);;

(* enregistrements avec champs modifiables *)

type point = {mutable x:int};;

let movepoint p dx = p.x<-p.x+dx;;

(* les cases memoire *)

type 'a ref = {mutable info: 'a};;

let refval {info=v} = v;;
let setref v r = r.info<-v;;

(* ce type predefini pour comodite, avec !r pour refval r et r:=v pour setref v r *)

(* un neud d'une liste avec "pointeurs" explicites *)

type 'a cell = {info: 'a; mutable next: 'a cell};;

(* exemple: liste circulaires *)

(* on utilise les noeuds ... *)

let make_cl v = let rec c = {info=v;next=c} 
                in c;;

let hd {info=v;next=l} = l.info;;

let tl {next=rest} = rest;;

let insert_hd v cl = let el = {info=v;next=cl.next}
                     in cl.next<-el; cl;;

let insert_tl v cl = let el = {info=v;next=cl.next}
                     in cl.next<-el; el;;

let remove_hd cl = cl.next<- cl.next.next; cl;;

(* mais cela ne marche que sur le liste non vides: *)

(* on va faire mieux ... *)

type 'a circ_list = Nil | List of 'a cell;;

(* il nous faut traiter les cas exceptionnels: *)

(* on definit des exceptions aussi *)

let insert_head v = function Nil -> List (make_cl v)
                    | (List cl)  -> List (insert_hd v cl);;

let insert_tail v = function Nil -> List (make_cl v)
                    | List cl    -> List (insert_tl v cl);;

exception Remove_Empty_cl;;

let remove_head   = function Nil -> raise Remove_Empty_cl
                    | List cl    -> let v =hd cl
                                    in let l= if cl.next==cl.next.next then Nil
                                              else List (remove_hd cl)
                                       in (v,l);;

(* cela est suffisant pour definir un type de donnee pile avec *)

(* insertion et suppression en temps constant *)

(* Les Modules *)

(* terminologie de l'algebre: les modules sont comme des algebres: *)

(* ils ont une sig(nature), sont des struc(tures), et on les transforme *)

(* avec des foncteurs *)

module type File = 
sig
  exception FileVide
  type 'a file
  val mkempty: unit -> 'a file
  val enqueue: 'a -> 'a file -> 'a file
  val dequeue: 'a file -> 'a * 'a file
  val isempty: 'a file -> bool
end;;

module FileCLPasProtege = 
struct
type 'a cell = {info: 'a; mutable next: 'a cell}
let make_cl v = let rec c = {info=v;next=c} in c

let hd {info=v;next=l} = l.info

let insert_tl v cl = let el = {info=v;next=cl.next}
                     in cl.next<-el; el

let remove_hd cl = cl.next<- cl.next.next; cl

type 'a circ_list = Nil | List of 'a cell

let insert_tail v = function Nil -> List (make_cl v)
                    | List cl    -> List (insert_tl v cl)

exception Remove_Empty_cl

let remove_head   = function Nil -> raise Remove_Empty_cl
                    | List cl    -> let v =hd cl
                                    in let l= if cl.next==cl.next.next then Nil
                                              else List (remove_hd cl)
                                       in (v,l)

(* attention aux pieges avec les effets de bord: si on ecrit *)

(* (hd cl, if .. then .. else ... remove_hd cl ..) *)

(* il peut arriver que remove_hd soit execute avant hd!!! *)

  exception FileVide
  type 'a file = 'a circ_list
  let mkempty () = Nil
  let enqueue v l = insert_tail v l
  let dequeue l = try remove_head l with Remove_Empty_cl -> raise FileVide
  let isempty = function Nil -> true | _ -> false
end;;

(* si on veut faire propre, on peut restraindre la signature *)

module FileCL = (FileCLPasProtege : File);;

FileCL.enqueue;;

(* Une autre structure de file: meme cout amortit, mais fonctionnelle *)

module FileDL : File =
struct
  type 'a file = 'a list * 'a list
  exception FileVide
  let mkempty () = [],[]
  let enqueue v (l1,l2) = (l1,v::l2)
  let dequeue = function (a::r,l)   -> a,(r,l)
                |        ([], [])   -> raise FileVide
                |        ([], l)    -> let (a::l') = List.rev l in (a,(l',[]))
  let isempty = function ([],[]) -> true
                |           _    -> false
end;;

type 'a arbre = Empty | Node of 'a arbre * 'a * 'a arbre

module ParcLarg =
  functor (F:File) ->
  struct
    let rec bf f p = if F.isempty f then List.rev p
                     else let (a,f') = F.dequeue f 
                          in match a with
                               Empty       -> bf f' p
                             | Node(g,v,d) -> bf (F.enqueue d (F.enqueue g f')) (v::p)
    let parclarg a = bf (F.enqueue a (F.mkempty())) []
  end;;

let b=
  Node
   (Node (Node (Empty, 4, Empty), 2, Node (Empty, 5, Empty)), 1,
    Node (Node (Empty, 6, Empty), 3, Node (Empty, 7, Empty)));;

(* et maintenant, testons le tout! *)

module PCL = ParcLarg(FileCL);;
 PCL.parclarg b;;
module PDL = ParcLarg(FileDL);;
 PDL.parclarg b;;