《GOF设计模式》—外观（FACADE）—Delphi源码示例：基于外观模式的编译子系统

来源：互联网发布：圣思园java 百度云编辑：程序博客网时间：2024/04/29 09:29

示例：基于外观的编译子系统

实现：

让我们仔细观察一下如何在一个编译子系统中使用Facade。

编译子系统定义了一个BytecodeStream类，它实现了一个Bytecode对象流（stream）。Bytecode对象封装一个字节码，这个字节码可用于指定机器指令。该子系统中还定义了一个Token类，它封装了编程语言中的标识符。

Scanner类接收字符流并产生一个标识符流，一次产生一个标识符(token)。

Parser类获取Scanner生成的标识符，然后通过回调ProgramNodeBuilder逐步构建一棵语法分析树，这些类遵循Builder模式进行交互操作。

语法分析树由ProgramNode子类(例如StatementNode和ExpressionNode等)的实例构成。ProgramNode层次结构是Composite模式的一个应用实例。ProgramNode定义了一个接口用于操作程序节点和它的子节点（如果有的话）。

ProgramNode类的Traverse操作以一个CodeGenerator对象为参数，ProgramNode子类使用这个对象产生机器代码，机器代码格式为BytecodeStream中的ByteCode对象。其中的CodeGenerator类是一个访问者。

CodeGenerator类有两个子类StackMachineCodeGenerator和RISCCodeGenerator，分别为不同的硬件体系结构生成机器代码。

ProgramNode的每个子类在实现Traverse时，对它的ProgramNode子对象调用Traverse。每个子类依次对它的子节点做同样的动作，这样一直递归下去。

我们上述讨论的类构成了编译子系统，现在我们引入Compiler类，Complier类是一个facade，它将所有部件集成在一起。Compiler提供了一个简单的接口用于为特定的机器编译源代码并生成可执行代码。

Compiler类中Compile操作的实现在代码中固定了要使用的代码生成器的种类，因此程序员不需要指定目标机的结构。在仅有一种目标机的情况下，这是合理的。如果有多种目标机，我们可能希望改变Compiler构造函数使之能接受CodeGenerator为参数，这样程序员可以在实例化Compiler时指定要使用的生成器。编译器的facade还可以对Scanner和ProgramNodeBuilder这样的其他一些参与者进行参数化以增加系统的灵活性，但是这并非Facade模式的主要任务，它的主要任务是为一般情况简化接口。

代码：

unit uIterator;

interface

uses classes;

type

{迭代器}

TIterator = class

public

procedure First(); virtual; abstract;

procedure Next(); virtual; abstract;

function IsDone: Boolean; virtual; abstract;

function CurrentItem(): TObject; virtual; abstract;

end;

{列表迭代器}

TListIterator = class(TIterator)

private

FList: TList;

FIndex: Integer;

public

constructor Create(List: TList);

//---

procedure First(); override;

procedure Next(); override;

function IsDone: Boolean; override;

function CurrentItem(): TObject; override;

end;

implementation

constructor TListIterator.Create(List: TList);

begin

FList := List;

end;

procedure TListIterator.First();

begin

FIndex := 0;

end;

procedure TListIterator.Next();

begin

FIndex := FIndex + 1;

end;

function TListIterator.IsDone: Boolean;

begin

Result := FIndex >= FList.Count;

end;

function TListIterator.CurrentItem(): TObject;

begin

Result := FList[FIndex];

end;

end.

unit uFacade;

interface

uses SysUtils,classes,uIterator;

（1）、文法规则

程序 → 语句

语句 → 赋值语句 | 条件语句

赋值语句 → 变量 = 表达式

条件语句 → if 条件 then ( 语句 | 程序 )

条件 → 表达式关系符表达式

关系符 → < | >

表达式 → 项 { + 项 | - 项 }

项 → 因子 { * 因子 | / 因子 }

因子 → 变量 | 数字 | ( 表达式 )

变量 → 标识符

type

TTokenType = (tokUnknown,tokEOF,

tokIdentifier,tokInteger,

tokLB,tokRB,

tokEqual,tokGreat,tokLess,

tokPlus,tokMinus,tokStar,tokDiv,

tokKeywordIf,tokKeywordThen,tokKeywordElse);

{输入字符流}

