次の例は、 Subject / Observer パターンとして知られ、相互に接続されたクラスを伴う難しい継承の問題としてよく文献で紹介されます。 一般的なパターンは相互再帰的にやりとりをする2つのクラスの対の定義なります。
クラス observer
には、メソッド notify
があり、 subject とアクションを実行するイベントの二引数を取ります。
#
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
はインスタンス変数に observer のリストを保持し、 notify_observers
メソッドですべての observer に、特定のイベント e
を伴って notify
メッセージを配信します。
#
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
難しいのは大抵、継承で上記のパターンのインスタンスを定義することです。 これはウィンドウを操作する次の例で示すように、 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
当然、ウィンドウの型は再帰的になります。
#
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
は、依然として継承で拡張することができます。 例えば、 subject に新しい振る舞いを加え、 observer の振舞いを再定義することができます。
#
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
別の種類の observer を作成することもできます:
#
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
そして同じオブジェクトに複数の observer を接続します。
#
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 = ()