Visitorサポートをclass helperで後付け

理想。

program Project1;

{$APPTYPE CONSOLE}

type
  TSuper = class(TObject)
  end;

  TSub1 = class(TSuper)
  end;

  TSub2 = class(TSuper)
  end;

type
  TVisitor = class abstract(TObject)
    procedure Visit(Obj: TSub1); overload; virtual; abstract;
    procedure Visit(Obj: TSub2); overload; virtual; abstract;
  end;

  VisitorSupport = class helper for TSuper
    procedure Accept(Visitor: TVisitor); virtual;
  end;

  VisitorSupport1 = class helper(VisitorSupport) for TSub1
    procedure Accept(Visitor: TVisitor); override;
  end;

  VisitorSupport2 = class helper(VisitorSupport) for TSub2
    procedure Accept(Visitor: TVisitor); override;
  end;

procedure VisitorSupport.Accept(Visitor: TVisitor);
begin
  Assert(False);  {後付けなのでabstractにできない}
end;

procedure VisitorSupport1.Accept(Visitor: TVisitor);
begin
  Visitor.Visit(Self)
end;

procedure VisitorSupport2.Accept(Visitor: TVisitor);
begin
  Visitor.Visit(Self)
end;

type
  TSampleVisitor = class(TVisitor)
    procedure Visit(Obj: TSub1); overload; override;
    procedure Visit(Obj: TSub2); overload; override;
  end;

procedure TSampleVisitor.Visit(Obj: TSub1);
begin
  WriteLn('TSub1');
end;

procedure TSampleVisitor.Visit(Obj: TSub2);
begin
  WriteLn('TSub2');
end;

var
  Obj1, Obj2: TSuper;
  V: TSampleVisitor;
begin
  Obj1 := TSub1.Create;
  Obj2 := TSub2.Create;
  V := TSampleVisitor.Create;
  Obj1.Accept(V);
  Obj2.Accept(V);

  ReadLn;
end;

現実。

...>project1

ハンドルされていない例外 : Borland.Delphi.EAssertionFailed: アサートの (D:\Progr
amming\tests\del10netvisitor\Project1.dpr - 37)
   at Borland.Delphi.Units.System.@Assert(String Message, String Filename, Int32
 LineNumber)
   at Project1.VisitorSupport.@5VisitorSupport.Accept(TVisitor Visitor)
   at Project1.Units.Project1.Project1() in D:\Programming\tests\del10netvisitor
\Project1.dpr:line 83

妥協。

program Project1;

{$APPTYPE CONSOLE}

type
  TSuper = class(TObject)
  end;

  TSub1 = class;
  TSub2 = class;

  TVisitor = class abstract(TObject)
    procedure Visit(Obj: TSub1); overload; virtual; abstract;
    procedure Visit(Obj: TSub2); overload; virtual; abstract;
  end;

  VisitorSupport = class helper for TSuper
    procedure Accept(Visitor: TVisitor); virtual;
  end;

  TSub1 = class(TSuper)
    procedure Accept(Visitor: TVisitor); override;
  end;

  TSub2 = class(TSuper)
    procedure Accept(Visitor: TVisitor); override;
  end;

procedure VisitorSupport.Accept(Visitor: TVisitor);
begin
  Assert(False);  {後付けなのでabstractにできない}
end;

procedure TSub1.Accept(Visitor: TVisitor);
begin
  Visitor.Visit(Self)
end;

procedure TSub2.Accept(Visitor: TVisitor);
begin
  Visitor.Visit(Self)
end;

type
  TSampleVisitor = class(TVisitor)
    procedure Visit(Obj: TSub1); overload; override;
    procedure Visit(Obj: TSub2); overload; override;
  end;

procedure TSampleVisitor.Visit(Obj: TSub1);
begin
  WriteLn('TSub1');
end;

procedure TSampleVisitor.Visit(Obj: TSub2);
begin
  WriteLn('TSub2');
end;

var
  Obj1, Obj2: TSuper;
  V: TSampleVisitor;
begin
  Obj1 := TSub1.Create;
  Obj2 := TSub2.Create;
  V := TSampleVisitor.Create;
  Obj1.Accept(V);
  Obj2.Accept(V);

  ReadLn;
end.

結果。

...>project1
TSub1
TSub2

class helperはいまひとつMixJuiceには及ばない、と、MixJuiceを仕様書だけ読んですげーと感心した*1私の戯れ言。
実際には可能な限り静的に解決されてしまうあたり応用が利かない。virtual付けても、オブジェクト自身がoverrideしていなければ、他のclass helperがoverrideしていても結び付かないのです。インスタンスの型ではなくて変数型を見て、TSuperに対応するclass helperはVisitorSupportである、と、実に明快過ぎる。
前者の使い方で多態してくれたら…って、ちょっとまて私。前者の使い方ができるならそもそもVisitorの形を取る必要がまるで無いわけで…。http://staff.aist.go.jp/y-ichisugi/ja/mj/design-pattern/index.htmlにも「アブストラクトメソッド追加」って書いてあるし。
…なにやってたんだろう。

*1:後から知りましたがこれがMixJuiceの「正しい使い方」らしい