# Глава 5. Дополнительные примеры классов и модулей

В этой главе приведены более масштабные примеры использования классов, объектов и модулей. При разработке банковского счета задействованы многие возможности объектов. В главе показано, как модули стандартной библиотеки используются в качестве классов. В конце главы на примере оконных менеджеров описывается шаблон проектирования, известный как виртуальные типы.

## 5.1 Банковский счет

В этом разделе иллюстрируются особенности объектов и наследования на примере уточнения, отладки и специализации первоначального грубого определения банковского счета (повторно используется модуль `Euro`, разработанный в конце главы 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 =
       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;;

    class account :
      object
        val mutable 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>

Теперь мы расширим класс, добавив метод для вычисления процентов.

    #class account_with_interests =
       object (self)
         inherit account
         method private interest = self # deposit (self # balance # times 0.03)
       end;;

    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

Метод `interest` объявлен как приватный, поскольку он, очевидно, не должен вызываться извне. Таким образом он доступен лишь для субклассов, которые ежемесячно или ежегодно будут обновлять счет.

Кроме того, стоит исправить ошибку в текущем определении: методом `deposit` можно снимать деньги, положив на счет отрицательную сумму. Это просто:

    #class safe_account =
       object
         inherit account
         method deposit x = if zero#leq x then balance <- balance#plus x
       end;;

    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

Однако есть и более тонкий способ исправить ошибку:

    #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;;

    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

В этом случае не требуеся знать реализацию метода `deposit`.

Ради возможности отслеживать операции со счетом в класс добавляется изменяемая переменная `history` и приватный метод `trace`, помещающий в журнал запись об операции. Кроме того, все журналируемые методы переопределяются.

    #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
         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;;

    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

Может возникнуть потребность одновременно открыть счет и перевести на него некоторую сумму. Первоначальное определение не позволяет это делать, но проблема решается с помощью инициализатора:

    #class account_with_deposit x =
       object
         inherit account_with_history
         initializer balance <- x
       end;;

    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

Есть решение лучше:

    #class account_with_deposit x =
       object (self)
         inherit account_with_history
         initializer self#deposit x
       end;;

    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

Оно безопаснее, так как вызов метода `deposit` автоаматически влечет за собой проверку значения и запись о событии в журнал. Проверим:

    #let ccp = new account_with_deposit (euro 100.) in
     let balance = ccp#withdraw (euro 50.) in
     ccp#history;;

    - : Euro.c operation list = [Deposit <obj>; Retrieval <obj>]

Закрытие счета осуществляется следующей полиморфной функцией:

    #let close c = c#withdraw (c#balance);;

    val close : < balance : 'a; withdraw : 'a -> 'b; .. > -> 'b = <fun>

Разумеется, она рабоает для всех типов счетов.

Наконец, несколько версий счета собираются в модуль `Account`, абстрагированный от типа валюты:

    #let today () = (01,01,2000) (* приблизительно *)
     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 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;;

Таким образом, модули помогают группировать определения классов, которые в результате рассматриваются как единое целое. Подобный модуль предоставляется банком как для внешнего, так и для внутреннего использования. Он реализован как функтор, абстрагированный от конкретной валюты, поэтому один и тот же код подходит для работы со счетами, ведущимися в разных денежных единицах.

Класс `bank` является полной реализацией банковского счета (его можно встраивать). Он пригоден для дальнешего расширения, уточнения и т.д. Клиент же, напротив, увидит только `client_view`.

    #module Euro_account = Account(Euro);;

     module Client = Euro_account.Client (Euro_account);;

     new Client.account (new Euro.c 100.);;

Клиенты не имеют прямого доступа ни к методу `balance`, ни к `history`. Единственный для них способ изменить состояние счета - это положить или снять деньги. Необходимо предоставить клиентам именно класс, а не просто возможность создавать счета (типа поощрительного счета `discount`), чтобы они могли персонализовать его. Например, клиент может расширить методы `deposit` и `withdraw`, чтобы вести собственную финансовую историю. С другой стороны, функция `discount` определена так, что ее персонализация невозможна.

Клиентская часть должна быть построена как функтор `Client`, тогда даже после специализации класса `bank` создание клиентских счетов останется возможным. Функтор в этом случае может остаться неизменным и даже в новом определении будет создавать клиентскую часть.

    #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;;

Точно так же можно переопределить и функтор `Client`, дополнив его новыми возможностями, доступными клиенту.

    #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;;

## 5.2 Простые модули как классы

Может возникнуть вопрос, возможно ли рассматривать как объекты примитивные типы, такие как целые числа или строки. Для строк или целых чисел в этом особого смысла обычно нет, но в некоторых ситуациях подобные вещи полезны. Пример тому - класс `money`. Ниже показано, как это делается для строк.

### 5 . 2.1 Строки

Наивное определение строки может быть таким:

    #class ostring s =
       object
          method get n = String.get n
          method set n c = String.set n c
          method print = print_string s
          method copy = new ostring (String.copy s)
       end;;

    class ostring :
      string ->
      object
        method copy : ostring
        method get : string -> int -> char
        method print : unit
        method set : string -> int -> char -> unit
      end

Однако метод `copy` возвращает объект класса `string`, а не текущего класса. Поэтому при дальнейшем расширении `copy` будет возвращать только объект родительского класса:

    #class sub_string s =
       object
          inherit ostring s
          method sub start len = new sub_string (String.sub s  start len)
       end;;

    class sub_string :
      string ->
      object
        method copy : ostring
        method get : string -> int -> char
        method print : unit
        method set : string -> int -> char -> unit
        method sub : int -> int -> sub_string
      end

Как мы видели в разделе 3.15, выходом может быть использование функционального обновления. Надо создать переменную экземпляра, хранящую значение `s`.

    #class better_string s =
       object
          val repr = s
          method get n = String.get n
          method set n c = String.set n c
          method print = print_string repr
          method copy = {< repr = String.copy repr >}
          method sub start len = {< repr = String.sub s  start len >}
       end;;

    class better_string :
      string ->
      object ('a)
        val repr : string
        method copy : 'a
        method get : string -> int -> char
        method print : unit
        method set : string -> int -> char -> unit
        method sub : int -> int -> 'a
      end

Как видно из сокращения, методы `copy` и `sub` теперь возвращают объекты того же типа, что и сам класс.

Еще одно затруднение проявляется в реализации метода `concat`. Чтобы объединить две строки, надо получить доступ извне к переменной экземпляра. Поэтому появляется метод `repr`, возвращающий `s`. Вот правильное определение строки:

    #class ostring s =
       object (self : 'mytype)
          val repr = s
          method repr = repr
          method get n = String.get n
          method set n c = String.set 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;;

    class ostring :
      string ->
      object ('a)
        val repr : string
        method concat : 'a -> 'a
        method copy : 'a
        method get : string -> int -> char
        method print : unit
        method repr : string
        method set : string -> int -> char -> unit
        method sub : int -> int -> 'a
      end

Можно определить еще один конструктор класса, возвращающий неинициализированную строку заданнной длины:

    #class cstring n = ostring (String.create n);;

    class cstring : int -> ostring

Доступ к реализации строки, вероятно, безопасен. Однако, можно и скрыть реализацию, как это делалось для валюты в классе `money` в разделе 3.16.

### 5 . 2.2 Стеки

Для параметризованных типов данных иногда непонятно, стоит ли использовать модули или классы. Действительно, в некоторых ситуациях оба подхода дают примерно одинаковый результат. Стек, например, может быть реализован непосредственно как класс.

    #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

Однако написать метод для итерации по стеку гораздо сложнее. Метод `fold` будет иметь тип `('b -> 'a -> 'b) -> 'b -> 'b`. `'a` здесь является параметром стека. Параметр `'b` относится не к классу `'a stack`, а к параметру метода `fold`. Проще всего сделать `'b` дополнительным параметром класса `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

Но тогда метод `fold` данного объекта будет применим только к функциям, имеющим тот же тип:

    #let s = new stack2;;

    val s : ('_a, '_b) stack2 = <obj>

    #s#fold (+) 0;;

    - : int = 0

    #s;;

    - : (int, int) stack2 = <obj>

Лучше использовать полиморфные методы, появшиеся в Objective Caml с версии 3.05. Они позволяют считать переменную `'b` универсально квантифицируемой, так что метод `fold` получает тип `Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b`. В данном случае требуется явное объявление типа метода, поскольку механизм проверки типов не может сам определить полиморфный тип.

    #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;;

    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

### 5 . 2.3 Хэш-таблицы

Упрощенная версия объектно-ориентированной хэш-таблицы может иметь следующий тип класса:

    #class type ['a, 'b] hash_table =
       object
         method find : 'a -> 'b
         method add : 'a -> 'b -> unit
       end;;

    class type ['a, 'b] hash_table =
      object method add : 'a -> 'b -> unit method find : 'a -> 'b end

Для небольших хэш-таблиц подходит реализация с использованием ассоциативного списка:

    #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;;

    class ['a, 'b] small_hashtbl : ['a, 'b] hash_table

Лучшую масштабируемость обеспечивает реализация основанная на настоящих хэш-таблицах, элементы которых... также являются маленькими хэш-таблицами.

    #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;;

    class ['a, 'b] hashtbl : int -> ['a, 'b] hash_table

### 5 . 2.4 Наборы

Реализация наборов связана с очередной трудностью. Дело в том, что метод `union` должен иметь доступ к внутреннему представлению другого объекта того же класса.

Это второе появление дружественных функций (первое было в разделе 3.16). Действительно, `Set` тоже реализуется как модуль без объектов.

В объектно-ориентированной версии наборов требуется только добавить метод `tag`, возвращающий представление набора. Поскольку набор параметризуется типом элементов, этот метод имеет параметрический тип `'a tag`, конкретный в определении модуля, но абстрактный в сигнатуре. Таким образом, два объекта с методом `tag` одного типа гарантировано будут иметь общее представление извне.

    #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;;

## 5.3 Шаблон субъект/наблюдатель

Следующий пример, известный как шаблон субъект/наблюдатель, часто связывается в литературе со сложной проблемой наследования классов, объединенных внутренними отношениями. Как правило, определяются два класса, рекурсивно взаимодействующие друг с другом.

Класс `observer` включает характерный метод `notify`, принимающий два аргумента - субъект и событие, требующее действия.

    #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

Класс `subject` записывает наблюдателей в переменную экземпляра и с помощью метода `notify_observers` рассылает всем им сообщения `notify` с событием `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

Обычно наиболее сложно определять классы по этому шаблону с помощью наследования. В OCaml подобные проблемы решаются естественным и очевидным способом, как показано ниже в примере с окнами.

    #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

Неудивительно, что тип `window` рекурсивен.

    #let window = new window_subject;;

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

Однако классы `window_subject` и `window_observer` не рекурсивны взаимно:

    #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 = ()

Классы `window_subject` и `window_observer` могут быть расширены через наследование. Например, `subject` может получить новые функции, а функции наблюдателя могут быть переопределены:

    #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

Можно даже создать новый тип наблюдателя:

    #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

и привязать несколько наблюдателей к одному субъекту:

    #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 2 <== Move>
    <Window 2 <== Raise>
    {Position = 1; Size = 1}
    {Position = 1; Size = 1}
    <Window 2 <== Resize>
    <Window 2 <== Raise>
    {Position = 1; Size = 3}
    {Position = 1; Size = 3}
    - : unit = ()