Глава 8 Расширенные примеры с классами и модулями
- 8.1 Расширенный пример: банковские счета
- 8.2 Простые модули как классы
- 8.3 Паттерн наблюдатель/субъект
(Глава написана Дидье Реми)
В этой главе мы покажем несколько более крупных примеров использования объектов, классов и модулей. Мы рассмотрим многие из особенностей работы с объектами на примере банковского счета. Мы покажем, как модули из стандартной библиотеки могут быть представлены как классы. Наконец, мы опишем паттерн программирования, известный как виртуальные типы, на примере менеджеров окон.
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 приватным, поскольку очевидно, что к нему не должно быть свободного доступа извне. Здесь он доступен только для подклассов, которые будут управлять ежемесячными или ежегодными обновлениями счета.
Вскоре мы должны исправить ошибку в текущем определении: метод 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; 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 Можно определить другой конструктор класса 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.
# 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/4.14/htmlman/advexamples.html
