Разработка программы-компилятора

БОЛЬШАЯ ЛЕНИНГРАДСКАЯ БИБЛИОТЕКА - РЕФЕРАТЫ - Разработка программы-компилятора

Разработка программы-компилятора

113

Содержание

• Введение
• 1. Анализ задания
• 2. Разработка лексического анализатора
• 2.1 Выбор и обоснование структур данных
• 2.2 Разработка автоматных грамматик для распознавания лексем
• 2.3 Разработка автоматов, работающих по правилам грамматики
• 2.3.1 Автомат для распознавания имён
• 2.3.2 Автомат для распознавания 16-ричных констант
• 2.3.3 Автомат для распознавания римских констант
• 2.3.4 Объединённый автомат
• 2.4 Разработка алгоритма и программы лексического анализа
• 2.4.1 Выделение лексем
• 2.4.2 Распознавание лексем
• 2.4.3 Реализация лексического анализатора
• 2.4.4 Тестирование лексического анализатора
• 3. Разработка синтаксического анализатора
• 3.1 Уточнение грамматики языка применительно к варианту задания
• 3.2 Разработка алгоритма синтаксического анализа
• 3.3 Алгоритмы распознающих функций
• 3.3.1 Функция Lex_Progr
• 3.3.2 Функция Lex_Descr_List
• 3.3.3 Функция Lex_Descr
• 3.3.4 Функция Lex_Name_List
• 3.3.5 Функция Lex_Oper_List
• 3.3.6 Функция Lex_Assign
• 3.3.7 Функция Lex_Exp
• 3.3.8 Функция Lex_Simple_Exp
• 3.3.9 Функция Lex_Term
• 3.3.10 Функция Lex_mnozh
• 3.3.12 Функция Lex_Body
• 3.4 Тексты распознающих процедур
• 3.5 Результаты тестирования синтаксического анализатора
• 4. Реализация двухфазного компилятора
• 4.1 Результаты тестирования двухфазного компилятора
• 5. Описание программы
• 5.1 Общие сведения и функциональное назначение
• 5.2 Вызов и загрузка
• 5.3 Входные данные
• 5.4 Выходные данные
• 5.5 Описание логической структуры программы
• 5.5.1 Файлы программы
• 5.5.2 Общее описание работы программы
• Список использованной литературы

где a Т; А, В N

Эти грамматики широко используются для построения лексических анализаторов. Грамматику лексических единиц обычно явно не описывают, а строят эквивалентный ей граф распознавания лексических единиц.

Грамматика для идентификаторов:

<имя>><буква><буква>

<буква>> ('a'. 'z')

<цифра>> (`0'. '9')

Грамматика для констант:

<константа>><16-рич. константа>|<римск. константа>

Для 16-ричных констант:

<16-рич. константа>> (`$+','$-`) (<цифра>, `A'. 'F') { (<цифра>,`A'. 'F') }

Для римских констант:

Синтаксический анализ производится методом рекурсивного спуска.

Анализатор, основанный на этом методе, состоит из отдельных процедур для распознавания нетерминальных символов, определённых в грамматике. Каждая такая процедура ищет во входном потоке лексем подстроку, которой может быть поставлен в соответствие нетерминальный символ, распознаваемый с помощью данной процедуры. В процессе своей работы процедура может обратиться к другим подобным процедурам для поиска других нетерминальных символов. Если эта процедура интерпретирует входную подстроку как соответствующий нетерминальный символ, то она заканчивает свою работу, передаёт в вызвавшую её программу или процедуру признак успешного завершения и устанавливает указатель текущей лексемы на первую лексему после распознанной подстроки. Если же процедура не может найти подстроку, которая могла бы быть интерпретирована как требуемый нетерминальный символ, она заканчивается с признаком неудачного завершения и выдает соответствующее диагностическое сообщение.

