Глава 8. Продвинутые примеры с классами и модулями
В этой главе мы рассмотрим несколько более крупных примеров, использующих объекты, классы и модули. На примере банковского счёта мы одновременно изучим многие возможности объектов. Мы покажем, как модули из стандартной библиотеки можно выразить в виде классов. Наконец, на примере оконных менеджеров мы опишем шаблон программирования, известный как виртуальные типы.
1 Расширенный пример: банковские счета
В этом разделе мы проиллюстрируем большинство аспектов объектов и наследования, последовательно уточняя, отлаживая и специализируя следующее исходное наивное определение простого банковского счёта. (Мы повторно используем модуль Euro, определённый в конце главы 3.)
# let euro = new Euro.c;; val euro : float -> Euro.c =
# let zero = euro 0.;; val zero : Euro.c =
# let neg x = x#times (-1.);; val neg : < times : float -> 'a; .. > -> 'a =
# 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 =
Теперь мы уточним это определение, добавив метод для вычисления процентов.
# 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 приватным, поскольку очевидно, что его не следует свободно вызывать извне. В данном случае он доступен только подклассам, которые будут выполнять ежемесячное или ежегодное обновление счёта.
Вскоре следует исправить ошибку в текущем определении: метод внесения средств можно использовать для снятия денег, внося отрицательные суммы. Это можно исправить напрямую:
# 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; Retrieval ]
Закрыть счёт можно с помощью следующей полиморфной функции:
# let close c = c#withdraw c#balance;; val close : < balance : 'a; withdraw : 'a -> 'b; .. > -> 'b =
Разумеется, это применимо ко всем типам счетов.
Наконец, объединим несколько версий счёта в модуль Account, параметризованный валютой.
# 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;;
Этот пример показывает, как с помощью модулей объединить несколько определений классов, которые фактически можно рассматривать как единое целое. Банк предоставлял бы это целое для внутреннего и внешнего использования. Оно реализовано в виде функтора, параметризованного валютой, чтобы один и тот же код можно было использовать для создания счетов в разных валютах.
Класс bank — это реализация банковского счёта (его можно было бы встроить непосредственно). Именно он будет использоваться для дальнейших расширений, уточнений и т. д. Клиенту же будет предоставлено только клиентское представление.
# 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. Функтор Client может остаться без изменений: ему передаётся новое определение для создания клиентского представления расширенного счёта.
# 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;;
2 Простые модули в виде классов
Можно задаться вопросом, возможно ли представлять примитивные типы, такие как целые числа и строки, в виде объектов. Обычно это не представляет интереса для целых чисел или строк, однако в некоторых случаях такая возможность может быть полезна. Примером служит описанный выше класс money. Здесь мы покажем, как сделать это для строк.
2.1 Строки
Наивное определение строк в виде объектов могло бы выглядеть так:
# class ostring s =
object
method get n = String.get s n
method print = print_string s
method escaped = new ostring (String.escaped s)
end;;
class ostring :
string ->
object
method escaped : ostring
method get : int -> char
method print : unit
end Однако метод escaped возвращает объект класса ostring, а не объект текущего класса. Поэтому, если класс будет расширен, метод escaped будет возвращать только объект родительского класса.
# 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 escaped : ostring
method get : int -> char
method print : unit
method sub : int -> int -> sub_string
end Как было показано в разделе 3.16, решение состоит в использовании функционального обновления. Нам нужно создать переменную экземпляра, содержащую представление строки s.
# 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;;
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 Как показывает выведенный тип, теперь методы escaped и sub возвращают объекты того же типа, что и объекты данного класса.
Другая сложность связана с реализацией метода concat. Чтобы соединить строку с другой строкой того же класса, необходимо иметь возможность получить доступ к переменной экземпляра извне. Для этого нужно определить метод repr, возвращающий s. Вот правильное определение строк:
# 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 Можно определить ещё один конструктор класса string, возвращающий новую строку заданной длины:
# class cstring n = ostring (String.make n ' ');; class cstring : int -> ostring
В данном случае открытое представление строк, вероятно, безвредно. Однако можно было бы скрыть его так же, как мы скрыли валюту в классе money из раздела 3.17.
Стек
Иногда параметрические типы данных можно реализовать как с помощью модулей, так и с помощью классов. Действительно, в некоторых случаях эти подходы весьма похожи. Например, стек можно без труда реализовать в виде класса:
# 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 : ('_weak1, '_weak2) stack2 = # s#fold ( + ) 0;; - : int = 0
# s;; - : (int, int) stack2 =
Более удачное решение — использовать полиморфные методы, появившиеся в OCaml версии 3.05. Полиморфные методы позволяют считать переменную типа 'b в типе fold квантифицированной по всем значениям этого типа. Тогда метод fold получает полиморфный тип Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b. Для метода fold необходимо явно объявить тип, поскольку проверяющая типы система не может вывести полиморфный тип самостоятельно.
# 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 2.2 Хеш-таблицы
Упрощённый класс объектно-ориентированных хеш-таблиц должен иметь следующий тип класса.
# 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 value = table <- (key, value) :: 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 2.3 Множества
При реализации множеств возникает ещё одна сложность. Дело в том, что методу union нужно иметь возможность обращаться к внутреннему представлению другого объекта того же класса.
Это ещё один пример функций-друзей, рассмотренных в разделе 3.17. В отсутствие объектов тот же механизм используется в модуле Set.
В объектно-ориентированной реализации множеств достаточно добавить метод tag, возвращающий представление множества. Поскольку множества параметризованы типом элементов, метод 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;;
3 Шаблон «субъект/наблюдатель»
Следующий пример, известный как шаблон «субъект/наблюдатель», часто описывается в литературе как сложная задача наследования с взаимосвязанными классами. В общем случае этот шаблон сводится к определению пары классов, рекурсивно взаимодействующих друг с другом.
У класса observer есть специальный метод notify, которому нужны два аргумента — субъект и событие, — чтобы выполнить действие.
# class virtual ['subject, 'event] observer =
object
method virtual notify : 'subject -> 'event -> unit
end;;
class virtual ['subject, 'event] observer :
object method virtual notify : 'subject -> 'event -> 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, '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 Обычно сложность состоит в том, чтобы определить экземпляры описанного выше шаблона с помощью наследования. В 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 = # 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; .. > as '_weak3) window_subject as 'a =
Однако классы window_subject и window_observer не являются взаимно рекурсивными.
# let window_observer = new window_observer;; val window_observer : (< draw : unit; .. > as '_weak4) window_observer =
# window#add_observer window_observer;; - : unit = ()
# window#move 1;;
{Position = 1}
- : unit = () Классы window_observer и window_subject по-прежнему можно расширять с помощью наследования. Например, можно добавить новые возможности классу 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; .. > as '_weak5) richer_window_subject as 'a =
# window#add_observer (new richer_window_observer);; - : unit = ()
# window#add_observer (new trace_observer);; - : unit = ()
# window#move 1; window#resize 2;;{Position = 1; Size = 1} {Position = 1; Size = 1} {Position = 1; Size = 3} {Position = 1; Size = 3} - : unit = ()
© 1995-2026 INRIA.
https://ocaml.org/manual/5.5/advexamples.html
