Скачиваний:
23
Добавлен:
02.05.2014
Размер:
17.85 Кб
Скачать
unit laba2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Grids, ExtCtrls;

type
TAutoState=(AUTO_H,AUTO_TZ,AUTO_TT,AUTO_TT1,AUTO_SK1,AUTO_SK2,AUTO_E,AUTO_S,
AUTO_A,AUTO_A1,AUTO_A2,AUTO_I,AUTO_N,AUTO_N1,AUTO_N2,AUTO_O,AUTO_O1,AUTO_X,
AUTO_X1,AUTO_X2,AUTO_S0,AUTO_S1);

TForm3 = class(TForm)
Label1: TLabel;
Button1: TButton;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
Label5: TLabel;
StringGrid3: TStringGrid;
Button2: TButton;
Memo2: TMemo;
Label2: TLabel;
TreeView1: TTreeView;
Memo3: TMemo;
Label3: TLabel;
procedure Button1Click(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure Button2Click(Sender:TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;

implementation
{$R *.dfm}

procedure TForm3.Button1Click(Sender:TObject);
begin
if Form3.OpenDialog1.Execute
then Form3.Memo1.Lines.LoadFromFile(Form3.OpenDialog1.FileName);
end;

procedure TForm3.FormCreate(Sender:TObject);
begin
Memo1.Text:='';
Memo2.Text:='';
Memo3.Text:='';
StringGrid3.Cells[0,0]:='№';
StringGrid3.Cells[1,0]:='Лексема';
StringGrid3.Cells[2,0]:='Тип лексемы';
end;

procedure TForm3.Button2Click(Sender:TObject);
Const N1=10;
N2=7;
N3=10;
Label M1,M2;
var nom,dl,i,j,i1,f,yy,m:integer;
st,str,stroka:string;
s:TAutoState;
CepofV:array [1..100]of integer;
p,stek,d:TStringList;
ind,i2,i4,j2,fl2,n,k,vetv,u,ddd:integer;
o1,o2,o3,o4,o5,o6,pr:string;
MyTreeNode:TTreeNode;
nodeTree: TTreeNode;
const
matrix: array [1..N3,1..N3] of char =(
(' ','>','>',' ','>','=','>',' ','>',' '),
('<','>','>','<','<',' ','>','<','>',' '),
('<','>','>','<','<',' ','>','<','>',' '),
(' ',' ',' ',' ',' ',' ',' ','=',' ',' '),
('<','>','>','<','>',' ','>','<','>',' '),
('<','<','<','<','<',' ','=','<',' ',' '),
(' ',' ',' ',' ',' ',' ',' ',' ',' ','>'),
('<','<','<','<','<',' ',' ','<','=',' '),
(' ','>','>',' ','>',' ','>',' ','>',' '),
('<',' ',' ',' ',' ',' ',' ',' ',' ',' '));
prav_1:array [1..N2,1..2] of string= (
('1','a:=E;'),
('2','EorE'),
('3','ExorE'),
('4','EandE'),
('5','(E)'),
('6','not(E)'),
('7','a'));
term:array [1..N1,1..2] of string =(
('1','a'),
('2','or'),
('3','xor'),
('4','not'),
('5','and'),
('6',':='),
('7',';'),
('8','('),
('9',')'),
('10','@'));
notterm:array [1..7] of char=
('E','E','E','E','E','E','E');
Canon:array [1..7,1..4] of string= (
('a',':=','E',';'),
('E','or','E',''),
('E','xor','E',''),
('E','and','E',''),
('(','E',')',''),
('not','(','E',')'),
('a','','',''));
begin
u:=1;
p:=TStringList.Create;
p.Sorted:=False;
stek:=TStringList.Create;
stek.Sorted:=False;
d:=TStringList.Create;
d.Sorted:=False;
i1:=Memo1.Lines.Count;
Form3.StringGrid3.RowCount:=1001;
for j:=1 to 1000 do Form3.StringGrid3.Cells[0,j]:='';
for j:=1 to 1000 do Form3.StringGrid3.Cells[1,j]:='';
for j:=1 to 1000 do Form3.StringGrid3.Cells[2,j]:='';
nom:=1;ind:=1;
for i:=1 to i1 do
begin
str:='';
stroka:=Memo1.Lines[i-1];
stroka:=stroka+' ';
dl:=length(stroka);
s:=AUTO_H;
f:=0; yy:=0;
for j:=1 to dl do
begin
st:=stroka[j];
case s of
AUTO_H:
case stroka[j] of
';': begin s:=AUTO_TZ; str:=str+st; end;
':': begin s:=AUTO_TT; str:=str+st; end;
'(': begin s:=AUTO_SK1; str:=str+st; end;
')': begin s:=AUTO_SK2; str:=str+st; end;
'o': begin s:=AUTO_O; str:=str+st; end;
'x': begin s:=AUTO_X; str:=str+st; end;
'a': begin s:=AUTO_A; str:=str+st; end;
'n': begin s:=AUTO_N; str:=str+st; end;
'0': begin s:=AUTO_S0; str:=str+st; end;
'1': begin s:=AUTO_S1; str:=str+st; end;
'b'..'m','p'..'w','y','z':
begin s:=AUTO_I; str:=str+st; end;
' ': begin s:=AUTO_H; str:=''; end;
else begin s:=AUTO_E; str:=str+st; end;
end;
AUTO_TZ:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=2; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_TT:
case stroka[j] of
'=': begin s:=AUTO_TT1;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_TT1:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=3; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_SK1:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=4; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_SK2:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=5; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_O:
case stroka[j] of
'a'..'q','s'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'r': begin s:=AUTO_O1;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_O1:
case stroka[j] of
'a'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=6; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_X:
case stroka[j] of
'a'..'n','p'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'o': begin s:=AUTO_X1;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_X1:
case stroka[j] of
'a'..'q','s'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'r': begin s:=AUTO_X2;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_X2:
case stroka[j] of
'a'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=7; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_A:
case stroka[j] of
'a'..'m','o'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'n': begin s:=AUTO_A1;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_A1:
case stroka[j] of
'a'..'c','e'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'd': begin s:=AUTO_A2;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_A2:
case stroka[j] of
'a'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=8; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_N:
case stroka[j] of
'a'..'n','p'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
'o': begin s:=AUTO_N1;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_N1:
case stroka[j] of
'a'..'s','u'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
't': begin s:=AUTO_N2;str:=str+st; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_N2:
case stroka[j] of
'a'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=9; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_S0:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=10; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_S1:
case stroka[j] of
' ': begin s:=AUTO_H;f:=1;yy:=11; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_I:
case stroka[j] of
'a'..'z','0'..'9':
begin s:=AUTO_I;str:=str+st; end;
' ': begin s:=AUTO_H;f:=1;yy:=1; end;
else begin s:=AUTO_E;str:=str+st; end;
end;
AUTO_E: begin
if stroka[j]<>' 'then
begin
s:=AUTO_E;
str:=str+st;
end
else begin
s:=AUTO_H;
Memo2.Lines.Append(str);
str:='';
end;
end;
end;
if f=1 then
begin
StringGrid3.Cells[0,nom]:=IntToStr(nom);
StringGrid3.Cells[1,nom]:=str;
case yy of
1: begin StringGrid3.Cells[2,nom]:='Идентификатор';p.Add('a'); end;
2: begin StringGrid3.Cells[2,nom]:='Разделяюший знак';p.Add(';'); end;
3: begin StringGrid3.Cells[2,nom]:='Знак присваивания';p.Add(':='); end;
4: begin StringGrid3.Cells[2,nom]:='Круглая скобка открывающаяся';p.Add('(');end;
5: begin StringGrid3.Cells[2,nom]:='Круглая скобка закрывающаяся';p.Add(')'); end;
6: begin StringGrid3.Cells[2,nom]:='Оператор сравнения "or"';p.Add('or'); end;
7: begin StringGrid3.Cells[2,nom]:='Оператор сравнения "xor"'; p.Add('xor');end;
8: begin StringGrid3.Cells[2,nom]:='Оператор сравнения "and"'; p.Add('and');end;
9: begin StringGrid3.Cells[2,nom]:='Оператор сравнения "not"'; p.Add('not');end;
10: begin StringGrid3.Cells[2,nom]:='Константа 0';p.Add('a');end;
11: begin StringGrid3.Cells[2,nom]:='Константа 1';p.Add('a'); end;
end;
str:='';
nom:=nom+1;
f:=0;
end;
end;
end;
for j:=1 to 999 do
begin
if Form3.StringGrid3.Cells[1,j]=''
then Form3.StringGrid3.RowCount:=Form3.StringGrid3.RowCount-1;
end;
f:=p.Count;
p.Add('@');
stek.Add('@');
stek.Add(p.Strings[0]);
p.Delete(0);
ind:=p.Count-1;
o1:=p.Strings[0];
f:=stek.Count-1;
o2:=stek.Strings[f];
repeat Begin
o1:=p.Strings[0];
f:=stek.Count-1;
repeat if stek.Strings[f]<>'E' then o2:=stek.Strings[f]
else f:=f-1;
until(o2<>'E');
j:=1;i1:=0;
repeat if term[j][2]=o1 then i1:=StrToInt(term[j][1])
else j:=j+1;
if i1>N1 then begin ShowMessage('Ошибка!');exit;end;
until(i1<>0);
j:=1;i2:=0;
repeat if term[j][2]=o2 then i2:=StrToInt(term[j][1])
else j:=j+1;
if i2>N1 then begin ShowMessage('Ошибка!');exit;end;
until(i2<>0);
o3:=matrix[i2][i1];
if (o3='=')or(o3='<') then begin stek.Add(o1);p.Delete(0); end
else if o3='>' then begin
if f=stek.Count-1 then begin
dl:=1;
i:=1;
pr:=o2;
M1:o4:=stek.Strings[f-i];
if o4<>'E' then begin
j:=1;i4:=0;
repeat if term[j][2]=o4 then i4:=StrToInt(term[j][1])
else j:=j+1;
if i4>N1 then begin ShowMessage('Ошибка!');exit;end;
until(i4<>0);
o5:=matrix[i4][i2];
if o5='='then begin
dl:=dl+1;pr:=o4+pr;i:=i+1;i2:=i4;
goto M1;
end
else begin goto M2; end;
end
else begin
if stek.Strings[f-i-1]<>'E' then begin
j:=1;i4:=0;
repeat if term[j][2]=stek.Strings[f-i-1] then i4:=StrToInt(term[j][1])
else j:=j+1;
if i4>N1 then begin ShowMessage('Ошибка!');exit;end;
until(i4<>0);
o5:=matrix[i4][i2];
if o5='='then begin
dl:=dl+1;pr:=o4+pr; i:=i+1;goto M1;
end
else begin goto M2; end;
end;
end;

end
else begin
dl:=1;
i:=1;
pr:=o2;
o4:=stek.Strings[f-i];
o6:=stek.Strings[f+i];
if (o4='E')and(o6='E') then begin pr:='E'+o2+'E';dl:=3;end
else begin ShowMessage('Ошибка входной цепочки ('+o2+')!');exit; end;
end;
M2:
for j:=1 to dl do stek.Delete(stek.Count-1);
j:=1;yy:=0;
repeat if prav_1[j][2]=pr then yy:=StrToInt(prav_1[j][1])
else j:=j+1;
if yy>N2 then begin ShowMessage('Ошибка!');exit;end;
until(yy<>0);
stek.Add('E');
d.Add(IntToStr(yy));
CepofV[u]:=yy;
u:=u+1;
end
else begin ShowMessage('Ошибка во входной цепочке!');
Memo3.Text:='';
Form3.StringGrid3.RowCount:=1001;
for j:=1 to 1000 do Form3.StringGrid3.Cells[0,j]:='';
for j:=1 to 1000 do Form3.StringGrid3.Cells[1,j]:='';
for j:=1 to 1000 do Form3.StringGrid3.Cells[2,j]:='';
with TreeView1 do begin
Items.Clear;
Items.Add(Nil,'');
vetv:=0;
j:=0;
end;
exit; end;
f:=stek.Count-1;
o1:=p.Strings[0];
o2:=stek.Strings[f-1];
end;
until (o1='@')and(o2='@');
p.Clear;
str:='';
i4:=d.Count-1;
for i:=0 to i4 do str:=str+d.Strings[i]+' ';
memo3.Text:=str;
n:=d.Count;
with TreeView1 do begin
Items.Clear;
Items.Add(Nil,'E');
vetv:=0;
j:=0;
for k:=n downto 1 do begin
m:=Items.Count;
if k<n then
for i:=m-1 downto 0 do if (Items[i].Text=notterm[CepofV[k]])and(Items[i].HasChildren=False) then begin vetv:=i;break; end;
for i:=1 to 4 do
if Canon[CepofV[k],i]<>'' then Items.AddChild(Items[vetv],Canon[CepofV[k],i]);
end;
FullExpand
end;
p.Destroy;
stek.Destroy;
d.Destroy;
end;

end.
Соседние файлы в папке СПО лаба 3
  • #
    02.05.201416.9 Кб23laba2.dcu
  • #
    02.05.201451 б23laba2.ddp
  • #
    02.05.20144.51 Кб23laba2.dfm
  • #
    02.05.201417.85 Кб23laba2.pas
  • #
    02.05.201476 б25laba2.txt
  • #
    02.05.2014434 б23Project1.cfg
  • #
    02.05.20141.97 Кб23Project1.dof
  • #
    02.05.2014188 б24Project1.dpr
  • #
    02.05.2014876 б23Project1.res