path: root/manual/src/tutorials/advexamples.etex

\chapter{Advanced examples with classes and modules}
%HEVEA\cutname{advexamples.html}
\label{c:advexamples}

{\it (Chapter written by Didier Rémy)}

\bigskip

\noindent

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 {\em virtual types} through the example
of window managers.

\section{s:extended-bank-accounts}{Extended 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~\ref{c:objectexamples}.)
\begin{caml_eval}
module type MONEY =
  sig
    type t
    class c : float ->
      object ('a)
        val repr : t
        method value : t
        method print : unit
        method times : float -> 'a
        method leq : 'a -> bool
        method plus : 'a -> 'a
      end
  end;;
module Euro : MONEY =
  struct
    type t = float
    class c x =
      object (self : 'a)
        val repr = x
        method value = repr
        method print = print_float repr
        method times k = {< repr = k *. x >}
        method leq (p : 'a) = repr <= p#value
        method plus (p : 'a) = {< repr = x +. p#value >}
      end
  end;;
\end{caml_eval}
\begin{caml_example}{toplevel}
let euro = new Euro.c;;
let zero = euro 0.;;
let neg x = x#times (-1.);;
class account =
  object
    val mutable 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;;
let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);;
\end{caml_example}
We now refine this definition with a method to compute interest.
\begin{caml_example}{toplevel}
class account_with_interests =
  object (self)
    inherit account
    method private interest = self # deposit (self # balance # times 0.03)
  end;;
\end{caml_example}
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:
\begin{caml_example}{toplevel}
class safe_account =
  object
    inherit account
    method deposit x = if zero#leq x then balance <- balance#plus x
  end;;
\end{caml_example}
However, the bug might be fixed more safely by  the following definition:
\begin{caml_example}{toplevel}
class safe_account =
  object
    inherit account as unsafe
    method deposit x =
      if zero#leq x then unsafe # deposit x
      else raise (Invalid_argument "deposit")
  end;;
\end{caml_example}
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.
\begin{caml_example}{toplevel}
type 'a operation = Deposit of 'a | Retrieval of 'a;;
class account_with_history =
  object (self)
    inherit safe_account as super
    val mutable history = []
    method private 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;;
\end{caml_example}
%% \label{ss:bank:initializer}
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.
\begin{caml_example}{toplevel}
class account_with_deposit x =
  object
    inherit account_with_history
    initializer balance <- x
  end;;
\end{caml_example}
A better alternative is:
\begin{caml_example}{toplevel}
class account_with_deposit x =
  object (self)
    inherit account_with_history
    initializer self#deposit x
  end;;
\end{caml_example}
Indeed, the latter is safer since the call to "deposit" will automatically
benefit from safety checks and from the trace.
Let's test it:
\begin{caml_example}{toplevel}
let ccp = new account_with_deposit (euro 100.) in
let _balance = ccp#withdraw (euro 50.) in
ccp#history;;
\end{caml_example}
Closing an account can be done with the following polymorphic function:
\begin{caml_example}{toplevel}
let close c = c#withdraw c#balance;;
\end{caml_example}
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.
\begin{caml_example*}{toplevel}
let today () = (01,01,2000) (* an approximation *)
module Account (M:MONEY) =
  struct
    type m = M.c
    let m = new M.c
    let zero = m 0.

    class bank =
      object (self)
        val mutable balance = zero
        method balance = balance
        val mutable history = []
        method private 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
      end

    class type client_view =
      object
        method deposit : m -> unit
        method history : m operation list
        method withdraw : m -> m
        method balance : m
      end

    class virtual check_client x =
      let y = if (m 100.)#leq x then x
      else raise (Failure "Insufficient initial deposit") in
      object (self)
        initializer self#deposit y
        method virtual deposit: m -> unit
      end

    module Client (B : sig class bank : client_view end) =
      struct
        class account x : client_view =
          object
            inherit B.bank
            inherit check_client x
          end

        let discount x =
          let c = new account x in
          if today() < (1998,10,30) then c # deposit (m 100.); c
      end
  end;;
\end{caml_example*}
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 {\em 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.
\begin{caml_example*}{toplevel}
module Euro_account = Account(Euro);;
module Client = Euro_account.Client (Euro_account);;
new Client.account (new Euro.c 100.);;
\end{caml_example*}
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.
\begin{caml_example*}{toplevel}
module Investment_account (M : MONEY) =
  struct
    type m = M.c
    module A = Account(M)

    class bank =
      object
        inherit 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
      end

    module Client = A.Client
  end;;
\end{caml_example*}
\begin{caml_eval}
module Euro_account = Investment_account (Euro);;
module Client = Euro_account.Client (Euro_account);;
new Client.account (new Euro.c 100.);;
\end{caml_eval}
The functor "Client" may also be redefined when some new features of the
account can be given to the client.
\begin{caml_example*}{toplevel}
module Internet_account (M : MONEY) =
  struct
    type m = M.c
    module A = Account(M)

    class bank =
      object
        inherit A.bank
        method mail s = print_string s
      end

    class type client_view =
      object
        method deposit : m -> unit
        method history : m operation list
        method withdraw : m -> m
        method balance : m
        method mail : string -> unit
      end

    module Client (B : sig class bank : client_view end) =
      struct
        class account x : client_view =
          object
            inherit B.bank
            inherit A.check_client x
          end
      end
  end;;
\end{caml_example*}
\begin{caml_eval}
module Euro_account = Internet_account (Euro);;
module Client = Euro_account.Client (Euro_account);;
new Client.account (new Euro.c 100.);;
\end{caml_eval}


\section{s:modules-as-classes}{Simple modules as classes}

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.

\subsection{ss:string-as-class}{Strings}

A naive definition of strings as objects could be:
\begin{caml_example}{toplevel}
class ostring s =
  object
     method get n = String.get s n
     method print = print_string s
     method escaped = new ostring (String.escaped s)
  end;;
\end{caml_example}
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.
\begin{caml_example}{toplevel}
class sub_string s =
  object
     inherit ostring s
     method sub start len = new sub_string (String.sub s  start len)
  end;;
\end{caml_example}
As seen in section~\ref{s:binary-methods}, the solution is to use
functional update instead. We need to create an instance variable
containing the representation "s" of the string.
\begin{caml_example}{toplevel}
class better_string s =
  object
     val 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;;
\end{caml_example}
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:
\begin{caml_example}{toplevel}
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;;
\end{caml_example}
Another constructor of the class string can be defined to return a new
string of a given length:
\begin{caml_example}{toplevel}
class cstring n = ostring (String.make n ' ');;
\end{caml_example}
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~\ref{s:friends}.

\subsubsection{sss:stack-as-class}{Stacks}

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:
\begin{caml_example}{toplevel}
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;;
\end{caml_example}
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".
A naive approach is to make "'b" an extra parameter of class "stack":
\begin{caml_example}{toplevel}
class ['a, 'b] stack2 =
  object
    inherit ['a] stack
    method fold f (x : 'b) = List.fold_left f x l
  end;;
\end{caml_example}
However, the method "fold" of a given object can only be
applied to functions that all have the same type:
\begin{caml_example}{toplevel}
let s = new stack2;;
s#fold ( + ) 0;;
s;;
\end{caml_example}
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.
\begin{caml_example}{toplevel}
class ['a] stack3 =
  object
    inherit ['a] stack
    method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b
                = fun f x -> List.fold_left f x l
  end;;
\end{caml_example}

% However, the nice correspondence between the implementations of stacks as
% modules or classes is a very particular case.

% XXX Maps

\subsection{ss:hashtbl-as-class}{Hashtbl}

A simplified version of object-oriented hash tables should have the
following class type.
\begin{caml_example}{toplevel}
class type ['a, 'b] hash_table =
  object
    method find : 'a -> 'b
    method add : 'a -> 'b -> unit
  end;;
\end{caml_example}
A simple implementation, which is quite reasonable for small hash tables is
to use an association list:
\begin{caml_example}{toplevel}
class ['a, 'b] small_hashtbl : ['a, 'b] hash_table =
  object
    val mutable table = []
    method find key = List.assoc key table
    method add key value = table <- (key, value) :: table
  end;;
\end{caml_example}
A better implementation, and one that scales up better, is to use a
true hash table\ldots\ whose elements are small hash tables!
\begin{caml_example}{toplevel}
class ['a, 'b] hashtbl size : ['a, 'b] hash_table =
  object (self)
    val table = Array.init size (fun i -> new small_hashtbl)
    method private hash key =
      (Hashtbl.hash key) mod (Array.length table)
    method find key = table.(self#hash key) # find key
    method add key = table.(self#hash key) # add key
  end;;
\end{caml_example}

% problem

% solution

\subsection{ss:set-as-class}{Sets}

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~\ref{s:friends}. 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.
\begin{caml_example*}{toplevel}
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 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;;
\end{caml_example*}

\section{s:subject-observer}{The subject/observer pattern}

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.
\begin{caml_example}{toplevel}
class virtual ['subject, 'event] observer =
  object
    method virtual notify : 'subject ->  'event -> unit
  end;;
\end{caml_example}
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".
\begin{caml_example}{toplevel}
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;;
\end{caml_example}
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.
\begin{caml_example}{toplevel}
type event = Raise | Resize | Move;;
let string_of_event = function
    Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";;
let count = ref 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 ['subject] window_observer =
  object
    inherit ['subject, event] observer
    method notify s e = s#draw
  end;;
\end{caml_example}
As can be expected, the type of "window" is recursive.
\begin{caml_example}{toplevel}
let window = new window_subject;;
\end{caml_example}
However, the two classes of "window_subject" and "window_observer" are not
mutually recursive.
\begin{caml_example}{toplevel}
let window_observer = new window_observer;;
window#add_observer window_observer;;
window#move 1;;
\end{caml_example}

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.
\begin{caml_example}{toplevel}
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 ['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;;
\end{caml_example}
We can also create a different kind of observer:
\begin{caml_example}{toplevel}
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;;
\end{caml_example}
and attach several observers to the same object:
\begin{caml_example}{toplevel}
let window = new richer_window_subject;;
window#add_observer (new richer_window_observer);;
window#add_observer (new trace_observer);;
window#move 1; window#resize 2;;
\end{caml_example}

%\subsection{ss:Classes used as modules with inheritance}
%
% to be filled for next release...
%
% an example of stateless objects used to provide inheritance in modules
%


% LocalWords:  objectexamples bsection init caml val int Oo succ incr ref
% LocalWords:  typecheck leq bool cp eval sig struct ABSPOINT Abspoint iter neg
% LocalWords:  accu mem rec repr Euro euro ccp inlined ostring len concat OCaml