Глава 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;;
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-2024 INRIA.
https://ocaml.org/manual/5.2/advexamples.html
