Objects in Caml

(Chapter written by Jérôme Vouillon and Didier Rémy)

This chapter gives an overview of the object-oriented features of Objective Caml.

Classes and objects

The class point has one instance variable x and two methods get_x and move. The initial value of the instance variable is 0. The variable x is declared mutable, so the method move can change its value.

# class point =
    object 
      val mutable x = 0
      method get_x = x
      method move d = x <- x + d
    end;;
class point :
  object val mutable x : int method get_x : int method move : int -> unit end

We now create a new point p.

# let p = new point;;
val p : point = <obj>

Note that the type of p is point. This is an abbreviation automatically defined by the class definition above. It stands for the object type <get_x : int; move : int -> unit>, listing the methods of class point along with their types.

Let us apply some methods to p:

# p#get_x;;
- : int = 0

# p#move 3;;
- : unit = ()

# p#get_x;;
- : int = 3

The class point can also be abstracted over the initial values of points.

# class point = fun x_init -> 
    object 
      val mutable x = x_init
      method get_x = x
      method move d = x <- x + d
    end;;
class point :
  int ->
  object val mutable x : int method get_x : int method move : int -> unit end

As for declaration of functions, the above definition can be abbreviated as:

# class point x_init =
    object 
      val mutable x = x_init
      method get_x = x
      method move d = x <- x + d
    end;;
class point :
  int ->
  object val mutable x : int method get_x : int method move : int -> unit end

An instance of the class point is now a function that expects an initial parameter to create a point object:

# new point;;
- : int -> point = <fun>

# let p = new point 7;;
val p : point = <obj>

The parameter x_init is, of course, visible in the whole body of the definition, including methods. For instance, the method get_offset in the class below returns the position of the object to the origin.

# class point x_init =
    object 
      val mutable x = x_init
      method get_x = x
      method get_offset = x - x_init
      method move d = x <- x + d 
    end;;
class point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

Expressions can be evaluated and bound before defining the object body of the class. This is useful to enforce invariants. For instance, points can be automatically adjusted to grid as follows:

# class adjusted_point x_init =
    let origin = (x_init / 10) * 10 in
    object 
      val mutable x = origin
      method get_x = x
      method get_offset = x - origin
      method move d = x <- x + d
    end;;
class adjusted_point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

(One could also raise an exception if the x_init coordinate is not on the grid.) In fact, the same effect could here be obtained by calling the definition of class point with the value of the origin.

# class adjusted_point x_init =  point ((x_init / 10) * 10);;
class adjusted_point : int -> point

An alternative solution would have been to define the adjustement in a special allocation function:

# let new_adjusted_point x_init = new point ((x_init / 10) * 10);;
val new_adjusted_point : int -> point = <fun>

However, the former pattern is generally more appropriate, since the code for adjustment is part of the definition of the class and will be inherited.

This ability provides class constructors as can be found in other languages. Several constructors can be defined this way to build objects of the same class but with different initialization patterns.

Reference to self

A method can also send messages to self (that is, the current object). For that, self must be explicitly bound, here to the variable s (s could be any identifier, even though we will often choose the name self.)

# class printable_point x_init =
    object (s)
      val mutable x = x_init
      method get_x = x
      method move d = x <- x + d
      method print = print_int s#get_x
    end;;
class printable_point :
  int ->
  object
    val mutable x : int
    method get_x : int
    method move : int -> unit
    method print : unit
  end

# let p = new printable_point 7;;
val p : printable_point = <obj>

# p#print;;
7- : unit = ()

Dynamically, the variable s is bound at the invocation of a method. In particular, when the class printable_point will be inherited, the variable s will be correctly bound to the object of the subclass.

Initializers

Let-bindings within class definitions are evaluated before the object is constructed. It is also possible to evaluate an expression immediately after the object has been built. Such code is written as an anonymous hidden method called an initializer. Therefore, is can access self and the instance variables.

# class printable_point x_init =
    let origin = (x_init / 10) * 10 in
    object (self)
      val mutable x = origin
      method get_x = x
      method move d = x <- x + d
      method print = print_int self#get_x
      initializer print_string "new point at "; self#print; print_newline()
    end;;