TIStream = class(TStringStream);

{输出字符流}

TOStream = class(TStringStream);

{标识符}

TToken = record

Pos: integer;

Kind: TTokenType;

Value: string;

end;

{词法分析}

TScanner = class

private

FStream: TIStream;

FBufferPos: integer;

FBufferSize: integer;

public

constructor Create(aStream: TIStream);

//---

function Scan(): TToken; virtual;

end;

TCodeGenerator = class;

{程序节点：采用组合模式}

TProgramNode = class

public

procedure GetSourcePosition(Line,Index: integer); virtual;

procedure Add(Node: TProgramNode); virtual;

procedure Remove(Node: TProgramNode); virtual;

procedure Traverse(aCodeGenerator: TCodeGenerator); virtual;

end;

{组合节点}

TCompositeNode = class(TProgramNode)

private

FChildrens: TList;

public

constructor Create;

destructor Destroy; override;

//---

procedure GetSourcePosition(Line,Index: integer); override;

procedure Add(Node: TProgramNode); override;

procedure Remove(Node: TProgramNode); override;

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

end;

{表达式}

TExpressionNode = class(TCompositeNode)

public

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

end;

{项}

TTermNode = class(TCompositeNode)

private

FSignal: TTokenType;

public

constructor Create(Signal: TTokenType);

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

//---

property Signal: TTokenType read FSignal;

end;

{条件}

TConditionNode = class(TProgramNode)

private

FExpression1,FExpression2: TProgramNode;

FSignal: TTokenType;

public

constructor Create(Expression1,Expression2: TProgramNode; Signal: TTokenType);

destructor Destroy; override;

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

//---

property Signal: TTokenType read FSignal;

end;

{因子}

TFactorNode = class(TProgramNode)

private

FFactor: TProgramNode;

FSignal: TTokenType;

public

constructor Create(Factor: TProgramNode; Signal: TTokenType);

destructor Destroy; override;

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

//---

property Signal: TTokenType read FSignal;

end;

{数字}

TNumberNode = class(TProgramNode)

private

FNumber: Double;

public

constructor Create(Number: string);

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

//---

property Number: Double read FNumber;

end;

{语句}

TStatementNode = class(TProgramNode)

end;

{赋值语句}

TAssigmentNode = class(TStatementNode)

private

FVariable: TProgramNode;

FExpression: TProgramNode;

public

constructor Create(Variable,Expression: TProgramNode);

destructor Destroy; override;

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

end;

{条件语句}

TIfStatementNode = class(TStatementNode)

private

FCondition,FTruePart,FFalsePart: TProgramNode;

public

constructor Create(Condition,truePart,falsePart: TProgramNode);

destructor Destroy; override;

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

end;

{变量}

TVariableNode = class(TProgramNode)

private

FName: string;

public

constructor Create(variableName: string);

//---

procedure Traverse(aCodeGenerator: TCodeGenerator); override;

//---

property Name: string read FName;

end;

{语法树生成器}

TProgramNodeBuilder = class

private

FNode: TProgramNode;

public

constructor Create;

//---

procedure NewRootNode(const Node: TProgramNode);

function NewAssigment(Variable,Expression: TProgramNode): TProgramNode;

virtual;

function NewCondition(condition,truePart,falsePart: TProgramNode): TProgramNode; virtual;

function NewReturnStatement(value: TProgramNode): TProgramNode; virtual;

function NewExpression: TProgramNode; virtual;

function NewTerm(Signal: TTokenType): TProgramNode; virtual;

function NewFactor(Factor: TProgramNode; Signal: TTokenType): TProgramNode; virtual;

function NewNumber(Number: string): TProgramNode; virtual;

function NewVariable(variableName: string): TProgramNode; virtual;

function NewCond(Expression1,Expression2: TProgramNode; Signal: TTokenType): TProgramNode; virtual;

//---

function GetRootNode(): TProgramNode;

end;

{语法分析}

TParser = class

public

procedure Parse(Scanner: TScanner; ProgramNodeBuilder: TProgramNodeBuilder);

virtual;

end;

TBytecode = byte;

{Bytecode对象流}

TBytecodeStream = class(TOStream)

public

procedure BuildCode(Bytecode: TBytecode);