Правила синтаксического анализа относятся к грамматике вида LL (1), т.е. используется левосторонний просмотр и левосторонний вывод, при этом необходимо просматривать не более 1 символа.

Множество правил грамматики реализуемого языка, записанных в форме Бэкуса-Наура, имеет следующий вид:

1. <программа>>program<имя программы>;

var<список описаний>

begin<список операторов>end.

2. <имя программы>>ИМЯ

3. <список описаний>><описание>; {<описание>; }

4. <описание>><список имён>: <тип>

5. <тип>>real

6. <список имён>>ИМЯ{, ИМЯ}

7. <список операторов>><оператор>; {<оператор>; }

8. <оператор>><присваивание> | <цикл>

9. <присваивание>>ИМЯ: =<выражение>

10. <выражение>><простое выражение>{ (=, <, <>, >, >=, <=) <простое выражение>}

11. <простое выражение>><терм>+<терм>

12. <терм>><множитель>*<множитель>

13. <множитель>>ИМЯ | КОНСТАНТА | <простое выражение>

14. <цикл>>repeat<тело цикла>until<выражение>

15. <тело цикла>><оператор>|<составной оператор>

16. <составной оператор>>begin<список операторов>end

В грамматике, помимо общепринятых, используются следующие терминальные символы: ИМЯ - идентификатор; КОНСТАНТА - 16-ричная или римская константа.

3.3.11 Функция Lex_Repeat_Until

1. Методические указания к лабораторным работам по СПО.

2. Курс лекций по дисциплине "Системное программное обеспечение".

3. А.Ю. Молчанов "Системное программное обеспечение", СПб, 2003 г.

4. Ю.Г. Карпов "Теория автоматов", СПб, 2002 г.

5. В.В. Фаронов“Delphi. Программирование на языке высокого уровня", Питер, 2004 г.

Приложение: текст программы

unit lex;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, StdCtrls, Grids;

type

TVyh = Record // Тип таблицы кодов лексем

nomer: integer; // Номер

typ: char; // Тип лексемы

Num: integer; // Номер в таблице

Lex: String; // Лексема

numstr: integer; // Номер строки

end;

TTerm = Record // тип таблицы терминальных символов

nomer: integer; // номер

Lex: String; // Лексема

razd: byte; // Разделитель?

oper: byte; // Операция?

slug: byte; // Служебное слово?

Left: integer; // Левая ветвь дерева.

Right: integer; // Правая ветвь дерева.

Way: string;

end;

TConst = Record // Тип таблицы констант

nomer: integer; // Номер

value: string; // Само значение лексемы.

Typ: string; // Тип лексемы

Width: string; // Ширина константы

Val10: string; // 10-тичный формат константы

Left: integer; // Левая ветвь дерева.

Right: integer; // Правая ветвь дерева.

Way: string;

end;

TId = Record // таблица имен

nomer: integer; // номер лексемы

lex: string; // лексема

ssylka: integer; // ссылка на элемент цепочки

end;

