Chapter 8Advanced examples with classes and modules
In this chapter, we show some larger examples using objects, classes
and modules. We review many of the object features simultaneously on
the example of a bank account. We show how modules taken from the
standard library can be expressed as classes. Lastly, we describe a
programming pattern known as virtual types through the example
of window managers.
1Extended example: bank accounts
In this section, we illustrate most aspects of Object and inheritance
by refining, debugging, and specializing the following
initial naive definition of a simple bank account. (We reuse the
module Euro defined at the end of chapter 3.)
#let euro = new Euro.c;;
val euro : float -> Euro.c = <fun>
#let zero = euro 0.;;
val zero : Euro.c = <obj>
#let neg x = x#times (-1.);;
val neg : < times : float -> 'a; .. > -> 'a = <fun>
#class account =
objectvalmutable balance = zero
method balance = balance
method deposit x = balance <- balance # plus x
method withdraw x =
if x#leq balance then (balance <- balance # plus (neg x); x) else zero
end;;
class account :
objectvalmutable balance : Euro.c
method balance : Euro.c
method deposit : Euro.c -> unit
method withdraw : Euro.c -> Euro.c
end
#let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);;
- : Euro.c = <obj>
We now refine this definition with a method to compute interest.
class account_with_interests :
objectvalmutable balance : Euro.c
method balance : Euro.c
method deposit : Euro.c -> unit
methodprivate interest : unit
method withdraw : Euro.c -> Euro.c
end
We make the method interest private, since clearly it should not be
called freely from the outside. Here, it is only made accessible to subclasses
that will manage monthly or yearly updates of the account.
We should soon fix a bug in the current definition: the deposit method can
be used for withdrawing money by depositing negative amounts. We can
fix this directly:
#class safe_account =
objectinherit account
method deposit x = if zero#leq x then balance <- balance#plus x
end;;
class safe_account :
objectvalmutable balance : Euro.c
method balance : Euro.c
method deposit : Euro.c -> unit
method withdraw : Euro.c -> Euro.c
end
However, the bug might be fixed more safely by the following definition:
#class safe_account =
objectinherit account as unsafe
method deposit x =
if zero#leq x then unsafe # deposit x
else raise (Invalid_argument "deposit")
end;;
class safe_account :
objectvalmutable balance : Euro.c
method balance : Euro.c
method deposit : Euro.c -> unit
method withdraw : Euro.c -> Euro.c
end
In particular, this does not require the knowledge of the implementation of
the method deposit.
To keep track of operations, we extend the class with a mutable field
history and a private method trace to add an operation in the
log. Then each method to be traced is redefined.
#type 'a operation = Deposit of 'a | Retrieval of 'a;;
type 'a operation = Deposit of 'a | Retrieval of 'a
#class account_with_history =
object (self)
inherit safe_account as super
valmutable history = []
methodprivate trace x = history <- x :: history
method deposit x = self#trace (Deposit x); super#deposit x
method withdraw x = self#trace (Retrieval x); super#withdraw x
method history = List.rev history
end;;
class account_with_history :
objectvalmutable balance : Euro.c
valmutable history : Euro.c operation list
method balance : Euro.c
method deposit : Euro.c -> unit
method history : Euro.c operation list
methodprivate trace : Euro.c operation -> unit
method withdraw : Euro.c -> Euro.c
end
One may wish to open an account and simultaneously deposit some initial
amount. Although the initial implementation did not address this
requirement, it can be achieved by using an initializer.
#class account_with_deposit x =
objectinherit account_with_history
initializer balance <- x
end;;
class account_with_deposit :
Euro.c ->
objectvalmutable balance : Euro.c
valmutable history : Euro.c operation list
method balance : Euro.c
method deposit : Euro.c -> unit
method history : Euro.c operation list
methodprivate trace : Euro.c operation -> unit
method withdraw : Euro.c -> Euro.c
end
A better alternative is:
#class account_with_deposit x =
object (self)
inherit account_with_history
initializer self#deposit x
end;;
class account_with_deposit :
Euro.c ->
objectvalmutable balance : Euro.c
valmutable history : Euro.c operation list
method balance : Euro.c
method deposit : Euro.c -> unit
method history : Euro.c operation list
methodprivate trace : Euro.c operation -> unit
method withdraw : Euro.c -> Euro.c
end
Indeed, the latter is safer since the call to deposit will automatically
benefit from safety checks and from the trace.
Let’s test it:
#let ccp = new account_with_deposit (euro 100.) inlet _balance = ccp#withdraw (euro 50.) in
ccp#history;;
- : Euro.c operation list = [Deposit <obj>; Retrieval <obj>]
Closing an account can be done with the following polymorphic function:
#let close c = c#withdraw c#balance;;
val close : < balance : 'a; withdraw : 'a -> 'b; .. > -> 'b = <fun>
Of course, this applies to all sorts of accounts.
Finally, we gather several versions of the account into a module Account
abstracted over some currency.
#let today () = (01,01,2000) (* an approximation *)module Account (M:MONEY) =
structtype m = M.c
let m = new M.c
let zero = m 0.
class bank =
object (self)
valmutable balance = zero
method balance = balance
valmutable history = []
methodprivate trace x = history <- x::history
method deposit x =
self#trace (Deposit x);
if zero#leq x then balance <- balance # plus x
else raise (Invalid_argument "deposit")
method withdraw x =
if x#leq balance then
(balance <- balance # plus (neg x); self#trace (Retrieval x); x)
else zero
method history = List.rev history
endclasstype client_view =
objectmethod deposit : m -> unit
method history : m operation list
method withdraw : m -> m
method balance : m
endclassvirtual check_client x =
let y = if (m 100.)#leq x then x
else raise (Failure "Insufficient initial deposit") inobject (self)
initializer self#deposit y
methodvirtual deposit: m -> unit
endmodule Client (B : sigclass bank : client_view end) =
structclass account x : client_view =
objectinherit B.bank
inherit check_client x
endlet discount x =
let c = new account x inif today() < (1998,10,30) then c # deposit (m 100.); c
endend;;
This shows the use of modules to group several class definitions that can in
fact be thought of as a single unit. This unit would be provided by a bank
for both internal and external uses.
This is implemented as a functor that abstracts over the currency so that
the same code can be used to provide accounts in different currencies.
The class bank is the real implementation of the bank account (it
could have been inlined). This is the one that will be used for further
extensions, refinements, etc. Conversely, the client will only be given the client view.
Hence, the clients do not have direct access to the balance, nor the
history of their own accounts. Their only way to change their balance is
to deposit or withdraw money. It is important to give the clients
a class and not just the ability to create accounts (such as the
promotional discount account), so that they can
personalize their account.
For instance, a client may refine the deposit and withdraw methods
so as to do his own financial bookkeeping, automatically. On the
other hand, the function discount is given as such, with no
possibility for further personalization.
It is important to provide the client’s view as a functor
Client so that client accounts can still be built after a possible
specialization of the bank.
The functor Client may remain unchanged and be passed
the new definition to initialize a client’s view of the extended account.
#module Investment_account (M : MONEY) =
structtype m = M.c
module A = Account(M)
class bank =
objectinherit A.bank as super
method deposit x =
if (new M.c 1000.)#leq x then
print_string "Would you like to invest?";
super#deposit x
endmodule Client = A.Client
end;;
The functor Client may also be redefined when some new features of the
account can be given to the client.
#module Internet_account (M : MONEY) =
structtype m = M.c
module A = Account(M)
class bank =
objectinherit A.bank
method mail s = print_string s
endclasstype client_view =
objectmethod deposit : m -> unit
method history : m operation list
method withdraw : m -> m
method balance : m
method mail : string -> unit
endmodule Client (B : sigclass bank : client_view end) =
structclass account x : client_view =
objectinherit B.bank
inherit A.check_client x
endendend;;
One may wonder whether it is possible to treat primitive types such as
integers and strings as objects. Although this is usually uninteresting
for integers or strings, there may be some situations where
this is desirable. The class money above is such an example.
We show here how to do it for strings.
A naive definition of strings as objects could be:
#class ostring s =
objectmethod get n = String.get s n
method print = print_string s
method escaped = new ostring (String.escaped s)
end;;
class ostring :
string ->
objectmethod escaped : ostring
method get : int -> char
method print : unit
end
However, the method escaped returns an object of the class ostring,
and not an object of the current class. Hence, if the class is further
extended, the method escaped will only return an object of the parent
class.
#class sub_string s =
objectinherit ostring s
method sub start len = new sub_string (String.sub s start len)
end;;
class sub_string :
string ->
objectmethod escaped : ostring
method get : int -> char
method print : unit
method sub : int -> int -> sub_string
end
As seen in section 3.16, the solution is to use
functional update instead. We need to create an instance variable
containing the representation s of the string.
#class better_string s =
objectval repr = s
method get n = String.get repr n
method print = print_string repr
method escaped = {< repr = String.escaped repr >}
method sub start len = {< repr = String.sub s start len >}
end;;
class better_string :
string ->
object ('a)
val repr : string
method escaped : 'a
method get : int -> char
method print : unit
method sub : int -> int -> 'a
end
As shown in the inferred type, the methods escaped and sub now return
objects of the same type as the one of the class.
Another difficulty is the implementation of the method concat.
In order to concatenate a string with another string of the same class,
one must be able to access the instance variable externally. Thus, a method
repr returning s must be defined. Here is the correct definition of
strings:
#class ostring s =
object (self : 'mytype)
val repr = s
method repr = repr
method get n = String.get repr n
method print = print_string repr
method escaped = {< repr = String.escaped repr >}
method sub start len = {< repr = String.sub s start len >}
method concat (t : 'mytype) = {< repr = repr ^ t#repr >}
end;;
class ostring :
string ->
object ('a)
val repr : string
method concat : 'a -> 'a
method escaped : 'a
method get : int -> char
method print : unit
method repr : string
method sub : int -> int -> 'a
end
Another constructor of the class string can be defined to return a new
string of a given length:
#class cstring n = ostring (String.make n ' ');;
class cstring : int -> ostring
Here, exposing the representation of strings is probably harmless. We do
could also hide the representation of strings as we hid the currency in the
class money of section 3.17.
There is sometimes an alternative between using modules or classes for
parametric data types.
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 =
objectvalmutable 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 :
objectvalmutable 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.
A naive approach is to make 'b an extra parameter of class stack:
#class ['a, 'b] stack2 =
objectinherit ['a] stack
method fold f (x : 'b) = List.fold_left f x l
end;;
class ['a, 'b] stack2 :
objectvalmutable 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, the method fold of a given object can only be
applied to functions that all have the same type:
#let s = new stack2;;
val s : ('_weak1, '_weak2) stack2 = <obj>
# s#fold ( + ) 0;;
- : int = 0
# s;;
- : (int, int) stack2 = <obj>
A better solution is to use polymorphic methods, which were
introduced in OCaml version 3.05. Polymorphic methods makes
it possible to treat the type variable 'b in the type of fold as
universally quantified, giving fold the polymorphic type
Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b.
An explicit type declaration on the method fold is required, since
the type checker cannot infer the polymorphic type by itself.
#class ['a] stack3 =
objectinherit ['a] stack
method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b
= fun f x -> List.fold_left f x l
end;;
class ['a] stack3 :
objectvalmutable l : 'a list
method clear : unit
method fold : ('b -> 'a -> 'b) -> 'b -> 'b
method length : int
method pop : 'a
method push : 'a -> unit
end
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.
This is another instance of friend functions as seen in
section 3.17. Indeed, this is the same mechanism used in the module
Set in the absence of objects.
In the object-oriented version of sets, we only need to add an additional
method tag to return the representation of a set. Since sets are
parametric in the type of elements, the method tag has a parametric type
'a tag, concrete within
the module definition but abstract in its signature.
From outside, it will then be guaranteed that two objects with a method tag
of the same type will share the same representation.
#moduletype SET =
sigtype '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
endend;;
#module Set : SET =
structletrec merge l1 l2 =
match l1 with
[] -> l2
| h1 :: t1 ->
match l2 with
[] -> l1
| h2 :: t2 ->
if h1 < h2 then h1 :: merge t1 l2
elseif 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
endend;;
The following example, known as the subject/observer pattern, is often
presented in the literature as a difficult inheritance problem with
inter-connected classes.
The general pattern amounts to the definition a pair of two
classes that recursively interact with one another.
The class observer has a distinguished method notify that requires
two arguments, a subject and an event to execute an action.
classvirtual ['subject, 'event] observer :
objectmethodvirtual notify : 'subject -> 'event -> unit end
The class subject remembers a list of observers 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 ['a, 'event] subject :
object ('b)
constraint 'a = < notify : 'b -> 'event -> unit; .. >
valmutable observers : 'a list
method add_observer : 'a -> unit
method notify_observers : 'event -> unit
end
The difficulty usually lies 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.
#class ['observer] window_subject =
let id = count := succ !count; !count inobject (self)
inherit ['observer, event] subject
valmutable 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; .. >
valmutable observers : 'a list
valmutable 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 =
objectinherit ['subject, event] observer
method notify s e = s#draw
end;;
class ['a] window_observer :
objectconstraint 'a = < draw : unit; .. >
method notify : 'a -> event -> unit
end
As can be expected, 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.
Classes window_observer and window_subject can still be extended by
inheritance. For instance, one may enrich the subject with new
behaviors and refine the behavior of the observer.
class ['a] richer_window_subject :
object ('b)
constraint 'a = < notify : 'b -> event -> unit; .. >
valmutable observers : 'a list
valmutable position : int
valmutable size : int
valmutable 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 =
objectinherit ['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 :
objectconstraint 'a = < draw : unit; raise : unit; .. >
method notify : 'a -> event -> unit
end