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

interface

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

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
Label1: TLabel;
Edit8: TEdit;
Label3: TLabel;
Button9: TButton;
TreeView1: TTreeView;
Label2: TLabel;
Edit9: TEdit;
StringGrid4: TStringGrid;
Button8: TButton;
Button7: TButton;
StringGrid3: TStringGrid;
Memo2: TMemo;
Button6: TButton;
Label4: TLabel;
Memo1: TMemo;
GroupBox1: TGroupBox;
Label5: TLabel;
Button1: TButton;
GroupBox2: TGroupBox;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Button4: TButton;
Button5: TButton;
GroupBox3: TGroupBox;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Button2: TButton;
Edit2: TEdit;
Edit4: TEdit;
Edit1: TEdit;
Edit3: TEdit;
Button3: TButton;
OpenDialog1: TOpenDialog;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button7Click(Sender: TObject);

procedure Button9Click(Sender: TObject);
procedure MyMemo(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
{ Private declarations }
public
F:TextFile;
Words:TStringList;
{ Public declarations }
end;
const
{Описание матрицы предшествования}
PredMatrix:array [1..26,1..26] of char=
( {pr end. ; if then els enf beg end do wle a := or and not < > = ( ) - + * / !}
{prog} (' ','=','<','<',' ',' ',' ','<',' ','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{end.} (' ',' ','>',' ',' ',' ','>',' ','>',' ',' ','>',' ',' ',' ',' ',' ',' ',' ',' ','>',' ',' ',' ',' ','>'),
{;} (' ','>','>','<',' ',' ',' ','<','>','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{if} (' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ','<',' ','<','<','<','<','<','<','<',' ','<','<','<','<',' '),
{then} (' ',' ',' ','<',' ','=','=','<',' ','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{else} (' ',' ',' ','<',' ',' ','=','<',' ','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{endif}(' ','>','>',' ',' ','>','>',' ','>','<','>',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{begin}(' ',' ','<','<',' ',' ',' ','<','=','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{end} (' ','>','>',' ',' ','>','>',' ','>',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{do} (' ',' ',' ','<',' ',' ',' ','<',' ','<','=','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{while}(' ','>','>',' ',' ',' ','>',' ','>',' ',' ','<',' ',' ',' ',' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' '),
{a} (' ','>','>',' ','>','>','>',' ','>','>','>',' ','=','>','>','>','>','>','>',' ','>','>','>','>','>',' '),
{:=} (' ','>','>',' ',' ','>','>',' ','>','>',' ','<',' ',' ',' ',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{or} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{and} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{not} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{<} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{>} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{=} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{(} (' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','<',' ','<','<','<','<','<','<','<','=','<','<','<','<',' '),
{)} (' ','>','>',' ','>','>','>',' ','>','>','>',' ',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{-} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{+} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{*} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{/} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{!} ('<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '));
{Описание правил грамматики}
grammar:array [1..27] of string=
('programEend.','E','E;E','E;','ifBthenEelseEendif','ifBthenEendif','beginEend','doEwhile(B)','E','a:=E',
'BorB','B','BandB','B','notB','B','E<E','E>E','E=E','(B)','E-E','E+E','E*E','E/E','E','(E)','a');
term:array [1..26] of string=
('program','end.',';','if','then','else','endif','begin','end','do','while','a',':=','or','and','not','<','>','=','(',')','-','+','*','/','!');
notterm:array [1..27] of char=
('E','E','E','E','E','E','E','E','E','E','B','B','B','B','B','B',
'B','B','B','B','E','E','E','E','E','E','E');
CanonO:array [1..27,1..7] of string=
(('program','E','end.','','','',''),
('E','','','','','',''),
('E',';','E','','','',''),
('E',';','','','','',''),
('if','B','then','E','else','E','endif'),
('if','B','then','E','endif','',''),
('begin','E','end','','','',''),
('do','E','while','(','B',')',''),
('E','','','','','',''),
('a',':=','E','','','',''),
('B','or','B','','','',''),
('B','','','','','',''),
('B','and','B','','','',''),
('B','','','','','',''),
('not','B','','','','',''),
('B','','','','','',''),
('E','<','E','','','',''),
('E','>','E','','','',''),
('E','=','E','','','',''),
('(','B',')','','','',''),
('E','-','E','','','',''),
('E','+','E','','','',''),
('E','*','E','','','',''),
('E','/','E','','','',''),
('E','','','','','',''),
('(','E',')','','','',''),
('a','','','','','',''));
var
Form1: TForm1;

implementation


function IndMatrix(SymS:String):integer;
var i:integer;
begin
indMatrix:=0;
if term[1]=SymS then IndMatrix:=1;
for i:=1 to 26 do
if term[i]=SymS then IndMatrix:=i;
end;


function inArray(myS:String;A:Array of string;N:integer):boolean;
var i:integer;
begin
inArray:=False;
if MyS='program' then inArray:=true;
for i:=1 to N do
if myS=A[i] then begin inArray:=true end;
end;


function NomRul(myS:String):integer;
var i:integer;
begin
NomRul:=0;
if (myS=grammar[1])then NomRul:=1;
for i:=1 to 27 do
if grammar[i]=myS then NomRul:=i;
end;


function findnt(myS:String):string;
begin
findnt:='';
findnt:=notterm[nomRul(myS)]
end;


{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var F:TextFile;
S:String;
begin
if OpenDialog1.Execute then Memo1.Lines.LoadFromFile(Opendialog1.Filename)
else
begin
ShowMessage('Вы отказались от выбора файла');
Exit
end;
AssignFile(F, OpenDialog1.FileName);
reset(f);{Открытие файла для чтения}
{Создание строкового списка из строк файла}
Words:=TStringList.Create;{Вызов конструктора класса}
Words.Sorted:=False;
Screen.Cursor:=crHourGlass;{Изменение типа курсора перед длительной работой}
{Извлечение строк из файла и занесение их в список}
while not EOF(F) do
begin
readln(F,S);
if S<>'' then Words.Add(S)
end;
Screen.Cursor:=crDefault;{Восстановление типа курсора по умолчанию}
CloseFile(F);
if Words.Count=0 then
begin
ShowMessage('Файл пуст');
Exit;{Выход, если список пуст}
end
end;

procedure TForm1.Button2Click(Sender: TObject);
const
HFMIN=Ord('0')+Ord('0');
HFMAX=Ord('z')+Ord('z');
label Poisk;
var s,Word:string;
Kol,Com,Key,Key1:integer;
begin
Kol:=0;
Com:=0;
S:=Edit1.Text;
if s='' then
begin
Showmessage('Вы не ввели идентификатор для поиска');
Exit
end;
if length(S)>=3 then Key:=Ord(S[1])+Ord(S[3])
else Key:=Ord(S[1]);
if StringGrid1.Cells[1,Key]='' then
begin
Com:=Com+1;
ShowMessage('Идентификатор не найден');
Word:=InttoStr(Com);
Edit2.Text:=Word;
Word:=InttoStr(Kol);
Edit3.Text:=Word;
Exit
end
else
begin
if S=StringGrid1.Cells[1,Key] then
begin
Com:=Com+1;
ShowMessage('Идентификатор находится по адресу'+inttoStr(Key));
Word:=InttoStr(Com);
Edit2.Text:=Word;
Word:=InttoStr(Kol);
Edit3.Text:=Word;
Exit
end
else
begin
Kol:=1;
Com:=Com+1;
Poisk: Key1:=(Key*Kol) mod (HFMAX-HFMIN+1){-2};
if StringGrid1.Cells[1,Key1]='' then
begin
Com:=Com+1;
ShowMessage('Идентификатор не найден');
Word:=InttoStr(Com);
Edit2.Text:=Word;
Word:=InttoStr(Kol);
Edit3.Text:=Word;
Exit
end
else
begin
if S=StringGrid1.Cells[1,Key1] then
begin
Com:=Com+1;
ShowMessage('Идентификатор находится по адресу'+inttoStr(Key1));
Word:=InttoStr(Com);
Edit2.Text:=Word;
Word:=InttoStr(Kol);
Edit3.Text:=Word;
Exit
end
else
begin
Key:=Key1;
Kol:=Kol+1;
goto Poisk
end
end;
end
end

end;

procedure TForm1.Button3Click(Sender: TObject);
label der;
var S,Now,Word:string;
Com,Kol,Code,NomNow:integer;
begin
Com:=0;
Kol:=0;
S:=Edit1.Text;
If S='' then begin
ShowMessage('Вы не ввели идентификатор для поиска');
Exit
end;
NomNow:=1;
Now:=StringGrid2.Cells[1,NomNow];
der:if S=Now then
begin
Com:=Com+1;
ShowMessage('Идентификатор находится по адресу '+InttoStr(NomNow));
Word:=InttoStr(Com);
Edit4.Text:=Word;
end
else
begin
Com:=Com+1;
if S<Now then
begin
Com:=Com+1;
Kol:=Kol+1;
if StringGrid2.Cells[2,NomNow]='' then
begin
ShowMessage('Идентификатор не найден ');
Word:=InttoStr(Com);
Edit4.Text:=Word;
end
else
begin
val(StringGrid2.Cells[2,NomNow],NomNow,Code);
Now:=StringGrid2.Cells[1,NomNow];
Goto der
end
end
else
begin
Com:=Com+1;
Kol:=Kol+1;
if StringGrid2.Cells[3,NomNow]='' then
begin
ShowMessage('Идентификатор не найден ');
Word:=InttoStr(Com);
Edit4.Text:=Word;
end
else
begin
val(StringGrid2.Cells[3,NomNow],NomNow,Code);
Now:=StringGrid2.Cells[1,NomNow];
Goto der
end
end
end

end;


procedure TForm1.Button4Click(Sender: TObject);
label Shag3;
const
HFMIN=Ord('0')+Ord('0');
HFMAX=Ord('z')+Ord('z');
var
S,Word:String;
NRow, i,Kol,KolO, Com,Key, Key1: Integer;
begin
{Рисование ХТ и занесение пустых значений во все ее ячейки}
KolO:=0;{Количество колизий}
Com:=0;{Количество сравнений}
with StringGrid1 do
begin
cells[0,0]:='HF';
cells[1,0]:='Address';
For NRow:=1 to HFMAX do
begin
cells[0,NRow]:=InttoStr(NRow);
cells[1,NRow]:=''
end
end;
{Собственно хэширование}
for i:=0 to Words.Count-1 do
begin
Kol:=0;
s:=Words[i];
if length(S)>=3 then Key:=Ord(S[1])+Ord(S[3]){Вычисление значения ключа}
else Key:=Ord(S[1]);
if StringGrid1.Cells[1,Key]='' then
begin {ячейка с данным значением ХФ свободна}
Com:=Com+1;{число сравнений}
StringGrid1.Cells[1,Key]:=S;{Заносим запись в ТИ по значению указателя}
end
else {ячейка с данным заначением ХФ занята}
begin
Shag3: Kol:=Kol+1;
KolO:=KolO+1;
Com:=Com+1;
Key1:=(Key*Kol) mod (HFMAX-HFMIN+1);
if StringGrid1.Cells[1,Key1]='' then
begin {ячейка с данным значением ХФ свободна}
Com:=Com+1;{число сравнений}
StringGrid1.Cells[1,Key1]:=S;{Заносим запись в ТИ по значению указателя}
end
else {ячейка с данным заначением ХФ занята}
if Key1=Key then
begin
ShowMessage('Ошибка! В ХТ нет свободного места');
Exit
end
else
begin
key:=key1;
goto Shag3;

end
end;
end;
Word:=InttoStr(KolO);
Edit5.Text:=Word;
word:=InttoSTR(Com);
Edit6.Text:=Word;
end;


procedure TForm1.Button5Click(Sender: TObject);
Label M1;
var i,Address,NomNow,Code,Com,Kol: integer;
SnomNow,Now,Word:String;
begin
with StringGrid2 do
begin
cells[0,0]:='Address';
cells[1,0]:='Meaning';
cells[2,0]:='Left';
cells[3,0]:='Right';
for i:=1 to 245 do begin
cells[0,i]:=InttoStr(i);
cells[1,i]:='';
cells[2,i]:='';
cells[3,i]:=''
end;
end;
Com:=0;
Kol:=0;
StringGrid2.Cells[1,1]:=Words[0];
Address:=1;
for i:=1 to Words.Count-1 do
begin
NomNow:=1;
Now:=StringGrid2.Cells[1,1];
M1:if Words[i]=Now then
begin
ShowMessage('Ошибка! Не может быть двух одинаковых идентификаторов');
Exit
end
else
begin
if Words[i]<Now then
begin
Com:=Com+1;
if stringGrid2.Cells[2,NomNow]='' then
begin
Address:=Address+1;
StringGrid2.Cells[2,NomNow]:=InttoStr(Address);
StringGrid2.Cells[1,Address]:=Words[i];
end
else
begin
Kol:=Kol+1;
SNomNow:=StringGrid2.Cells[2,NomNow];
val(SNomNow,NomNow,Code);
Now:=StringGrid2.Cells[1,NomNow];
goto M1
end
end
else
begin
Com:=Com+1;
if stringGrid2.Cells[3,NomNow]='' then
begin
Address:=Address+1;
StringGrid2.Cells[3,NomNow]:=InttoStr(Address);
StringGrid2.Cells[1,Address]:=Words[i];
end
else
begin
Kol:=Kol+1;
SNomNow:=StringGrid2.Cells[3,NomNow];
val(SNomNow,NomNow,Code);
Now:=StringGrid2.Cells[1,NomNow];
goto M1
end
end
end
end;
Word:=inttostr(Com);
Edit7.Text:=Word
end;


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


procedure TForm1.Button7Click(Sender: TObject);
Type
TAutoState = ( AUTO_H, AUTO_A, AUTO_B, AUTO_C, AUTO_D, AUTO_F,
AUTO_E,AUTO_G, AUTO_I, AUTO_J,AUTO_K, AUTO_L,AUTO_M,
AUTO_N,AUTO_O, AUTO_P, AUTO_Q, AUTO_R, AUTO_T, AUTO_U, AUTO_V, AUTO_W,
AUTO_X, AUTO_Y,AUTO_Z,AUTO_AA,AUTO_AB,AUTO_AC,AUTO_AD,AUTO_AE,AUTO_AI,
AUTO_AH,AUTO_SRAVN,AUTO_WHILE, AUTO_DO,AUTO_IDENT, AUTO_PR,AUTO_BEGIN,
AUTO_END1,AUTO_END2, AUTO_IF, AUTO_THEN,AUTO_ELSE, AUTO_PROGRAM,AUTO_ENDIF,
AUTO_CONST, AUTO_COMMENT,AUTO_ARIPH, AUTO_DOP,AUTO_ER, AUTO_S,AUTO_AND,
AUTO_OR,AUTO_NOT);
label MYGRaph;
var
s,S1,S2:String;
i,Address,K,str:integer;
iState:TAutoState;
begin
iState:=AUTO_H;
S1:='';
Address:=1;
With StringGrid3 do
begin
cells[0,0]:='№';
cells[1,0]:='Значение';
cells[2,0]:='Тип лексемы';
end;
str:=0;
While not EOF(F) do
begin
readln(F,S);
str:=Str+1;
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_AC end;
'>','<','=':begin S1:=S1+S[i];S2:='Сравнение';iState:=AUTO_SRAVN end;
'+','-':begin S1:=S1+S[i];S2:='Арифметическая операция';iState:=AUTO_ARIPH end;
'*','/':begin S1:=s1+S[i];S2:='Дополнительная операция';iState:=AUTO_DOP end;
'i','I':begin S1:=S1+S[i];iState:=AUTO_A end;
't','T':begin S1:=S1+S[i];iState:=AUTO_B end;
'e','E':begin S1:=S1+S[i];iState:=AUTO_E end;
'b','B':begin S1:=S1+S[i];iState:=AUTO_AH end;
'd','D':begin S1:=S1+S[i];iState:=AUTO_AD end;
'p','P':begin S1:=S1+S[i];iState:=AUTO_M end;
'w','W':begin S1:=S1+S[i];iState:=AUTO_T end;
'a','A':begin S1:=S1+S[i];iState:=AUTO_X end;
'o','O':begin S1:=S1+S[i];iState:=AUTO_Z end;
'n','N':begin S1:=S1+S[i];iState:=AUTO_AA end;
'{':begin S1:=S1+S[i];iState:=AUTO_COMMENT end;
'c','f'..'h','j'..'m','r','s','u','v','x'..'z','C','F'..'H','J'..'M','R','S','U','V','X'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
'0':begin S1:=S1+S[i];iState:=AUTO_AE end;
'1'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_CONST end;
' ':iState:=AUTO_H;
else iState:=AUTO_ER;
end;
AUTO_A:
case S[i] of
'F','f':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_IF end;
'a'..'e','g'..'z','0'..'9','A'..'E','G'..'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
'h','H':begin S1:=S1+S[i];iState:=AUTO_C end;
'a'..'g','i'..'z','0'..'9','A'..'G','I'..'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
'e','E':begin S1:=S1+S[i];iState:=AUTO_D end;
'a'..'d','f'..'z','0'..'9','A'..'D','F'..'Z': begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_D:
case S[i] of
'n','N':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_THEN end;
'a'..'m','o'..'z','0'..'9','A'..'M','O'..'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
'l','L':begin S1:=S1+S[i];iState:=AUTO_F end;
'n','N':begin S1:=S1+S[i];iState:=AUTO_L end;
'a'..'k','m','o'..'z','0'..'9','A'..'K','M','O'..'Z': begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_F:
case S[i] of
's','S':begin S1:=S1+S[i];iState:=AUTO_G end;
'a'..'r','t'..'z','0'..'9','A'..'R','T'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_G:
case S[i] of
'e','E':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_ELSE end;
'a'..'d','f'..'z','0'..'9','A'..'D','F'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_AH:
case S[i] of
'e','E':begin S1:=S1+S[i];iState:=AUTO_I end;
'a'..'d','f'..'z','0'..'9','A'..'D','F'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_I:
case S[i] of
'g','G':begin S1:=S1+S[i];iState:=AUTO_J end;
'a'..'f','h'..'z','0'..'9','A'..'F','H'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_J:
case S[i] of
'i','I':begin S1:=S1+S[i];iState:=AUTO_K end;
'a'..'h','j'..'z','0'..'9','A'..'H','J'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_K:
case S[i] of
'n','N':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_BEGIN end;
'a'..'m','o'..'z','0'..'9','A'..'M','O'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_L:
case S[i] of
'd','D':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_END1 end;
'a'..'c','e'..'z','0'..'9','A'..'C','E'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_M:
case S[i] of
'r','R':begin S1:=S1+S[i];iState:=AUTO_N 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_N:
case S[i] of
'o','O':begin S1:=S1+S[i];iState:=AUTO_O 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_O:
case S[i] of
'g','G':begin S1:=S1+S[i];iState:=AUTO_P end;
'a'..'f','h'..'z','0'..'9','A'..'F','H'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_P:
case S[i] of
'r','R':begin S1:=S1+S[i];iState:=AUTO_Q 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_Q:
case S[i] of
'a','A':begin S1:=S1+S[i];iState:=AUTO_R end;
'b'..'z','0'..'9','B'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_R:
case S[i] of
'm','M':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_PROGRAM end;
'a'..'l','n'..'z','0'..'9','A'..'L','N'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_T:
case S[i] of
'h','H':begin S1:=S1+S[i];iState:=AUTO_U end;
'a'..'g','i'..'z','0'..'9','A'..'G','I'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_U:
case S[i] of
'i','I':begin S1:=S1+S[i];iState:=AUTO_V end;
'a'..'h','j'..'z','0'..'9','A'..'H','J'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_V:
case S[i] of
'l','L':begin S1:=S1+S[i];iState:=AUTO_W end;
'a'..'k','m'..'z','0'..'9','A'..'K','M'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_W:
case S[i] of
'e','E':begin S1:=S1+S[i];S2:='Условный оператор';iState:=AUTO_WHILE end;
'a'..'d','f'..'z','0'..'9','A'..'D','F'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_X:
case S[i] of
'n','N':begin S1:=S1+S[i];iState:=AUTO_Y end;
'a'..'m','o'..'z','0'..'9','A'..'M','O'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_Y:
case S[i] of
'd','D':begin S1:=S1+S[i];s2:='Логическая операция';iState:=AUTO_AND end;
'a'..'c','e'..'z','0'..'9','A'..'C','E'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_Z:
case S[i] of
'r','R':begin S1:=S1+S[i];S2:='Логическая операция';iState:=AUTO_OR 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_AA:
case S[i] of
'o','O':begin S1:=S1+S[i];iState:=AUTO_AB 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_AB:
case S[i] of
't','T':begin S1:=S1+S[i];S2:='Логическая операция';iState:=AUTO_NOT end;
'a'..'s','u'..'z','0'..'9','A'..'S','U'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_AC:
case S[i] of
'=':begin S1:=S1+S[i];S2:='Присваивание'; iState:=AUTO_PR end
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_AD:
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_AE:
case S[i] of
'a'..'f','A'..'F','1'..'9':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_CONST end;
else iState:=AUTO_ER;
END;
AUTO_AI:
case S[i] of
'f','F':begin S1:=S1+S[i];S2:='Служебное слово';iState:=AUTO_ENDIF end;
'a'..'e','g'..'z','0'..'9','A'..'E','G'..'Z':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end;
else begin S2:='Идентификатор';iState:=AUTO_S end
end;
AUTO_PR:iState:=AUTO_S;{}
AUTO_SRAVN:iState:=AUTO_S;{}
AUTO_ARIPH:iState:=AUTO_S;{}
AUTO_DOP:iState:=AUTO_S;{}
AUTO_WHILE:
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_BEGIN:
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_IF:
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_THEN:
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_ELSE:
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_PROGRAM:
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_ENDIF:
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_END1:
case S[i] of
'.':begin S1:=S1+S[i];S2:='Конец программы';iState:=AUTO_END2 end;
'i','I':begin S1:=S1+S[i];iState:=AUTO_AI end;
'a'..'h','j'..'z','A'..'H','J'..'Z','0'..'9':begin S1:=S1+S[i];S2:='Идентификатор';iState:=AUTO_IDENT end
else iState:=AUTO_S; {}
end;
AUTO_END2:
case S[i] of
' ':iState:=AUTO_S
else iState:=AUTO_ER; {}
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_CONST:
case S[i] of
'0'..'9','A'..'F','a'..'f':begin S1:=S1+S[i];S2:='Константа';iState:=AUTO_CONST end;
'H','h':begin iState:=AUTO_S;K:=-1 end;
'g','i'..'z','G','I'..'Z','(':iState:=AUTO_ER;
else iState:=AUTO_S
end;
AUTO_COMMENT:
case S[i] of
'}':begin S1:=S1+S[i];iState:=AUTO_S end;
else begin S1:=S1+S[i];K:=-1;S2:='Комментарий';IState:=AUTO_COMMENT end;
end;
AUTO_ER:begin ShowMessage('Ошибка! В строке номер '+InttoStr(str)+' позиция '+InttoStr(i));Exit end;
end;
if iState=AUTO_S then begin
StringGrid3.Cells[0,Address]:=InttoStr(Address);
StringGrid3.Cells[1,Address]:=S1;
StringGrid3.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.Button9Click(Sender: TObject);
label Myend,zap,tree;

var inputString,SymbStack:TStringList;{входная строка и стэк соответственно}
NRow,i,j,verh,k,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 StringGrid3 do
begin
while cells[0,NRow]<>'' do
begin
if ((cells[2,NRow]='Константа')or(cells[2,NRow]='Идентификатор')) then
inputString.Add('a')
else
if cells[2,NRow]<>'Комментарий' then
inputString.Add(cells[1,Nrow]);

NRow:=Nrow+1
end;
end;
for i:=0 to inputString.Count-1 do MyinS:=MyinS+InputString[i];
Edit8.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,26))) 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;
end
else
if (mycase='>')
then
begin {свертка}
gamma:='';
tek:='';
for j:=SymbStack.Count-1 downto 0 do
if not(inArray(SymbStack[j],term,26)) then
begin
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else
if (inArray(SymbStack[j],term,26))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;



if findnt(gamma)<>''
then
begin
SymbStack.Add(findnt(gamma));
k:=k+1;
CepofV[k]:=NomRul(gamma);
{ShowMessage('Цепочка '+gamma+' заменяется на '+findnt(gamma)+' по правилу '+inttostr(Nomrul(gamma)));}
cep:=inttostr(CepofV[k])+' '+cep;
end
else
begin {ошибка}
ShowMessage('Ошибка! Цепочка '+gamma+' недопустима');
goto tree
end;
end;
if mycase=' ' then
begin {ошибка}
ShowMessage('Ошибка! Символы '+Symbstack[verh]+' и '+InputString[i]+' не могут следовать друг за другом');
goto tree;
end;
end;
Myend:Edit9.Text:=cep;
{вывод дерева}
tree:n:=k;
with TreeView1 do
begin
Items.Add(Nil,'E');
vetv:=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]] then
if Items[i].HasChildren=False then
begin
vetv:=i;
goto zap
end;
zap: for i:=1 to 7 do
if CanonO[CepofV[k],i]<>'' then
Items.AddChild(Items[vetv],CanonO[CepofV[k],i])
end;
FullExpand
end;
end;

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

procedure TForm1.Button8Click(Sender: TObject);
Label M1,cont;
var i,Address,NomNow,Code,Com,Kol,NrOw,j,h: integer;
SnomNow,Now,Word,tek:String;
Ident:TStringList;
begin
Ident:=TStringList.Create;
With StringGrid3 do
for Nrow:=1 to StringGrid3.RowCount do
if cells[2,Nrow]='Идентификатор' then Ident.Add(Cells[1,NRow]);
h:=Ident.Count-1;
for i:=0 to Ident.Count-2 do
begin
tek:=Ident[i];
j:=i+1;
while j<h do
if tek=Ident[j] then begin Ident.delete(j);h:=h-1 end else j:=j+1;
if h=1 then goto cont
end;
cont:with StringGrid4 do
begin
cells[0,0]:='Address';
cells[1,0]:='Meaning';
cells[2,0]:='Left';
cells[3,0]:='Right';
for i:=1 to 245 do begin
cells[0,i]:=InttoStr(i);
cells[1,i]:='';
cells[2,i]:='';
cells[3,i]:=''
end;
end;
Com:=0;
Kol:=0;
StringGrid4.Cells[1,1]:=Ident[0];
Address:=1;
for i:=1 to Ident.Count-1 do
begin
NomNow:=1;
Now:=StringGrid4.Cells[1,1];
M1:if Ident[i]=Now then
begin
ShowMessage('Ошибка! Не может быть двух одинаковых идентификаторов');
Exit
end
else
begin
if Ident[i]<Now then
begin
Com:=Com+1;
if stringGrid4.Cells[2,NomNow]='' then
begin
Address:=Address+1;
StringGrid4.Cells[2,NomNow]:=InttoStr(Address);
StringGrid4.Cells[1,Address]:=Ident[i];
end
else
begin
Kol:=Kol+1;
SNomNow:=StringGrid4.Cells[2,NomNow];
val(SNomNow,NomNow,Code);
Now:=StringGrid4.Cells[1,NomNow];
goto M1
end
end
else
begin
Com:=Com+1;
if stringGrid4.Cells[3,NomNow]='' then
begin
Address:=Address+1;
StringGrid4.Cells[3,NomNow]:=InttoStr(Address);
StringGrid4.Cells[1,Address]:=Ident[i];
end
else
begin
Kol:=Kol+1;
SNomNow:=StringGrid4.Cells[3,NomNow];
val(SNomNow,NomNow,Code);
Now:=StringGrid4.Cells[1,NomNow];
goto M1
end
end
end
end;
Word:=inttostr(Com);
Edit7.Text:=Word
end;

end.
Соседние файлы в папке еще спо
  • #
    02.05.201432.33 Кб21Kurs_all.dcu
  • #
    02.05.20149.88 Кб22Kurs_all.dfm
  • #
    02.05.201450.68 Кб22Kurs_all.pas
  • #
    02.05.2014922 б21Kurs_Last.dof
  • #
    02.05.2014195 б21Kurs_Last.dpr