Visitor Pattern

[hansmaad]

Wie es scheint, kommt man um hässliche Typecasts nicht herum. Ich hab mir noch eine Lösung geschrieben, die diese Typunterscheidung wenigstens an einer Stelle kapselt und ein normales Visitor 'faked':

Delphi-Quellcode:

unit UBase;
interface

type
    BaseVisitor = class;

    Base = class
    public
      procedure Accept(v : BaseVisitor);virtual;abstract;
    end;

    BaseVisitor = class
    public
        procedure Visit(b : Base); virtual; abstract;
    end;
implementation
end.

Delphi-Quellcode:

unit UnitA;
interface
uses
    UBase;

type
    A = class(Base)
        Socke_ : Integer;
    public
        procedure Accept(v : BaseVisitor);override;
        property Socke : Integer read Socke_;
    end;

implementation

{ A }
procedure A.Accept(v: BaseVisitor);
begin
    v.Visit(Self);
end;

end.

Delphi-Quellcode:

unit UnitB;
interface
uses
    UBase;
type
    B = class(Base)
    private
        Schnitzel_ :String;
    public
        procedure Accept(v : BaseVisitor);override;
        property Schnitzel : String read Schnitzel_;
    end;

implementation

{ B }
procedure B.Accept(v: BaseVisitor);
begin
    v.Visit(Self);
end;

end.

Delphi-Quellcode:

unit UVisitor;

interface
uses
    UBase,
    UConcreteVisitor;
type
    Visitor = class(BaseVisitor)
    private
        V_ :  ConcreteVisitor;
    public
        constructor Create(v : ConcreteVisitor);overload;
        destructor Destroy();override;
        procedure Visit(el : Base); override;
    end;

implementation
uses
    SysUtils,
    UnitA,
    UnitB;

{ Visitor }

constructor Visitor.Create(v: ConcreteVisitor);
begin
  inherited Create;
  V_ := v;
end;

destructor Visitor.Destroy;
begin
  V_.Free;
  inherited;
end;

procedure Visitor.Visit(el: Base);
begin
    // Die gekapselte Ekelstelle:
    if el is A then
        V_.Visit(A(el))
    else if el is B then
        V_.Visit(B(el))
    else
        Raise Exception.Create('Unknown Element!');
end;

end.

Delphi-Quellcode:

unit UConcreteVisitor;

interface

uses
    UnitA,UnitB;
type

    ConcreteVisitor = class
    public
        procedure Visit(x : A);overload;virtual;abstract;
        procedure Visit(x : B);overload;virtual;abstract;
    end;

implementation
end.

Delphi-Quellcode:

unit UWriteVisitor;

interface
uses
    UConcreteVisitor,
    UnitA,
    UnitB;
type
    WriteVisitor = class(ConcreteVisitor)
    public
        procedure Visit(x : A);overload;override;
        procedure Visit(x : B);overload;override;
    end;
implementation
uses
    SysUtils;

{ WriterVisitor }

procedure WriteVisitor.Visit(x: A);
begin
    WriteLn('Ein A! mit ' + IntToStr(x.Socke))
end;

procedure WriteVisitor.Visit(x: B);
begin
    WriteLn('BeeeeH! :>>> ' + x.Schnitzel)
end;

end.

Delphi-Quellcode:

program visit;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Generics.Collections,
  UBase in 'UBase.pas',
  UVisitor in 'UVisitor.pas',
  UConcreteVisitor in 'UConcreteVisitor.pas',
  UnitA in 'UnitA.pas',
  UnitB in 'UnitB.pas',
  UWriteVisitor in 'UWriteVisitor.pas';

var
    list : TList<Base>;
    v : BaseVisitor;
    x : Base;
begin
    list := TList<Base>.Create;
    list.Add(A.Create);
    list.Add(B.Create);

    v := Visitor.Create(WriteVisitor.Create);

    for x in list do
        x.Accept(v);

    list.Free;
    v.Free;

    ReadLn;
end.

Neue Visitor erben von ConcreteVisitor und können wie 'normale' Visitor geschrieben werden.

[Uwe Raabe]