class printable_point :
  int ->
  object
    val mutable x : int
    method get_x : int
    method move : int -> unit
    method print : unit
  end

# let p = new printable_point 17;;
new point at 10
val p : printable_point = <obj>

Virtual methods

It is possible to declare a method without actually defining it, using the keyword virtual. This method will be provided latter in subclasses. A class containing virtual methods must be flagged virtual, and cannot be instantiated (that is, no object of this class can be created). It still defines abbreviations (treating virtual methods as other methods.)

# class virtual abstract_point x_init =
    object (self)
      val mutable x = x_init
      method virtual get_x : int
      method get_offset = self#get_x - x_init
      method virtual move : int -> unit
    end;;
class virtual abstract_point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method virtual get_x : int
    method virtual move : int -> unit
  end

# class point x_init =
    object
      inherit abstract_point x_init
      method get_x = x
      method move d = x <- x + d 
    end;;
class point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

Private methods

Private methods are methods that do not appear in object interfaces. They can only be invoked from other methods of the same object.

# class restricted_point x_init =
    object (self)
      val mutable x = x_init
      method get_x = x
      method private move d = x <- x + d
      method bump = self#move 1
    end;;
class restricted_point :
  int ->
  object
    val mutable x : int
    method bump : unit
    method get_x : int
    method private move : int -> unit
  end

# let p = new restricted_point 0;;
val p : restricted_point = <obj>

# p#move 10;;
Characters 0-1:
This expression has type restricted_point
It has no method move

# p#bump;;
- : unit = ()

Private methods are inherited (they are by default visible in subclasses), unless they are hidden by signature matching, as described below.

Class interfaces

Class interfaces are inferred from class definitions. They may also be defined directly and used to restrict the type of a class. As class declarations, they also define a new type constructor.

# class type restricted_point_type = 
    object
      method get_x : int
      method bump : unit
  end;;
class type restricted_point_type =
  object method bump : unit method get_x : int end

# fun (x : restricted_point_type) -> x;;
- : restricted_point_type -> restricted_point_type = <fun>

In addition to documentation, these class interfaces can be used to constrain the type of a class. Both instance variables and concrete private methods can be hidden by a class type constraint. Public and virtual methods, however, cannot.

# class restricted_point' x = (restricted_point x : restricted_point_type);;
class restricted_point' : int -> restricted_point_type

Or, equivalently:

# class restricted_point' = (restricted_point : int -> restricted_point_type);;
class restricted_point' : int -> restricted_point_type

The interface of a class can also be specified in a module signature, and used to restrict the inferred signature of a module.

# module type POINT = sig 
    class restricted_point' : int ->
      object    
        method get_x : int
        method bump : unit
      end 
  end;;
module type POINT =
  sig
    class restricted_point' :
      int -> object method bump : unit method get_x : int end
  end

# module Point : POINT = struct 
    class restricted_point' = restricted_point
  end;;
module Point : POINT

Inheritance

We illustrate inheritance by defining a class of colored points that inherits from the class of points. This class has all instance variables and all methods of class point, plus a new instance variable c and a new method color.

# class colored_point x (c : string) =
    object 
      inherit point x
      val c = c
      method color = c
    end;;
class colored_point :
  int ->
  string ->
  object
    val c : string
    val mutable x : int
    method color : string
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

# let p' = new colored_point 5 "red";;
val p' : colored_point = <obj>

# p'#get_x, p'#color;;
- : int * string = 5, "red"

A point and a colored point have incompatible types, since a point has no method color. However, the function get_x below is a generic function applying method get_x to any object p that has this method (and possibly some others, which are represented by an ellipsis in the type). Thus, it applies to both points and colored points.

# let get_succ_x p = p#get_x + 1;;
val get_succ_x : < get_x : int; .. > -> int = <fun>

# get_succ_x p + get_succ_x p';;
- : int = 8

Methods need not be declared previously, as shown by the example:

# let set_x p = p#set_x;;
val set_x : < set_x : 'a; .. > -> 'a = <fun>

# let incr p = set_x p (get_succ_x p);;
val incr : < get_x : int; set_x : int -> 'a; .. > -> 'a = <fun>

Multiple inheritance

