<!DOCTYPE html> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=US-ASCII"> <meta name="generator" content="hevea 2.00"> <link rel="stylesheet" type="text/css" href="manual.css"> <title>Advanced examples with classes and modules</title> </head> <body> <a href="lablexamples.html"><img src="previous_motif.gif" alt="Previous"></a> <a href="index.html"><img src="contents_motif.gif" alt="Up"></a> <a href="language.html"><img src="next_motif.gif" alt="Next"></a> <hr> <h1 class="chapter" id="sec50">Chapter 5  Advanced examples with classes and modules</h1> <ul> <li><a href="advexamples.html#sec51">Extended example: bank accounts</a> </li><li><a href="advexamples.html#sec52">Simple modules as classes</a> </li><li><a href="advexamples.html#sec57">The subject/observer pattern</a> </li></ul> <p> <a id="c:advexamples"></a></p><p><span class="c013">(Chapter written by Didier Rémy)</span></p><p><br> <br> </p><p>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 know of as <em>virtual types</em> through the example of window managers.</p> <h2 class="section" id="sec51">5.1  Extended example: bank accounts</h2> <p> <a id="ss:bank-accounts"></a></p><p>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 <span class="c007">Euro</span> defined at the end of chapter <a href="objectexamples.html#c%3Aobjectexamples">3</a>.) </p><pre><span class="c004">#</span><span class="c003"> let euro = new Euro.c;; <span class="c006">val euro : float -> Euro.c = <fun> </span><span class="c004">#</span> let zero = euro 0.;; <span class="c006">val zero : Euro.c = <obj> </span><span class="c004">#</span> let neg x = x#times (-1.);; <span class="c006">val neg : < times : float -> 'a; .. > -> 'a = <fun> </span><span class="c004">#</span> 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;; <span class="c006">class account : object val mutable balance : Euro.c method balance : Euro.c method deposit : Euro.c -> unit method withdraw : Euro.c -> Euro.c end </span><span class="c004">#</span> let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);; </span><span class="c006">- : Euro.c = <obj> </span></pre><p> We now refine this definition with a method to compute interest. </p><pre><span class="c004">#<span class="c003"> class account_with_interests = object (self) inherit account method private interest = self # deposit (self # balance # times 0.03) end;; <span class="c006">class account_with_interests : object val mutable balance : Euro.c method balance : Euro.c method deposit : Euro.c -> unit method private interest : unit method withdraw : Euro.c -> Euro.c end </span></span></span></pre><p> We make the method <span class="c007">interest</span> 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.</p><p>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: </p><pre><span class="c004">#<span class="c003"> class safe_account = object inherit account method deposit x = if zero#leq x then balance <- balance#plus x end;; <span class="c006">class safe_account : object val mutable balance : Euro.c method balance : Euro.c method deposit : Euro.c -> unit method withdraw : Euro.c -> Euro.c end </span></span></span></pre><p> However, the bug might be fixed more safely by the following definition: </p><pre><span class="c004">#<span class="c003"> 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;; <span class="c006">class safe_account : object val mutable balance : Euro.c method balance : Euro.c method deposit : Euro.c -> unit method withdraw : Euro.c -> Euro.c end </span></span></span></pre><p> In particular, this does not require the knowledge of the implementation of the method <span class="c007">deposit</span>.</p><p>To keep track of operations, we extend the class with a mutable field <span class="c007">history</span> and a private method <span class="c007">trace</span> to add an operation in the log. Then each method to be traced is redefined. </p><pre><span class="c004">#</span><span class="c003"> type 'a operation = Deposit of 'a | Retrieval of 'a;; <span class="c006">type 'a operation = Deposit of 'a | Retrieval of 'a </span><span class="c004">#</span> 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;; </span><span class="c006">class account_with_history : object val mutable balance : Euro.c val mutable history : Euro.c operation list method balance : Euro.c method deposit : Euro.c -> unit method history : Euro.c operation list method private trace : Euro.c operation -> unit method withdraw : Euro.c -> Euro.c end </span></pre><p> 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. </p><pre><span class="c004">#<span class="c003"> class account_with_deposit x = object inherit account_with_history initializer balance <- x end;; <span class="c006">class account_with_deposit : Euro.c -> object val mutable balance : Euro.c val mutable history : Euro.c operation list method balance : Euro.c method deposit : Euro.c -> unit method history : Euro.c operation list method private trace : Euro.c operation -> unit method withdraw : Euro.c -> Euro.c end </span></span></span></pre><p> A better alternative is: </p><pre><span class="c004">#<span class="c003"> class account_with_deposit x = object (self) inherit account_with_history initializer self#deposit x end;; <span class="c006">class account_with_deposit : Euro.c -> object val mutable balance : Euro.c val mutable history : Euro.c operation list method balance : Euro.c method deposit : Euro.c -> unit method history : Euro.c operation list method private trace : Euro.c operation -> unit method withdraw : Euro.c -> Euro.c end </span></span></span></pre><p> Indeed, the latter is safer since the call to <span class="c007">deposit</span> will automatically benefit from safety checks and from the trace. Let’s test it: </p><pre><span class="c004">#<span class="c003"> let ccp = new account_with_deposit (euro 100.) in let _balance = ccp#withdraw (euro 50.) in ccp#history;; <span class="c006">- : Euro.c operation list = [Deposit <obj>; Retrieval <obj>] </span></span></span></pre><p> Closing an account can be done with the following polymorphic function: </p><pre><span class="c004">#<span class="c003"> let close c = c#withdraw (c#balance);; <span class="c006">val close : < balance : 'a; withdraw : 'a -> 'b; .. > -> 'b = <fun> </span></span></span></pre><p> Of course, this applies to all sorts of accounts.</p><p>Finally, we gather several versions of the account into a module <span class="c007">Account</span> abstracted over some currency. </p><pre><span class="c004">#</span><span class="c003"> 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 <U>self#deposit</U> y 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;; </span></pre><p> 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.</p><p>The class <span class="c007">bank</span> is the <em>real</em> 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. </p><pre><span class="c004">#<span class="c003"> module Euro_account = Account(Euro);; module Client = Euro_account.Client (Euro_account);; new Client.account (new Euro.c 100.);; </span></span></pre><p> Hence, the clients do not have direct access to the <span class="c007">balance</span>, nor the <span class="c007">history</span> 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 <span class="c007">discount</span> account), so that they can personalize their account. For instance, a client may refine the <span class="c007">deposit</span> and <span class="c007">withdraw</span> methods so as to do his own financial bookkeeping, automatically. On the other hand, the function <span class="c007">discount</span> is given as such, with no possibility for further personalization.</p><p>It is important to provide the client’s view as a functor <span class="c007">Client</span> so that client accounts can still be built after a possible specialization of the <span class="c007">bank</span>. The functor <span class="c007">Client</span> may remain unchanged and be passed the new definition to initialize a client’s view of the extended account. </p><pre><span class="c004">#<span class="c003"> 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;; </span></span></pre><p> The functor <span class="c007">Client</span> may also be redefined when some new features of the account can be given to the client. </p><pre><span class="c004">#<span class="c003"> 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;; </span></span></pre> <h2 class="section" id="sec52">5.2  Simple modules as classes</h2> <p> <a id="ss:modules-as-classes"></a></p><p>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 <span class="c007">money</span> above is such an example. We show here how to do it for strings.</p> <h3 class="subsection" id="sec53">5.2.1  Strings</h3> <p> <a id="module:string"></a></p><p>A naive definition of strings as objects could be: </p><pre><span class="c004">#<span class="c003"> class ostring s = object method get n = String.get s n method set n c = String.set s n c method print = print_string s method copy = new ostring (String.copy s) end;; <span class="c006">class ostring : string -> object method copy : ostring method get : int -> char method print : unit method set : int -> char -> unit end </span></span></span></pre><p> However, the method <span class="c007">copy</span> returns an object of the class <span class="c007">ostring</span>, and not an objet of the current class. Hence, if the class is further extended, the method <span class="c007">copy</span> will only return an object of the parent class. </p><pre><span class="c004">#<span class="c003"> class sub_string s = object inherit ostring s method sub start len = new sub_string (String.sub s start len) end;; <span class="c006">class sub_string : string -> object method copy : ostring method get : int -> char method print : unit method set : int -> char -> unit method sub : int -> int -> sub_string end </span></span></span></pre><p> As seen in section <a href="objectexamples.html#ss%3Abinary-methods">3.16</a>, the solution is to use functional update instead. We need to create an instance variable containing the representation <span class="c007">s</span> of the string. </p><pre><span class="c004">#<span class="c003"> class better_string s = object val repr = s method get n = String.get repr n method set n c = String.set repr n c method print = print_string repr method copy = {< repr = String.copy repr >} method sub start len = {< repr = String.sub s start len >} end;; <span class="c006">class better_string : string -> object ('a) val repr : string method copy : 'a method get : int -> char method print : unit method set : int -> char -> unit method sub : int -> int -> 'a end </span></span></span></pre><p> As shown in the inferred type, the methods <span class="c007">copy</span> and <span class="c007">sub</span> now return objects of the same type as the one of the class.</p><p>Another difficulty is the implementation of the method <span class="c007">concat</span>. 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 <span class="c007">repr</span> returning s must be defined. Here is the correct definition of strings: </p><pre><span class="c004">#<span class="c003"> class ostring s = object (self : 'mytype) val repr = s method repr = repr method get n = String.get repr n method set n c = String.set repr n c method print = print_string repr method copy = {< repr = String.copy repr >} method sub start len = {< repr = String.sub s start len >} method concat (t : 'mytype) = {< repr = repr ^ t#repr >} end;; <span class="c006">class ostring : string -> object ('a) val repr : string method concat : 'a -> 'a method copy : 'a method get : int -> char method print : unit method repr : string method set : int -> char -> unit method sub : int -> int -> 'a end </span></span></span></pre><p> Another constructor of the class string can be defined to return an uninitialized string of a given length: </p><pre><span class="c004">#<span class="c003"> class cstring n = ostring (String.create n);; <span class="c006">class cstring : int -> ostring </span></span></span></pre><p> 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 <span class="c007">money</span> of section <a href="objectexamples.html#ss%3Afriends">3.17</a>.</p> <h4 class="subsubsection" id="sec54">Stacks</h4> <p> <a id="module:stack"></a></p><p>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: </p><pre><span class="c004">#</span><span class="c003"> exception Empty;; <span class="c006">exception Empty </span><span class="c004">#</span> 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;; </span><span class="c006">class ['a] stack : object val mutable l : 'a list method clear : unit method length : int method pop : 'a method push : 'a -> unit end </span></pre><p> However, writing a method for iterating over a stack is more problematic. A method <span class="c007">fold</span> would have type <span class="c007">('b -> 'a -> 'b) -> 'b -> 'b</span>. Here <span class="c007">'a</span> is the parameter of the stack. The parameter <span class="c007">'b</span> is not related to the class <span class="c007">'a stack</span> but to the argument that will be passed to the method <span class="c007">fold</span>. A naive approach is to make <span class="c007">'b</span> an extra parameter of class <span class="c007">stack</span>: </p><pre><span class="c004">#<span class="c003"> class ['a, 'b] stack2 = object inherit ['a] stack method fold f (x : 'b) = List.fold_left f x l end;; <span class="c006">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 </span></span></span></pre><p> However, the method <span class="c007">fold</span> of a given object can only be applied to functions that all have the same type: </p><pre><span class="c004">#</span><span class="c003"> let s = new stack2;; <span class="c006">val s : ('_a, '_b) stack2 = <obj> </span><span class="c004">#</span> s#fold (+) 0;; <span class="c006">- : int = 0 </span><span class="c004">#</span> s;; </span><span class="c006">- : (int, int) stack2 = <obj> </span></pre><p> 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 <span class="c007">'b</span> in the type of <span class="c007">fold</span> as universally quantified, giving <span class="c007">fold</span> the polymorphic type <span class="c007">Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b</span>. An explicit type declaration on the method <span class="c007">fold</span> is required, since the type checker cannot infer the polymorphic type by itself. </p><pre><span class="c004">#<span class="c003"> 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;; <span class="c006">class ['a] stack3 : 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 </span></span></span></pre> <h3 class="subsection" id="sec55">5.2.2  Hashtbl</h3> <p> <a id="module:hashtbl"></a></p><p>A simplified version of object-oriented hash tables should have the following class type. </p><pre><span class="c004">#<span class="c003"> class type ['a, 'b] hash_table = object method find : 'a -> 'b method add : 'a -> 'b -> unit end;; <span class="c006">class type ['a, 'b] hash_table = object method add : 'a -> 'b -> unit method find : 'a -> 'b end </span></span></span></pre><p> A simple implementation, which is quite reasonable for small hastables is to use an association list: </p><pre><span class="c004">#<span class="c003"> class ['a, 'b] small_hashtbl : ['a, 'b] hash_table = object val mutable table = [] method find key = List.assoc key table method add key valeur = table <- (key, valeur) :: table end;; <span class="c006">class ['a, 'b] small_hashtbl : ['a, 'b] hash_table </span></span></span></pre><p> A better implementation, and one that scales up better, is to use a true hash tables… whose elements are small hash tables! </p><pre><span class="c004">#<span class="c003"> 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;; <span class="c006">class ['a, 'b] hashtbl : int -> ['a, 'b] hash_table </span></span></span></pre> <h3 class="subsection" id="sec56">5.2.3  Sets</h3> <p> <a id="module:set"></a></p><p>Implementing sets leads to another difficulty. Indeed, the method <span class="c007">union</span> needs to be able to access the internal representation of another object of the same class.</p><p>This is another instance of friend functions as seen in section <a href="objectexamples.html#ss%3Afriends">3.17</a>. Indeed, this is the same mechanism used in the module <span class="c007">Set</span> in the absence of objects.</p><p>In the object-oriented version of sets, we only need to add an additional method <span class="c007">tag</span> to return the representation of a set. Since sets are parametric in the type of elements, the method <span class="c007">tag</span> has a parametric type <span class="c007">'a tag</span>, concrete within the module definition but abstract in its signature. From outside, it will then be guaranteed that two objects with a method <span class="c007">tag</span> of the same type will share the same representation. </p><pre><span class="c004">#<span class="c003"> 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;; </span></span></pre> <h2 class="section" id="sec57">5.3  The subject/observer pattern</h2> <p> <a id="ss:subject-observer"></a></p><p>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.</p><p>The class <span class="c007">observer</span> has a distinguished method <span class="c007">notify</span> that requires two arguments, a subject and an event to execute an action. </p><pre><span class="c004">#<span class="c003"> class virtual ['subject, 'event] observer = object method virtual notify : 'subject -> 'event -> unit end;; <span class="c006">class virtual ['subject, 'event] observer : object method virtual notify : 'subject -> 'event -> unit end </span></span></span></pre><p> The class <span class="c007">subject</span> remembers a list of observers in an instance variable, and has a distinguished method <span class="c007">notify_observers</span> to broadcast the message <span class="c007">notify</span> to all observers with a particular event <span class="c007">e</span>. </p><pre><span class="c004">#<span class="c003"> 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;; <span class="c006">class ['a, 'event] subject : object ('b) constraint 'a = < notify : 'b -> 'event -> unit; .. > val mutable observers : 'a list method add_observer : 'a -> unit method notify_observers : 'event -> unit end </span></span></span></pre><p> 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. </p><pre><span class="c004">#</span><span class="c003"> type event = Raise | Resize | Move;; <span class="c006">type event = Raise | Resize | Move </span><span class="c004">#</span> let string_of_event = function Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";; <span class="c006">val string_of_event : event -> string = <fun> </span><span class="c004">#</span> let count = ref 0;; <span class="c006">val count : int ref = {contents = 0} </span><span class="c004">#</span> 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;; <span class="c006">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 </span><span class="c004">#</span> class ['subject] window_observer = object inherit ['subject, event] observer method notify s e = s#draw end;; </span><span class="c006">class ['a] window_observer : object constraint 'a = < draw : unit; .. > method notify : 'a -> event -> unit end </span></pre><p> As can be expected, the type of <span class="c007">window</span> is recursive. </p><pre><span class="c004">#<span class="c003"> let window = new window_subject;; <span class="c006">val window : < notify : 'a -> event -> unit; _.. > window_subject as 'a = <obj> </span></span></span></pre><p> However, the two classes of <span class="c007">window_subject</span> and <span class="c007">window_observer</span> are not mutually recursive. </p><pre><span class="c004">#</span><span class="c003"> let window_observer = new window_observer;; <span class="c006">val window_observer : < draw : unit; _.. > window_observer = <obj> </span><span class="c004">#</span> window#add_observer window_observer;; <span class="c006">- : unit = () </span><span class="c004">#</span> window#move 1;; </span><span class="c006">{Position = 1} - : unit = () </span></pre><p>Classes <span class="c007">window_observer</span> and <span class="c007">window_subject</span> can still be extended by inheritance. For instance, one may enrich the <span class="c007">subject</span> with new behaviors and refine the behavior of the observer. </p><pre><span class="c004">#</span><span class="c003"> 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;; <span class="c006">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 </span><span class="c004">#</span> 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;; </span><span class="c006">class ['a] richer_window_observer : object constraint 'a = < draw : unit; raise : unit; .. > method notify : 'a -> event -> unit end </span></pre><p> We can also create a different kind of observer: </p><pre><span class="c004">#<span class="c003"> 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;; <span class="c006">class ['a] trace_observer : object constraint 'a = < identity : int; .. > method notify : 'a -> event -> unit end </span></span></span></pre><p> and attach several observers to the same object: </p><pre><span class="c004">#</span><span class="c003"> let window = new richer_window_subject;; <span class="c006">val window : < notify : 'a -> event -> unit; _.. > richer_window_subject as 'a = <obj> </span><span class="c004">#</span> window#add_observer (new richer_window_observer);; <span class="c006">- : unit = () </span><span class="c004">#</span> window#add_observer (new trace_observer);; <span class="c006">- : unit = () </span><span class="c004">#</span> window#move 1; window#resize 2;; </span><span class="c006"><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 = () </span></pre> <hr> <a href="lablexamples.html"><img src="previous_motif.gif" alt="Previous"></a> <a href="index.html"><img src="contents_motif.gif" alt="Up"></a> <a href="language.html"><img src="next_motif.gif" alt="Next"></a> </body> </html>