Programmation Avancée

TP2: Objets

Exercice 1: laison tardive et mémoisation

Une fonction récursive phi : i -> o peut être donnée par le biais d'une fonction d'ordre supérieur f_phi : (i -> o) -> (i -> o) dont le premier argument donne la fonction à appeler pour les appels récursifs. Par exemple, avec la factorielle: 

let rec fact x = if x = 0 then 1 else x * fact (x-1)
let f_fact fact x = if x = 0 then 1 else x * fact (x-1)

On dit parfois qu'on a "ouvert" la récursion en passant ainsi de fact à f_fact. Pour "refermer" f_fact sur elle-même, on définit un combinateur de point fixe: 

let rec make_rec f_phi x = f_phi (make_rec f_phi) x
let fact' = make_rec f_fact
let () =
  (* Test: fact et fact' coincident sur 1, 2, 3, 4. *)
  assert (List.fold_left (fun b i -> b && fact i = fact' i) true [1;2;3;4])

On a ainsi défini fact', équivalente à fact, comme (le plus petit) point fixe de f_fact.

Un intérêt pratique de cette technique est qu'on peut utiliser d'autres combinateurs de point fixe que make_rec. Par exemple, voici un combinateur qui mémoise automatiquement la fonction récursive, permettant de faire de la programmation dynamique de façon implicite et générique: 

let make_rec_memo f_f =
  let table = Hashtbl.create 23 in
  let rec f x =
    try Hashtbl.find table x with
      | Not_found ->
          let r = f_f f x in
            Hashtbl.add table x r ;
            r
  in f

let fact'' = make_rec_memo f_fact
let () =
  (* Test: fact' et fact'' coincident sur 1, 2, 3, 4. *)
  assert (List.fold_left (fun b i -> b && fact' i = fact'' i) true [1;2;3;4])

Pour pouvoir appliquer cette technique il faut que la fonction récursive ait été préparée a priori, donnée sous sa forme ouverte. Nous allons faire la même chose en style objet, et utiliser la liaison dynamique des invocations de méthodes pour dérouter un calcul récursif qui n'est a priori pas prévu pour.

Question 1

Ecrire une classe fibo équipée d'une méthode compute : int -> int qui calcule la fonction de Fibonacci de façon naïve, en faisant des appels récursifs à la méthode compute. Afficher un message à chaque invocation de la méthode, de façon à expliciter, par exemple, que le calcul o#compute 4 nécessite 9 invocations de la méthode compute.

Question 2

Nous allons maintenant réaliser de façon générique un mécanisme de mémoisation pour les classes équipées de la méthode compute, comme la classe fibo de la question précédente. On se donne la signature suivante, pour parler d'une classe quelconque ayant le type qui nous intéresse: 

module type T = sig
  class c : object
    method compute : int -> int
  end
end

Implémenter Memo de type functor (M:T) -> T qui prend une classe M.c et renvoie un nouveau module dont la classe c fait le même calcul que M.c mais de façon mémoisée. On vérifiera que, sur l'exemple de fibo, o#compute n nécessitera (au plus) n+1 invocations de la méthode compute.

Note: La généricité de cette solution reste critiquable puisqu'on a dû annoncer d'entrée de jeu le type complet de la classe c attendue. On ne peut pas utiliser le foncteur obtenu ici pour une classe implémentant d'autres méthodes (publiques) que compute : int -> int. L'exercice reste de toute façon théorique et vise surtout à insister sur les surprises que peut causer la liaison dynamique/tardive des méthodes.

Exercice 2: sous-typage et sous-répertoires

Grâce au sous-typage, il est facile de construire une collection d'objets qui n'ont pas forcément le même type: 

let p = object method pos = (0.,0.) end
let pc = object method pos = (1.,2.) method color = "red" end
let l = [ p ; (pc :> <pos:float*float>) ]

Noter que la coercion est nécessaire ici pour que le typeur accepte la définition de l.

Dans l'exemle précédent, on a perdu de l'information sur l'élément pc dans la liste: on ne peut plus appeler la méthode color sur le second élément de l. Dans cet exercice, nous allons concevoir un type de collection qui permette de garder une information de typage précise pour un sous-ensemble des objets.

Question 1

Implémenter une class ['a,'b] directory, où le paramètre 'a représente le type des objets contenus dans le répertoire et 'b est le type des sous-répertoires, disposant des méthodes suivantes: directory#add_item label item ajoute un élément au répertoire, associé à une certaine étiquette; directory#add_directory label dir ajoute de même un sous-répertoire au répertoire; iter f itère f sur tous les éléments du répertoire et de ses sous-répertoires.

Si l'on utilise des variables d'instance (val mutable toto = ...) on ne s'étonnera pas d'avoir à spécifier leur type: les seules variables de type autorisées ici sont 'a et 'b, et l'inférence de type seule ne parvient pas à un type assez spécifié pour satisfaire cette contrainte.

La classe obtenue devrait avoir un type compatible avec le suivant: 

class ['a,'b] directory : object
  constraint 'b = < iter : ('a -> unit) -> unit; .. >
  method add_item : string -> 'a -> unit
  method add_directory : string -> 'b -> unit
  method iter : ('a -> unit) -> unit
end

On notera notamment la contrainte sur 'b, qui s'explique par le fait que l'itération sur tous les éléments doit aussi itérer sur les éléments des sous-répertoires.

Question 2

On voudrait convaincre OCaml que le code suivant est valide: 

type p = <pos:float*float>
type pc = <pos:float*float;color:string>
let d = new directory
let d' = new directory
let () =
  d#add_item "O" (object method pos = 0.,0. end) ;
  d'#add_item "O_red" (object method pos = 0.,0. method color = "red" end) ;
  (* !! La ligne problématique !! *)
  d#add_directory "pc" d'

En l'état, il ne type pas. Ajouter des définitions de type, des annotations et coercions au fragment de code ci-dessus pour le faire accepter par le compilateur. Pour les coercions "techniques, on n'hésitera pas à utiliser la syntaxe (v : t :> t') indiquant le type de v ainsi que le supertype t' vers lequel on coerce. Pour vous aider, réfléchissez aux questions suivantes:

Question 3

On veut maintenant pouvoir afficher nos répertoires, dès lors qu'ils contiennent des éléments de type 'a qui soit un sous-type de <to_string:string>.

Comme plusieurs formats d'affichage sont possibles, on pourrait définir plusieurs classes html_printable_directory, ascii_printable_directory, etc. Mais cette solution ne permet pas d'afficher un même répertoire de deux façons différentes en fonction des circonstances. Une autre solution est d'encapsuler les méthodes d'affichage dans une classe pretty_printer et d'implémenter dans la classe printable_directory la structure générale de l'affichage, en appelant les méthodes d'un pretty_printer pour réaliser les détails de l'opération.

Plus précisemment, l'afficheur offrira une méthode paragraph pour afficher un bout de texte (on l'utilisera pour afficher les éléments des répertoires) ainsi que des méthodes open_section et close_section pour structurer l'affichage en sections, sous-sections, etc. ce qui sera utilisé pour afficher les sous-répertoires.

On étendra ensuite la classe directory en une classe printable_directory offrant une méthode print. Celle-ci reçoit un pretty-printer et l'utilise pour afficher le contenu du répertoire.

Implémenter cette extension, suivant la signature ci-dessous: 

class type pretty_printer = object
  method open_section : string -> unit
  method close_section : unit
  method paragraph : string -> unit
end

(** ASCII pretty printer *)
class terminal_pp : pretty_printer

class ['a,'b] printable_directory : object
  constraint 'a = < to_string : string; .. >
  constraint 'b =
    < iter : ('a -> unit) -> unit; print : pretty_printer -> 'c; .. >
  inherit ['a,'b] directory
  method print : pretty_printer -> unit
end

Question 4

Pour finir nous utilisons nos classes sur un exemple jouet représentant le catalogue d'un magasin de disques et d'autres trucs.

Créer deux répertoires: un pour les produits génériques, et un sous-répertoire pour les disques. Créer les classes produit et disque tel qu'indiqué ci-dessous, en utilisant un initializer pour que chaque nouvelle instance de ces classes soit ajoutée au répertoire correspondant: 

(** Arguments: titre, genre, prix *)
class produit : string -> string -> int ->
  object
    method genre : string
    method prix : int
    method titre : string
    method to_string : string
  end

(** Arguments: titre, artiste, prix *)
class disque : string -> string -> int ->
  object
    method artiste : string
    method genre : string (* toujours "disque" *)
    method prix : int
    method titre : string
    method to_string : string
  end

On pourra alors exécuter le code suivant, qui crée quelques objets, affiche l'inventaire, et fait des recherches plus ou moins spécifiques: 

let () =
  ignore (new produit "Truc Tour" "place de concert" 42) ;
  ignore (new produit "Bob Marley" "poster" 5) ;
  ignore (new disque "Fashion Nugget" "Cake" 12) ;
  ignore (new disque "At the Pershing" "Ahmad Jamal" 19) ;
  ignore (new disque "Chamboultou" "Têtes Raides" 9)

let () =
  let pp = new terminal_pp in
    pp#open_section "Produits" ;
    produits#print pp ;
    pp#close_section

let () =
  Printf.printf "\nProduits à moins de 10 euros:\n" ;
  produits#iter
    (fun p ->
       if p#prix < 10 then Printf.printf "%s: %s\n" p#titre p#to_string) ;
  Printf.printf "\nDisques de Cake:\n" ;
  disques#iter
    (fun p ->
       if p#artiste = "Cake" then Printf.printf "%s: %s\n" p#titre p#to_string)

Pro tip: Il faut se méfier des tables recensant tous les objets créés, car elles empêchent le garbage collector de faire son travail... à moins d'utiliser une structure de données idoine, à pointeurs faibles (cf. module Weak).