Adrien Friggeri presented a very simple way to do prototype-based programming in OCaml. He defines objects as a hash table (with one slot per instance variable/method) plus an optional reference to the parent, but in doing so completely bypasses the type discipline! As he says

it's horrible, but funny

Adrien's method loses the type of the object's fields and forces you to use manual annotations, which, if wrong, will easily cause a segfault:

((get o "bar") : 'a->'b) print_endline
(* slot "bar" of object o*)

Fortunately, there is a way to recover type-safety. All we have to do is to turn selectors into first-class values, which also carry the type of the slot. Sounds familiar? This is what you have to do to implement property lists in OCaml. This method has interesting consequences:

Object model

The basic object model is very simple: each object has got a table (implemented as a property list) with methods ("slots"), and an optional parent (it'd be trivial to extend it to multiple parents).

module P = Plist

type obj = { dict : P.t; mutable parent: obj option }

let clone x = { dict = P.create (); parent = Some x }

The base object is obj:

let obj = { dict = P.create (); parent = None }

Setting the value of a slot is trivial too:

let set obj selector v = P.set obj.dict selector v

Method lookup is a bit more involved, but still easy: it's just a recursive function that tries to find the method for the specified selector and tries again in the parent if not found:

exception Method_not_found

let (%) t meth =
  let rec dispatch t meth self = match P.get t.dict meth with
      Some f -> f self
    | None -> match t.parent with
          Some p -> dispatch p meth self
        | None -> raise Method_not_found
  in dispatch t meth t

The (%) operator is used as in object%selector. Since function application binds more tightly that any operator, parentheses are needed if the method takes arguments: (object%dostuff) arg1 arg2. This is a bit inconvenient, but easily solved with a prefix operator:

let (!!) meth obj = obj%meth

It is now possible to write

!!dostuff obj arg1 arg2

Selectors

The object model is almost complete, only selectors remain to be done. A selector is just a property that will be used as the key in the property list holding object methods:

type 'a selector = 'a P.property

let new_selector = P.new_property

It is often convenient to create a new selector and define the corresponding method for an object:

let define t f =
  let prop = P.new_property () in
    set t prop f;
    prop

The basic machinery is in place now:

let duck = clone obj
let quack = define duck (fun self -> print_endline "QUACK!")

(* ... *)

duck % quack;  (* or !!quack duck *)
whatever % quack

Selector namespaces

The name used to refer to a selector carries no meaning by itself:

(* duplicate the draw selector *)
let do_it = draw
...
!!draw obj;
!!do_it obj (* same thing *)

We only need different selector names to the extent that we need to refer to several selectors in the same context, but we could place selectors with the same name in different modules:

module Data =
struct
  let load = new_selector ()
  ...
end

module Guns =
struct
  let load = new_selector ()
  ....
end

and then discriminate at call time:

!!Guns.load gun 2; (* bullets *)
!!Data.load level;

We can also parameterize code in a functor over a module with the selectors, or even use objects as the namespaces:

obj % namespace1#doit;
obj % namespace2#doit;

A small example

I'm reusing this minimal sample OO program as an example method invocation. We have a shape prototype and two derived prototypes (rectangle and circle) with trivial move, rmove (relative move) and draw methods.

A function that uses subclass polymorphism (sub-prototype polymorphism here?) to move and draw a list of shapes looks like this:

let f l = List.iter (fun o -> o%draw; !!rmove o 100 100; !!draw o) l

I've used the two possible syntaxes to call o's draw method.

A few convenience functions on top of the object model simplify the code:

let (<.) obj meth = (obj, set obj meth)
let (<==) (o, f) m = f m; o

let parent = define obj (fun x -> match x.parent with Some p -> p | None -> obj)
let set_parent t parent = obj.parent <- Some parent

let return x _ = x

Now for the bulk of the example:

open Printf

let puts fmt = ksprintf print_endline fmt

let shape = clone obj
let x = define shape (return 0)
let y = define shape (return 0)

let move = define shape (fun self x' y' -> set self x (return x');
                                           set self y (return y'))

let rmove = define shape
              (fun self dx dy -> set self x (return (self%x + dx));
                                 set self y (return (self%y + dy)))

let rectangle = clone shape
let height = define rectangle (return 0)
let width = define rectangle (return 0)

let draw =
  define rectangle
    (fun self -> puts "Rectangle %d x %d @ (%d, %d)"
                   (self%width) (self%height) (self%x) (self%y))

let make_rectangle ?(pos = (0, 0)) ~w ~h =
  let r = clone rectangle in
  let posx, posy = pos in
    !!move r posx posy;
    r <. height <== return h
      <. width <== return w

let circle = clone shape
let radius = define circle (return 0)
let () = set circle draw
           (fun self -> puts "Circle with radius %d at (%d, %d)"
                          (self%radius) (self%x) (self%y))

let make_circle (posx, posy) _radius =
  let c = clone circle in
    !!move c posx posy;
    c <. radius <== return _radius

let f l = List.iter (fun o -> o%draw; !!rmove o 100 100; !!draw o) l

This can be tested in the OCaml toplevel (REPL). (If you're new to the toplevel, lines starting with # are user input, everything else is the result printed by the toplevel or the program being executed)

$ ocaml plist.cmo proto.cmo shapes.cmo
        Objective Caml version 3.10.2

# open Proto;;
# open Shapes;;
# let r = make_rectangle ~pos:(20, 100) ~w:10 ~h:20;;
val r : Proto.obj = <abstr>
# !!draw r;;
Rectangle 10 x 20 @ (20, 100)
- : unit = ()
# let c = clone circle;;
val c : Proto.obj = <abstr>
# let draw_all = List.iter !!draw;;
val draw_all : Proto.obj list -> unit = <fun>
# draw_all [c; r; c];;
Circle with radius 0 at (0, 0)
Rectangle 10 x 20 @ (20, 100)
Circle with radius 0 at (0, 0)
- : unit = ()
# !!draw;;
- : Proto.obj -> unit = <fun>
16 February 2009 at 11:40