procedure BuildSignal(Bytecode: TBytecode);

procedure BuildVariable(const Name: string);

procedure BuildConst(Value: double);

//---

function GetBytecodes: string;

end;

{代码访问者}

TCodeGenerator = class

private

FOutput: TBytecodeStream;

public

constructor Create(aOutputStream: TBytecodeStream);

//---

procedure Visit(StatementNode: TStatementNode); overload; virtual;

procedure Visit(AssigmentNode: TAssigmentNode); overload; virtual;

procedure Visit(IfStatementNode: TIfStatementNode); overload; virtual;

procedure Visit(ExpressionNode: TExpressionNode); overload; virtual;

procedure Visit(TermNode: TTermNode); overload; virtual;

procedure Visit(FactorNode: TFactorNode); overload; virtual;

procedure Visit(VariableNode: TVariableNode); overload; virtual;

procedure Visit(NumberNode: TNumberNode); overload; virtual;

procedure Visit(ConditionNode: TConditionNode); overload; virtual;

end;

TRISCCodeGenerator = class(TCodeGenerator)

public

procedure Visit(AssigmentNode: TAssigmentNode); overload; override;

procedure Visit(IfStatementNode: TIfStatementNode); overload; override;

procedure Visit(ConditionNode: TConditionNode); overload; override;

procedure Visit(ExpressionNode: TExpressionNode); overload; override;

procedure Visit(TermNode: TTermNode); overload; override;

procedure Visit(FactorNode: TFactorNode); overload; override;

procedure Visit(NumberNode: TNumberNode); overload; override;

procedure Visit(VariableNode: TVariableNode); overload; override;

end;

TStackMachineCodeGenerator = class(TCodeGenerator);

{编译器:采用外观模式}

TCompiler = class

public

procedure Compile(input: TIStream; output: TBytecodeStream); virtual;

end;

const

SignalMap: array[0..8] of TIdentMapEntry = (

(Value: Integer(tokEqual); Name: '='),

(Value: Integer(tokPlus); Name: '+'),

(Value: Integer(tokMinus); Name: '-'),

(Value: Integer(tokStar); Name: '*'),

(Value: Integer(tokDiv); Name: '/'),

(Value: Integer(tokGreat); Name: '>'),

(Value: Integer(tokLess); Name: '<'),

(Value: Integer(tokLB); Name: '('),

(Value: Integer(tokRB); Name: ')')

);

KeywordMap: array[0..2] of TIdentMapEntry = (

(Value: Integer(tokKeywordIf); Name: 'If'),

(Value: Integer(tokKeywordThen); Name: 'Then'),

(Value: Integer(tokKeywordElse); Name: 'Else')

);

implementation

procedure TCompiler.Compile(input: TIStream; output: TBytecodeStream);

var

aScanner: TScanner;

aBuilder: TProgramNodeBuilder;

aParser: TParser;

aRISCCodeGenerator: TRISCCodeGenerator;

parseTree: TProgramNode;

begin

aParser := TParser.Create;

aScanner := TScanner.Create(input);

aBuilder := TProgramNodeBuilder.Create;

try

aParser.Parse(aScanner,aBuilder);

parseTree := aBuilder.GetRootNode;

finally

aScanner.Free;

aBuilder.Free;

aParser.Free;

end;

//---

aRISCCodeGenerator := TRISCCodeGenerator.Create(output);

try

parseTree.Traverse(aRISCCodeGenerator);

finally

aRISCCodeGenerator.Free;

parseTree.Free;

end;

constructor TScanner.Create(aStream: TIStream);

begin

FStream := aStream;

FBufferPos := 0;

FBufferSize := FStream.Size;

end;

function TScanner.Scan(): TToken;

var

AToken: TToken;

//---

function getChar: Char;

begin

with FStream do

begin

Position := FBufferPos;

ReadBuffer(Result,1);

end;

//---

function getNChar(APos,ALen: Integer): string;

begin

setlength(Result,ALen);

with FStream do

begin

Position := APos;

ReadBuffer(Result[1],ALen);

end;

//---

procedure get_Blanks;

const

T_Blanks = [' ',chr(9)];

T_Returns = [chr(13),chr(10)];

T_Blanks_Returns = T_Blanks + T_Returns;

begin