Multiple inheritance is allowed. Only the last definition of a method is kept: the redefinition in a subclass of a method that was visible in the parent class overrides the definition in the parent class. Previous definitions of a method can be reused by binding the related ancestor. Below, super is bound to the ancestor printable_point. The name super is not actually a variable and can only be used to select a method as in super#print.

# class printable_colored_point y c = 
    object (self)
      val c = c
      method color = c
      inherit printable_point y as super
      method print =
        print_string "(";
        super#print;
        print_string ", ";
        print_string (self#color);
        print_string ")"
    end;;
class printable_colored_point :
  int ->
  string ->
  object
    val c : string
    val mutable x : int
    method color : string
    method get_x : int
    method move : int -> unit
    method print : unit
  end

# let p' = new printable_colored_point 17 "red";;
new point at (10, red)
val p' : printable_colored_point = <obj>

# p'#print;;
(10, red)- : unit = ()

A private method that has been hidden in the parent class is no more visible, and is thus not overriden. This also applies to initializers: all initializers along the class hierachy are evaluated, in the order they are introduced.

Parameterized classes

Reference cells can also be implemented as objects. The naive definition fails to typecheck:

# class ref x_init =
    object 
      val mutable x = x_init
      method get = x
      method set y = x <- y
    end;;
Characters 5-106:
Some type variables are unbound in this type:
  class ref :
    'a ->
    object val mutable x : 'a method get : 'a method set : 'a -> unit end
The method get has type 'a where 'a is unbound

The reason is that at least one of the methods has a polymorphic type (here, the type of the value stored in the reference cell), thus the class should be parametric, or the method type should be constrained to a monomorphic type. A monomorphic instance of the class could be defined by:

# class ref (x_init:int) =
    object 
      val mutable x = x_init
      method get = x
      method set y = x <- y
    end;;
class ref :
  int ->
  object val mutable x : int method get : int method set : int -> unit end

A class for polymorphic references must explicitly list the type parameters in its declaration. Class type parameters are always listed between [ and ]. The type parameters must also be bound somewhere in the class body by a type constraint.

# class ['a] ref x_init = 
    object 
      val mutable x = (x_init : 'a)
      method get = x
      method set y = x <- y
    end;;
class ['a] ref :
  'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end

# let r = new ref 1 in r#set 2; (r#get);;
- : int = 2

The type parameter in the declaration may actually be constrained in the body of the class definition. In the class type, the actual value of the type parameter is displayed in the constraint clause.

# class ['a] ref (x_init:'a) = 
    object
      val mutable x = x_init + 1
      method get = x
      method set y = x <- y
    end;;
class ['a] ref :
  'a ->
  object
    constraint 'a = int
    val mutable x : int
    method get : int
    method set : int -> unit
  end

Let us consider a more realistic example. We put an additional type constraint in method move, since no free variables must remain uncaptured by a type parameter.

# class ['a] circle (c : 'a) =
    object 
      val mutable center = c
      method center = center
      method set_center c = center <- c
      method move = (center#move : int -> unit)
    end;;
class ['a] circle :
  'a ->
  object
    constraint 'a = < move : int -> unit; .. >
    val mutable center : 'a
    method center : 'a
    method move : int -> unit
    method set_center : 'a -> unit
  end

An alternate definition of circle, using a constraint clause in the class definition, is shown below. The type #point used below in the constraint clause is an abbreviation produced by the definition of class point. This abbreviation unifies with the type of any object belonging to a subclass of class point. It actually expands to < get_x : int; move : int -> unit; .. >. This leads to the following alternate definition of circle, which has slightly stronger constraints on its argument, as we now expect center to have a method get_x.

# class ['a] circle (c : 'a) =
    object 
      constraint 'a = #point
      val mutable center = c
      method center = center
      method set_center c = center <- c
      method move = center#move
    end;;
class ['a] circle :
  'a ->
  object
    constraint 'a = #point
    val mutable center : 'a
    method center : 'a
    method move : int -> unit
    method set_center : 'a -> unit
  end

The class colored_circle is a specialized version of class circle which requires the type of the center to unify with #colored_point, and adds a method color. Note that when specializing a parameterized class, the instance of type parameter must always be explicitly given. It is again written inside [ and ].

# class ['a] colored_circle c =
    object
      constraint 'a = #colored_point
      inherit ['a] circle c
      method color = center#color
    end;;
class ['a] colored_circle :
  'a ->
  object
    constraint 'a = #colored_point
    val mutable center : 'a
    method center : 'a
    method color : string
    method move : int -> unit
    method set_center : 'a -> unit
  end

Using coercions

Subtyping is never implicit. There are, however, two ways to perform subtyping. The most general construction is fully explicit: both the domain and the codomain of the type coercion must be given.

We have seen that points and colored points have incompatible types. For instance, they cannot be mixed in the same list. However, a colored point can be coerced to a point, hiding its color method:

# let colored_point_to_point cp = (cp : colored_point :> point);;
val colored_point_to_point : colored_point -> point = <fun>

# let p = new point 3 and q = new colored_point 4 "blue";;
val p : point = <obj>
val q : colored_point = <obj>

# let l = [p; (colored_point_to_point q)];;
val l : point list = [<obj>; <obj>]

An object of type t can be seen as an object of type t' only if t is a subtype of t'. For instance, a point cannot be seen as a colored point.

# (p : point :> colored_point);;
Characters 0-28:
Type point = < get_offset : int; get_x : int; move : int -> unit >
is not a subtype of type
  colored_point =
    < color : string; get_offset : int; get_x : int; move : int -> unit >

Indeed, backward coercions are unsafe, and should be combined with a type case, possibly raising a runtime error. However, there is no such operation available in the language.

Be aware that subtyping and inheritance are not related. Inheritance is a syntactic relation between classes while subtyping is a semantic relation between types. For instance, the class of colored points could have been defined directly, without inheriting from the class of points; the type of colored points would remain unchanged and thus still be a subtype of points. The domain of a coercion can usually be omitted. For instance, one can define:

# let to_point cp = (cp :> point);;
val to_point :
  < get_offset : int; get_x : int; move : int -> unit; .. > -> point = <fun>

In this case, the function colored_point_to_point is an instance of the function to_point. This is not always true, however. The fully explicit coercion is more precise and is sometimes unavoidable. Here is an example where the shorter form fails:

# class virtual c  = object method virtual m : c end;;
class virtual c : object method virtual m : c end

# class c'  =
    object (self)
      inherit c 
      method m = (self :> c)
      method m' = 1
  end;;
Characters 59-63:
This expression cannot be coerced to type c = < m : c >; it has type
  < m : c; .. >
but is here used with type < m : 'a; .. > as 'a
Type c = < m : c > is not compatible with type 'a
Self type cannot be unified with a closed object type

The type of the coercion to type c can be seen here:

# function x -> (x :> c);;
- : (< m : 'a; .. > as 'a) -> c = <fun>

As class c' inherits from class c, its method m must have type c. On the other hand, in expression (self :> c) the type of self and the domain of the coercion above must be unified. That is, the type of the method m in self (i.e. c) is also the type of self. So, the type of self is c. This is a contradiction, as the type of self has a method m', whereas type c does not.

The desired coercion of type <m : c;..> -> c can be obtained by using a fully explicit coercion:

# function x -> (x : #c :> c);;
- : #c -> c = <fun>

Thus one can define class c' as follows:

# class c'  =
    object (self)
      inherit c 
      method m = (self : #c :> c)
      method m' = 1
    end;;
class c' : object method m : c method m' : int end

An alternative is to define class c this way (of course this definition is not equivalent to the previous one):

# class virtual c = object (_ : 'a) method virtual m : 'a end;;
class virtual c : object ('a) method virtual m : 'a end

Then, a coercion operator is not even required.

# class c' = object (self) inherit c  method m = self method m' = 1 end;;
class c' : object ('a) method m : 'a method m' : int end

Here, the simple coercion operator (e :> c) can be used to coerce an object expression e from type c' to type c. Semi-implicit coercions are actually defined so as to work correctly with classes returning self.

# (new c' :> c);;
- : c = <obj>

Another common problem may occur when one tries to define a coercion to a class c inside the definition of class c. The problem is due to the type abbreviation not being completely defined yet, and so its subtypes are not clearly known. Then, a coercion (_ : #c :> c) is taken to be the identity function, as in

# function x -> (x :> 'a);;
- : 'a -> 'a = <fun>

As a consequence, if the coercion is applied to self, as in the following example, the type of self is unified with the closed type c (a closed object type is an object type without ellipsis). This would constrains the type of self be closed and is thus rejected. Indeed, the type of self cannot be closed: this would prevent any further extension of the class. Therefore, a type error is generated when the unification of this type with another type would result in a closed object type.

# class c = object (self) method m = (self : #c :> c) end;;
Characters 36-40:
This expression has type < m : 'a; .. > but is here used with type c = < .. >
Self type cannot escape its class

This problem can sometimes be avoided by first defining the abbreviation, using a class type:

# class type c0 = object method m : c0 end;;
class type c0 = object method m : c0 end

# class c : c0 = object (self) method m = (self : #c0 :> c0) end;;
class c : c0

It is also possible to use a virtual class. Inheriting from this class simultaneously allows to enforce all methods of c to have the same type as the methods of c0.

# class virtual c0 = object method virtual m : c0 end;;
class virtual c0 : object method virtual m : c0 end

# class c = object (self) inherit c0 method m = (self : #c0 :> c0) end;;
class c : object method m : c0 end

One could think of defining the type abbreviation directly:

# type c1 = <m : c1>;;
type c1 = < m : c1 >

However, the abbreviation #c1 cannot be defined this way (the abbreviation #c0 is defined from the class c0, not from the type c0), and should be expanded:

# class c = object (self)  method m = (self : <m : c1; ..> as 'a :> c1) end;;
class c : object method m : c1 end

Functional objects

It is possible to write a version of class point without assignments on the instance variables. The construct {< ... >} returns a copy of ``self'' (that is, the current object), possibly changing the value of some instance variables.

# class functional_point y =
    object 
      val x = y
      method get_x = x
      method move d = {< x = x + d >}
    end;;
class functional_point :
  int ->
  object ('a) val x : int method get_x : int method move : int -> 'a end

# let p = new functional_point 7;;
val p : functional_point = <obj>

# p#get_x;;
- : int = 7

# (p#move 3)#get_x;;
- : int = 10

# p#get_x;;
- : int = 7

Note that the type abbreviation functional_point is recursive, which can be seen in the class type of functional_point: the type of self to 'a and 'a appears inside the type of the move method.

The above definition of functional_point is not equivalent with the following:

# class bad_functional_point y =
    object 
      val x = y
      method get_x = x
      method move d = new functional_point (x+d)
    end;;
class bad_functional_point :
  int ->
  object
    val x : int
    method get_x : int
    method move : int -> functional_point
  end

# let p = new functional_point 7;;
val p : functional_point = <obj>

# p#get_x;;
- : int = 7

# (p#move 3)#get_x;;
- : int = 10

# p#get_x;;
- : int = 7

While objects of either class will behave the same, objects of their subclasses will be different. In a subclass of later, the move method will keep returning an object of the parent class. On the contrary, in a subclass of the former, the move method will return an object of the subclass.

Cloning objects

Objects can also be cloned, whether they are functional or imperative. The library function Oo.copy makes a shallow copy of an object. That is, it returns an object that is equal to the previous one. The instance variables have been copied but their contents are shared. Assigning a new value to an instance variable of the copy (using a method call) will not affect instance variables of the original, and conversely. A deeper assigned (for example if the instance variable if a reference cell) will of course affect both the original and the copy.

The type of Oo.copy is the following:

# Oo.copy;;
- : (< .. > as 'a) -> 'a = <fun>

The keyword as in that type binds the type variable 'a to the object type < .. >. Therefore, Oo.copy takes an object with any methods (represented by the ellipsis), and returns an object of the same type. The type of Oo.copy is different from type < .. > -> < .. > as each ellipsis represents a different set of methods. Ellipsis actually behaves as a type variable.

# let p = new point 5;;
val p : point = <obj>

# let q = Oo.copy p;;
val q : point = <obj>

# q#move 7; (p#get_x, q#get_x);;
- : int * int = 5, 12

In fact, Oo.copy p will behave as p#copy assuming that a public method copy with body {< >} has been defined in the class of p.

Objects can be compared using the generic comparison functions (=, <, ...). Two objects are equal if and only if they are physically equal. In particular, an object and its copy are not equal.

# let q = Oo.copy p;;
val q : point = <obj>

# p = q, p = p;;
- : bool * bool = false, true

Recursive classes

Recursive classes can be used to define objects whose types are mutually recursive.

# class window =
    object 
      val mutable top_widget = (None : widget option)
      method top_widget = top_widget
    end
  and widget (w : window) =
    object
      val window = w
      method window = window
    end;;
class window :
  object
    val mutable top_widget : widget option
    method top_widget : widget option
  end
class widget :
  window -> object val window : window method window : window end

Although their types are mutually recursive, the classes widget and window are themselves independent.

Binary methods

A binary method is a method which takes an argument of the same type as self. The class comparable below is a template for classes with a binary method leq of type 'a -> bool where the type variable 'a is bound to the type of self. Therefore, #comparable expands to < leq : 'a -> bool; .. > as 'a. We see here that the binder as also allows to write recursive types.

# class virtual comparable = 
    object (_ : 'a)
      method virtual leq : 'a -> bool
    end;;
class virtual comparable : object ('a) method virtual leq : 'a -> bool end

We then define a subclass of comparable that wraps integers as comparable objects. There is a type constraint on the class parameter x as the primitive <= is a polymorphic comparison function in Objective Caml. The inherit clause ensures that the type of objects of this class is an instance of #comparable.

# class int_comparable (x : int) =
    object
      inherit comparable
      val mutable x = x
      method x = x
      method leq p = x <= p#x
    end;;
class int_comparable :
  int ->
  object ('a) val mutable x : int method leq : 'a -> bool method x : int end

Objects of class int_comparable2 below also modify the integer they hold. Note that the type int_comparable2 is not a subtype of type int_comparable, as the self type appears in contravariant position in the type of method leq. Indeed, an object p of class int_comparable has a method leq that expects an argument of type int_comparable since it accesses its x method. Considering p of type comparable would allow to call method leq on p with an argument that does not have a method x, which would be an error.

# class int_comparable2 x =
    object   
      inherit int_comparable x
      method set_x y = x <- y
    end;;
class int_comparable2 :
  int ->
  object ('a)
    val mutable x : int
    method leq : 'a -> bool
    method set_x : int -> unit
    method x : int
  end

It is however possible to define functions that manipulate objects of type either int_comparable or int_comparable2: the function min will return the minimum of any two objects whose type unifies with #comparable. The type of min is not the same as #comparable -> #comparable -> #comparable, as the abbreviation #comparable hides a type variable (an ellipsis). Each occurrence of this abbreviation generates a new variable.

# let min (x : #comparable) y =
    if x#leq y then x else y;;
val min : (#comparable as 'a) -> 'a -> 'a = <fun>

This function can be applied to objects of type int_comparable or int_comparable2.

# (min (new int_comparable  7) (new int_comparable 11))#x;;
- : int = 7

# (min (new int_comparable2 5) (new int_comparable2 3))#x;;
- : int = 3

Simple modules as classes

There is sometime an alternative between using modules or classes. Indeed, there are situations when the two approaches are quite similar. For instance, a stack can be straightforwardly implemented as a class:

# exception Empty;;
exception Empty

# class ['a] stack =
    object 
      val mutable l = ([] : 'a list)
      method push x = l <- x::l
      method pop = match l with [] -> raise Empty | a::l' -> l <- l'; a
      method clear = l <- []
      method length = List.length l
    end;;
class ['a] stack :
  object
    val mutable l : 'a list
    method clear : unit
    method length : int
    method pop : 'a
    method push : 'a -> unit
  end

However, writing a method for iterating over a stack is more problematic. A method fold would have type ('b -> 'a -> 'b) -> 'b -> 'b. Here 'a is the parameter of the stack. The parameter 'b is not related to the class 'a stack but to the argument that will be passed to the method fold. The intuition is that method fold should be polymorphic, i.e. of type All ('a) ('b -> 'a -> 'b) -> 'b -> 'b, which is not currently possible. One possibility would be to make 'b an extra parameter of class stack

# class ['a, 'b] stack2 =
    object
      inherit ['a] stack
      method fold f (x : 'b) = List.fold_left f x l
    end;;
class ['a, 'b] stack2 :
  object
    val mutable l : 'a list
    method clear : unit
    method fold : ('b -> 'a -> 'b) -> 'b -> 'b
    method length : int
    method pop : 'a
    method push : 'a -> unit
  end

However, method fold of a given object can only be applied to functions that all have the same type:

# let s = new stack2;;
val s : ('_a, '_b) stack2 = <obj>

# s#fold (+) 0;;
- : int = 0

# s;;
- : (int, int) stack2 = <obj>

The best solution would be to make method fold polymorphic. However Ocaml does not currently allow methods to be polymorphic.

Thus, the current solution is to leave the function fold outside of the class.

# class ['a] stack3 =
    object
      inherit ['a] stack
      method iter f = List.iter (f : 'a -> unit) l
    end;;
class ['a] stack3 :
  object
    val mutable l : 'a list
    method clear : unit
    method iter : ('a -> unit) -> unit
    method length : int
    method pop : 'a
    method push : 'a -> unit
  end

# let stack_fold (s : 'a #stack3) f x =
    let accu = ref x in
    s#iter (fun e -> accu := f !accu e);
    !accu;;
val stack_fold : 'a #stack3 -> ('b -> 'a -> 'b) -> 'b -> 'b = <fun>

Implementing sets leads to another difficulty. Indeed, the method union needs to be able to access the internal representation of another object of the same class. For that, a set class must have an additional method returning this representation. However, this representation should not be public. This result is obtained by making the type of the representation abstract via a module signature constraint. From outside, the additional method appears like a tag ensuring that an object belongs to class set.

# module type SET =
    sig
      type 'a tag
      class ['a] c :
        object ('b)
          method is_empty : bool
          method mem : 'a -> bool
          method add : 'a -> 'b
          method union : 'b -> 'b
          method iter : ('a -> unit) -> unit
          method tag : 'a tag
        end
    end;;
module type SET =
  sig
    type 'a tag
    class ['a] c :
      object ('b)
        method add : 'a -> 'b
        method is_empty : bool
        method iter : ('a -> unit) -> unit
        method mem : 'a -> bool
        method tag : 'a tag
        method union : 'b -> 'b
      end
  end

# module Set : SET =
    struct
      let rec merge l1 l2 =
        match l1 with
          [] -> l2
        | h1 :: t1 ->
            match l2 with
              [] -> l1
            | h2 :: t2 ->
                if h1 < h2 then h1 :: merge t1 l2
                else if h1 > h2 then h2 :: merge l1 t2
                else merge t1 l2
      type 'a tag = 'a list
      class ['a] c =
        object (_ : 'b)
          val repr = ([] : 'a list)
          method is_empty = (repr = [])
          method mem x = List.exists ((=) x) repr
          method add x = {< repr = merge [x] repr >}
          method union (s : 'b) = {< repr = merge repr s#tag >}
          method iter (f : 'a -> unit) = List.iter f repr
          method tag = repr
        end
    end;;
module Set : SET

The subject/observer pattern

The following example, known as the subject/observer pattern, is often presented in the litterature as a difficult inheritance problem with inter-connected classes. The general pattern amounts to the definition a pair of two classes that recusively interact with one another.

The class observer has a distinguished method notify that requires two arguments, a subject and an event to excecute an action.

# class virtual ['subject, 'event] observer =
    object
      method virtual notify : 'subject ->  'event -> unit
    end;;
class virtual ['a, 'b] observer :
  object method virtual notify : 'a -> 'b -> unit end

The class subject remembers a list of oberservers in an instance variable, and has a distinguished method notify_observers to broadcast the message notify to all observers with a particular event e.

# class ['observer, 'event] subject =
    object (self)
      val mutable observers = ([]:'observer list)
      method add_observer obs = observers <- (obs :: observers)
      method notify_observers (e : 'event) = 
          List.iter (fun x -> x#notify self e) observers
    end;;
class ['a, 'b] subject :
  object ('c)
    constraint 'a = < notify : 'c -> 'b -> unit; .. >
    val mutable observers : 'a list
    method add_observer : 'a -> unit
    method notify_observers : 'b -> unit
  end

The difficulty usually relies in defining instances of the pattern above by inheritance. This can be done in a natural and obvious manner in Ocaml, as shown on the following example manipulating windows.

# type event = Raise | Resize | Move;;
type event = | Raise | Resize | Move

# let string_of_event = function
      Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";;
val string_of_event : event -> string = <fun>

# let count = ref 0;;
val count : int ref = {contents=0}

# class ['observer] window_subject =
    let id = count := succ !count; !count in
    object (self)
      inherit ['observer, event] subject
      val mutable position = 0
      method identity = id
      method move x = position <- position + x; self#notify_observers Move
      method draw = Printf.printf "{Position = %d}\n"  position;
    end;;
class ['a] window_subject :
  object ('b)
    constraint 'a = < notify : 'b -> event -> unit; .. >
    val mutable observers : 'a list
    val mutable position : int
    method add_observer : 'a -> unit
    method draw : unit
    method identity : int
    method move : int -> unit
    method notify_observers : event -> unit
  end

# class ['subject] window_observer =
    object
      inherit ['subject, event] observer
      method notify s e = s#draw
    end;;
class ['a] window_observer :
  object
    constraint 'a = < draw : unit; .. >
    method notify : 'a -> event -> unit
  end

Unsurprisingly the type of window is recursive.

# let window = new window_subject;;
val window : < notify : 'a -> event -> unit; _.. > window_subject as 'a =
  <obj>

However, the two classes of window_subject and window_observer are not mutually recursive.

# let window_observer = new window_observer;;
val window_observer : < draw : unit; _.. > window_observer = <obj>

# window#add_observer window_observer;;
- : unit = ()

# window#move 1;;
{Position = 1}
- : unit = ()

Classes window_observer and window_subject can still be extended by inheritance. For instance, one may enrich the subject with new behaviors and refined the behavior of the observer.

# class ['observer] richer_window_subject =
    object (self)
      inherit ['observer] window_subject
      val mutable size = 1
      method resize x = size <- size + x; self#notify_observers Resize
      val mutable top = false
      method raise = top <- true; self#notify_observers Raise
      method draw = Printf.printf "{Position = %d; Size = %d}\n"  position size;
    end;;
class ['a] richer_window_subject :
  object ('b)
    constraint 'a = < notify : 'b -> event -> unit; .. >
    val mutable observers : 'a list
    val mutable position : int
    val mutable size : int
    val mutable top : bool
    method add_observer : 'a -> unit
    method draw : unit
    method identity : int
    method move : int -> unit
    method notify_observers : event -> unit
    method raise : unit
    method resize : int -> unit
  end

# class ['subject] richer_window_observer =
    object 
      inherit ['subject] window_observer as super
      method notify s e = if e <> Raise then s#raise; super#notify s e
    end;;
class ['a] richer_window_observer :
  object
    constraint 'a = < draw : unit; raise : unit; .. >
    method notify : 'a -> event -> unit
  end

We can also create a different kind of observer:

# class ['subject] trace_observer = 
    object 
      inherit ['subject, event] observer
      method notify s e =
        Printf.printf
          "<Window %d <== %s>\n" s#identity (string_of_event e)
    end;;
class ['a] trace_observer :
  object
    constraint 'a = < identity : int; .. >
    method notify : 'a -> event -> unit
  end

and combine them as follows:

# let window = new richer_window_subject;;
val window :
  < notify : 'a -> event -> unit; _.. > richer_window_subject as 'a = <obj>

# window#add_observer (new richer_window_observer);;
- : unit = ()

# window#add_observer (new trace_observer);;
- : unit = ()

# window#move 1; window#resize 2;;
<Window 1 <== Move>
<Window 1 <== Raise>
{Position = 1; Size = 1}
{Position = 1; Size = 1}
<Window 1 <== Resize>
<Window 1 <== Raise>
{Position = 1; Size = 3}
{Position = 1; Size = 3}
- : unit = ()