Das ganze läßt sich allerdings viel eleganter, flexibler und nebenbei noch typsicher mit Interfaces realisieren. Dabei können die Basis-Klasse und die abgeleiteten Klassen in unterschiedlichen Units liegen und brauchen über den konkreten Visitor gar nichts wissen. Der Visitor muss natütlich alle Klassen kennen, die er besuchen will.

Delphi-Quellcode:

unit uVisitorTypes;

interface

type
  IVisitor = interface
    ['{59A6BE7C-6BD7-4746-AA37-F42DCB6D8D01}']
    procedure Visit(Instance: IInterface);
    procedure NotSupported(const Name: string);
  end;

  IVisited = interface
    ['{6C55ECC2-E1AB-43DD-96EC-755FF5C12400}']
    procedure Accept(Visitor: IVisitor);
  end;

implementation

end.

Delphi-Quellcode:

unit uBase;

interface

uses
  Classes, uVisitorTypes;

type
  { wahlweise auch von TInterfacedObject ableiten }
  TBase = class(TInterfacedPersistent, IVisited)
  protected
    procedure Accept(Visitor: IVisitor); virtual;
  public
  end;

  IBaseVisitor = interface
    ['{ACD6D82F-8C09-4B13-833B-9C653B99E050}']
    procedure VisitBase(Instance: TBase);
  end;

implementation

uses
  SysUtils;

procedure TBase.Accept(Visitor: IVisitor);
var
  MyVisitor: IBaseVisitor;
