Разработка программы-компилятора — страница 3
Обновлено
Term_tab [NumTerm]. Left: =0;
Term_tab [NumTerm]. Right: =0;
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L';
end else begin
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L';
Add_Term (Term_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя.
end;
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то
if Term_tab [Curr_term]. Right=0 then
begin
Term_tab [Curr_term]. Right: =NumTerm; // Создаем правый элемент.
Term_tab [NumTerm]. lex: =str_lex;
Term_tab [NumTerm]. nomer: =NumTerm;
Term_tab [NumTerm]. Left: =0;
Term_tab [NumTerm]. Right: =0;
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R';
end else begin
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R';
Add_Term (Term_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя.
end;
end;
procedure Add_Ident (str: string); // процедура добавления константы
var i: integer;
begin
kod: =Length (str) +2;
hesh: =0;
for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш
hesh: =round (hesh/kod); // метод деления
while (Id_tab [hesh]. lex<>'') and (hesh<maxnum) do // пока ячейка занята
begin
Id_tab [hesh]. ssylka: =hesh+1;
hesh: =hesh+1;
end;
Id_tab [hesh]. nomer: =Numid; // запись данных
Id_tab [hesh]. lex: =str;
end;
function Search_Ident (str: string): integer; // функция поиска терминала
var i: integer;
label 1;
begin
kod: =Length (str) +2;
hesh: =0;
for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш
hesh: =round (hesh/kod);
1: if str=Id_tab [hesh]. lex then Search_Ident: =Id_tab [hesh]. nomer else // поиск идентификатора
begin
if Id_tab [hesh]. ssylka=0 then Search_Ident: =0 else
begin
hesh: =Id_tab [hesh]. ssylka;
goto 1;
end;
end;
end;
procedure Search_Const (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов
begin
Constyes: =0; // флаг: найдена ли лексема
if (NumConst<>0) and (str_lex<>'') then
begin
if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) and (Const_tab [Curr_term]. Left<>0) then
Search_Const (Const_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву"
if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) and (Const_tab [Curr_term]. Right<>0) then
Search_Const (Const_tab [Curr_term]. Right,str_lex);
if Const_tab [Curr_term]. value=str_lex then Constyes: =Const_tab [Curr_term]. nomer;
end;
end;
procedure Search_Term (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов
begin
Termyes: =0; // флаг: найдена ли лексема
if (NumTerm<>0) and (str_lex<>'') then
begin
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) and (Term_tab [Curr_term]. Left<>0) then
Search_Term (Term_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву"
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) and (Term_tab [Curr_term]. Right<>0) then
Search_Term (Term_tab [Curr_term]. Right,str_lex);
if Term_tab [Curr_term]. lex=str_lex then Termyes: =Term_tab [Curr_term]. nomer;
end;
end;
// функция распознавания 16-рич. констант
function FConst (str: string): integer;
var
sost: byte;
begin
sost: =0;
if str [1] ='$' then // распознаём символ '$'
begin
sost: =1;
delete (str,1,1);
end
else exit;
if (str [1] ='+') or (str [1] ='-') then // распознаём знак
begin
sost: =2;
delete (str,1,1)
end
else begin sost: =4; exit; end;
if str='' then exit;
while length (str) >0 do begin
if (str [1] in cifra) or (str [1] in bukva)
then sost: =2 // распознаём буквы или цифры
else begin sost: =4; exit;
end;
delete (str,1,1);
end;
sost: =3;
if sost=3 then FConst: =1 else FConst: =-1;
end;
function termin: integer; // распознаватель терминальных символов
begin
termin: =-1;
for k: =1 to 14 do if Words [k] =Lexem then termin: =3;
for k: =1 to 8 do if Razdel [k] =Lexem then termin: =1;
for k: =1 to 11 do if Operacii [k] =Lexem then termin: =2;
end;
function Rome (str: string): integer; // распознаватель римских констант
var sost: byte;
begin
sost: =0;
if (str [1] ='-') or (str [1] ='+')
then begin sost: =12; delete (str,1,1); end;
if str='' then exit;
if str [1] ='X'
then begin sost: =1; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
while Length (str) <>0 do begin
case sost of
1: if str [1] ='X'
then begin sost: =5; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
2: if str [1] ='I'
then begin sost: =7; delete (str,1,1) end
else begin sost: =4; exit; end;
3: if str [1] ='X'
then begin sost: =8; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =9; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =10; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
4: exit;
5: if str [1] ='X'
then begin sost: =6; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
6: if str [1] ='V'
then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end;
7: if str [1] ='I'
then begin sost: =10; delete (str,1,1) end
else begin sost: =4; exit; end;
8: begin sost: =4; exit; end;
9: begin sost: =4; exit; end;
10: if str [1] ='I'
then begin sost: =11; delete (str,1,1) end
else begin sost: =4; exit; end;
11: begin sost: =4; exit; end;
end;
end;
if (sost=4) or (sost=12) then Rome: =-1 else Rome: =1;
end;
// функция распознавания идентификаторов
function Ident (str: string): integer;
var
sost: byte;
begin
sost: =0; // реализация конечного автомата
if str [1] in ['a'. 'z'] then
begin
sost: =1;
delete (str,1,1)
end
else exit;
while length (str) >0 do begin
if str [1] in ['a'. 'z','0'. '9','_']
then begin sost: =1; delete (str,1,1); end
else begin sost: =3; exit; end;
end;
sost: =2;
if sost=2 then ident: =1 else ident: =-1;
end;
procedure WriteCode (nomer: integer; lex: string; typ: char; num: integer); // запись в таблицу кодов лексем
begin
Code_Tab [NumLex]. nomer: =nomer;
Code_Tab [NumLex]. Lex: =lex;
Code_Tab [NumLex]. typ: =typ;
Code_Tab [NumLex]. Num: =num;
Code_Tab [NumLex]. numstr: =string_counter+1;
end;
procedure WriteLex (typelex: char); // запись лексем в таблицы
begin
case typelex of
'C': begin // если лексема-16-рич. константа
NumLex: =NumLex+1;
Search_Const (1,Lexem);
if Constyes=0 then // если лексема не найдена
begin
NumConst: =NumConst+1;
Add_Const (1,Lexem);
Const_tab [NumConst]. Typ: ='16-рич. ';
Const_tab [Numconst]. Width: ='2 байта';
WriteCode (NumLex,Lexem,'C',NumConst);
end else // если лексема найдена
begin
WriteCode (NumLex,Lexem,'C',Constyes);
end;
end;
'M': begin // если лексема-римская константа
NumLex: =NumLex+1;
Search_Const (1,Lexem);
if Constyes=0 then // если лексема не найдена
begin
NumConst: =NumConst+1;
Add_Const (1,Lexem);
Const_tab [NumConst]. Typ: ='римск. ';
Const_tab [Numconst]. Width: ='2 байта';
WriteCode (NumLex,Lexem,'C',NumConst);
end else // если лексема найдена
begin
WriteCode (NumLex,Lexem,'C',Constyes);
end;
end;
'I': begin // если лексема-идентификатор
NumLex: =NumLex+1;
y: =Search_Ident ({1,}Lexem);
if y=0 then // если лексема не найдена
begin
NumId: =NumId+1;
WriteCode (NumLex,Lexem,'I',NumId);
Add_Ident (Lexem);
end else WriteCode (NumLex,Lexem,'I',y); // если лексема найдена
end;
'K': begin // если лексема-служебное слово
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [Numterm]. razd: =0;
Term_tab [Numterm]. oper: =0;
Term_tab [Numterm]. slug: =1;
WriteCode (NumLex,Lexem,'T',NumTerm);
end else WriteCode (NumLex,Lexem,'T',Termyes); // если лексема найдена
end;
'R': begin // если лексема-разделитель
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [NumTerm]. razd: =1;
Term_tab [NumTerm]. oper: =0;
Term_tab [NumTerm]. slug: =0;
WriteCode (NumLex,Lexem,'T',NumTerm)
end else WriteCode (NumLex,Lexem,'T',Termyes) // если лексема найдена
end;
'O': begin // если лексема-знак операция
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [Numterm]. razd: =0;
Term_tab [Numterm]. oper: =1;
Term_tab [Numterm]. slug: =0;
WriteCode (NumLex,Lexem,'T',NumTerm)
end else WriteCode (NumLex,Lexem,'T',Termyes) // есди лексема найдена
end;
end;
end;
procedure TForm1. N5Click (Sender: TObject);
var i,pip: integer;
begin
for k: =1 to numid do // обнуление таблицы идентификаторов
begin
id_tab [k]. lex: ='0';
id_tab [k]. nomer: =0;
id_tab [i]. ssylka: =0;
end;
for i: =1 to numlex do // обнуление выходной таблицы
begin
Code_Tab [i]. Lex: ='';
Code_Tab [i]. typ: =#0;
Code_Tab [i]. Num: =0;
Code_Tab [i]. nomer: =0;
end;
for i: =0 to numconst do // обнуление таблицы констант
begin
Const_tab [i]. nomer: =0;
Const_tab [i]. value: ='';
Const_tab [i]. Typ: ='';
Const_tab [i]. Width: ='';
Const_tab [i]. Val10: ='';
Const_tab [k]. Left: =0;
Const_tab [k]. Right: =0;
Const_tab [k]. Way: ='';
end;
for i: =1 to numterm do
begin
Term_tab [i]. nomer: =0;
Term_tab [i]. Lex: ='';
Term_tab [i]. razd: =0;
Term_tab [i]. oper: =0;
Term_tab [i]. slug: =0;
Term_tab [k]. Left: =0;
Term_tab [k]. Right: =0;
Term_tab [k]. Way: ='';
end;
// инициализация
NumLex: =0; NumId: =0; NumConst: =0; NumErr: =0; NumTerm: =0;
Error: =false; Found: =false;
i: =0; j: =0; k: =0; y: =0;
String_counter: =0;
Memo2. Lines. Clear;
N6. Enabled: =true;
while string_counter<=Memo1. Lines. Count do // цикл по строкам файла
begin
n: =1;
m: =1;
s: =Form1. Memo1. Lines. Strings [string_counter] ;
for l: =1 to 2 do
while m<=Length (s) do // цикл по строке
begin
n: =m;
m: =Select_Lex (s,Lexem,n);
if (Lexem<>'') and not (Lexem [1] in [#0. #32]) then
begin
if FConst (Lexem) =1 then WriteLex ('C') else // вызов процедуры записи
if Termin=3 then WriteLex ('K') else
if Rome (Lexem) =1 then WriteLex ('M') else
if Ident (Lexem) =1 then WriteLex ('I') else
if Termin=1 then WriteLex ('R') else
if Termin=2 then WriteLex ('O')
else Err_lex;
end;
end;
string_counter: =string_counter+1;
end;
vyvod; // вызов процедуры вывода
end;
procedure TForm1. vyvod; // Вывод результатов
var
f: textfile; // выходной файл
begin
StringGrid1. RowCount: =NumConst+1; // определение числа строк в таблицах
StringGrid2. RowCount: =NumId+1;
StringGrid3. RowCount: =NumTerm+1;
StringGrid4. RowCount: =NumLex+1;
StringGrid1. Cells [0,0]: ='№'; StringGrid1. Cells [1,0]: ='Константа'; StringGrid1. Cells [2,0]: ='Тип';
StringGrid1. Cells [3,0]: ='Ширина'; StringGrid1. Cells [4,0]: ='10-тичный формат';
StringGrid1. Cells [5,0]: ='L'; StringGrid1. Cells [6,0]: ='R';
StringGrid1. Cells [7,0]: ='Путь'; // определение заголовков
for k: =1 to NumConst do // вывод таблицы констант
begin
StringGrid1. cells [0,k]: = Inttostr (Const_Tab [k]. nomer);
StringGrid1. cells [1,k]: = Const_Tab [k]. value;
StringGrid1. cells [2,k]: = Const_Tab [k]. Typ;
StringGrid1. cells [3,k]: = Const_Tab [k]. Width;
StringGrid1. cells [4,k]: = Const_Tab [k]. Val10;
StringGrid1. cells [5,k]: = Inttostr (Const_Tab [k]. Left);
StringGrid1. cells [6,k]: = Inttostr (Const_Tab [k]. Right);
StringGrid1. cells [7,k]: = Const_Tab [k]. Way;
end;
AssignFile (F,'Const. txt'); // запись в файл таблицы констант
Rewrite (F);
for k: =1 to NumConst do
Writeln (F, StringGrid1. cells [0,k] +' '+StringGrid1. cells [1,k] +' '+StringGrid1. cells [2,k] +' '+StringGrid1. cells [3,k]);
CloseFile (F);
StringGrid2. Cells [0,0]: ='№'; StringGrid2. Cells [1,0]: ='Имя'; // определение заголовков
k: =0;
k1: =0;
while k<numid do // вывод таблицы идентификаторов
begin
if Id_tab [k1]. lex<>'' then
begin
StringGrid2. cells [0,k+1]: =IntToStr (Id_tab [k1]. nomer);
StringGrid2. cells [1,k+1]: =Id_Tab [k1]. lex;
k: =k+1;
end;
k1: =k1+1;
end;
AssignFile (F,'Ident. txt'); // запись в файл таблицы констант
Rewrite (F);
for k: =1 to NumId do Writeln (F, StringGrid2. cells [0,k] +' '+StringGrid2. cells [1,k]);
CloseFile (F);
StringGrid3. Cells [0,0]: ='№'; StringGrid3. Cells [1,0]: ='Символ'; StringGrid3. Cells [2,0]: ='Раздел. ';
StringGrid3. Cells [3,0]: ='Зн. операции'; StringGrid3. Cells [4,0]: ='Ключ. слово';
StringGrid3. Cells [5,0]: ='L'; StringGrid3. Cells [6,0]: ='R';
StringGrid3. Cells [7,0]: ='Путь'; // определение заголовков
for k: =1 to NumTerm do // вывод таблицы терминальных символов
begin
StringGrid3. cells [0,k]: = Inttostr (Term_Tab [k]. nomer);
StringGrid3. cells [1,k]: = Term_Tab [k]. lex;
StringGrid3. cells [2,k]: = Inttostr (Term_Tab [k]. razd);
StringGrid3. cells [3,k]: = Inttostr (Term_Tab [k]. oper);
StringGrid3. cells [4,k]: = Inttostr (Term_Tab [k]. slug);
StringGrid3. cells [5,k]: = Inttostr (Term_Tab [k]. Left);
StringGrid3. cells [6,k]: = Inttostr (Term_Tab [k]. Right);
StringGrid3. cells [7,k]: = Term_Tab [k]. Way;
end;
AssignFile (F,'Term. txt'); // запись в файл таблицы терминальных символов
Rewrite (F);
for k: =1 to NumTerm do Writeln (F, StringGrid3. cells [0,k] +' '+StringGrid3. cells [1,k] +' '+StringGrid3. cells [2,k] +' '+StringGrid3. cells [3,k] +' '+StringGrid3. cells [4,k]);
CloseFile (F);
StringGrid4. Cells [0,0]: ='№'; StringGrid4. Cells [1,0]: ='Тип'; StringGrid4. Cells [2,0]: ='№ в таблице'; StringGrid4. Cells [3,0]: ='Лексема'; // определение заголовков
for k: =1 to NumLex do // вывод таблицы кодов лексем
begin
StringGrid4. cells [0,k]: = Inttostr (Code_Tab [k]. nomer);
StringGrid4. cells [1,k]: = Code_Tab [k]. typ;
StringGrid4. cells [2,k]: = Inttostr (Code_Tab [k]. num);
StringGrid4. cells [3,k]: = Code_Tab [k]. lex;
end;
AssignFile (F,'Cod. txt'); // запись в файл выходной таблицы
Rewrite (F);
for k: =1 to NumLex do Writeln (F, StringGrid4. cells [0,k] +' '+StringGrid4. cells [1,k] +' '+StringGrid4. cells [2,k] +' '+StringGrid4. cells [3,k]);
CloseFile (F);
end;
procedure TForm1. Err_Lex; // процедура вывода ошибки в лексеме
begin
Memo2. Lines. Add ('В строке №'+Inttostr (String_counter+1) +' ошибочная лексема '+Lexem);
NumErr: =NumErr+1;
NumLex: =NumLex+1;
Code_Tab [NumLex]. nomer: =NumLex;
Code_Tab [NumLex]. Lex: =Lexem;
Code_Tab [NumLex]. typ: ='E';
Code_Tab [NumLex]. Num: =NumErr;
Exit;
end;
procedure TForm1. N6Click (Sender: TObject);
begin
Syntax;
end;
procedure TForm1. Syntax;
begin
i: =1; // инициализация
Error: =false;
Scobka: =false;
Memo2. Clear;
if (Lex_Progr=true) and (Error<>true) then Memo2. Lines [0]: ='Ошибок нет' else if Memo2. Lines [0] ='' then Memo2. Lines [0]: ='Неизвестная ошибка'
end;
function TForm1. Lex_Progr: boolean; // 1. программа
begin
Lex_Progr: =False;
if Code_Tab [i]. Lex='program' then i: =i+1 else // конец блока для PROGRAM
begin
Err_Synt ('Отсутствует служебное слово program, либо в нем ошибка ', i);
Exit;
end;
if Lex_Prog_Name=false then Exit; // начало блока для имени программы
if Code_Tab [i]. Lex='; ' then i: =i+1 else // начало блока для точки с запятой
begin
Err_Synt ('Отсутствует точка с запятой после имени программы', i-1);
Exit;
end;
if Code_Tab [i]. Lex='var' then i: =i+1 else // начало блока для VAR
begin
Err_Synt ('Отсутствует служебное слово var после заголовка программы', i);
Exit;
end;
if Lex_descr_list=false then Exit;
if Code_Tab [i]. Lex='begin' then // начало блока для BEGIN
begin
i: =i+1;
if Code_Tab [i]. Lex='; ' then
begin
Err_Synt ('После begin недопустим символ "; "', i);
Exit;
end;
end else
begin
Err_Synt ('Отсутствует служебное слово begin после описаний переменных', i);
Exit;
end;
if Lex_oper_list=false then Exit;
if Code_Tab [i]. Lex='end' then i: =i+1 else // начало блока для END
begin
Err_Synt ('Отсутствует служебное слово end в конце программы', i);
Exit;
end; // начало блока для точки
if Code_Tab [i]. Lex='. ' then Lex_Progr: =true else if Code_Tab [i]. Lex<>'' then Err_Synt ('После служебного слова END вместо точки находится "'+Code_Tab [i]. Lex+'"', i) else Err_Synt ('Ожидается точка после служебного слова END в конце программы', i-1);
end;
procedure TForm1. Err_Synt (text: string; l: integer);
begin
if Error<>true then
begin
Memo1. Lines [Code_tab [l]. numstr-1]: =Memo1. Lines [Code_tab [l]. numstr-1] +'!!! '+'Error!!! ';
Memo2. Lines [0]: =Memo2. Lines [0] +text;
end;
Error: =true;
Exit;
end;
function TForm1. Lex_Prog_Name: boolean; // имя программы
begin
Lex_Prog_Name: =False;
if (Code_Tab [i]. typ<>'I') and (Code_Tab [i]. Lex<>'; ') then
begin
Err_Synt ('Неправильное имя программы. Ошибочное выражение: "'+Code_Tab [i]. Lex+'"', i);
Exit;
end;
if Code_Tab [i]. Lex='; ' then
begin
Err_Synt ('Отсутствует имя программы после program', i);
Exit;
end;
Lex_Prog_Name: =true;
i: =i+1;
end;
function TForm1. Lex_Descr_List: boolean; // список описаний
begin
Lex_descr_list: =false;
Found: =false;
while Code_Tab [i]. typ='I' do
begin
Found: =true;
if Lex_descr=false then Exit;
if Code_Tab [i]. Lex='; ' then i: =i+1 else
begin
Err_Synt ('Отсутствует точка с запятой после описания переменных ', i-1);
Exit;
end;
end;;
if Found=false then
begin
Err_Synt ('Отсутствует идентификатор в описании ', i);
Exit;
end;
Lex_descr_list: =true;
end;
function TForm1. Lex_descr: boolean; // описание
begin
Lex_descr: =false;
if Lex_name_list=true then
begin
if Code_Tab [i]. Lex=': ' then i: =i+1 else
begin
Err_Synt ('Отсутствует двоеточие перед типом '+Code_Tab [i]. Lex, i);
Exit;
end;
if Lex_type=true then Lex_descr: =true else Exit;
end else Exit;
end;
function TForm1. Lex_name_list: boolean; // список имен
begin
Lex_name_list: =false;
if Code_Tab [i]. typ='I' then i: =i+1 else
begin
Err_Synt ('Ожидается идентификатор ', i);
Exit;
end;
while Code_Tab [i]. Lex=',' do
begin
i: =i+1;
if Code_Tab [i]. Typ='I' then i: =i+1 else
begin
Err_Synt ('Ожидается идентификатор ', i);
Exit;
end;
end;
Lex_name_list: =true;
end;
function TForm1. Lex_type: boolean; // тип
begin
Lex_type: =false;
if (Code_Tab [i]. Lex='integer') then
begin
Lex_type: =true;
i: =i+1
end else
begin
Err_Synt ('Отсутствует тип: integer ', i-1);
Exit;
end;
end;
function TForm1. Lex_oper_list: boolean; // список операторов
begin
Lex_oper_list: =false;
found: =false;
while Lex_oper=true do
begin
Found: =true;
if (Code_Tab [i]. Lex='; ') then i: =i+1 else // Если след. лексема после проверенного оператора ни "; ", ни END, а любая другая лексема.
if Code_Tab [i]. Lex<>'end' then
begin
Err_Synt ('Ожидается точка с запятой после оператора (после лексемы '+Code_Tab [i-1]. Lex+') ', i-1);
Exit;
end;
end;
Lex_oper_list: =true;
if found=false then
begin
Err_Synt ('Не найдены операторы между begin и end', i-1);
Lex_oper_list: =false;
end;
end;
function TForm1. Lex_oper: boolean;
begin
Lex_oper: =false;
if (Lex_assign) or (Lex_repeat_until) then Lex_oper: =true else
if (Code_Tab [i]. Lex='; ') and (Code_Tab [i-1]. Lex='; ') then Lex_oper: =true else // проверяется на пустой оператор, т.е. на ";; ".
if (Code_Tab [i]. Typ='T') and (Code_Tab [i]. Lex<>'end') and (Code_Tab [i]. Lex<>'begin') and (Code_Tab [i]. Lex<>'; ') then Err_Synt ('Лишняя лексема в программе: '+Code_Tab [i]. Lex, i);
end;
function TForm1. Lex_assign: boolean; // присваивание
begin
Lex_assign: =false;
if Code_Tab [i]. typ='I' then
begin
if Code_Tab [i+1]. Lex=': =' then
begin
i: =i+2;
if Lex_Exp=true then Lex_assign: =true else Memo2. Lines [1]: =Memo2. Lines [1] +' в операторе присваивания'
end else Err_Synt ('Ошибка в операторе присваивания', i)
end;
end;
function TForm1. Lex_Exp: boolean; // выражение
begin
Lex_Exp: =false;
if Lex_simple_Exp=true then
begin
if ( (Code_Tab [i]. Lex='=') or (Code_Tab [i]. Lex='>') or (Code_Tab [i]. Lex='<')
or (Code_Tab [i]. Lex='<>') or (Code_Tab [i]. Lex='<=') or (Code_Tab [i]. Lex='>=')) then
begin
i: =i+1;
if Lex_simple_Exp=true then
begin
Lex_Exp: =true;
Exit;
end;
end;
end else Exit;
Lex_Exp: =true; // если простое выражение без знака
end;
function TForm1. Lex_simple_Exp: boolean; // простое выражение
begin
Found: =false;
Lex_simple_Exp: =false;
if Lex_term=true then
begin
Found: =true;
while ( (Code_Tab [i]. Lex='+') or (Code_Tab [i]. Lex='-')) and (Found=true) do
begin
i: =i+1;
if Lex_term=false then
begin
Found: =False;
Err_Synt ('Ожидается константа, идентификатор или выражение ', i-1);
Exit;
end;
end;
if (Code_Tab [i]. Lex=') ') and (Scobka=false) then Err_Synt ('Ожидается открывающаяся скобка в множителе', i)
end;
if Found=true then Lex_simple_Exp: =true;
end;
function TForm1. Lex_Term: boolean; // терм
begin
Found: =false;
Lex_Term: =false;
if Lex_mnozh=true then
begin
Found: =true;
while ( (Code_Tab [i]. Lex='*') or (Code_Tab [i]. Lex='/')) and (Found=true) do
begin
i: =i+1;
if Lex_mnozh=false then Found: =False;
end;
end;
if Found=true then Lex_Term: =true;
end;
function TForm1. Lex_mnozh: boolean; // множитель
begin
Lex_mnozh: =false;
if (Code_Tab [i]. typ='I') or (Code_Tab [i]. typ='C') then
begin
i: =i+1;
Lex_mnozh: =true;
Exit;
end else
begin
if Code_Tab [i]. Lex=' (' then
begin
Scobka: =true;
i: =i+1;
if Lex_simple_Exp=true then
begin
if Code_Tab [i]. Lex=') ' then
begin
i: =i+1;
Lex_mnozh: =true;
end else
begin
Err_Synt ('Ожидается закрывающая скобка в множителе ', i);
Exit;
end;
end;
end else Err_Synt ('Ожидается константа, идентификатор или выражение ', i);
end;
end;
function TForm1. Lex_repeat_until: boolean; // цикл
begin
Lex_repeat_until: =false;
if Code_Tab [i]. Lex='repeat' then
begin
i: =i+1;
if Lex_body=true then begin i: =i+1;
if Code_Tab [i]. Lex='until' then begin i: =i+1;
if Lex_Exp=true then Lex_repeat_until: =true
else Err_Synt ('Ожидается выражение после служебного слова until', i); end
else Err_Synt ('Ожидается служебное слово until', i);
end;
end;
end;
function TForm1. Lex_body: boolean; // тело цикла
begin
Lex_body: =false;
if Lex_oper=true then
begin
Lex_body: =true;
Exit;
end else
if Code_Tab [i]. Lex='begin' then
begin
i: =i+1;
if Code_Tab [i]. Lex='; ' then
begin
Err_Synt ('После begin недопустим символ "; "', i);
Exit;
end;
if Lex_oper_list=true then
begin
if (Code_Tab [i]. Lex='end') and (Code_Tab [i+1]. Lex<>'; ') then
begin
Lex_body: =true;
i: =i+1;
end else Err_Synt ('Ожидается служебное слово end после блока операторов', i-1)
end;
end;
end;
end.