Глава 8 Расширенные примеры с классами и модулями
- 8.1 Расширенный пример: банковские счета
- 8.2 Простые модули как классы
- 8.3 Паттерн наблюдатель/субъект
(Глава написана Didier Rémy)
В этой главе мы показываем несколько более крупных примеров, использующих объекты, классы и модули. Мы рассматриваем многие особенности объектов одновременно на примере банковского счета. Мы показываем, как модули из стандартной библиотеки можно выразить в виде классов. Наконец, мы описываем программный паттерн, известный как виртуальные типы, на примере менеджеров окон.
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;;
8.2 Простые модули как классы
Можно задаться вопросом, можно ли рассматривать такие примитивные типы, как целые числа и строки, как объекты. Хотя это обычно неинтересно для целых чисел или строк, могут быть ситуации, где это желательно. Класс money выше — один из таких примеров. Здесь мы покажем, как это сделать для строк.
8.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 Можно определить другой конструктор класса строка, который возвращает новую строку заданной длины:
# 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.
# 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 8.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 8.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;;
8.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; _.. > window_subject as 'a =
Однако, два класса window_subject и window_observer не являются взаимно рекурсивными.
# let window_observer = new window_observer;; val window_observer : < draw : unit; _.. > 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; _.. > 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-2022 INRIA.
https://v2.ocaml.org/releases/5.0/htmlman/advexamples.html
