OCaml de pied en cap

Un article de Cacophrene    4 Commentaires

Bonjour !

Ce petit billet s’intercale insidieusement dans la série de billets consacrés à LablGTK suite à la demande d’un ami. Il s’agit de présenter une alternative au mot-clef lazy d’OCaml. Façon de dire : « alternative » est ici un bien grand mot. Nous allons juste survoler la question et voir qu’il est possible de simuler facilement un type de données paresseux avec des ingrédients classiques de la programmation fonctionnelle.

Principe

On veut simuler le comportement du module Lazy d’OCaml en n’utilisant que des traits classiques d’OCaml (c’est-à-dire sans faire appel à la magie noire). En particulier, on voudrait écrire une fonction force qui se comporte (presque) comme Lazy.force. En d’autres termes, forcer une suspension qui déclenche l’exception X la déclenche à chaque nouvel appel de force. De même, forcer une suspension déjà évaluée ne nécessite aucun calcul supplémentaire (mémoïsation). En revanche nous allons laisser tomber le cas des appels cycliques à force.

Pour y parvenir, nous allons utiliser :

• Un type somme pour représenter les états possibles de la suspension.
• Des références.
• Des fonctions.

Implémentation

Commençons par définir un type 'a state qui renseigne sur l’état (évalué ou non) d’une suspension :

