Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
24
Добавлен:
02.05.2014
Размер:
21.66 Кб
Скачать
unit laba2;

interface

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

type
TAutoState=( AUTO_H, AUTO_ZZ,AUTO_L,AUTO_N,AUTO_Z1,AUTO_O2,AUTO_O1,AUTO_E,AUTO_F1,AUTO_K1, AUTO_F2,AUTO_K2,AUTO_K3,AUTO_D2,AUTO_Z2, AUTO_D1,AUTO_T1,AUTO_I );

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=11;
N2=10;
N3=11;
Label M1,M2,M3,M4,M5;
var pos,dl,i,j,i1,fl,zn,m:integer;
st,str,stroka:string;
sost: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 =(
{a for do ( ) ; := = < > @}
{a} (' ',' ',' ',' ','>','>','=','=','=','=',' '),
{for}(' ',' ','=','=',' ',' ',' ',' ',' ',' ',' '),
{do} ('<','<',' ',' ','>','>',' ',' ',' ',' ',' '),
{(} ('<',' ',' ',' ','=','<',' ',' ',' ',' ',' '),
{)} (' ',' ','=',' ',' ','>',' ',' ',' ',' ',' '),
{;} ('<',' ','>',' ','>','=',' ',' ',' ',' ','>'),
{:=} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{=} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{<} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{>} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{@} ('<','<',' ',' ',' ','<',' ',' ',' ',' ',' '));
prav_1:array [1..N2,1..2] of string= (
('1','E;'),
('2','for(E)doE'),
('3','a:=a'),
('4','E;E;E'),
('5',';E;E'),
('6','E;E;'),
('7',';E;'),
('8','a<a'),
('9','a>a'),
('10','a=a'));
term:array [1..N1,1..2] of string =(
('1','a'),
('2','for'),
('3','do'),
('4','('),
('5',')'),
('6',';'),
('7',':='),
('8','='),
('9','<'),
('10','>'),
('11','@'));
notterm:array [1..10] of char=
('E','E','E','E','E','E','E','E','E','E');
Canon:array [1..10,1..6] of string= (
('E',';','','','',''),
('for','(','E',')','do','E'),
('a',':=','a','','',''),
('E',';','E',';','E',''),
(';','E',';','E','',''),
('E',';','E',';','',''),
(';','E',';','','',''),
('a','<','a','','',''),
('a','>','a','','',''),
('a','=','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;
Memo3.Text:='';
Memo2.Text:='';
Form3.StringGrid3.RowCount:=1001;
With Form3.StringGrid3 do begin
for i:=0 to 3 do begin
for j:=1 to 1000 do Form3.StringGrid3.Cells[i,j]:='';
end; end;

i1:=Memo1.Lines.Count;
ind:=1;
pos:=1;
for i:=1 to i1 do
begin
str:='';
stroka:=Memo1.Lines[i-1];
stroka:=stroka+' ';
dl:=Length(stroka);
sost:=AUTO_H;
fl:=0;
zn:=0;
for j:=1 to dl do
begin
st:=stroka[j];
case sost of
AUTO_H:
case stroka[j] of
';': begin sost:=AUTO_L;str:=str+st; end;
'I','X','V': begin sost:=AUTO_N;str:=str+st; end;
'>': begin sost:=AUTO_ZZ;str:=str+st; end;
'<': begin sost:=AUTO_Z1; str:=str+st end;
'=': begin sost:=AUTO_Z2; str:=str+st end;
':': begin sost:=AUTO_F1;str:=str+st; end; {1}
'(': begin sost:=AUTO_O2;str:=str+st; end; {1}
')': begin sost:=AUTO_O1;str:=str+st; end; {1}
'd': begin sost:=AUTO_D1;str:=str+st; end; {1}
'f': begin sost:=AUTO_K1;str:=str+st; end; {1}
'.': begin sost:=AUTO_T1;str:=str+st; end;
'a'..'c','e','g'..'z': begin sost:=AUTO_I;str:=str+st; end;
' ': begin sost:=AUTO_H;str:=''; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_L: {;}
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=1; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_N: {римские буквы}
case stroka[j] of
'X','I','V': begin sost:=AUTO_N; str:=str+st; end;
' ': begin sost:=AUTO_H; fl:=1; zn:=12; end;
'a'..'h','j'..'u','w','y','z': begin sost:=AUTO_H;fl:=1;zn:=5;str:=str+st; end;
else begin sost:=AUTO_E; str:=str+st; end;
end;
AUTO_O2: {(}
case stroka[j] of
' ': begin sost:=AUTO_H; fl:=1; zn:=2; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_O1: {)}
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=3; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_F1:
case stroka[j] of {:=}
'=': begin sost:=AUTO_F2;str:=str+st; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_F2:
case stroka[j] of {:=}
' ': begin sost:=AUTO_H;fl:=1;zn:=4; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_K1: {for}
case stroka[j] of
'a'..'n','p'..'z','0'..'9',' ': begin sost:=AUTO_I;str:=str+st; end;
'o': begin sost:=AUTO_K2;str:=str+st; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_K2: {for}
case stroka[j] of
'a'..'q','s'..'z','0'..'9',' ': begin sost:=AUTO_I;str:=str+st; end;
'r': begin sost:=AUTO_K3;str:=str+st; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_K3: {for}
case stroka[j] of
'a'..'z','0'..'9': begin sost:=AUTO_I;str:=str+st; end;
' ': begin sost:=AUTO_H; fl:=1; zn:=11; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_I:
case stroka[j] of
'a'..'z','0'..'9': begin sost:=AUTO_I;str:=str+st; end;
' ': begin sost:=AUTO_H;fl:=1;zn:=5; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_ZZ: {<,>,=}
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=6; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_Z1:
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=7; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_Z2:
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=8; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_D1: {DO}
case stroka[j] of
'a'..'n','p'..'z','0'..'9',' ': begin sost:=AUTO_I;str:=str+st; end;
'o': begin sost:=AUTO_D2;str:=str+st; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;

AUTO_D2:
case stroka[j] of
'a'..'z','0'..'9': begin sost:=AUTO_I;str:=str+st; end;
' ': begin sost:=AUTO_H;fl:=1;zn:=10; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_T1:
case stroka[j] of
' ': begin sost:=AUTO_H;fl:=1;zn:=9; end;
'.': begin sost:=AUTO_T1; str:=str+st; end;
else begin sost:=AUTO_E;str:=str+st; end;
end;
AUTO_E: begin
if stroka[j]<>' 'then
begin
sost:=AUTO_E;
str:=str+st;
end
else
begin
sost:=AUTO_H;
Memo2.Lines.Append(str);
str:='';
end;
end;
end;
if fl=1 then
begin

StringGrid3.Cells[0,ind]:=IntToStr(ind);
StringGrid3.Cells[1,ind]:=str;
case zn of
1: begin StringGrid3.Cells[2,ind]:='Разделяюший знак';p.Add(';'); end;
2: begin StringGrid3.Cells[2,ind]:='Круглые открывающиеся скобки';p.Add('('); end;
3: begin StringGrid3.Cells[2,ind]:='Круглые закрывающиеся скобки';p.Add(')'); end;
4: begin StringGrid3.Cells[2,ind]:='Знак присваивания';p.Add(':=');end;
5: begin StringGrid3.Cells[2,ind]:='Идентификатор';p.Add('a'); end;
6: begin StringGrid3.Cells[2,ind]:='>';p.Add('>'); end;
7: begin StringGrid3.Cells[2,ind]:='<'; p.Add('<');end;
8: begin StringGrid3.Cells[2,ind]:='='; p.Add('=');end;
10: begin StringGrid3.Cells[2,ind]:='Оператор "DO" '; p.Add('do');end;
11: begin StringGrid3.Cells[2,ind]:='Оператор "for"';p.Add('for');end;
12: begin StringGrid3.Cells[2,ind]:='Римские цифры или Константа';p.Add('a'); end;
end;
str:='';
ind:=ind+1;
fl:=0;
end;
end;
end;
fl:=p.Count;
p.Add('@');
stek.Add('@');
stek.Add(p.Strings[0]);
p.Delete(0);
ind:=p.Count-1;
o1:=p.Strings[0];
fl:=stek.Count-1;
o2:=stek.Strings[fl];
repeat
Begin
o1:=p.Strings[0];
fl:=stek.Count-1;
repeat if stek.Strings[fl]<>'E' then o2:=stek.Strings[fl]
else fl:=fl-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 fl=stek.Count-1 then
begin
dl:=1;
i:=1;
pr:=o2;
M2:
o4:=stek.Strings[fl-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 j>N1 then begin ShowMessage('Ошибка1!');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 M2;
end
else begin goto M3; end;
end
else
begin
dl:=dl+1;pr:=o4+pr; i:=i+1;goto M2;
end;

end
else
begin
dl:=1;
i:=1;
pr:=o2;
M4:
o4:=stek.Strings[fl-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 j>N1 then begin ShowMessage('Ошибка2!');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 M4;
end
else begin goto M5; end;
end
else
begin
dl:=dl+1;pr:=o4+pr; i:=i+1;goto M4;
end;
M5:
pr:=pr+'E';dl:=dl+1;
end;
M3:
for j:=1 to dl do stek.Delete(stek.Count-1);
j:=1;zn:=0;
repeat
if prav_1[j][2]=pr then zn:=StrToInt(prav_1[j][1])
else j:=j+1;
if j>N2 then begin ShowMessage('Ошибка3!'+' pr= '+pr);exit;end;
until(zn<>0);
stek.Add('E');
d.Add(IntToStr(zn));
CepofV[u]:=zn;
u:=u+1;

end
else begin ShowMessage('Ошибка во входной цепочке!'+' pr= '+pr);exit; end;

fl:=stek.Count-1;
o1:=p.Strings[0];
o2:=stek.Strings[fl-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:=2+2+1;
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 j+1 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.201415.97 Кб24laba2.dcu
  • #
    02.05.201451 б24laba2.ddp
  • #
    02.05.20144.51 Кб25laba2.dfm
  • #
    02.05.201421.66 Кб24laba2.pas
  • #
    02.05.201451 б24laba2.~ddp
  • #
    02.05.20144.51 Кб24laba2.~dfm
  • #
    02.05.201421.66 Кб24laba2.~pas
  • #
    02.05.2014434 б24Project1.cfg
  • #
    02.05.20141.97 Кб24Project1.dof