《GOF设计模式》—访问者（VISITOR）—Delphi源码示例：编译器

示例：编译器
说明：
考虑一个编译器，它将源程序表示为一个抽象语法树。该编译器需在抽象语法树上实施某些操作以进行"静态语义"分析，例如检查是否所有的变量都已经被定义了。我们可以将每一个类中相关的操作包装在一个独立的对象（称为一个Visitor）中。

代码：
unit uCode;

interface

uses
    Classes, Dialogs, Contnrs;

type
    TNodeVisitor = class;

    TNode = class
    public
        procedure Accept(AVisitor: TNodeVisitor); virtual; abstract;
    end;
    TVariableRefNode = class(TNode)
    public
        procedure Accept(AVisitor: TNodeVisitor); override;
    end;
    TAssignmentNode = class(TNode)
    public
        procedure Accept(AVisitor: TNodeVisitor); override;
    end;

    TProgram1 = class(TObjectList)
    private
        function GetItems(Index: Integer): TNode;
    public
        procedure Accept(AVisitor: TNodeVisitor);
        //---
        property Items[Index: Integer]: TNode read GetItems;
    end;

    TNodeVisitor = class
    public
        procedure VisitAssignment(ANode: TAssignmentNode); virtual; abstract;
        procedure VisitVariableRef(ANode: TVariableRefNode); virtual; abstract;
    end;
    TTypeCheckingVisitor = class(TNodeVisitor)
    public
        procedure VisitAssignment(ANode: TAssignmentNode); override;
        procedure VisitVariableRef(ANode: TVariableRefNode); override;
    end;
    TCodeGeneratingVisitor = class(TNodeVisitor)
    private
        FList: TStringList;
        function GetCode: string;
    public
        constructor Create();
        destructor Destroy; override;
        //---
        procedure VisitAssignment(ANode: TAssignmentNode); override;
        procedure VisitVariableRef(ANode: TVariableRefNode); override;
        //---
        property Code: string read GetCode;
    end;

procedure Test;
procedure Test1;

implementation

procedure Test;
var
    AProgram: TProgram1;
    AVisitor: TNodeVisitor;
begin
    AProgram := TProgram1.Create;
    AVisitor := TTypeCheckingVisitor.Create;
    try
        with AProgram do
        begin
            Add(TAssignmentNode.Create);
            Add(TVariableRefNode.Create);
            //---
            Accept(AVisitor);
        end;
    finally
        AVisitor.Free;
        AProgram.Free;
    end;
end;

procedure Test1;
var
    AProgram: TProgram1;
    AVisitor: TCodeGeneratingVisitor;
begin
    AProgram := TProgram1.Create;
    AVisitor := TCodeGeneratingVisitor.Create;
    try
        with AProgram do
        begin
            Add(TAssignmentNode.Create);
            Add(TVariableRefNode.Create);
            //---
            Accept(AVisitor);
            ShowMessage(AVisitor.Code);
        end;
    finally
        AVisitor.Free;
        AProgram.Free;
    end;
end;

procedure TAssignmentNode.Accept(AVisitor: TNodeVisitor);
begin
    AVisitor.VisitAssignment(Self);
end;

procedure TVariableRefNode.Accept(AVisitor: TNodeVisitor);
begin
    AVisitor.VisitVariableRef(Self);
end;

procedure TProgram1.Accept(AVisitor: TNodeVisitor);
var
    i: Integer;
begin
    for i := 0 to Self.Count - 1 do
        Self.Items[i].Accept(AVisitor);
end;

function TProgram1.GetItems(Index: Integer): TNode;
begin
    Result := TNode(inherited Items[Index]);
end;

procedure TTypeCheckingVisitor.VisitAssignment(ANode: TAssignmentNode);
begin
    ShowMessage('赋值语句');
end;

procedure TTypeCheckingVisitor.VisitVariableRef(ANode: TVariableRefNode);
begin
    ShowMessage('变量');
end;

constructor TCodeGeneratingVisitor.Create;
begin
    FList := TStringList.Create;
end;

destructor TCodeGeneratingVisitor.Destroy;
begin
    FList.Free;
    //---
    inherited;
end;

function TCodeGeneratingVisitor.GetCode: string;
begin
    Result := FList.Text;
end;

procedure TCodeGeneratingVisitor.VisitAssignment(ANode: TAssignmentNode);
begin
    FList.Add('赋值语句');
end;

procedure TCodeGeneratingVisitor.VisitVariableRef(ANode: TVariableRefNode);
begin
    FList.Add('变量');
end;

end.