第 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 方法設為私有，因為很明顯它不應該從外部自由呼叫。在這裡，它僅可供子類別存取，子類別將管理帳戶的每月或每年更新。

我們應該盡快修復目前定義中的一個錯誤：存款方法可以透過存入負數金額來提款。我們可以直接修復此問題

# 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) (* 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 的實作。為了將字串與同類別的另一個字串連接起來，必須能夠從外部存取實例變數。因此，必須定義一個傳回 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

這裡，公開字串的表示方式可能無害。我們也可以像在 money 類別中隱藏貨幣一樣，隱藏字串的表示方式，如第 3.17 節所述 ‍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 = <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 節中看到的友元函式的另一個實例 ‍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 = <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 編寫)
Copyright © 2024 Institut National de Recherche en Informatique et en Automatique