unit Lexical;
interface
USES SysUtils;
TYPE TLexemeType=(LTrue, LFalse, LAnd, LOr, LNot, FINISH);
Tres=RECORD
lexeme:TLExemeType;
value: LONGINT;
name:STRING;
position:WORD
END;
TResult=ARRAY OF TRes;
TLexicalAnalyzer=CLASS
PRIVATE
Ferr:STRING;
Flex:TResult;
FUNCTION GetError:STRING;
FUNCTION GetLex:TResult;
PUBLIC
CONSTRUCTOR Create;
DESTRUCTOR Free;
PROCEDURE Run(s:STRING);
PROPERTY Error:STRING READ GetError;
PROPERTY Lexem:TResult READ GetLex;
END;
implementation
DESTRUCTOR TLexicalAnalyzer.Free;
BEGIN
Finalize(Flex)
END;
FUNCTION TLexicalAnalyzer.GetLex:TResult;
BEGIN
Result:=Self.Flex
END;
CONSTRUCTOR TLexicalAnalyzer.Create;
BEGIN
INHERITED Create;
FErr:='';
SetLength(FLex,0);
END;
FUNCTION TLexicalAnalyzer.GetError:STRING;
BEGIN
Result:=Ferr
END;
PROCEDURE TLexicalAnalyzer.Run(s:STRING);
VAR i:WORD;
PROCEDURE addlex(l:TLexemeType; v:LONGINT; n:STRING);
BEGIN
SetLength(FLex,Length(FLex)+1);
WITH FLex[Length(FLex)-1] DO
BEGIN
Lexeme:=L;
Value:=v;
Name:=n;
Position:=i
END
END;
PROCEDURE ReadAnd;
VAR n:STRING;
BEGIN
n:=s[i];
INC(i);
If (i<=LENGTH(s)) AND (s[i] in ['n','N']) Then
BEGIN
n:=n+s[i];
INC(i);
If (i<=LENGTH(s)) AND (s[i] in ['d','D']) Then
BEGIN
n:=n+s[i];
AddLex(LAnd,0,n);
end
ELSE BEGIN Ferr:='Недопустимые символы после '''+s[i-1]+''''; Exit END;
END
ELSE BEGIN Ferr:='Недопустимые символы после '''+s[i-1]+''''; Exit END;
END;
PROCEDURE ReadOr;
VAR n:STRING;
BEGIN
n:=s[i];
INC(i);
If (i<=LENGTH(s)) AND (s[i] in ['r','R']) Then
BEGIN
n:=n+s[i];
AddLex(LOr,0,n);
END
ELSE IF Not(s[i] in ['r','R']) THEN BEGIN Ferr:='Недопустимые символы после '''+s[i-1]+''''; Exit END;
END;
PROCEDURE ReadNot;
VAR n:STRING;
BEGIN
n:=s[i];
INC(i);
If (i<=LENGTH(s)) AND (s[i] in ['o','O'])Then
BEGIN
n:=n+s[i];
INC(i);
If (i<=LENGTH(s)) AND (s[i] in ['t','T']) Then
BEGIN
n:=n+s[i];
AddLex(LNot,0,n);
end
Else BEGIN Ferr:='Недопустимые символы после '''+s[i-1]+''''; Exit END;
END
ELSE BEGIN Ferr:='Недопустимые символы после '''+s[i-1]+''''; Exit END;
END;
BEGIN
i:=1;
SetLength(Flex,0);
Ferr:='';
WHILE i<=LENGTH(s) DO
BEGIN
CASE s[i] OF
'T','t': AddLex(LTrue,0,'T');
'F','f': AddLex(LFalse,0,'F');
'A','a': ReadAnd;
'O','o': ReadOr;
'N','n': ReadNot;
ELSE
BEGIN
Ferr:='Недопустимый символ';
Exit
END
END;
INC(i)
END;
AddLex(FINISH,0,'')
END;
end.
unit Syntax2;
interface
USES Lexical;
type TSyntaxAnalyzer=CLASS
PROTECTED
FLex:TResult;
Ferr:STRING;
Ferrpos:WORD;
count:LONGINT;
FUNCTION GetLex:TRes;
FUNCTION GetError:STRING;
FUNCTION GetErrorPos:WORD;
PUBLIC
CONSTRUCTOR Create(ll:TResult);
DESTRUCTOR Free;
PROPERTY error:STRING READ GetError;
PROPERTY errorpos:WORD READ GetErrorPos;
PROCEDURE Parse;VIRTUAL;
END;
implementation
CONSTRUCTOR TSyntaxAnalyzer.Create(ll:TResult);
BEGIN
INHERITED Create;
Flex:=ll;
count:=0;
Ferr:='';
Ferrpos:=0
END;
DESTRUCTOR TSyntaxAnalyzer.Free;
BEGIN
Finalize(Flex)
END;
FUNCTION TSyntaxAnalyzer.GetError:STRING;
BEGIN
Result:=self.Ferr
END;
FUNCTION TSyntaxAnalyzer.GetErrorPos:WORD;
BEGIN
Result:=self.FErrPos
END;
FUNCTION TSyntaxAnalyzer.GetLex:TRes;
BEGIN
IF count<=LENGTH(FLex)-1 THEN
BEGIN
Result:=Flex[count];
INC(count)
END
ELSE
WITH Result DO
BEGIN
Lexeme:=FINISH;
name:='';
value:=0;
position:=0
END
END;
PROCEDURE TSyntaxAnalyzer.Parse;
CONST unaryoper=LNot;
binaryoper=[LAnd, LOr];
item=[LTrue,LFalse];
TYPE TState=(TSTART, TITEM, TUNARYOPER, TBINARYOPER,TERROR, TFINISH);
VAR state:TState;
curlex:TRes;
BEGIN
state:=TSTART;
REPEAT
curlex:=GetLex;
CASE state OF
TSTART:
IF curlex.lexeme = unaryoper THEN
State:=TUNARYOPER
ELSE
IF curlex.lexeme IN item THEN
State:=TITEM
Else
State:=TERROR;
TITEM:
IF curlex.Lexeme IN binaryoper THEN
state:=TBINARYOPER
ELSE
IF curlex.lexeme = FINISH THEN
State:=TFINISH
ELSE
state:=TERROR;
TUNARYOPER:
IF curlex.Lexeme IN item THEN
state:=TITEM
ELSE
state:=TERROR;
TBINARYOPER:
IF curlex.Lexeme IN item THEN
state:=TITEM
ELSE
state:=TERROR;
END;
UNTIL (State=TERROR) OR (curlex.lexeme=FINISH);
IF STATE=TERROR THEN
BEGIN
Ferr:='Синтаксическая ошибка';
FErrPos:=curlex.position
END
END;
end.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Lexical, Syntax2,StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
public
end;
var
Form1: TForm1;
LA:TLExicalAnalyzer;
SA:TSyntaxAnalyzer;
Rez:Boolean;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
LA:=TLExicalAnalyzer.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
var R:tresult;
mes:STRING;
begin
SetLength(r,0);
WITH LA DO
BEGIN
Run(Trim(edit1.Text));
IF Error='' THEN
begin
r:=Lexem;
SA:=TSyntaxAnalyzer.Create(r);
SA.Parse;
IF SA.error='' THEN
mes:='выражение корректное'
ELSE
BEGIN
mes:=SA.error+' (поз. '+IntToStr(SA.errorpos)+')';
WITH Edit1 DO
BEGIN
SetFocus;
IF SA.errorpos<Length(Edit1.Text) THEN
SelStart:=SA.errorpos
ELSE
SelStart:=Length(Edit1.Text)-1;
SelLength:=1
END
END;
MessageDlg(mes,mtInformation,[mbOK],0);
SA.Free;
END
ELSE
MessageDlg(error,mtInformation,[mbOK],0);
END
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LA.Free
end;
end.
13.08.2010, 14:39
Лог.Выражение
Комбинированный вид