while (FBufferPos < FBufferSize) and (getChar in T_Blanks_Returns) do

inc(FBufferPos);

end;

//---

procedure get_Identifier;

const

T_Identifier = ['a'..'z', 'A'..'Z', '_', '0'..'9'];

var

AStartPos: Integer;

begin

AStartPos := FBufferPos;

//---

inc(FBufferPos);

while (FBufferPos < FBufferSize) and (getChar in T_Identifier) do

inc(FBufferPos);

//---

with AToken do

begin

Pos := AStartPos;

Kind := tokIdentifier;

Value := getNChar(AStartPos,FBufferPos - AStartPos);

end;

//---

procedure get_Keyword;

var

AKind: Integer;

begin

if IdentToInt(AToken.Value,AKind,KeywordMap) then

AToken.Kind := TTokenType(AKind);

end;

//---

procedure get_Number;

const

T_Digits = ['0'..'9'];

var

AStartPos: Integer;

begin

AStartPos := FBufferPos;

//---

inc(FBufferPos);

while (FBufferPos < FBufferSize) and (getChar in T_Digits) do

inc(FBufferPos);

//---

with AToken do

begin

Pos := AStartPos;

Kind := tokInteger;

Value := getNChar(AStartPos,FBufferPos - AStartPos);

end;

//---

procedure get_Signal;

var

AKind: Integer;

begin

with AToken do

begin

Pos := FBufferPos;

Value := getChar;

IdentToInt(Value,AKind,SignalMap);

Kind := TTokenType(AKind);

end;

//---

inc(FBufferPos);

end;

begin

get_Blanks;

//---

if FBufferPos < FBufferSize then

begin

case getChar of

'a'..'z', 'A'..'Z':

begin

get_Identifier;

get_Keyword;

end;

'0'..'9': get_Number;

'(', ')', '+', '-', '*', '/', '=', '>', '<': get_Signal;

else

begin

with AToken do

begin

Pos := FBufferPos;

Kind := tokUnknown;

Value := getChar;

end;

inc(FBufferPos);

end;

end

else

begin

with AToken do

begin

Pos := FBufferPos;

Kind := tokEOF;

Value := '';

end;

//---

Result := AToken;

end;

procedure TProgramNode.GetSourcePosition(Line,Index: integer);

begin

end;

procedure TProgramNode.Add(Node: TProgramNode);

begin

end;

procedure TProgramNode.Remove(Node: TProgramNode);

begin

end;

procedure TProgramNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

end;

constructor TCompositeNode.Create;

begin

inherited;

//---

FChildrens := TList.Create;

end;

destructor TCompositeNode.Destroy;

//---

procedure _Clear;

var

i: integer;

begin

with FChildrens do

begin

for i := 0 to Count - 1 do

TObject(Items[i]).Free;

Clear;

end;

begin

_Clear;

FChildrens.Free;

//---

inherited;

end;

procedure TCompositeNode.Add(Node: TProgramNode);

begin

FChildrens.Add(Node);

end;

procedure TCompositeNode.GetSourcePosition(Line,Index: integer);

begin

end;

procedure TCompositeNode.Remove(Node: TProgramNode);

begin

FChildrens.Remove(Node);

end;

procedure TCompositeNode.Traverse(aCodeGenerator: TCodeGenerator);

var

AIterator: TIterator;

begin

AIterator := TListIterator.Create(FChildrens);

try

with AIterator do

begin

First;

while not IsDone do

begin

TExpressionNode(CurrentItem).traverse(aCodeGenerator);

//---

Next;

end;

finally

AIterator.Free;

end;

procedure TExpressionNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.visit(self);

//---

inherited;

end;

constructor TTermNode.Create(Signal: TTokenType);

begin

inherited Create;

//---

FSignal := Signal;

end;

procedure TTermNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.visit(self);

//---

inherited;

end;

constructor TConditionNode.Create(Expression1,Expression2: TProgramNode;

Signal: TTokenType);

begin

inherited Create;

//---

FExpression1 := Expression1;

FExpression2 := Expression2;

FSignal := Signal;

end;

destructor TConditionNode.Destroy;

begin

FExpression1.Free;

FExpression2.Free;

//---

inherited;

end;

procedure TConditionNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.Visit(self);

//---

