Текст книги "Системное программное обеспечение. Лабораторный практикум"

Модуль описания матрицы предшествования и правил исходной грамматики

Листинг П3.6. Описание матрицы предшествования и правил исходной грамматики

unit SyntRule; {!!! Зависит от входного языка!!!}

interface

{ Модуль, содержащий описание матрицы предшествования

и правил грамматики }

uses LexType, Classes;

const { Максимальная длина правила }

RULE_LENGTH = 7; { (в расчете на символы грамматики) }

RULE_NUM = 28; { Общее количество правил грамматики }

Var { Матрица операторного предшествования }

GramMatrix: array[TLexType,TLexType] of char =

({pr. end.; if () else beg end whl do a c:= or xor and < > = <> not – + um! }

{pr.} ( , = , <, <, ,', ,'<, ,'<, ,'<, ,', ,', ,', ,', ,

', , , , ),

{end.}( , , , , , , , , , , , , , , , , , , , , ,

', , , , >),

{;} ( , >, >, <, ,', ,'<, >, <, ,'<, ,', ,', ,', ,', ,

', , , , ),

{if} ( , , , , = , , , , , , , , , , , , , , , , ,

', , , , ),

{(} ( , , , , <, =, ,', ,', ,'<, <,

', <, <, <, <, <, <, <, <, <, <, <, ),

{)} ( , >, >, <, ,'>, =, <, >, <, =, <, ,', >, >, >, >, >, >, >,

', >, >, ,'),

{else}( , >, >, <, ,', >, <, >, <, ,'<, ,', ,', ,', ,', ,

', , , , ),

{beg.}( , , <, <, ,', ,'<, =, <, ,'<, ,', ,', ,', ,', ,

', , , , ),

{end} ( , >, >, ,', ,'>, ,'>, ,', ,', ,', ,', ,', ,',

', , , , ),

{whil}( , , , , = , , , , , , , , , , , , , , , , ,

', , , , ),

{do} ( , >, >, <, ,', >, <, <, <, ,'<, ,', ,', ,', ,', ,

', , , , ),

{a} ( , >, >, ,', >, >, ,'>, ,', ,', =, >, >, >, >, >, >, >,

', >, >, ,'),

{c} ( , >, >, ,', >, >, ,'>, ,', ,', ,'>, >, >, >, >, >, >,

', >, >, ,'),

{:=} ( , >, >, ,'<, ,'>, ,'>, ,', <, <, ,', ,', ,', ,',

', <, <, <, ),

{or} ( , , , , <, >, ,', ,', ,'<, <,

', >, >, <, <, <, <, <, <, <, <, <, ),

{xor} ( , , , , <, >, ,', ,', ,'<, <,

', >, >, <, <, <, <, <, <, <, <, <, ),

{and} ( , , , , <, >, ,', ,', ,'<, <,

', >, >, >, <, <, <, <, <, <, <, <, ),

{<} ( , , , , <, >, ,', ,', ,'<, <, ,'>, >, >, ,', ,',

', <, <, <, ),

{>} ( , , , , <, >, ,', ,', ,'<, <, ,'>, >, >, ,', ,',

', <, <, <, ),

{=} ( , , , , <, >, ,', ,', ,'<, <, ,'>, >, >, ,', ,',

', <, <, <, ),

{<>} ( , , , , <, >, ,', ,', ,'<, <, ,'>, >, >, ,', ,',

', <, <, <, ),

{not} ( , , , , = , , , , , , , , , , , , , , , , ,

', , , , ),

{-} ( , >, >, ,'<, >, >, ,'>, ,', <, <, ,'>, >, >, >, >, >, >,

', >, >, <, ),

{+} ( , >, >, ,'<, >, >, ,'>, ,', <, <, ,'>, >, >, >, >, >, >,

', >, >, <, ),

{um} ( , >, >, ,'<, >, >, ,'>, ,', <, <, ,'>, >, >, >, >, >, >,

', >, >, <, ),

{!} (<, ,', ,', ,', ,', ,', ,', ,', ,', ,', ,',

', , , , ));

{ Правила исходной грамматики }

GramRules: array[1..RULE_NUM] of string =

('progEend.,'E','E;E','E;,'if(B)EelseE','if(B)E',

'beginEend','while(B)doE','a:=E','BorB','BxorB','B',

'BandB','B','E<E','E>E','E=E','E<>E', (B),'not(B),

'E-E','E+E','E', -E','E', (E),'a','c');

{ Функция имени нетерминала для каждого правила }

function MakeSymbolStr(iRuleNum: integer): string;

{ Функция корректировки отношений предшествования

для расширения матрицы предшествования }

function CorrectRule(cRule: char; lexTop,lexCur: TLexType;

symbStack: TList): char;

implementation

uses SyntSymb;

function MakeSymbolStr(iRuleNum: integer): string;

begin

if iRuleNum in [10..20] then Result:= 'B'

else Result:= 'E';

end;

function CorrectRule(cRule: char; lexTop,lexCur: TLexType;

symbStack: TList): char;

var j: integer;

begin { Корректируем отношение для символа «else»,

если в стеке не логическое выражение }

Result:= cRule;

if (cRule = = ) and (lexTop = LEX_CLOSE)

and (lexCur = LEX_ELSE) then

begin

j:= TSymbStack(symbStack). Count-1;

if (j > 2)

and (TSymbStack(symbStack)[j-2].SymbolStr <> 'B')

then Result:= >;

end;

end;

end.

Модуль описания структур данных синтаксического анализатора и реализации алгоритма «сдвиг-свертка»

Листинг П3.7. Описание структур данных синтаксического анализатора и реализация алгоритма «сдвиг-свертка»

unit SyntSymb;

interface

{ Модуль, обеспечивающий выполнение функций синтаксического

разбора с помощью алгоритма «сдвиг-свертка» }

uses Classes, LexElem, SyntRule;

{ Типы символов: терминальные (лексемы) и нетерминальные }

type TSymbKind = (SYMB_LEX, SYMB_SYNT);

TSymbInfo = record{Структура данных для символа грамматики}

case SymbType: TSymbKind of { Тип символа }

{ Для терминального символа – ссылка на лексему }

SYMB_LEX: (LexOne: TLexem);

{ Для нетерминального символа – ссылка на список

символов, из которых он был построен }

SYMB_SYNT: (LexList: TList);

end;

TSymbol = class; {Предварительное описание класса «Символ»}

{ Массив символов, составляющих правило грамматики }

TSymbArray = array[0..RULE_LENGTH] of TSymbol;

TSymbol = class(TObject)

protected { Структура, описывающая грамматический символ }

SymbInfo: TSymbInfo; { Информация о символе }

iRuleNum: integer; {Номер правила, которым создан символ}

public

{ Конструктор создания терминального символа по лексеме }

constructor CreateLex(Lex: TLexem);

{ Конструктор создания нетерминального символа }

constructor CreateSymb(iR,iSymbN: integer;

const SymbArr: TSymbArray);

{ Деструктор для удаления символа }

destructor Destroy; override;

{Функция получения символа из правила по номеру символа}

function GetItem(iIdx: integer): TSymbol;

{ Функция получения количества символов в правиле }

function Count: integer;

{ Функция, формирующая строковое представление символа }

function SymbolStr: string;

{ Свойство, возвращающее тип символа }

property SymbType: TSymbKind read SymbInfo.SymbType;

{Свойство «Ссылка на лексему» для терминального символа}

property Lexem: TLexem read SymbInfo.LexOne;

{ Свойство, возвращающее символ правила по номеру }

property Items[i: integer]: TSymbol read GetItem; default;

{ Свойство, возвращающее номер правила }

property Rule: integer read iRuleNum;

end;

TSymbStack = class(TList)

public { Структура, описывающая синтаксический стек }

destructor Destroy; override; { Деструктор для стека }

procedure Clear; override; { Функция очистки стека }

{ Функция выборки символа по номеру от вершины стека }

function GetSymbol(iIdx: integer): TSymbol;

{ Функция помещения в стек входящей лексемы }

function Push(lex: TLexem): TSymbol;

{ Свойство выборки символа по номеру от вершины стека }

property Symbols[iIdx: integer]: TSymbol read GetSymbol;

default;

{ Функция, возвращающая самую верхнюю лексему в стеке }

function TopLexem: TLexem;

{ Функция, выполняющая свертку и помещающая новый символ

на вершину стека }

function MakeTopSymb: TSymbol;

end;

{ Функция, выполняющая алгоритм «сдвиг-свертка» }

function BuildSyntList(const listLex: TLexList;

symbStack: TSymbStack): TSymbol;

implementation

uses LexType, LexAuto;

constructor TSymbol.CreateLex(Lex: TLexem);

{ Создание терминального символа на основе лексемы }

begin

inherited Create; { Вызываем конструктор базового класа }

SymbInfo.SymbType:= SYMB_LEX;{Ставим тип «терминальный»}

SymbInfo.LexOne:= Lex; { Запоминаем ссылку на лексему }

iRuleNum:= 0; { Правило не используется, поэтому «0» }

end;

constructor TSymbol.CreateSymb(iR{Номер правила},

iSymbN{количество исходных символов}: integer;

const SymbArr: TSymbArray{Массив исходных символов});

{ Конструктор создания нетерминального символа

на основе правила и массива символов }

var i: integer;

begin

inherited Create; { Вызываем конструктор базового класа }

{ Тип символа «нетерминальный» }

SymbInfo.SymbType:= SYMB_SYNT;

{ Создаем список для хранения исходных символов }

SymbInfo.LexList:= TList.Create;

{Переносим исходные символы в список в обратном порядке}

for i:=iSymbN-1 downto 0 do

SymbInfo.LexList.Add(SymbArr[i]);

iRuleNum:= iR; { Запоминаем номер правила }

end;

function TSymbol.GetItem(iIdx: integer): TSymbol;

{ Функция получения символа из правила по номеру символа }

begin Result:= TSymbol(SymbInfo.LexList[iIdx]) end;

function TSymbol.Count: integer;

{ Функция, возвращающая количество символов в правиле }

begin Result:= SymbInfo.LexList.Count; end;

function TSymbol.SymbolStr: string;

{ Функция, формирующая строковое представление символа }

begin { Если это нетерминальный символ, формируем его

представление в зависимости от номера правила }

if SymbType = SYMB_SYNT then

Result:= MakeSymbolStr(iRuleNum)

{ Если это терминальный символ, формируем его

представление в соответствии с типом лексемы }

else Result:= Lexem.LexInfoStr;

end;

destructor TSymbol.Destroy;

{ Деструктор для удаления символа }

var i: integer;

begin

if SymbInfo.SymbType = SYMB_SYNT then

with SymbInfo.LexList do

begin { Если это нетерминальный символ, }

{ удаляем все его исходные символы из списка }

for i:=Count-1 downto 0 do TSymbol(Items[i]). Free;

Free; { Удаляем сам список символов }

end;

inherited Destroy; { Вызываем деструктор базового класа }

end;

destructor TSymbStack.Destroy;

{ Деструктор для удаления синтаксического стека }

begin

Clear; { Очищаем стек }

inherited Destroy; { Вызываем деструктор базового класа }

end;

procedure TSymbStack.Clear;

{ Функция очистки синтаксического стека }

var i: integer;

begin { Удаляем все символы из стека }

for i:=Count-1 downto 0 do TSymbol(Items[i]). Free;

inherited Clear; { Вызываем функцию базового класса }

end;

function TSymbStack.GetSymbol(iIdx: integer): TSymbol;

{ Функция выборки символа по номеру от вершины стека }

begin Result:= TSymbol(Items[iIdx]); end;

function TSymbStack.TopLexem: TLexem;

{ Функция, возвращающая самую верхнюю лексему в стеке }

var i: integer;

begin

Result:= nil; { Начальный результат функции пустой }

for i:=Count-1 downto 0 do{Для символов от вершины стека}

if Symbols[i].SymbType = SYMB_LEX then

begin { Если это терминальный символ }

Result:= Symbols[i].Lexem; {Берем ссылку на лексему}

Break; { Прекращаем поиск }

end;

end;

function TSymbStack.Push(lex: TLexem): TSymbol;

{ Функция помещения лексемы в синтаксический стек }

begin { Создаем новый терминальный символ }

Result:= TSymbol.CreateLex(lex);

Add(Result); { Добавляем его в стек }

end;

function TSymbStack.MakeTopSymb: TSymbol;

{ Функция, выполняющая свертку. Результат функции:

nil – если не удалось выполнить свертку, иначе – ссылка

на новый нетерминальный символ (если свертка выполнена).}

var

symCur: TSymbol; {Текущий символ стека}

SymbArr: TSymbArray;{Массив хранения символов правила}

i,iSymbN: integer;{Счетчики символов в стеке и в правиле}

sRuleStr: string; {Строковое представление правила}

{ Функция добавления символа в правило }

procedure AddToRule(const sStr: string;{Строка символа}

sym: TSymbol{Тек. символ});

begin

symCur:= sym; { Устанавливаем ссылку на текущий символ }

{ Добавляем очередной символ в массив символов правила }

SymbArr[iSymbN]:= Symbols[i];

{ Добавляем его в строку правила (слева!) }

sRuleStr:= sStr + sRuleStr;

Delete(i); { Удаляем символ из стека }

Inc(iSymbN); { Увеличиваем счетчик символов в правиле }

end;

begin

Result:= nil; { Сначала обнуляем результат функции }

iSymbN:= 0; { Сбрасываем счетчик символов }

symCur:= nil; { Обнуляем текущий символ }

sRuleStr:= ; { Сначала строка правила пустая }

for i:=Count-1 downto 0 do{ Выполняем алгоритм }

begin { Для всех символов начиная с вершины стека }

if Symbols[i].SymbType = SYMB_SYNT then

{ Если это нетерминальный символ, то добавляем его

в правило, текущий символ при этом не меняется }

AddToRule(Symbols[i].SymbolStr,symCur)

else { Если это терминальный символ }

if symCur = nil then {и текущий символ пустой }

{ Добавляем его в правило и делаем текущим }

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else { Если это терминальный символ и он связан

отношением "=" с текущим символом }

if GramMatrix[Symbols[i].Lexem.LexType,

symCur.Lexem.LexType] = = then

{ Добавляем его в правило и делаем текущим }

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else { Иначе – прерываем цикл, дальше искать не нужно }

Break;

if iSymbN > RULE_LENGTH then Break; { Если превышена

максимальная длина правила, цикл прекращаем }

end;

if iSymbN <> 0 then

begin { Если выбран хотя бы один символ из стека, то

ищем простым перебором правило, у которого строковое

представление совпадает с построенной строкой }

for i:=1 to RULE_NUM do

if GramRules[i] = sRuleStr then{Если правило найдено,}

begin { создаем новый нетерминальный символ }

Result:= TSymbol.CreateSymb(i,iSymbN,SymbArr);

Add(Result); { и добавляем его в стек. }

Break; { Прерываем цикл поиска правил }

end;

{ Если не был создан новый символ (правило не найдено),

надо удалить все исходные символы, это ошибка }

if Result = nil then

for i:=0 to iSymbN-1 do SymbArr[i].Free;

end;

end;

function BuildSyntList(

const listLex: TLexList{входная таблица лексем};

symbStack: TSymbStack{стек для работы алгоритма}

): TSymbol;

{ Функция, выполняющая алгоритм «сдвиг-свертка».

Результат функции:

– нетерминальный символ (корень синтаксического дерева),

если разбор был выполнен успешно;

– терминальный символ, ссылающийся на лексему, где была

обнаружена ошибка, если разбор выполнен с ошибками. }

var

i,iCnt: integer; {счетчик лексем и длина таблицы лексем}

lexStop: TLexem; { Ссылка на начальную лексему }

lexTCur: TLexType; { Тип текущей лексемы }

cRule: char;{ Текущее отношение предшествования }

begin

Result:= nil; { Сначала результат функции пустой }

iCnt:= listLex.Count-1; { Берем длину таблицы лексем }

{ Создаем дополнительную лексему «начало строки» }

lexStop:= TLexem.CreateInfo('Начало файла',0,0,0);

try { Помещаем начальную лексему в стек }

symbStack.Push(lexStop);

i:= 0; { Обнуляем счетчик входных лексем }

while i<=iCnt do { Цикл по всем лексемам от начала }

begin { до конца таблицы лексем }

{ Получаем тип лексемы на вершине стека }

lexTCur:= symbStack.TopLexem.LexType;

{ Если на вершине стека начальная лексема,

а текущая лексема – конечная, то разбор завершен }

if (lexTCur = LEX_START)

and (listLex[i].LexType = LEX_START) then Break;

{ Смотрим отношение лексемы на вершине стека

и текущей лексемы в строке }

cRule:= GramMatrix[lexTCur,listLex[i].LexType];

{ Корректируем отношение. Если корректировка матрицы

предшествования не используется, то функция должна

вернуть то же самое отношение }

cRule:= CorrectRule(cRule,lexTCur,

listLex[i].LexType,symbStack);

case cRule of

'<, =: { Надо выполнять сдвиг (перенос) }

begin { Помещаем текущую лексему в стек }

symbStack.Push(listLex[i]);

Inc(i); { Увеличиваем счетчик входных лексем }

end;

'>: { Надо выполнять свертку }

if symbStack.MakeTopSymb = nil then

begin { Если не удалось выполнить свертку, }

{ запоминаем текущую лексему как место ошибки }

Result:= TSymbol.CreateLex(listLex[i]);

Break; { Прерываем алгоритм }

end;

else { Отношение не установлено – ошибка разбора }

begin {Запоминаем текущую лексему (место ошибки)}

Result:= TSymbol.CreateLex(listLex[i]);

Break; { Прерываем алгоритм }

end;

end{case};

end{while};

if Result = nil then { Если разбор прошел без ошибок }

begin{Убеждаемся, что в стеке осталось только 2 символа}

if symbStack.Count = 2 then

{ Если да, то верхний символ – результат разбора }

Result:= symbStack[1]

{ Иначе это ошибка – отмечаем место ошибки }

else Result:= TSymbol.CreateLex(listLex[iCnt]);

end;

finally { Уничтожаем временную начальную лексему }

lexStop.Free;

end;

end;

end.

Модуль описания допустимых типов триад

Листинг П3.8. Описание допустимых типов триад

unit TrdType; {!!! Зависит от входного языка!!!}

interface

{ Модуль для описания допустимых типов триад }

const { Имена предопределенных функций и переменных }

NAME_PROG = 'MyCurs';

NAME_INPVAR = 'InpVar';

NAME_RESULT = 'Result';

NAME_FUNCT = 'CompileTest';

NAME_TYPE = 'integer';

type { Типы триад, соответствующие типам допустимых

операций, а также три дополнительных типа триад:

– CONST – для алгоритма свертки объектного кода;

– SAME – для алгоритма исключения лишних операций;

– NOP (No OPerations) – для ссылок на конец списка триад. }

TTriadType = (TRD_IF,TRD_OR,TRD_XOR,TRD_AND,TRD_NOT,

TRD_LT,TRD_GT,TRD_EQ,TRD_NEQ,TRD_ADD,TRD_SUB,TRD_UMIN,

TRD_ASSIGN,TRD_JMP,TRD_CONST,TRD_SAME,TRD_NOP);

{Массив строковых обозначений триад для вывода их на экран}

TTriadStr = array[TTriadType] of string;

const TriadStr: TTriadStr =('if','or','xor','and','not',

'<, >, =, <>, +, -, -,

':=,'jmp','C','same','nop');

{ Множество триад, которые являются линейными операциями }

TriadLineSet: set of TTriadType =

[TRD_OR, TRD_XOR, TRD_AND, TRD_NOT, TRD_ADD, TRD_SUB,

TRD_LT, TRD_GT, TRD_EQ, TRD_NEQ, TRD_UMIN];

implementation

end.

Модуль вычисления значений триад при свертке объектного кода

Листинг П3.9. Вычисление значений триад при свертке объектного кода

unit TrdCalc; {!!! Зависит от входного языка!!!}

interface

{ Модуль, вычисляющий значения триад при свертке операций }

uses TrdType;

{ Функция вычисления триады по значениям двух операндов }

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

implementation

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

{ Функция вычисления триады по значениям двух операндов }

begin

Result:= 0;

case Triad of

TRD_OR: Result:= (iOp1 or iOp2) and 1;

TRD_XOR: Result:= (iOp1 xor iOp2) and 1;

TRD_AND: Result:= (iOp1 and iOp2) and 1;

TRD_NOT: Result:= (not iOp1) and 1;

TRD_LT: if iOp1<iOp2 then Result:= 1

else Result:= 0;

TRD_GT: if iOp1>iOp2 then Result:= 1

else Result:= 0;

TRD_EQ: if iOp1=iOp2 then Result:= 1

else Result:= 0;

TRD_NEQ: if iOp1<>iOp2 then Result:= 1

else Result:= 0;

TRD_ADD: Result:= iOp1 + iOp2;

TRD_SUB: Result:= iOp1 – iOp2;

TRD_UMIN: Result:= – iOp2;

end;

end;

end.

Модуль описания структур данных триад

Листинг П3.10. Описание структур данных триад

unit Triads;

interface

{ Модуль, обеспечивающий работу с триадами и их списком }

uses Classes, TblElem, LexElem, TrdType;

type

TTriad = class; { Предварительное описание класса триад }

TOpType = (OP_CONST, OP_VAR, OP_LINK); { Типы операндов:

константа, переменная, ссылка на другую триаду }

TOperand = record { Структура описания операнда в триадах }

case OpType: TOpType of { Тип операнда }

OP_CONST: (ConstVal: integer);{для констант – значение}

OP_VAR: (VarLink: TVarInfo);{ для переменной – ссылка

на элемент таблицы идентификаторов }

OP_LINK: (TriadNum: integer);{ для триады – номер }

end;

TOpArray = array[1..2] of TOperand; {Массив из 2 операндов}

TTriad = class(TObject)

private { Структура данных для описания триады }

TriadType: TTriadType; { Тип триады }

Operands: TOpArray; { Массив операндов }

public

Info: longint; { Дополнительная информация

для оптимизирующих алгоритмов }

IsLinked: Boolean; { Флаг наличия ссылки на эту триаду }

{ Конструктор для создания триады }

constructor Create(Typ: TTriadType; const Ops: TOpArray);

{ Функции для чтения и записи операндов }

function GetOperand(iIdx: integer): TOperand;

procedure SetOperand(iIdx: integer; Op: TOperand);

{ Функции для чтения и записи ссылок на другие триады }

function GetLink(iIdx: integer): integer;

procedure SetLink(iIdx: integer; TrdN: integer);

{ Функции для чтения и записи типа операндов }

function GetOpType(iIdx: integer): TOpType;

procedure SetOpType(iIdx: integer; OpT: TOpType);

{ Функции для чтения и записи значений констант }

function GetConstVal(iIdx: integer): integer;

procedure SetConstVal(iIdx: integer; iVal: integer);

{ Свойства триады, основанные на описанных функциях }

property TrdType: TTriadType read TriadType;

property Opers[iIdx: integer]: TOperand read GetOperand

write SetOperand; default;

property Links[iIdx: integer]: integer read GetLink

write SetLink;

property OpTypes[iIdx: integer]: TOpType read GetOpType

write SetOpType;

property Values[iIdx: integer]: integer read GetConstVal

write SetConstVal;

{ Функция, проверяющая эквивалентность двух триад }

function IsEqual(Trd1: TTriad): Boolean;

{ Функция, формирующая строковое представление триады }

function MakeString(i: integer): string;

end;

TTriadList = class(TList)

public { Класс для описания списка триад и работы с ним }

procedure Clear; override; { Процедура очистки списка }

destructor Destroy; override;{Деструктор удаления списка}

{ Процедура вывода списка триад в список строк

для отображения списка триад }

procedure WriteToList(list: TStrings);

{ Процедура удаления триады из списка }

procedure DelTriad(iIdx: integer);

{ Функция получения триады из списка по ее номеру }

function GetTriad(iIdx: integer): TTriad;

{ Свойство списка триад для доступа по номеру триады }

property Triads[iIdx: integer]: TTriad read GetTriad;

default;

end;

{ Процедура удаления из списка триад заданного типа }

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

implementation

uses SysUtils, FncTree, LexType;

constructor TTriad.Create(Typ: TTriadType;

const Ops: TOpArray);

{ Конструктор создания триады }

var i: integer;

begin

inherited Create; {Вызываем конструктор базового класса}

TriadType:= Typ; { Запоминаем тип триады }

{ Запоминаем два операнда триады }

for i:=1 to 2 do Operands[i]:= Ops[i];

Info:= 0; { Очищаем поле дополнительной информации }

IsLinked:= False; { Очищаем поле внешней ссылки }

end;

function TTriad.GetOperand(iIdx: integer): TOperand;

{ Функция получения данных об операнде по его номеру }

begin Result:= Operands[iIdx]; end;

procedure TTriad.SetOperand(iIdx: integer; Op: TOperand);

{ Функция записи данных операнда триады по его номеру }

begin Operands[iIdx]:= Op; end;

function TTriad.GetLink(iIdx: integer): integer;

{ Функция получения ссылки на другую триаду из операнда }

begin Result:= Operands[iIdx].TriadNum; end;

procedure TTriad.SetLink(iIdx: integer; TrdN: integer);

{ Функция записи номера ссылки на другую триаду }

begin Operands[iIdx].TriadNum:= TrdN; end;

function TTriad.GetOpType(iIdx: integer): TOpType;

{ Функция получения типа операнда по его номеру }

begin Result:= Operands[iIdx].OpType; end;

function TTriad.GetConstVal(iIdx: integer): integer;

{ Функция записи типа операнда по его номеру }

begin Result:= Operands[iIdx].ConstVal; end;

procedure TTriad.SetConstVal(iIdx: integer; iVal: integer);

{ Функция получения значения константы из операнда }

begin Operands[iIdx].ConstVal:= iVal; end;

procedure TTriad.SetOpType(iIdx: integer; OpT: TOpType);

{ Функция записи значения константы в операнд }

begin Operands[iIdx].OpType:= OpT; end;

function IsEqualOp(const Op1,Op2: TOperand): Boolean;

{ Функция проверки совпадения двух операндов }

begin { Операнды равны, если совпадают их типы }

Result:= (Op1.OpType = Op2.OpType);

if Result then { и значения в зависимости от типа }

case Op1.OpType of

OP_CONST: Result:= (Op1.ConstVal = Op2.ConstVal);

OP_VAR: Result:= (Op1.VarLink = Op2.VarLink);

OP_LINK: Result:= (Op1.TriadNum = Op2.TriadNum);

end;

end;

function TTriad.IsEqual(Trd1: TTriad): Boolean;

{ Функция, проверяющая совпадение двух триад }

begin { Триады эквивалентны, если совпадают их типы }

Result:= (TriadType = Trd1.TriadType) { и оба операнда }

and IsEqualOp(Operands[1],Trd1[1])

and IsEqualOp(Operands[2],Trd1[2]);

end;

function GetOperStr(Op: TOperand): string;

{ Функция формирования строки для отображения операнда }

begin

case Op.OpType of

OP_CONST: Result:= IntToStr(Op.ConstVal);

OP_VAR: Result:= Op.VarLink.VarName;

OP_LINK: Result:= ^ + IntToStr(Op.TriadNum+1);

end{case};

end;

function TTriad.MakeString(i: integer): string;

begin

Result:= Format(%d: #9 %s (%s, %s),

[i+1,TriadStr[TriadType],

GetOperStr(Opers[1]), GetOperStr(Opers[2])]);

end;

destructor TTriadList.Destroy;

{ Деструктор для удаления списка триад }

begin

Clear; { Очищаем список триад }

inherited Destroy; {Вызываем деструктор базового класса}

end;

procedure TTriadList.Clear;

{ Процедура очистки списка триад }

var i: integer;

begin { Освобождаем память для всех триад из списка }

for i:=Count-1 downto 0 do TTriad(Items[i]). Free;

inherited Clear; { Вызываем функцию базового класса }

end;

procedure TTriadList.DelTriad(iIdx: integer);

{ Функция удаления триады из списка триад }

begin

if iIdx < Count-1 then { Если это не последняя триада,

переставляем флаг ссылки на предыдущую (если флаг есть)}

TTriad(Items[iIdx+1]). IsLinked:=

TTriad(Items[iIdx+1]). IsLinked

or TTriad(Items[iIdx]). IsLinked;

TTriad(Items[iIdx]). Free; { Освобождаем память триады }

Delete(iIdx); { Удаляем ссылку на триаду из списка }

end;

function TTriadList.GetTriad(iIdx: integer): TTriad;

{ Функция выборки триады из списка по ее номеру }

begin Result:= TTriad(Items[iIdx]); end;

procedure TTriadList.WriteToList(list: TStrings);

{ Процедура вывода списка триад в список строк

для отображения списка триад }

var i,iCnt: integer;

begin

list.Clear; { Очищаем список строк }

iCnt:= Count-1;

for i:=0 to iCnt do { Для всех триад из списка триад }

{ Формируем строковое представление триады

и добавляем его в список строк }

list.Add(TTriad(Items[i]). MakeString(i));

end;

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

{ Процедура удаления из списка триад заданного типа }

var

i,j,iCnt,iDel: integer;

listNum: TList;

Trd: TTriad; { Список запоминания изменений индексов }

begin

iDel:= 0; { В начале изменение индекса нулевое }

iCnt:= listTriad.Count-1;

{ Создаем список запоминания изменений индексов триад }

listNum:= TList.Create;

try

for i:=0 to iCnt do { Для всех триад списка выполняем }

begin { запоминание изменений индекса }

{ Запоминаем изменение индекса данной триады }

listNum.Add(TObject(iDel));

{Если триада удаляется, увеличиваем изменение индекса}

if listTriad[i].TriadType = TrdType then Inc(iDel);

end;

for i:=iCnt downto 0 do { Для всех триад списка }

begin { изменяем индексы ссылок }

Trd:= listTriad[i];

{ Если эта триада удаляемого типа, то удаляем ее }

if Trd.TriadType = TrdType then listTriad.DelTriad(i)

else { Иначе для каждого операнда триады смотрим,

не является ли он ссылкой }

for j:=1 to 2 do

if Trd[j].OpType = OP_LINK then { Если операнд

является ссылкой на триаду, уменьшаем ее индекс }

Trd.Links[j]:=

Trd.Links[j] – integer(listNum[Trd.Links[j]]);

end;

finally listNum.Free; { Уничтожаем временный список }

end;

end;

end.