type 'a state =
  | Maybe of (unit -> 'a)
  | Value of 'a 
  | Error of exn

Trois cas de figure sont envisageables :

• la suspension n’a pas été évaluée (Maybe),
• la suspension a été évaluée et un résultat a été obtenu (Value),
• l’évaluation de la suspension a déclenché une erreur (Error).

Comme nous souhaitons être en mesure de modifier l’état de notre suspension, nous avons besoin d’une référence. Nous définissons donc notre type « suspension » de la façon suivante :

type 'a lazy_val = 'a state ref

À partir de là, nous pouvons écrire une fonction qui renvoie une suspension à partir d’une fonction f et de l’argument x qu’elle reçoit en entrée :

let create f = ref (Maybe f)

Nous pouvons maintenant écrire une fonction qui force l’évaluation d’une suspension. Cette fonction doit :

• forcer l’évaluation si l’état est Maybe,
• renvoyer la valeur précédemment calculée si l’état est Value,
• lever l’exception précédemment levée si l’état est Error.

Nous écrivons donc :

let rec force t =
  match !t with
  | Value x -> x
  | Error x -> raise x
  | Maybe f -> t := (try Value (f ()) with x -> Error x);
    force t

Nous pouvons également écrire une fonction qui renvoie Some x si l’évaluation de la suspension a donné un résultat x, et None dans tous les autres cas (évaluation non effectuée ou levée d’exception) :

let may_get t =
  match !t with
  | Value x -> Some x
  | _ -> None

Enfin, nous pouvons écrire une fonction qui indique si l’évaluation d’une valeur paresseuse a déjà été forcée :

let is_value t =
  match !t with
  | Maybe _ -> false
  | _ -> true

Quelques exemples d’application

Arithmétique

Nous pouvons commencer par redéfinir les opérations usuelles telles que l’addition, la soustraction, la multiplication et la division :

let aux f x y = create (fun () -> f x y)
let ( ++ ) = aux ( + )
let ( -- ) = aux ( - )
let ( ** ) = aux ( * )
let ( // ) = aux ( / )

Un exemple d’application plutôt « tarte à la crème » :

Les listes paresseuses

Un ordinateur est incapable de manipuler directement une infinité de valeurs, pour la simple et bonne raison qu’il lui faudrait pour cela une mémoire infinie. En revanche, un ordinateur peut tout à fait manipuler des structures potentiellement infinies (l’adverbe change tout).

Voyons par exemple comment implémenter des listes potentiellement infinies en utilisant notre implémentation des structures paresseuses. D’abord, il faut définir un type pour nos listes. Ce sera :

type 'a t =
  | Empty 
  | Cell of 'a * 'a t lazy_val

Jusqu’ici, rien que de bien classique : une liste est vide (Empty) ou constituée d’un couple tête/queue (Cell). La seule originalité concerne ici la queue, qui est une suspension.

Initialisation

Maintenant que le type est fixé, nous pouvons écrire une fonction semblable à Array.init :

let init f =
  let rec loop i () =
    Cell (f i, create (loop (i + 1)))
  in loop 0 ()

Il est alors très facile de créer la liste des entiers naturels :

let integers = init (fun i -> i)

Tête et queue de liste

Continuons sur notre lancée et écrivons deux fonctions hd et tl qui renvoient respectivement la tête et la queue d’une liste paresseuse. Comme leur équivalent du module List, ces fonctions lèvent l’exception Invalid_argument lorsqu’elles reçoivent une liste vide en entrée :

let hd = function
  | Empty -> invalid_arg "hd"
  | Cell (x, _) -> x

let tl = function
  | Empty -> invalid_arg "tl"
  | Cell (_, x) -> force x

Conversion en liste standard

La fonction take reçoit un entrée une liste paresseuse t et un entier n. Elle renvoie les n premiers éléments de t stockés dans une liste standard. S’il y a moins de n éléments disponibles, tous les éléments restants sont renvoyés.

let take n t =
  if n < 0 then invalid_arg "take";
  let rec loop n = function
    | Empty -> []
    | Cell (x, t) -> if n = 0 then []
      else x :: loop (n - 1) (force t)
  in loop n t

Filtrage des éléments

Voici maintenant une fonction de filtrage des éléments d’une liste paresseuse. Cette fonction reçoit un entrée un prédicat p et une liste paresseuse t. Elle renvoie la sous-liste constituée des éléments de t qui satisfont le prédicat p.

let rec filter f = function
  | Empty -> Empty
  | Cell (x, t) -> let g () = filter f (force t) in
    if f x then Cell (x, create g) else g ()

Itérateurs

La fonction map reçoit une fonction f et une liste paresseuse t en entrée et renvoie la liste paresseuse [f(t₀); f(t₁); … f(t_n)].

let rec map f = function
  | Empty -> Empty
  | Cell (x, t) -> let g () = map f (force t) in
    Cell (f x, create g)

On peut également écrire un itérateur map2 qui manipule deux listes paresseuses supposées de même longueur. Cette fonction est l’équivalent de la fonction zipWith d’Haskell.

let rec map2 f x y =
  match x, y with
  | Empty, Empty -> Empty
  | Cell (x, t1), Cell (y, t2) -> let g () = map2 f (force t1) (force t2) in
    Cell (f x y, create g)
  | _ -> invalid_arg "map2"

Longueur de liste

On peut aussi écrire une fonction length qui renvoie, non pas la longueur réelle de la liste (cela n’a aucun sens puisqu’on manipule une liste potentiellement infinie), mais le nombre de suspensions déjà évaluées. Cela donne quelque chose comme ceci :

let length x =
  let rec loop n = function
    | Empty -> n
    | Cell (_, t) -> match may_get t with
      | Some t -> loop (n + 1) t
      | _ -> n
  in loop 0 x

Liste des entiers impairs

Les entiers naturels impairs possèdent la propriété suivante : leur écriture binaire contient toujours un bit de poids faible égal à 1. On peut donc écrire une fonction odd en utilisant l’opérateur bit-à-bit land (on pouvait aussi se servir du modulo pour ne pas se compliquer la vie…), puis extraire de la liste des entiers naturels la liste des entiers impairs :

let odd x = x land 1 = 1 
let odd_list = filter odd integers

Liste des puissances de 2

Dans le même genre, on peut construire la liste des puissances de 2. Il s’agit pour le coup d’une version très inefficace (dans l’interpréteur, mon ordinateur met 26 s pour calculer les 25 premières puissances de 2).

let two x = x > 0 && x land (x - 1) = 0
let two_list = filter two integers

Liste des nombres de Fibonacci

L’évaluation retardée permet également de construire la liste des nombres de Fibonacci (cf. la notion associée de corécursion). L’idée est simple : on fournit les deux cas de base (ici 0 et 1, mais certains commencent avec 1 et 1) puis on indique que la construction des éléments suivants s’effectue en appliquant la formule F_{n + 1} = F_n + F_{n – 1}. J’utilise la bibliothèque Num car les termes de la suite de Fibonacci sont rapidement grands.

open Num

let fib =
  let rec aux a b =
    Cell (a, create (fun () -> aux b (a +/ b)))
  in aux (Int 0) (Int 1)

Exemple : take 10 fib = [Int 0; Int 1; Int 1; Int 2; Int 3; Int 5; Int 8; Int 13; Int 21; Int 34]. Voici une autre version moins efficace (dans cet exemple, aux pourrait ne pas être une fonction, mais les restrictions imposées par OCaml en matière de récursion du fait de son mode d’évaluation strict obligent à procéder de la sorte) :

let fib =
  let rec aux () =
    Cell (Int 0, create (fun () -> 
      Cell (Int 1, create (fun () ->
        let x = aux () in
        map2 (+/) x (tl x)
  )))) in aux ()

Bibliographie

• Principe de l’évaluation retardée (en anglais)
• L’évaluation retardée avec Haskell (en anglais)
• Les 1001 premiers termes de la suite de Fibonacci (attention, initialisation avec 1 et 1).
• La suite de Fibonacci et évaluation retardée avec Clojure (en anglais)

À bientôt,
Cacophrène