FExpression1.Traverse(aCodeGenerator);

FExpression2.Traverse(aCodeGenerator);

end;

{ TFactorNode }

constructor TFactorNode.Create(Factor: TProgramNode; Signal: TTokenType);

begin

inherited Create;

//---

FFactor := Factor;

FSignal := Signal;

end;

destructor TFactorNode.Destroy;

begin

FFactor.Free;

//---

inherited;

end;

procedure TFactorNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.visit(self);

FFactor.Traverse(aCodeGenerator);

end;

constructor TNumberNode.Create(Number: string);

begin

inherited Create;

//---

FNumber := strtofloat(Number);

end;

procedure TNumberNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.Visit(self);

end;

constructor TAssigmentNode.Create(Variable,Expression: TProgramNode);

begin

inherited Create;

//---

FVariable := Variable;

FExpression := Expression;

end;

destructor TAssigmentNode.Destroy;

begin

FVariable.Free;

FExpression.Free;

//---

inherited;

end;

procedure TAssigmentNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.Visit(self);

//---

FVariable.Traverse(aCodeGenerator);

FExpression.Traverse(aCodeGenerator);

end;

constructor TIfStatementNode.Create(Condition,truePart,falsePart: TProgramNode);

begin

inherited Create;

//---

FCondition := Condition;

FTruePart := truePart;

FFalsePart := falsePart;

end;

destructor TIfStatementNode.Destroy;

begin

FCondition.Free;

if FTruePart <> nil then

FTruePart.Free;

if FFalsePart <> nil then

FFalsePart.Free;

//---

inherited;

end;

procedure TIfStatementNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.Visit(self);

//---

FCondition.Traverse(aCodeGenerator);

if FTruePart <> nil then

FTruePart.Traverse(aCodeGenerator);

if FFalsePart <> nil then

FFalsePart.Traverse(aCodeGenerator);

end;

constructor TVariableNode.Create(variableName: string);

begin

inherited Create;

//---

FName := variableName;

end;

procedure TVariableNode.Traverse(aCodeGenerator: TCodeGenerator);

begin

aCodeGenerator.Visit(self);

end;

constructor TProgramNodeBuilder.Create;

begin

FNode := nil;

end;

function TProgramNodeBuilder.NewVariable(variableName: string): TProgramNode;

begin

Result := TVariableNode.Create(variableName);

end;

function TProgramNodeBuilder.NewAssigment(Variable,Expression: TProgramNode):

TProgramNode;

begin

Result := TAssigmentNode.Create(Variable,Expression);

end;

function TProgramNodeBuilder.NewReturnStatement(value: TProgramNode): TProgramNode;

begin

Result := nil;

end;

function TProgramNodeBuilder.NewCondition(condition,truePart,falsePart: TProgramNode): TProgramNode;

begin

Result := TIfStatementNode.Create(condition,truePart,falsePart);

end;

function TProgramNodeBuilder.GetRootNode(): TProgramNode;

begin

Result := FNode;

end;

procedure TProgramNodeBuilder.NewRootNode(const Node: TProgramNode);

begin

FNode := Node;

end;

function TProgramNodeBuilder.NewExpression: TProgramNode;

begin

Result := TExpressionNode.Create;

end;

function TProgramNodeBuilder.NewTerm(Signal: TTokenType): TProgramNode;

begin

Result := TTermNode.Create(Signal);

end;

function TProgramNodeBuilder.NewFactor(Factor: TProgramNode;

Signal: TTokenType): TProgramNode;

begin

Result := TFactorNode.Create(Factor,Signal);

end;

function TProgramNodeBuilder.NewNumber(Number: string): TProgramNode;

begin

Result := TNumberNode.Create(Number);

end;

function TProgramNodeBuilder.NewCond(Expression1,

Expression2: TProgramNode; Signal: TTokenType): TProgramNode;

begin

Result := TConditionNode.Create(Expression1,Expression2,Signal);

end;

procedure TBytecodeStream.BuildCode(Bytecode: TBytecode);

begin

self.Write(Bytecode,sizeof(Bytecode));

end;

procedure TBytecodeStream.BuildSignal(Bytecode: TBytecode);

begin

self.Write(Bytecode,sizeof(Bytecode));

end;

