let pr s = print_string s; print_string "\n";;

pr "Programme de test du compilateur ML";
pr "Alain FRISCH.  Debut du projet : decembre 1998";
pr "";;

(* Tests du typage *)

let curry f x y = f(x,y);;
let decurry f c = f (fst c) (snd c);;
let rec fact x = if x=0 then 1 else x*(fact (x-1));;

let liste = ref [];;


(* Manipulations de listes *)

let rec it_list f x l = if l=[] then x else it_list f (f x (hd l)) (tl l);;
let rec map f l = if l=[] then [] else (f (hd l)) :: (map f (tl l));;
let rev l = it_list (fun accu x -> x::accu) [] l;;

let build_list f deb fin =
 let rec phi fin l =
  if deb>fin then l else phi (fin-1) ((f fin)::l)
 in
 phi fin [];;

let list_length l =
  let rec aux l n = if l=[] then n else aux (tl l) (n+1)
  in aux l 0;;

let rec do_list f l =
  if l=[] then () else
  (
   f (hd l);
   do_list f (tl l)
  );;

let print_int_list l =
  print_string "[";
  do_list print_int l ;
  print_string "]";;

pr "I. Manipulations de listes";
let l=[10;20;30]
and aff s l = print_string s; print_int_list l; pr ""
in
 aff "Voici une liste :" l;
 aff "A l'envers :" (rev l);
 aff "Le carre :" (map (fun x->x*x) l);
 print_string "Somme :"; print_int (it_list (fun s x -> s+x) 0 l); pr "";;
pr "";;


let fibo n =
        let rec itere n f x = if n=0 then x else itere (n-1) f (f x)
        in
        itere n (fun l-> (hd l + (hd (tl l)))::l) [1;0];;


pr "II. Fibonnacci";;
print_int_list (rev (fibo 10)); pr "";;
pr "";;

(* CRIBLE DE RECHERCHE DES NOMBRES PREMIERS *)

(* supprimer les multiples de n dans une liste *)

let rec supprime liste n =
 if liste=[] then []
 else let t=hd liste in
 if ((t/n)*n)=t then supprime (tl liste) n
 else t::(supprime (tl liste) n);;

let build_seq  = build_list (fun x -> x);;

let crible n =
let rec crible liste =
 if liste=[] then [] else
 let t=hd liste in
 t::(crible (supprime liste t))
in
 let entiers=build_seq 2 500 in
 crible (build_seq 2 n);;


pr "III. Les nombres premier (crible)";
print_int_list (crible 100); pr "";;
pr "";;

(* Suite de Syracuse *)

let rec syrac x l =
        let l = x::l in
        if x=1 then l else
        if ((x/2)*2)=x then syrac (x/2) l else syrac (3*x+1) l;;


let list_max l =
  let rec aux l n = if l=[] then n else if (hd l)>n then aux (tl l ) (hd l) else aux (tl l) n
  in aux (tl l) (hd l);;


(* Tri fusion *)

let rec tri_fusion ordre liste =
  let rec fusion l1 l2 =
    if l1=[] then l2 else
    if l2=[] then l1 else
    if (ordre (hd l1) (hd l2)) then (hd l1)::(fusion (tl l1) l2)
    else (hd l2)::(fusion l1 (tl l2))
  in
  let rec decoupe l dec =
   if l=[] then dec else
   let tete=hd l and queue=tl l in
   decoupe queue (tete::(snd dec),fst dec)
  in
  if liste=[] then liste
  else if (tl liste)=[] then liste
  else
    let dec=decoupe liste ([],[]) in
    let a=tri_fusion ordre (fst dec)
    and b=tri_fusion ordre (snd dec)
    in
      fusion a b;;


pr "IV. Tri fusion";;

let l = syrac 71 [];;
print_string "Une suite de Syracuse :"; print_int_list l; pr "";;
print_string "Triée :"; print_int_list (tri_fusion (fun x y -> x>y) l);
pr "";;
pr "";;

pr "V. References et encapsulation";;

let l = ref [];;
let ajoute x = l:=x::!l;;

ajoute 5;;
ajoute 10;;
ajoute 15;;
print_int_list !l; pr"";;


let compteur init =
 let n=ref init in
 let add k = n:=!n+k
 and reinit x = n:=init
 and get x = !n
 in (add,(reinit,get));;
let add c=fst c
and reinit c=(fst (snd c)) ()
and get c=(snd (snd c)) ();;


let c1=compteur 10
and c2=compteur 20
in
 add c1 5;
 add c2 6;
 reinit c1;
 print_int (get c1);
 print_int (get c2);;


pr "VI. Types somme, arbres, listes bouclées";;



type ('a,'b) Arbre =
  Feuille of 'b
| Noeud of (('a,'b) Arbre*('a,'b) Arbre)*'a;;


Feuille;;
Feuille 1;;
Feuille true;;
Noeud;;

let xfeuille = Feuille;;


let rec fff y =
match y with
 | Feuille x -> Feuille (x+1) 
 | Noeud y -> Noeud ((fff (fst (fst y)), fff (snd (fst y))),(snd y))
;;


(* parcours infixe d'un arbre *)
let infixe fn ff = 
let rec aux a = match a with 
| Feuille x -> ff x
| Noeud y -> aux (fst (fst y)); fn (snd y); aux (snd (fst y))
in aux;;

let aff_arbre = infixe (fun x -> print_string x; print_string " ") print_int;;

pr "Arbres:";;

let ar1 = Noeud ((Feuille 10, Feuille 20),"A");;
let ar2 = Noeud ((ar1, ar1), "B");;

aff_arbre ar2;;

pr "";;

type Alt = A of int | B of string | C | D | E;;


let aff x = match x with
| A n -> print_int n; print_string "\n"
| B s -> print_string s; print_string "\n"
| C -> print_string "C\n"
| x -> pr "?"
;;


pr "Affichages divers:";
aff (A 6);
aff C;
aff D;
aff (B "Hello world !!");;


let arbre = (Feuille (A 10));;
let arbre= Noeud ((Feuille (B "Alain"), Feuille (B "Frisch")), "*");;


infixe;;
infixe pr aff arbre;; 



type 'a Option = None | Some of 'a;;


fun x -> match x with Some x -> x+1;;


let do f x = match x with
| Some x -> f x
| None -> ();;

do print_string;;
do print_string (Some "XYZ");;
do print_string None;;

type 'a Liste = Nil | Cell of ('a*(('a Liste) ref));;

let boucler liste =
 let rec aux l = match l with
 | Nil -> ()
 | Cell c -> let t=snd c in 
   if !t=Nil then t:=liste else aux (!t)
 in aux liste;;

let rec decompter liste n = match liste with
 | Nil -> n
 | Cell c -> 
	print_int (fst c);
	if n=0 then 0 else decompter !(snd c) (n-1);;
    
 
let liste = Cell (10, ref (Cell (20, ref Nil)));; 

pr "Avant bouclage :";  (decompter liste 10); pr "";;
boucler liste;;
pr "Après bouclage :";  (decompter liste 10); pr "";;