Re: [Caml-list] Re: OO programming

[Julien Moutinho <julien.moutinho@gmail.com>]

On Thu, Feb 21, 2008 at 08:47:17PM +0100, Tiphaine.Turpin wrote:
> [...]

Below is a couple of design patterns which may be of interest to you.
The first one uses the [and] keyword with [class].
The second one uses the [and] keyword with [class type].

One advantage of the later being its capacity to be split
into several files (namely: header.ml, observer.ml and subject.ml),
but it is a little bit more verbose.

BTW, See also this chapter focusing on POO with OCaml:
  http://caml.inria.fr/pub/docs/oreilly-book/html/index.html#chap-POO

HTH.


# First design: implementation
# -----------------------------

% cat tiph_oo_and.ml
class ['msg] observer
  (subject: 'msg subject) =
  object
    method subject = subject
    method send : 'msg -> unit = fun _ -> ()
  end
and ['msg] subject =
  object (self)
    method private coerce =
        (self :> 'msg subject)
    val mutable observers : 'msg observer list = []
    method add () =
        let o = new observer self#coerce in
        observers <- o :: observers; o
    method notify (msg: 'msg) =
        List.iter
          (fun obs -> obs#send msg)
          observers
  end

let s = new subject
let o = s#add ()
let () = o#send `HELLO

# First design: interface
# -----------------------------

% ocamlc -i tiph_oo.ml
class ['a] observer :
  'a subject ->
  object
    method send : 'a -> unit
    method subject : 'a subject
  end

and ['a] subject :
  object
    val mutable observers : 'a observer list
    method add : unit -> 'a observer
    method private coerce : 'a subject
    method notify : 'a -> unit
  end

val s : _[> `HELLO ] subject
val o : _[> `HELLO ] observer

# Second design: implementation
# -----------------------------

% cat tiph_oo_mod.ml
module Header =
  struct
    class type ['msg] observer =
      object
        method subject : 'msg subject
        method send    : 'msg -> unit
      end
    and ['msg] subject =
      object
        method add    : unit -> 'msg observer
        method notify : 'msg -> unit
      end
  end

module Observer =
  struct
    class ['msg] observer :
      'msg Header.subject ->
      ['msg] Header.observer =
      fun subject ->
      object
        method subject = subject
        method send = fun _ -> ()
      end
  end

module Subject =
  struct
    class ['msg] subject :
      ['msg] Header.subject =
      object (self)
        method private coerce =
            (self :> 'msg subject)
        val mutable observers = []
        method add () =
            let o = (new Observer.observer self#coerce :> 'msg Header.observer) in
            observers <- o :: observers; o
        method notify (msg: 'msg) =
            List.iter
              (fun obs -> obs#send msg)
              observers
      end
  end

let s = new Subject.subject
let o = s#add ()
let () = o#send `HELLO

module Subject__alternative =
  (* NOTE: in this alternative, a double coercion is used
   * in order to have a [subject] class bigger than
   * [Header.subject] (a public method [some_method] here). *)
  struct
    class ['msg] subject =
      object (self)
        method private coerce =
            ((self :> 'msg subject) :> 'msg Header.subject)
        val mutable observers = []
        method add () =
            let o = (new Observer.observer self#coerce :> 'msg Header.observer) in
            observers <- o :: observers; o
        method notify (msg: 'msg) =
            List.iter
              (fun obs -> obs#send msg)
              observers
        method some_method = ()
      end
  end

let s_a = new Subject__alternative.subject
let o_a = s_a#add ()
let () = o_a#send `HI


# Second design: interface
# -----------------------------

% ocamlc -i tiph_oo_mod.ml
module Header :
  sig
    class type ['a] observer =
      object method send : 'a -> unit method subject : 'a subject end
    and ['a] subject =
      object method add : unit -> 'a observer method notify : 'a -> unit end
  end

module Observer :
  sig class ['a] observer : 'a Header.subject -> ['a] Header.observer end

module Subject : sig class ['a] subject : ['a] Header.subject end

val s : _[> `HELLO ] Subject.subject
val o : _[> `HELLO ] Header.observer


module Subject__alternative :
  sig
    class ['a] subject :
      object
        val mutable observers : 'a Header.observer list
        method add : unit -> 'a Header.observer
        method private coerce : 'a Header.subject
        method notify : 'a -> unit
        method some_method : unit
      end
  end

val s_a : _[> `HI ] Subject__alternative.subject
val o_a : _[> `HI ] Header.observer