procedure TBytecodeStream.BuildVariable(const Name: string);

begin

self.Write(Name[1],length(Name));

end;

procedure TBytecodeStream.BuildConst(Value: double);

begin

self.Write(Value,sizeof(Value));

end;

function TBytecodeStream.GetBytecodes: string;

begin

Result := self.DataString;

end;

constructor TCodeGenerator.Create(aOutputStream: TBytecodeStream);

begin

FOutput := aOutputStream;

end;

procedure TCodeGenerator.Visit(StatementNode: TStatementNode);

begin

end;

procedure TCodeGenerator.Visit(ExpressionNode: TExpressionNode);

begin

end;

procedure TCodeGenerator.Visit(AssigmentNode: TAssigmentNode);

begin

end;

procedure TCodeGenerator.Visit(VariableNode: TVariableNode);

begin

end;

procedure TCodeGenerator.Visit(TermNode: TTermNode);

begin

end;

procedure TCodeGenerator.Visit(FactorNode: TFactorNode);

begin

end;

procedure TCodeGenerator.Visit(NumberNode: TNumberNode);

begin

end;

procedure TCodeGenerator.Visit(ConditionNode: TConditionNode);

begin

end;

procedure TCodeGenerator.Visit(IfStatementNode: TIfStatementNode);

begin

end;

procedure TRISCCodeGenerator.Visit(AssigmentNode: TAssigmentNode);

begin

FOutput.BuildCode(ord('='));

end;

procedure TRISCCodeGenerator.Visit(IfStatementNode: TIfStatementNode);

begin

FOutput.BuildCode(ord('I'));

FOutput.BuildCode(ord('F'));

end;

procedure TRISCCodeGenerator.Visit(ConditionNode: TConditionNode);

var

Ident: string;

begin

IntToIdent(ord(ConditionNode.Signal),Ident,SignalMap);

//---

//FOutput.BuildCode(ord('C'));

FOutput.BuildSignal(ord(Ident[1]));

end;

procedure TRISCCodeGenerator.Visit(ExpressionNode: TExpressionNode);

begin

//FOutput.BuildCode(ord('E'));

end;

procedure TRISCCodeGenerator.Visit(TermNode: TTermNode);

var

Ident: string;

begin

IntToIdent(ord(TermNode.Signal),Ident,SignalMap);

//---

//FOutput.BuildCode(ord('T'));

FOutput.BuildSignal(ord(Ident[1]));

end;

procedure TRISCCodeGenerator.Visit(FactorNode: TFactorNode);

var

Ident: string;

begin

IntToIdent(ord(FactorNode.Signal),Ident,SignalMap);

//---

//FOutput.BuildCode(ord('F'));

FOutput.BuildSignal(ord(Ident[1]));

end;

procedure TRISCCodeGenerator.Visit(NumberNode: TNumberNode);

begin

FOutput.BuildConst(NumberNode.Number);

end;

procedure TRISCCodeGenerator.Visit(VariableNode: TVariableNode);

begin

FOutput.BuildVariable(VariableNode.Name);

end;

procedure TParser.Parse(Scanner: TScanner; ProgramNodeBuilder:

TProgramNodeBuilder);

var

Token: TToken;

//---

procedure RaiseError(n: integer);

var

str: string;

begin

case n of

str := '无效语句!';

str := '赋值语句错误!';

str := '标识符then错误!';

str := '算术表达式错误!';

str := '缺少")"!';

str := '条件表达式错误!';

else

str := 'Compile failed!';

end;

//---

raise Exception.Create(str);

end;

//---

function getVariable: TProgramNode;

begin

Result := ProgramNodeBuilder.NewVariable(Token.Value);

Token := Scanner.Scan;

end;

//---

function getNumber: TProgramNode;

begin

Result := ProgramNodeBuilder.NewVariable(Token.Value);

Token := Scanner.Scan;

end;

//---

function getExpression: TProgramNode;

//---

function getFactor(Signal: TTokenType): TProgramNode;

begin

case Token.Kind of

tokIdentifier:

Result := ProgramNodeBuilder.NewFactor(getVariable,Signal);

tokInteger:

Result := ProgramNodeBuilder.NewFactor(getNumber,Signal);

tokLB:

begin

Token := Scanner.Scan;

