Programmation Avancée

TP8: monades (1)

Les exercices suivants portent sur la notion de monade, donnée par la signature suivante:

module type MONAD = sig
  type +'a t
  val return : 'a -> 'a t
  val bind : 'a t -> ('a -> 'b t) -> 'b t
end

Monade d'exceptions

La monade d'exception est basée sur le type 'a t = Val of 'a | Exn of exn. L'idée est qu'un calcul avec exception peut soit retourner normalement une valeur v, auquel cas il sera représenté par Val v, soit retourner en levant une exception e, auquel cas il sera représenter par Exn e.

Question 1

Implémenter la monade d'exception comme un module Exn ayant la signature suivante:

module type EXN = sig
  include MONAD
  val throw : exn -> 'a t
  val try_with : 'a t -> (exn -> 'a t) -> 'a t
  val run : 'a t -> 'a   (* peut lever une exception *)
end

Tester (au moins) sur le code suivant:

let () =
  let module M = Exn in
  let m =
    M.try_with
      (M.throw (Failure "normal"))
      (fun _ ->
         M.try_with
           (M.return 42)
           (fun _ -> M.throw (Failure "pas normal")))
  in
    Printf.printf "Test exn: %d\n" (M.run m)

Monade de continuations

On pose 'a -> unit le type des continuations 'a cont. La monade de continuation est construite sur le type 'a t = 'a cont -> unit.

Question 1

Ecrire cette monade, comme un module Cont implémentant la signature suivante:

module type CONT = sig
  include MONAD
  val run : unit t -> unit
end

Un test:

let () =
  let m = Cont.bind (Cont.return 21) (fun x -> Cont.return (2*x)) in
    Cont.run
      (Cont.bind m
         (fun x -> Printf.printf "Test cont: %d\n" x ; Cont.return ()))

Question 2

Traduire List.iter dans la monade de continuation, comme une fonction iter de type ('a -> unit Cont.t) -> 'a list -> unit Cont.t. La tester en affichant les éléments d'une liste avec printf.

Question 3

Ajouter les opérations suivantes à votre monade:

type 'a cont
val throw : 'a cont -> 'a -> 'b t
val callcc : ('a cont -> 'a t) -> 'a t

La sémantique a été vue en cours: callcc (fun k -> ...) permet d'accéder à la continuation courante k dans un calcul; throw k v appelle une continuation en lui passant une valeur.

Vous devriez ainsi pouvoir écrire le code suivant, issu du cours, qui change iter en un find avec backtracking:

let find pred lst =
  Cont.callcc (fun k ->
    Cont.bind
      (iter
         (fun x ->
            if pred x then
              Cont.callcc (fun k' -> Cont.throw k (Some (x,k')))
            else Cont.return ())
         lst)
      (fun () -> Cont.throw k None))

let () =
  Cont.run
    (Cont.bind
       (find (fun x -> x mod 2 = 0) [1;2;3;4;5])
       (function
          | Some (x,_) ->
              Printf.printf "Found %d\n" x ;
              Cont.return ()
          | None ->
              Printf.printf "Not found.\n" ;
              Cont.return ()))

Ecrire et tester une fonction print_all qui appelle find une seule fois mais utilise les continuations retournées pour obtenir successivement toutes les valeurs possibles et les afficher avec printf. On a fait un aller-retour entre un itérateur et un générateur en CPS.