3.11/Chapter 5 クラスとモジュールの高度な例

このページは最後に更新されてから1年以上経過しています。情報が古い可能性がありますので、ご注意ください。

 (Chapter written by Didier Rémy)

この章では、オブジェクト、クラス、モジュールを使ったより大きな例を示します。 銀行口座の例を用いて、オブジェクトの多くの機能を再考します。 標準ライブラリのモジュールがどのようにクラスとして表現できるのかを示します。 最後に、ウィンドウマネージャの例を通して、仮想型(FIXME:virtual type)として知られるプログラミングパターンを説明します。

高度な例：銀行口座 (Extended example: bank accounts)

この節では、次に示す最初の単純な銀行口座の定義を、改良し、デバッグし、特化することでオブジェクトと継承のほとんどの側面を明らかにしていきます。 (3章の最後のモジュール ユーロ を再び使用します。)

#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メソッドの実装に関する知識を必要としません。

操作の履歴を保持するため，クラスを mutable なフィールド 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

口座を開くとともに最初の金額を入金しておきたいと願う人もいます。 最初の実装はこの要求を扱っていませんが、これは初期化子(FIXME:initializer)を使うことで達成できます。

#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;;
Warning Y: unused variable balance.
- : 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 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;;

これは単一のユニット(FIXME:unit)とみなすことができるいくつかのクラス定義をグループ化するための、モジュールの使い方を示しています。 このユニットは銀行の内部と外部両方での利用によって提供されます。 この実装は通貨を抽象化しているので、同じコードを異なる通貨の口座を提供するために使うことができます。

クラスbankは銀行口座の実際の実装です (インライン化することもできました) (FIXME:どういう意味だ？)。 これをさらなる拡張や改良等のために使うことになります。 逆に、顧客には顧客ビューのみが与えられます。

#module Euro_account = Account(Euro);;
 
#module Client = Euro_account.Client (Euro_account);;
 
#new Client.account (new Euro.c 100.);;

これにより、顧客は残高や口座の履歴への直接のアクセスをもつことはありません。 残高を変える唯一の方法はお金を預けるか引き出すことです。顧客にクラスを与え、口座(たとえば販促のためのディスカウント口座)を作る能力を与えないことが重要です、このために顧客はかれらの口座をパーソナライズできます。 例えば、顧客はdepositとwithdrawメソッドを改良すれば自動的に彼自身の財務簿記ができるようになります。 一方、discount関数は上のように、これ以上のパーソナライゼーションの余地ができないようになっています。

クライアントのビューを Client ファンクタとして提供するのが重要です。これにより、クライアントの口座を、銀行の特化の後に構築することができます。

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;;

クラスを用いた簡単なモジュール (Simple modules as classes)

integerやstringのようなプリミティブ方をオブジェクトとして扱うことができるのかどうか疑問に思った人もいるでしょう。 普通 integerやstringではおもしろくないものの、それが要求されるようないくつかの状況があります。 上の moneyクラスはその一例です。 どのようにして stringでこれを行うかをここで示します。

文字列 Strings

string をオブジェクトとして ばか正直に定義すると次のようになるでしょう： A naive definition of strings as objects could be:

#class ostring s =
#  object
#     method get n = String.get s n
#     method set n c = String.set s n c
#     method print = print_string s
#     method copy = new ostring (String.copy s)
#  end;;
class ostring :
  string ->
  object
    method copy : ostring
    method get : int -> char
    method print : unit
    method set : int -> char -> unit
  end

しかしながら、 copyメソッドは クラス ostring のオブジェクトを返します。現在のクラスのオブジェクトを返すわけではありません。 このため、 クラスがこれ以上拡張された場合には、 copyメソッドは親クラスのオブジェクトを返すだけでしょう。

#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 copy : ostring
    method get : int -> char
    method print : unit
    method set : int -> char -> unit
    method sub : int -> int -> sub_string
  end

解決法は、3.16節でみた関数的な更新(FIXME:functional update)を代わりに使うことです。 文字列の表現を格納するインスタンス変数の作成が必要になります。