Result := ProgramNodeBuilder.NewFactor(getExpression,Signal);

//---

if (Token.Kind = tokRB) then

Token := Scanner.Scan

else

RaiseError(5);

end;

else

Result := nil;

RaiseError(4);

end;

//---

function getTerm(Signal: TTokenType): TProgramNode;

var

Factor: TProgramNode;

begin

Result := ProgramNodeBuilder.NewTerm(Signal);

//---

Factor := getFactor(tokStar);

Result.Add(Factor);

//---

while (Token.Kind in [tokStar,tokDiv]) do

begin

Signal := Token.Kind;

//---

Token := Scanner.Scan;

Factor := getFactor(Signal);

Result.Add(Factor);

end;

var

Term: TProgramNode;

Signal: TTokenType;

begin

Result := ProgramNodeBuilder.NewExpression;

//---

Term := getTerm(tokPlus);

Result.Add(Term);

//---

while (Token.Kind in [tokPlus,tokMinus]) do

begin

Signal := Token.Kind;

//---

Token := Scanner.Scan;

Term := getTerm(Signal);

Result.Add(Term);

end;

//---

function getCondition: TProgramNode;

var

Expression1,Expression2: TProgramNode;

Signal: TTokenType;

begin

Expression1 := getExpression;

//---

Signal := Token.Kind;

if Signal in [tokGreat,tokLess] then

begin

Token := Scanner.Scan;

Expression2 := getExpression;

//---

Result := ProgramNodeBuilder.NewCond(Expression1,Expression2,Signal);

end

else

begin

Result := nil;

RaiseError(6);

end;

//---

function getStatement: TProgramNode;

//---

function getAssigment: TProgramNode;

var

Variable,Expression: TProgramNode;

begin

Variable := getVariable;

//---

if (Token.Kind = tokEqual) then

begin

Token := Scanner.Scan;

Expression := getExpression;

//---

Result := ProgramNodeBuilder.NewAssigment(Variable,Expression);

end

else

begin

Result := nil;

RaiseError(2);

end;

//---

function getIfStatement: TProgramNode;

var

condition,truePart,falsePart: TProgramNode;

begin

Token := Scanner.Scan;

condition := getCondition;

//---

if (Token.Kind = tokKeywordThen) then

begin

Token := Scanner.Scan;

truePart := getStatement;

//---

if (Token.Kind = tokKeywordElse) then

begin

Token := Scanner.Scan;

falsePart := getStatement;

end

else

falsePart := nil;

//---

Result := ProgramNodeBuilder.NewCondition(condition,truePart,falsePart);

end

else

begin

Result := nil;

RaiseError(3);

end;

begin

case Token.Kind of

tokIdentifier:

Result := getAssigment;

tokKeywordIf:

Result := getIfStatement;

else

Result := nil;

RaiseError(1);

end;

//---

procedure getProgram;

var

Node: TProgramNode;

begin

Node := getStatement;

ProgramNodeBuilder.NewRootNode(Node);

end;

begin

Token := Scanner.Scan;

getProgram;

//---

if Token.Kind <> tokEOF then

RaiseError(-1);

end;

end.

unit Unit1;

interface

uses

Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,

Dialogs,StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses uFacade;

const

CNT_TestText = 'if 1+2 > 3 then '

+ 'a = 3 + 4*5 - 21 '

+ 'else '

+ 'b = 5 + 60 ';

procedure TForm1.Button1Click(Sender: TObject);

var

iStream: TIStream;

Scanner: TScanner;

AToken: TToken;

begin

iStream := TIStream.Create(CNT_TestText);

try

Scanner := TScanner.Create(iStream);

try

AToken := Scanner.Scan;

while AToken.Kind <> tokEOF do

begin

Memo1.Lines.Add(AToken.Value);

AToken := Scanner.Scan;

end;

finally

Scanner.Free;

end;

finally

iStream.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

input: TIStream;

output: TBytecodeStream;

Compiler: TCompiler;

begin

input := TIStream.Create(CNT_TestText);

output := TBytecodeStream.Create('');

try

Compiler := TCompiler.Create;

try

Compiler.Compile(input,output);

Memo1.Text := output.GetBytecodes;

finally

Compiler.Free;

end;

finally

input.Free;

output.Free;

end;

end.