Next: Chapitre 4 Up: Programmes en Caml Previous: Chapitre 2
Next: Chapitre 4
Up: Programmes en Caml
Previous: Chapitre 2
Remarque: nous suivons les signatures des procédures C. Les listes étant polymorphes et prédéfinies en Caml, on les utilise plus naturellement sans déclarer un type liste particulier. La manipulation des listes est facilitée en Caml par la gestion automatique de la mémoire: allocation et libération sont implicites. Enfin les listes prédéfinies ne sont pas mutables.
type element == int;;
type liste = Nil | Cons of cellule
and cellule =
{ mutable contenu : element;
mutable suivant : liste };;
(* {\em Ajouter, voir page \pageref{prog:ajouter-liste}} *)
let lajouter x ap =
ap := Cons {contenu = x; suivant = !ap};;
lajouter :
element -> liste ref -> unit = <fun>
(* {\em Recherche, voir page \pageref{prog:recherche-liste}} *)
let lrecherche x a =
let l = ref a in
let result = ref false in
while !l <> Nil do
match !l with
| Cons {contenu = y; suivant = s} ->
if x = y then result := true
else l := s
| _ -> ()
done;
!result;;
lrecherche : element -> liste -> bool = <fun>
(* {\em Longueur d'une liste, voir page \pageref{prog:longueur-liste-rec}} *)
let rec llongueur = function
| Nil -> 0
| Cons {suivant = reste; _} ->
1 + llongueur reste;;
(* {\em Longueur d'une liste, voir page \pageref{prog:longueur-liste}} *)
let llongueur a =
let r = ref 0
and accu = ref a in
while !accu <> Nil do
incr r;
match !l with
| Cons {suivant = reste; _} ->
accu := reste
| _ -> ()
done;
!r;;
(* {\em Supprimer, voir page \pageref{prog:supprimer-liste-recursif}} *)
let lsupprimer x ap =
let rec supprime precedente = function
| Nil -> ()
| Cons ({contenu = c; suivant = reste}
as cellule) ->
if c = x then precedente.suivant <- reste
else supprime cellule reste in
match !ap with
| Nil -> ()
| Cons ({contenu = c; suivant = reste}
as cellule) ->
if c = x then ap := reste
else supprime cellule reste;;
(* {\em Liste des nombres premiers, voir page \pageref{prog:liste-premiers}} *)
let liste_premier n =
let a = ref Nil in
for i = n downto 2 do lajouter i a done;
let k = ref 2 in
let b = ref !a in
while !k * !k <= n do
match !b with
| Nil -> failwith "liste_premier"
| Cons {contenu = c; suivant = s} ->
k := c;
for j = c to n / c do
lsupprimer (j * !k) a done;
b := s
done;
a;;
(* {\em Les files avec des vecteurs, voir page \pageref{prog:files-vect}} *)
let maxf = 100;;
type 'a file =
{ mutable debut: int;
mutable fin: int;
mutable pleine: bool;
mutable vide: bool;
contenu: 'a vect };;
let fairefvide () = {debut = 0; fin = 0;
pleine = false; vide = true;
contenu = make_vect maxf 0};;
let successeur x = (x + 1) mod maxf ;;
let fvide f = f.vide;;
let fpleine f = f.pleine;;
let fvaleur f = begin
if f.vide then failwith "Pile vide.";
f.contenu.(f.debut)
end;;
let fajouter x f = begin
if f.pleine then failwith "Pile pleine.";
f.contenu.(f.fin) <- x;
f.fin <- successeur (f.fin);
f.vide <- false;
f.pleine <- f.fin = f.debut;
end;;
let fsupprimer f = begin
if f.vide then failwith "File vide.";
f.debut <- successeur (f.debut);
f.vide <- f.fin = f.debut;
f.pleine <- false;
end;;
(* {\em Les files avec des listes, voir page \pageref{prog:files-listes}} *)
type 'a liste = Nil | Cons of 'a cellule
and 'a cellule =
{contenu: 'a; mutable suivant: 'a liste};;
type 'a file =
{ mutable debut: 'a cellule;
mutable fin: 'a cellule };;
let fairefvide f =
let b =
{contenu = f.debut.contenu;
suivant = Nil} in
f.debut <- b; f.fin <- f.debut;;
let successeur c = c.suivant;;
let fvide f = f.fin == f.debut;;
let fvaleur f =
match successeur f.debut with
| Nil -> failwith "Pile vide"
| Cons cell -> cell.contenu;;
let fajouter x f =
let b = {contenu = x; suivant = Nil} in
f.fin.suivant <- Cons b;
f.fin <- b;;
let fsupprimer f =
match successeur f.debut with
| Nil -> ()
| Cons cell -> f.debut <- cell;;
(* {\em Déclarations et opérations sur les piles,}
{\em voir page \pageref{prog:piles}} *)
type 'a pile =
{mutable hauteur: int;
mutable contenu: 'a vect};;
let fairepvide p = p.hauteur <- 0;;
let pvide p = p.hauteur = 0;;
let pajouter x p =
p.contenu.(p.hauteur) <- x;
p.hauteur <- p.hauteur + 1;;
let pvaleur p =
let i = p.hauteur - 1 in
p.contenu.(i);;
let psupprimer p = p.hauteur <- p.hauteur - 1;;
(* {\em Opérations sur les piles, version plus traditionelle} *)
type 'a pile == 'a list ref;;
let fairepvide () = ref [];;
let pvide p = (!p = []);;
let pajouter x p = p := x :: !p;;
let pvaleur p = match !p with
[] -> failwith "Pile Vide."
| x :: p' -> x;;
let psupprimer p = p := match !p with
[] -> failwith "Pile Vide."
| x :: p' -> p';;
(* Evaluation des expressions préfixées,
{\em voir page \pageref{prog:evaluation-prefixe}} *)
type expression == element vect
and element =
| Symbole of char
| Nombre of int;;
let calculer a x y =
match a with
| `+` -> x + y
| `*` -> x * y
| _ -> failwith "unknown operator";;
let rec inserer x p =
match x with
| Symbole c -> pajouter x p
| Nombre n ->
if pvide p then pajouter x p else
match pvaleur p with
| Symbole c as y -> pajouter x p
| Nombre m ->
psupprimer p;
match pvaleur p with
| Symbole c ->
psupprimer p;
let res = Nombre (calculer c n m) in
inserer res p
| _ -> failwith "pile mal construite";;
let evaluer u =
let p =
{hauteur = 0;
contenu = make_vect 100 (Nombre 0)} in
for i = 0 to vect_length u - 1 do
match u.(i) with
| Nombre _ | Symbole `+`
| Symbole `*` as x -> inserer x p
| _ -> ()
done;
match pvaleur p with
| Symbole c -> failwith "pile mal construite"
| Nombre n -> n;;
let pile_of_string s =
let u =
make_vect (string_length s) (Symbole ` `) in
let l = ref 0 in
for i = 0 to string_length s - 1 do
let element =
match s.[i] with
| `0` .. `9` as c ->
let n =
int_of_char c - int_of_char `0` in
begin match u.(!l) with
| Symbole c -> Nombre n
| Nombre m ->
decr l; Nombre (10 * m + n)
end
| c -> Symbole c in
incr l;
u.(!l) <- element
done;
sub_vect u 0 !l;;
evaluer
(pile_of_string
"(* (+ 10 (* 2 3)) (+ (* 10 10) (* 9 9)))");;
- : int = 1996
(* {\em Tail et cons, voir page \pageref{prog:tail}} *)
let tail = function
| Nil -> failwith "tail"
| Cons cell -> cell.contenu;;
let cons x l =
Cons {contenu = x; suivant = l};;
(* Append et nconc,
{\em voir page \pageref{prog:append}} *)
let rec append a b =
match a with
| Nil -> b
| Cons cell ->
cons (cell.contenu)
(append cell.suivant b);;
let nconc ap b =
match !ap with
| Nil -> ap := b
| _ ->
let c = ref !ap in
while
match !c with
| Cons {suivant = (Cons cell as l); _} ->
c := l; true
| _ -> false
do () done;
match !c with
| Cons cell -> cell.suivant <- b
| _ -> ();;
(* Plus conforme au style Caml:
on utilise une fonction récursive locale,
on fait l'opération physique sur la liste,
mais on rend un résultat *)
let rec nconc a b =
let rec nconc_aux c =
match c with
| Nil -> b
| Cons ({suivant = Nil; _} as cell) ->
cell.suivant <- b; a
| Cons {suivant = l; _} -> nconc_aux l in
nconc_aux a;;
(* Nreverse et reverse,
{\em voir page \pageref{prog:reverse}} *)
let nreverse ap =
let a = ref !ap in
let b = ref Nil in
let c = ref Nil in
while
match !a with
| Nil -> false
| Cons ({suivant = s; _} as cell) ->
c := s;
cell.suivant <- !b;
b := !a;
a := !c;
true
do () done;
ap := !b;;
(* Version plus habituelle:
on renverse la liste en place
et l'on rend la nouvelle tête de liste *)
let nreverse l =
let rec nreverse_aux a b =
match a with
| Nil -> b
| Cons ({suivant = s; _} as cell) ->
cell.suivant <- b;
nreverse_aux s a in
nreverse_aux l Nil;;
let rec reverse a =
match a with
| Nil -> a
| Cons cell ->
append (reverse cell.suivant)
(cons (cell.contenu) Nil);;
(* {\em Insert, voir page \pageref{prog:insert}} *)
let insert v l =
match l with
| Nil -> failwith "insert"
| Cons c ->
let rec insert_aux a =
match a with
| Nil -> failwith "insert"
| Cons cell ->
if v > cell.contenu && cell != c
then insert_aux cell.suivant
else cell.suivant <-
cons v cell.suivant in
insert_aux c.suivant;
c.contenu <- l.contenu + 1;;