#class better_string s =
#  object
#     val repr = s
#     method get n = String.get repr n
#     method set n c = String.set repr n c
#     method print = print_string repr
#     method copy = {< repr = String.copy repr >}
#     method sub start len = {< repr = String.sub s  start len >}
#  end;;
class better_string :
  string ->
  object ('a)
    val repr : string
    method copy : 'a
    method get : int -> char
    method print : unit
    method set : int -> char -> unit
    method sub : int -> int -> 'a
  end

推論された型で示されているように、メソッド copy と sub は クラスの型と同じ型をもつオブジェクトを返すようになります。

他には メソッド concat の実装が難しいです。 文字列を他の文字列と連結するためには、インスタンス変数を外部からアクセスできなければなりません。それゆえ、s を返すメソッド repr が定義されなければなりません。 以下に stringの正しい定義を示します：

#class ostring s =
#  object (self : 'mytype)
#     val repr = s
#     method repr = repr
#     method get n = String.get repr n
#     method set n c = String.set repr n c
#     method print = print_string repr
#     method copy = {< repr = String.copy 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 copy : 'a
    method get : int -> char
    method print : unit
    method repr : string
    method set : int -> char -> unit
    method sub : int -> int -> 'a
  end

クラス string の別のコンストラクタは 与えられた長さの 未初期化の文字列を返すために定義できます：

#class cstring n = ostring (String.create n);;
class cstring : int -> ostring

ここで、 文字列の表現を露出することにおそらく害はありません。 もちろん、 3.17節で通貨を隠したように文字列の表現を隠すこともできます。

スタック Stacks

時々、パラメトリックなデータ型のためにモジュールを使うべきかクラスを使うべきかの間で選択肢が発生します。 実際、二つのアプローチがとても似通ったものになることもあります。 例えば、スタックは素直にクラスとして実装することができます：

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

より良い解は多相メソッドを使うことです。多相メソッドは Objective Caml バージョン 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

ハッシュテーブル Hashtbl

単純バージョンのオブジェクト指向 ハッシュテーブルは 次の クラス型 をもちます。

#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 valeur = table <- (key, valeur) :: 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

集合 Sets

集合を実装することはさらに困難です。 実際、メソッド union は同じクラスの別のオブジェクトの内部実装にアクセスできる必要があります。

これは 3.17節 でみた フレンド関数 (FIXME:friend function) の別の例です。 実際、これはオブジェクトなしのモジュール 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;;

主体/観察者パターン (The subject/observer pattern)

次の例は、主体/観察者パターンとして知られ、相互に接続されたクラスを伴う難しい継承の問題としてよく文献で紹介されます。 一般的なパターンはお互いに再帰的に相互作用する2つのクラスの対の定義が登場します。

クラス observer は、主体とアクションを実行するイベントの2引数をとる特別なメソッド notify を持ちます。

#class virtual ['subject, 'event] observer =
#  object
#    method virtual notify : 'subject ->  'event -> unit
#  end;;
class virtual ['a, 'b] observer :
  object method virtual notify : 'a -> 'b -> unit end

クラスsubjectは、インスタンス変数に観察者のリストを憶えており、あるイベントeを全ての観察者に メッセージ通知をブロードキャストするための特別なメソッド notify_observers を持ちます。

#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, 'b] subject :
  object ('c)
    constraint 'a = < notify : 'c -> 'b -> unit; .. >
    val mutable observers : 'a list
    method add_observer : 'a -> unit
    method notify_observers : 'b -> unit
  end

難しいのは大抵、継承で上記のパターンのインスタンスを定義することです。 これはウィンドウを操作する次の例で示すように自然で明らかな方法でできます。

#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

当然、ウィンドウの型は再帰的になります。

#let window = new window_subject;;
val window : < notify : 'a -> event -> unit; _.. > window_subject as 'a =
  <obj>

しかしながら、 window_subject と window_observer の2つのクラスは相互に再帰していません。

#let window_observer = new window_observer;;
val window_observer : < draw : unit; _.. > window_observer = <obj>
 
#window#add_observer window_observer;;
- : unit = ()
 
#window#move 1;;
{Position = 1}
- : unit = ()

クラス window_observer と window_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 = <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 = ()