begin
  if Supports(Visitor, IBaseVisitor, MyVisitor) then
    MyVisitor.VisitBase(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit unitA;

interface

uses
  uBase, uVisitorTypes;

type
  TA = class(TBase)
  private
    FAZeugs: string;
  protected
    procedure Accept(Visitor: IVisitor); override;
  public
    property AZeugs: string read FAZeugs write FAZeugs;
  end;

  IAVisitor = interface
    ['{3CEF1431-741C-4482-AC9C-1C787DE003C9}']
    procedure VisitA(Instance: TA);
  end;

implementation

uses
  SysUtils;

procedure TA.Accept(Visitor: IVisitor);
var
  MyVisitor: IAVisitor;
begin
  if Supports(Visitor, IAVisitor, MyVisitor) then
    MyVisitor.VisitA(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit unitB;

interface

uses
  uBase, uVisitorTypes;

type
  TB = class(TBase)
  private
    FBZeugs: string;
  protected
    procedure Accept(Visitor: IVisitor); override;
  public
    property BZeugs: string read FBZeugs write FBZeugs;
  end;

  IBVisitor = interface
    ['{801E4A2D-74B6-49FC-8BC6-DCB995AF25F6}']
    procedure VisitB(Instance: TB);
  end;

implementation

uses
  SysUtils;

procedure TB.Accept(Visitor: IVisitor);
var
  MyVisitor: IBVisitor;
begin
  if Supports(Visitor, IBVisitor, MyVisitor) then
    MyVisitor.VisitB(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit uVisitor;

interface

uses
  uVisitorTypes, unitA, unitB;

type
  { wahlweise auch von TInterfacedPersistent ableiten }
  TVisitor = class(TInterfacedObject, IVisitor, IAVisitor, IBVisitor)
  protected
    procedure NotSupported(const Name: string);
    procedure VisitA(Instance: TA);
    procedure VisitB(Instance: TB);
  public
    procedure Visit(Instance: IInterface);
  end;

implementation

uses
  SysUtils;

procedure TVisitor.NotSupported(const Name: string);
begin
  // nach Bedarf ignorieren oder Fehler melden
end;

procedure TVisitor.Visit(Instance: IInterface);
var
  visited: IVisited;
begin
  if Supports(Instance, IVisited, visited) then
    visited.Accept(Self)
  else
    // nach Bedarf ignorieren oder Fehler melden
end;

procedure TVisitor.VisitA(Instance: TA);
begin
  Writeln(Instance.AZeugs);
end;

procedure TVisitor.VisitB(Instance: TB);
begin
  Writeln(Instance.BZeugs);
end;

end.

[hansmaad]

Ok, das sieht ja ganz nett aus (mal davon abgesehen, dass Interfaces für meinen Geschmack generell furchtbar aussehen).

das IBaseVisitor Interface kann ich mir bei einer abstrakten Basisklasse schenken, da es keine Base Instanzen gibt, korrekt?

TVisitor.VisitA(Instance: TA);
TVisitor.VisitB(Instance: TB);

würde ich wohl abstrakt machen und konkrete Besucher von TVisitor ableiten. Das wäre dann im Stil 'Template Methode'. Dieser Supports / Not Supported Kram wird von der Basisklasse behandelt, der konkrete Besucher kümmert sich nur noch um A und B.

Auf den ersten Blick scheint mir das eine ganz brauchbare Lösung zu sein
Ich werde das mal ausprobieren,
Danke!

[Blup]

Im Normalfall Interface-Parameter besser als const deklarieren.
Sonst erfolgt unnötige Referenzzählung (wie auch bei string).

Delphi-Quellcode:

type
  IVisitor = interface
    ['{59A6BE7C-6BD7-4746-AA37-F42DCB6D8D01}']
    procedure Visit(const Instance: IInterface);
    procedure NotSupported(const Name: string);
  end;

  IVisited = interface
    ['{6C55ECC2-E1AB-43DD-96EC-755FF5C12400}']
    procedure Accept(const Visitor: IVisitor);
  end;

[hansmaad]

Zitat von Blup:

Im Normalfall Interface-Parameter besser als const deklarieren.
Sonst erfolgt unnötige Referenzzählung (wie auch bei string).

Was bedeuten in Delphi konstante Parameter? Was kann ich auf ihnen ausrufen? Von C++ kenne ich konstante Methoden, die auf konstanten Instanzen aufgerufen werden können. Sowas gibt es hier aber denke ich nicht.
Was bedeutet es einen const Visitor zu übergeben. Gilt dieses const nur für die Schnittstelle (eigentlich sinnlos da Schnittstellen gar keine Daten haben)? Oder weiß der Compiler, dass die Implementierung von Visit die Visitorinstanz nicht verändert? Was passiert, wenn Visit die Istanz verändert?

[Namenloser]

Zitat von hansmaad:

Oder weiß der Compiler, dass die Implementierung von Visit die Visitorinstanz nicht verändert? Was passiert, wenn Visit die Istanz verändert?

Genau das ist const : Eine Schreibschutz-Markierung. Das erlaubt natürlich gewisse Compileroptimierungen, genauer gesagt kann einfach ein Pointer auf das Original übergeben werden, statt dass eine Kopie auf dem Stack angelegt werden muss.

Zu deiner 2. Frage: Das geht nicht, der Compiler schmeißt dann einen Fehler.

Im Grunde ist const das gleiche wie var , nur mit dem Unterschied, dass das Original garantiert nicht verändert wird.

[himitsu]

CONST ist nicht immer genau das Gleiche wie VAR,
das siehst du, wenn du z.B. const i: Integer mit i: integer und var i: Integer vergleichst, denn dieses wird delphi meißt so weit optimieren, daß hier kein Pointer, sondern direkt der Wert mitgenommen wird, trots des CONST.
dennoch können, vorallem bei referenzzählenden Typen oder gar dem "kranken" WideString und Records, durch das CONST dennoch so einige kleine Stellen optimiert werden, da man hier explizit angibt, daß der Wert nicht verändert wird.

[Uwe Raabe]

Zitat von Blup:

Im Normalfall Interface-Parameter besser als const deklarieren.
Sonst erfolgt unnötige Referenzzählung (wie auch bei string).

Delphi-Quellcode:

type
  IVisitor = interface
    ['{59A6BE7C-6BD7-4746-AA37-F42DCB6D8D01}']
    procedure Visit(const Instance: IInterface);
    procedure NotSupported(const Name: string);
  end;

  IVisited = interface
    ['{6C55ECC2-E1AB-43DD-96EC-755FF5C12400}']
    procedure Accept(const Visitor: IVisitor);
  end;

Ist nur meine persönliche Meinung, aber ich würde genau das nicht machen. Die "überflüssige" Referenzzählung ist ein Inkrement und ein Dekrement eines internen Zählers und fällt überhaupt nicht ins Gewicht. Die Deklaration als const allerding übergibt einen Pointer auf ein Interface und bei jedem Zugriff auf das Interface erfolgt eine zusätzliche Dereferenzierung des Pointers (und übrigens auch noch eine Referenzzählung). Also lediglich in dem Fall, wo das Interface innerhalb der Methode so gut wie nicht verwendet wird, mag die const Variante marginal schneller sein - in allen anderen Fällen ist sie weniger performant.

[Uwe Raabe]

Zitat von hansmaad:

das IBaseVisitor Interface kann ich mir bei einer abstrakten Basisklasse schenken, da es keine Base Instanzen gibt, korrekt

Das hängt davon ab, was dein Visitor tun soll. So könnte ein Visitor, der lediglich auf TBase-Eigenschaften und Methoden zugreift, auch nur das IBaseVisitor-Interface implementieren und die IAVisitor- und IBVisitor-Interfaces gar nicht implementieren. Ergänzend dazu muss man dann allerdings die Implementationen von Accept in TA und TB leicht abwandeln.

Delphi-Quellcode:

procedure TA.Accept(Visitor: IVisitor);
var
  MyVisitor: IAVisitor;
begin
  if Supports(Visitor, IAVisitor, MyVisitor) then
    MyVisitor.VisitA(Self)
  else
    inherited;
end;

Delphi-Quellcode:

procedure TB.Accept(Visitor: IVisitor);
var
  MyVisitor: IBVisitor;
begin
  if Supports(Visitor, IBVisitor, MyVisitor) then
    MyVisitor.VisitB(Self)
  else
    inherited;
end;

Wenn nun der Visitor das passende Interface nicht implementiert, wird einfach die Accept-Methode des Vorfahren aufgerufen.

Delphi-Quellcode:

unit uBaseVisitor;

interface

uses
  Classes, uVisitorTypes, uBase;

type
  TBaseVisitor = class(TInterfacedObject, IVisitor, IBaseVisitor)
  protected
    procedure NotSupported(const Name: string);
    procedure VisitBase(Instance: TBase);
  public
    procedure Visit(Instance: IInterface);
  end;

implementation

uses
  SysUtils;

procedure TBaseVisitor.NotSupported(const Name: string);
begin
  // nach Bedarf ignorieren oder Fehler melden
end;

procedure TBaseVisitor.Visit(Instance: IInterface);
var
  visited: IVisited;
begin
  if Supports(Instance, IVisited, visited) then
    visited.Accept(Self)
  else
    // nach Bedarf ignorieren oder Fehler melden
end;

procedure TBaseVisitor.VisitBase(Instance: TBase);
begin
  // tue was mit Instance, was jedes TBase kann
end;

end.

Zitat von hansmaad:

TVisitor.VisitA(Instance: TA);
TVisitor.VisitB(Instance: TB);

würde ich wohl abstrakt machen und konkrete Besucher von TVisitor ableiten. Das wäre dann im Stil 'Template Methode'. Dieser Supports / Not Supported Kram wird von der Basisklasse behandelt, der konkrete Besucher kümmert sich nur noch um A und B.

Das hängt natürlich auch von deinem konkreten Fall ab. In meinen Anwendungen habe ich sowohl Visitors, die von einem Basis-Visitor abgeleitet sind, als auch solche, die von Grund auf neu implementiert werden.

Wenn irgendeine Struktur (Liste, Baum, ...) von TBase-Abkömmligen vorliegt, könnte man einen Visitor schreiben, der die Struktur iteriert und alle Instanzen zählt. Der bräcuhte dann nur IBaseVisitor implementieren.

Es gibt da keine allgemeingültige Vorgehensweise - wie so oft in unserer Branche...

Ich hatte mal vor, über das Thema "Visitor - eine praktikable Implementierung" einen Artikel zu schreiben, in dem die obige Implentierung erläutert und verschiedene Szenarien durchgespielt werden, aber es kommt halt immer etwas dazwischen.

Wär' ja vielleicht auch was für die Delphi-Tage???