Курсовые проекты / курса / бек / 1 / Ботва / ᯮ / СПО / Лабы_1 / AA_Unit2

unit AA_Unit2;

interface

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

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Button1: TButton;
TabSheet2: TTabSheet;
OpenDialog1: TOpenDialog;
StringGrid1: TStringGrid;
Button2: TButton;
TabSheet3: TTabSheet;
Edit1: TEdit;
Label1: TLabel;
TreeView1: TTreeView;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
Memo1: TMemo;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Mymemo(Sender: TObject);


private
{ Private declarations }
public

F:TextFile;
nomer:integer;
{ Public declarations }
end;
const
{Описание матрицы предшествования}
PredMatrix:array [1..13,1..13] of char=
( {a for do ( ) ; := ++ -- = < > !}
{a} (' ',' ',' ',' ',' ','>','=','=','=','=','=','=',' '),
{for}(' ',' ','=','<',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{do} ('<','<',' ',' ','>','>',' ',' ',' ',' ',' ',' ',' '),
{(} ('<',' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ',' '),
{)} (' ',' ','>',' ',' ','>',' ','>','>',' ',' ',' ',' '),
{;} ('<',' ','>',' ','=','=',' ',' ',' ',' ',' ',' ','>'),
{:=} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{++} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ',' ',' '),
{--} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ',' ',' '),
{=} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{<} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{>} ('=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{!} ('<','<',' ',' ',' ','<',' ',' ',' ',' ',' ',' ',' '));
{Описание правил грамматики}
grammar:array [1..12] of string=
('F;','forTdoF','a:=a','(F;E;Q)','(;E;Q)','(F;E;)','(;E;)','a++','a--','a<a','a>a','a=a');
term:array [1..14] of string=(' ','a','for','do','(',')',';',':=','++','--','=','<','>','!');
notterm:array [1..12] of char=
('S','F','F','T','T','T','T','Q','Q','E','E','E');
Canon:array [1..12,1..7] of string=
(('F',';','','','','',''),
('for','T','do','F','','',''),
('a',':=','a','','','',''),
('(','F',';','E',';','Q',')'),
('(',';','E',';','Q',')',''),
('(','F',';','E',';',')',''),
('(',';','E',';',')','',''),
('a','++','','','','',''),
('a','--','','','','',''),
('a','<','a','','','',''),
('a','>','a','','','',''),
('a','=','a','','','',''));
var
Form1: TForm1;

implementation
function IndMatrix(SymS:String):integer;
begin
if SymS='a' then IndMatrix:=1;
if SymS='for' then IndMatrix:=2;
if SymS='do' then IndMatrix:=3;
if SymS='(' then IndMatrix:=4;
if SymS=')' then IndMatrix:=5;
if SymS=';' then IndMatrix:=6;
if SymS=':=' then IndMatrix:=7;
if SymS='++' then IndMatrix:=8;
if SymS='--' then IndMatrix:=9;
if SymS='=' then IndMatrix:=10;
if SymS='<' then IndMatrix:=11;
if SymS='>' then IndMatrix:=12;
if SymS='!' then IndMatrix:=13;
end;
function inArray(myS:String;A:Array of string;N:integer):boolean;
var i:integer;
begin
inArray:=False;
for i:=1 to N do
if myS=A[i] then begin inArray:=true end;
end;
function findnt(myS:String):string;
var i:integer;
begin
findnt:='';
if (myS='F;') then findnt:='S';
if (MyS='a:=a')or(myS='forTdoF') then findnt:='F';
if (myS='(F;E;Q)')or(myS='(;E;Q)')or(myS='(F;E;)')or(myS='(;E;)') then findnt:='T';
if (myS='a++')or(myS='a--') then findnt:='Q';
if (myS='a<a')or(myS='a>a')or(myS='a=a') then findnt:='E';
end;
function NomRul(myS:String):integer;
var i:integer;
begin
NomRul:=0;
if (myS='F;')then NomRul:=1;
for i:=1 to 12 do
if grammar[i]=myS then NomRul:=i;
end;
{$R *.DFM}


procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Memo1.Lines.LoadFromFile(OpenDialog1.FileName)
end
else
begin
ShowMessage('Вы отказались открыть файл');
Exit
end;
assignFile(F,OpenDialog1.Filename);
reset(F)
end;


procedure TForm1.Button2Click(Sender: TObject);
Type
TAutoState = ( AUTO_H, AUTO_A, AUTO_B, AUTO_C, AUTO_D,AUTO_E,AUTO_F,
AUTO_G,AUTO_I,AUTO_SRAVN,AUTO_FOR,AUTO_DO,AUTO_IDENT,AUTO_PR,AUTO_UP,AUTO_UM,
AUTO_INTc,AUTO_REALc, AUTO_LOGc,AUTO_ER, AUTO_S );
label MYGRaph;
var
s,S1,S2:String;
i,Address,K,NRow:integer;
iState:TAutoState;
begin
iState:=AUTO_H;
S1:='';
Address:=1;
With StringGrid1 do
begin
cells[0,0]:='№';
cells[1,0]:='Значение';
cells[2,0]:='Тип лексемы';
for Nrow:=1 to 100 do begin
cells[0,nrow]:='';
cells[1,nrow]:='';
cells[2,nrow]:=''
end
end;
While not EOF(F) do
begin
readln(F,S);
S:=S+' ';
for i:=1 to Length(S) do
begin
K:=0;
MYGRaph: case iState of
AUTO_H:
case S[i] of
';','(',')': begin S1:=S1+S[i];K:=-1;S2:='Разделительный символ';iState:=AUTO_S end;
':': begin S1:=S1+S[i];iState:=AUTO_D end;
'>','<','=':begin S1:=S1+S[i];S2:='Сравнение';iState:=AUTO_SRAVN end;
'f','F':begin S1:=S1+S[i];iState:=AUTO_A end;
'd','D':begin S1:=S1+S[i];iState:=AUTO_C end;
'a'..'c','e','g'..'z','A'..'C','E','G'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
'0':begin S1:=S1+S[i];s2:='Константа';iState:=AUTO_F end;
'1'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_INTc end;
' ':iState:=AUTO_H;
'+':begin S1:=S1+S[i];iState:=AUTO_E end;
'-':begin S1:=S1+S[i];iState:=AUTO_G end;
else iState:=AUTO_ER;
end;
AUTO_D:
case S[i] of
'=':begin S1:=S1+S[i];S2:='Присваивание'; iState:=AUTO_PR end
else iState:=AUTO_ER
end;

AUTO_A:
case S[i] of
'o','O':begin S1:=S1+S[i];iState:=AUTO_B end;
'a'..'n','p'..'z','0'..'9','A'..'N','P'..'Z': begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_B:
case S[i] of
'r','R':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_FOR end;
'a'..'q','s'..'z','0'..'9','A'..'Q','S'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;

AUTO_C:
case S[i] of
'o','O':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_DO end;
'a'..'n','p'..'z','0'..'9','A'..'N','P'..'Z': begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_E:
case S[i] of
'+':begin S1:=S1+S[i];S2:='Унарный плюс';iState:=AUTO_UP end;
else iState:=AUTO_ER;
end;
AUTO_F:
case S[i] of
'.':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_REALc end
else iState:=AUTO_S
end;
AUTO_G:
case S[i] of
'-':begin S1:=S1+S[i];S2:='Унарный минус';iState:=AUTO_UM end;
else iState:=AUTO_ER;
end;
AUTO_I:
case S[i] of
'+','-':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_LOGc end
else iState:=AUTO_ER
end;
AUTO_PR:iState:=AUTO_S;{}
AUTO_SRAVN:iState:=AUTO_S;{}
AUTO_UP:iState:=AUTO_S;{}
AUTO_UM:iState:=AUTO_S;{}
AUTO_FOR:
case S[i] of
'a'..'z','A'..'Z','0'..'9':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else iState:=AUTO_S; {}
end;
AUTO_DO:
case S[i] of
'a'..'z','0'..'9','A'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
' ':iState:=AUTO_S;{}
else iState:=AUTO_S;
end;
AUTO_IDENT:
case S[i] of
'a'..'z','0'..'9','A'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else iState:=AUTO_S;{}
end;
AUTO_INTc:
case S[i] of
'0'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_INTc end;
'.':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_REALc end;
'a'..'z','A'..'Z','(',')':iState:=AUTO_ER
else iState:=AUTO_S
end;
AUTO_REALc:
case S[i] of
'0'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_REALc end;
'e','E':begin S1:=S1+S[i];iState:=AUTO_I end;
'a'..'d','f'..'z','.',',','(',')','A'..'D','F'..'Z':iState:=AUTO_ER
else iState:=AUTO_S
end;
AUTO_LOGc:
case S[i] of
'0'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_LOGc end;
'a'..'z','A'..'Z','.',',','+','-','(',')':iState:=AUTO_ER
else iState:=AUTO_S
end;
AUTO_ER:begin ShowMessage('Ошибка!');Exit end;
end;
if iState=AUTO_S then begin
StringGrid1.Cells[0,Address]:=InttoStr(Address);
StringGrid1.Cells[1,Address]:=S1;
StringGrid1.Cells[2,Address]:=S2;
Address:=Address+1;
S1:='';
iState:=AUTO_H;
K:=K+1;
if K=1 then goto MYGRaph;

end;

end
end;
CloseFile(F)
end;

procedure TForm1.Button3Click(Sender: TObject);
label Myend;

var inputString,SymbStack:TStringList;{входная строка и стэк соответственно}
NRow,i,j,verh,k,time,vetv,n,m:integer;
gamma,MyinS,syms,tek,cep:String;
Mycase:char;
CepofV:array [1..100]of integer;
begin
{формируем входную строку}
inputString:=TStringList.Create;
inputString.Sorted:=False;
Nrow:=1;
with StringGrid1 do
begin
while cells[0,NRow]<>'' do
begin
if ((cells[2,NRow]='Константа')or(cells[2,NRow]='Идентификатор')) then
inputString.Add('a')
else
inputString.Add(cells[1,Nrow]);

NRow:=Nrow+1
end;
end;
for i:=0 to inputString.Count-1 do MyinS:=MyinS+InputString[i];
Edit1.Text:=MyinS;
if inputString.Count=0 then
begin
ShowMessage('Таблица лексем или исходный файл не загружены');
exit
end;
inputString.Add('!');
{Объявляем стэк}
SymbStack:=TStringList.Create;
SymbStack.Sorted:=False;
SymbStack.Add('!');

{Начальная вершина в дереве}
i:=0;
k:=0;
cep:='';
while i<=inputString.Count-1 do
begin
verh:=SymbStack.Count-1;
syms:=SymbStack[verh];
while (not(inArray(SymbStack[verh],term,14))) do verh:=verh-1;
if (SymbStack[verh]='!') and (inputString[i]='!') then goto MyEnd;
Mycase:=PredMatrix[IndMatrix(SymbStack[verh]),IndMatrix(inputString[i])];
{ShowMessage(SymbStack[verh]+' '+InputString[i]+' '+InttoStr(IndMatrix(SymbStack[verh]))+' '+InttoStr(IndMatrix(inputString[i]))+' '+MyCase);}
if ((mycase='<')or(mycase='='))then
begin {сдвиг}
SymbStack.Add(inputString[i]);
i:=i+1;
{for j:=SymbStack.Count-1 downto 0 do ShowMessage(SymbStack[j]);}
end
else
if (mycase='>')
then
begin {свертка}
gamma:='';
tek:='';
for j:=SymbStack.Count-1 downto 0 do
if not(inArray(SymbStack[j],term,14)) then
begin
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else
if (inArray(SymbStack[j],term,14))and(tek='') then
begin
tek:=SymbStack[j];
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else
if predMatrix[Indmatrix(SymbStack[j]),IndMatrix(tek)]='=' then
begin
tek:=SymbStack[j];
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else break;


{ShowMessage(gamma);}
if findnt(gamma)<>''
then
begin
SymbStack.Add(findnt(gamma));
k:=k+1;
CepofV[k]:=NomRul(gamma);
cep:=inttostr(CepofV[k])+' '+cep;
{for k:=SymbStack.Count-1 downto 0 do ShowMessage(SymbStack[k]);}
end
else
begin {ошибка}
ShowMessage('Ошибка');
exit
end;
end;
if mycase=' ' then
begin {ошибка}
ShowMessage('Ошибка на пробел');
exit;
end;
end;
Myend:Edit2.Text:=cep;
{вывод дерева}
n:=k;
with TreeView1 do
begin
Items.Add(Nil,'S');
vetv:=1;
j:=0;
for k:=n downto 1 do begin
m:=Items.Count;
if (CepofV[k]=3) and (k=1) then begin
j:=0;
for i:=m-1 downto 0 do if Items[i].Text=notterm[CepofV[k]] then begin j:=j+1;vetv:=i;if j=2 then break end;
end else
for i:=m-1 downto 0 do if Items[i].Text=notterm[CepofV[k]] then begin {j:=j+1;} vetv:=i;{if j=5 then }break; end;
for i:=1 to 7 do
if Canon[CepofV[k],i]<>'' then Items.AddChild(Items[vetv],Canon[CepofV[k],i]);
vetv:=vetv+1;
end;

FullExpand
end;
end;

procedure TForm1.Mymemo(Sender: TObject);
begin
Memo1.Lines.Clear;
end;


end.