第 8 章 使用类和模块的高级示例



在本章中，我们将展示一些使用对象、类和模块的较大示例。我们将通过银行账户的示例同时回顾许多对象特性。我们将展示如何将标准库中的模块表示为类。最后，我们将通过窗口管理器的示例描述一种称为 *虚拟类型* 的编程模式。

1 扩展示例：银行账户

在本节中，我们将通过改进、调试和专门化以下简单银行账户的初始朴素定义来说明对象和继承的大多数方面。（我们重用在第 3 章末尾定义的模块 Euro。）

# 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 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方法的实现。为了将一个字符串与另一个相同类的字符串连接起来，必须能够从外部访问实例变量。因此，必须定义一个返回s的repr方法。以下是字符串的正确定义

# 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

在这里，公开字符串的表示可能无害。我们也可以像在第 ‍3.17节的money类中隐藏货币一样，隐藏字符串的表示。

栈

对于参数化数据类型，有时可以使用模块或类作为替代方案。实际上，在某些情况下，这两种方法非常相似。例如，栈可以很容易地实现为一个类

# 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 = <obj>
# s#fold ( + ) 0;;
- : int = 0
# s;;
- : (int, int) stack2 = <obj>

更好的解决方案是使用多态方法，这些方法是在 OCaml 3.05 版本中引入的。多态方法使得可以在 fold 的类型中将类型变量 'b 视为全局量化，从而为 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 t2 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 = <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; .. > as '_weak3) window_subject as 'a = <obj>

但是，window_subject 和 window_observer 这两个类不是相互递归的。

# let window_observer = new window_observer;;
val window_observer : (< draw : unit; .. > as '_weak4) window_observer = <obj>
# 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 = <obj>
# window#add_observer (new richer_window_observer);;
- : unit = ()
# window#add_observer (new trace_observer);;
- : unit = ()
# window#move 1; window#resize 2;;
<Window 1 <== Move> <Window 1 <== Raise> {Position = 1; Size = 1} {Position = 1; Size = 1} <Window 1 <== Resize> <Window 1 <== Raise> {Position = 1; Size = 3} {Position = 1; Size = 3} - : unit = ()
(章节作者：Didier Rémy)
版权所有 © 2024 法国国家信息与自动化研究所