TForm1 = class (TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

OpenDialog1: TOpenDialog;

Memo1: TMemo;

N6: TMenuItem;

StringGrid1: TStringGrid;

Label1: TLabel;

StringGrid2: TStringGrid;

Label2: TLabel;

StringGrid3: TStringGrid;

StringGrid4: TStringGrid;

Label3: TLabel;

Label4: TLabel;

Memo2: TMemo;

Label5: TLabel;

procedure N2Click (Sender: TObject);

procedure N3Click (Sender: TObject);

procedure N5Click (Sender: TObject);

procedure vyvod;

procedure Err_lex;

procedure Syntax;

procedure Err_Synt (text: string; l: integer);

function Lex_Progr: boolean;

function Lex_Prog_Name: boolean;

function Lex_Descr_List: boolean;

function Lex_descr: boolean;

function Lex_name_list: boolean;

function Lex_type: boolean;

function Lex_oper_list: boolean;

function Lex_oper: boolean;

function Lex_assign: boolean;

function Lex_Exp: boolean;

function Lex_simple_Exp: boolean;

function Lex_Term: boolean;

function Lex_mnozh: boolean;

function Lex_repeat_until: boolean;

function Lex_body: boolean;

procedure N6Click (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

MaxNum=100; // Максимальное число лексем

deleter= ['. ',' ',' (',') ','{','}',',','<','>','"','? ','! ','*','&','^', {'%','$',}' [','] ',': ','; ','=','-','+','/', '\',''''] ; // разделители лексем

words: Array [1. .14] of string [7] = ('program','var','then','begin','for','to','do','if','end','repeat','until','real','integer', 'else'); // Массив служебных слов

razdel: Array [1. .8] of char= (',','; ',': ',' (',') ',' [','] ','. '); // массив разделителей

operacii: Array [1. .11] of string [2] = (': =','>=','<=','<>','+','-','/','*','>','<','='); // массив операций

cifra= ['0'. '9'] ; // цифры

bukva= ['A'. 'F'] ;

var

Form1: TForm1;

FA,FName: textfile;

SA: array [1. .100] of string;

SS,Name,Constant: string;

Dlina: integer;

Code_tab: array [1. MaxNum] of TVyh; // Таблица кодов лексем

Term_tab: array [1. MaxNum] of TTerm; // Таблица терминальныз символов

Id_tab: array [1. MaxNum] of TId; // Таблица идентификаторов

Const_tab: array [1. .50] of TConst; // Таблица констант

Lexem,s,typel: string; // Лексема, Текст ошибки, Строка программы, Тип лексемы

i,j,k,l,m,n,y,String_counter,constyes,termyes,hesh, // счетчики циклов и строк

NumLex,{Число лексем}NumId,{Число идентификаторов}NumTerm,{Число терминальных символов}NumConst,{Число различных констант}

NumErr{Число ошибочных лексем}: integer;

Error,Found,Flag,Scobka: boolean; // Флаги

str16: string;

k1,kod: integer;

implementation

uses lex2;

{$R *. dfm}

procedure TForm1. N2Click (Sender: TObject);

var i: integer;

begin

OpenDialog1. Filter: ='*. txt';

if opendialog1. Execute and fileExists (openDialog1. FileName)

then

begin

Assignfile (FA, OpenDialog1. FileName);

Reset (FA);

Memo1. Lines. clear;

i: =1;

while not EOF (FA) do

begin

readln (Fa,SA [i]);

Memo1. Lines. Add (SA [i]);

i: =i+1;

end;

Closefile (FA);

end;

end;

// процедура перевода констант в десятичную форму

procedure perevod (SS: string; var Str16: string);

var ch3,ch4,ch, i: integer;

zn: string;

begin

ch: =0; // для римских констант

if (SS [2] ='X') or (SS [2] ='V') or (SS [2] ='I') then

begin

zn: =SS [1] ;

delete (SS,1,1);

while Length (SS) <>0 do

begin

if SS [1] ='X' then begin ch: =ch+10; delete (SS,1,1); end

else begin

if SS [1] ='V'then begin ch: =ch+5; delete (SS,1,1); end

else begin

if ( (SS [1] ='I') and (SS [2] ='I')) or ( (SS [1] ='I') and (SS [2] ='')) then begin ch: =ch+1; delete (SS,1,1); end

else begin

if (SS [1] ='I') and (SS [2] ='X') then begin ch: =ch+9; delete (SS,1,2); end

else begin

if (SS [1] ='I') and (SS [2] ='V') then begin ch: =ch+4; delete (SS,1,2); end;

end; end; end; end; end;

str16: =zn+IntToStr (ch);

exit;

end;

// для 16-рич. констант

If SS [3] in ['0'. '9']

then

ch3: =StrToInt (SS [3]) *16

else

if SS [3] in ['A'. 'F']

then

begin

ch3: =ord (SS [3]);

case ch3 of

65: ch3: =10*16;

66: ch3: =11*16;

67: ch3: =12*16;

68: ch3: =13*16;

69: ch3: =14*16;

70: ch3: =15*16;

end;

end;

If SS [4] in ['0'. '9']

then

ch4: =StrToInt (SS [4])

else

if SS [4] in ['A'. 'F']

then

begin

ch4: =ord (SS [4]);

case ch4 of

65: ch4: =10;

66: ch4: =11;

67: ch4: =12;

68: ch4: =13;

69: ch4: =14;

70: ch4: =15;

end;

end;

ch: =ch3+ch4;

If (SS [3] ='0') and (SS [4] ='0')

then Str16: =IntToStr (ch)

else Str16: =SS [2] +IntToStr (ch);

end;

procedure TForm1. N3Click (Sender: TObject);

begin

close;

end;

function Select_Lex (S: string; {исх. строка} var Rez: string; {лексема}N: integer {текущая позиция}): integer;

label 1;

begin // функция выбора слов из строки

k: = Length (S);

Rez: ='';

i: =N; // точка продолжения в строке

while (S [i] =' ') and (i<= k) do i: =i+1; // пропуск ' '

while not (S [i] in deleter) and (i<= k) do // накопление лексемы

begin

if s [i] ='$' then

begin

Rez: =s [i] +s [i+1] ;

i: =i+2;

end

else begin

1: Rez: =Rez+s [i] ;

i: =i+1;

end;

end;

if Rez='' then

begin

if (s [i] =': ') then

begin

if (s [i+1] ='=') then // в случае операции из двух символов

begin

Rez: =s [i] +s [i+1] ;

Select_Lex: =i+2;

end

else

begin

Rez: =s [i] ;

Select_Lex: =i+1;

end;

end else

begin

if ( (s [i] ='+') or (s [i] ='-')) and (s [i-1] =' (')

then begin

Rez: =s [i] +s [i+1] ;

i: =i+2;

goto 1;

end

else begin

Rez: =s [i] ;

Select_Lex: =i+1;

end; end;

end else Select_Lex: =i;

end;

procedure Add_Const (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево

begin

if NumConst=1 then // Если корень дерева еще не создан, то создаем его.

begin

perevod (str_lex,str16);

Const_tab [NumConst]. value: =str_lex;

Const_tab [NumConst]. nomer: =NumConst;

Const_tab [NumConst]. Val10: =str16;

Const_tab [NumConst]. Left: =0;

Const_tab [NumConst]. Right: =0;

Const_tab [NumConst]. Way: ='V';

Exit;

end;

if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого

if Const_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то

begin

perevod (str_lex,str16);

Const_tab [Curr_term]. Left: =NumConst; // Создание левого элемента.

Const_tab [NumConst]. value: =str_lex;

Const_tab [NumConst]. nomer: =NumConst;

Const_tab [NumConst]. Val10: =str16;

Const_tab [NumConst]. Left: =0;

Const_tab [NumConst]. Right: =0;

Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L';

end else begin

Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L';

Add_Const (Const_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя.

end;

if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то

if Const_tab [Curr_term]. Right=0 then

begin

perevod (str_lex,str16);

Const_tab [Curr_term]. Right: =NumConst; // Создаем правый элемент.

Const_tab [NumConst]. value: =str_lex;

Const_tab [NumConst]. nomer: =NumConst;

Const_tab [NumConst]. Val10: =str16;

Const_tab [NumConst]. Left: =0;

Const_tab [NumConst]. Right: =0;

Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R';

end else begin

Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R';

Add_Const (Const_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя.

end;

end;

procedure Add_Term (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево

begin

if NumTerm=1 then // Если корень дерева еще не создан, то создаем его.

begin

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: ='V';

Exit;

end;

if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого

if Term_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то

begin

Term_tab [Curr_term]. Left: =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+'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.