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