Search code examples
delphioopdelphi-2009visitor-pattern

Delphi Enterprise: how can I apply the Visitor Pattern without circular references?


With Delphi 2009 Enterprise I created code for the GoF Visitor Pattern in the model view, and separated the code in two units: one for the domain model classes, one for the visitor (because I might need other units for different visitor implementations, everything in one unit? 'Big ball of mud' ahead!).

unit VisitorUnit;

interface

uses
  ConcreteElementUnit;

type
  IVisitor = interface;

  IElement = interface
  procedure Accept(AVisitor :IVisitor);
  end;

  IVisitor = interface
  procedure VisitTConcreteElement(AElement :TConcreteElement);
  end;

  TConcreteVisitor = class(TInterfacedObject, IVisitor)
  public
    procedure VisitTConcreteElement(AElement :TConcreteElement);
  end;

implementation

procedure TConcreteVisitor.VisitTConcreteElement(AElement :TConcreteElement);
begin
  { provide implementation here }
end;

end.

and the second unit for the business model classes

unit ConcreteElementUnit;

interface

uses
  VisitorUnit;

type
  TConcreteElement = class(TInterfacedObject, IElement)
  public
    procedure Accept(AVisitor :IVisitor); virtual;
  end;

  Class1 = class(TConcreteElement)
  public
    procedure Accept(AVisitor :IVisitor);
  end;

implementation

{ Class1 }

procedure Class1.Accept(AVisitor: IVisitor);
begin
  AVisitor.VisitTConcreteElement(Self);
end;

end.

See the problem? A circular unit reference. Is there an elegant solution? I guess it requires "n+1" additional units with base interface / base class definitions to avoid the CR problem, and tricks like hard casts?


Solution

  • I use the following scheme to implement a flexible visitor pattern:

    Declaration of base visitor types

    unit uVisitorTypes;
    type
      IVisited = interface
      { GUID }
        procedure Accept(Visitor: IInterface);
      end;
    
      IVisitor = interface
      { GUID }
        procedure Visit(Instance: IInterface);
      end;
    
      TVisitor = class(..., IVisitor)
        procedure Visit(Instance: IInterface);
      end;
    
    procedure TVisitor.Visit(Instance: IInterface);
    var
      visited: IVisited;
    begin
      if Supports(Instance, IVisited, visited) then 
        visited.Accept(Self)
      else
        // raise exception or handle error elsewise    
    end;
    

    The unit for of the element class

    unit uElement;
    
    type
      TElement = class(..., IVisited)
        procedure Accept(Visitor: IInterface);
      end;
    
      // declare the visitor interface next to the class-to-be-visited declaration   
      IElementVisitor = interface
      { GUID }
        procedure VisitElement(Instance: TElement);
      end;
    
    procedure TElement.Accept(Visitor: IInterface);
    var
      elementVisitor: IElementVisitor;
    begin
      if Supports(Visitor, IElementVisitor, elementVisitor) then
        elementVisitor.VisitElement(Self)
      else
        // if override call inherited, handle error or simply ignore
    end;
    

    The actual visitor implementation

    unit MyVisitorImpl;
    
    uses
      uVisitorTypes, uElement;
    
    type
      TMyVisitor = class(TVisitor, IElementVisitor)
        procedure VisitElement(Instance: TElement);
      end;
    
    procedure TMyVisitor.VisitElement(Instance: TElement);
    begin
      // Do whatever you want with Instance 
    end;
    

    Calling the visitor

    uses
      uElement, uMyElementVisitor;
    
    var
      visitor: TMyVisitor;
      element: TElement;
    begin
      // get hands on some element
    
      visitor := TMyVisitor.Create;
      try
        visitor.Visit(element);
      finally
        visitor.Free;
      end;
    end;