Створення компілятора

var i : integer;

begin

  for i:=HASH_MIN to HASH_MAX do HashArray[i] := nil;

end;

 

procedure ClearTreeVar;

{ Освобождение памяти для всех элементов хэш-таблицы }

var i : integer;

begin

  for i:=HASH_MIN to HASH_MAX do

  begin

    HashArray[i].Free;

    HashArray[i] := nil;

  end;

end;

 

procedure ClearTreeInfo;

{ Удаление дополнительной  информации для всех

  элементов хэш-таблицы  }

var i : integer;

begin

  for i:=HASH_MIN to HASH_MAX do

   if HashArray[i] <> nil then HashArray[i].ClearAllInfo;

end;

 

function AddTreeVar(const sName: string): TVarInfo;

{ Добавление элемента  в хэш-таблицу и дерево }

var iHash: integer;

begin

  { Обнуляем счетчик количества сравнений }

  iCmpCount := 0;

  { Вычисляем хэш-адрес  с помощью хэш-функции }

  iHash := VarHash(Upper(sName));

  if HashArray[iHash] <> nil then

   Result := HashArray[iHash].AddElCnt(sName,iCmpCount)

  else

  begin

    Result := TVarInfo.Create(sName);

    HashArray[iHash] := Result;

  end;

end;

 

function GetTreeVar(const sName: string): TVarInfo;

var iHash: integer;

begin

  iCmpCount := 0;

  iHash := VarHash(Upper(sName));

  if HashArray[iHash] = nil then Result := nil

  else

   Result := HashArray[iHash].FindElCnt(sName,iCmpCount)

end;

 

initialization

{ Вызов начальной  инициализации таблицы

  при загрузке  модуля }

  InitTreeVar;

 

finalization

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

  ClearTreeVar;

 

end.

 

 

 

3. TblElem

 

unit TblElem;

 

interface

{ Модуль, описывающий структуру  данных элементов

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

 

type

 

{ Класс для описания  некоторых данных,

  связанных с элементом  таблицы }

TAddVarInfo = class(TObject)

 public

  procedure SetInfo(iIdx: integer; iInfo: longint);

   virtual; abstract;

  function GetInfo(iIdx: integer): longint;

   virtual; abstract;

  property Info[iIdx: integer]: longint

   read GetInfo write SetInfo; default;

end;

 

{ Класс для описания  элемента хэш-таблицы }

TVarInfo = class(TObject)

protected

  { Имя элемента }

  sName: string;

  { Дополнительная информация (для будущего использования)}

  pInfo: TAddVarInfo;

  { Ссылки на меньший  и больший элементы

    для организации  бинарного дерева }

  minEl,maxEl: TVarInfo;

 public

  { Конструктор создания  элемента хэш-таблицы }

  constructor Create(const sN: string);

  { Деструктор для освобождения памяти, занятой элементом }

  destructor Destroy; override;

  { Функция заполнения  дополнительной информации элемента }

  procedure SetInfo(pI: TAddVarInfo);

  { Функции для удаления  дополнительной информации }

  procedure ClearInfo;

  procedure ClearAllInfo;

  { Свойство "Имя элемента" }

  property VarName: string read sName;

  { Свойство "Дополнительная информация"

   (для  будущего использования) }

  property Info: TAddVarInfo read pInfo write SetInfo;

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

  function AddElCnt(const sAdd: string;

                    var iCnt: integer): TVarInfo;

  function AddElem(const sAdd: string): TVarInfo;

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

  function FindElCnt(const sN: string;

                     var iCnt: integer): TVarInfo;

  function FindElem(const sN: string): TVarInfo;

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

    в одну строку }

  function GetElList(const sLim,sInp,sOut: string): string;

end;

 

function Upper(const x:string): string;

 

implementation

 

uses SysUtils;

 

{ Условная компиляция: если  определено имя REGNAME,

  то имена переменных считаются регистрозависимыми,

  иначе - регистронезависимыми }

{$IFDEF REGNAME}

function Upper(const x:string): string;

begin Result := UpperCase(x); end;

{$ELSE}

function Upper(const x:string): string;

begin Result := x; end;

{$ENDIF}

 

constructor TVarInfo.Create(const sN: string);

{ Конструктор создания  элемента хэш-таблицы }

begin

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

  inherited Create;

  { Запоминаем имя элемента  и обнуляем все ссылки }

  sName := sN;

  pInfo := nil;

  minEl := nil;

  maxEl := nil;

end;

 

destructor TVarInfo.Destroy;

{ Деструктор для освобождения  памяти, занятой элементом }

begin

  { Освобождаем память по каждой ссылке

   (если она не  нулевая), при этом в дереве  рекурсивно

   будет освобождена  память для всех элементов  }

  ClearAllInfo;

  minEl.Free;

  maxEl.Free;

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

  inherited Destroy;

end;

 

function TVarInfo.GetElList(const sLim{разделитель списка},

sInp,sOut{имена, не включаемые в строку}: string): string;

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

var sAdd: string;

begin

  { Первоначально строка  пуста }

  Result := '';

  { Если элемент таблицы не совпадает с одним

    из невключаемых  имен, то его нужно включить  в строку }

  if (Upper(sName) <> Upper(sInp))

  and (Upper(sName) <> Upper(sOut)) then Result := sName;

  { Если есть левая ветвь дерева }

  if minEl <> nil then

  begin

    { Вычисляем строку  для этой ветви }

    sAdd := minEl.GetElList(sLim,sInp,sOut);

    { Если она не пустая, добавляем ее через разделитель }

    if sAdd <> '' then

    begin

      if Result <> '' then Result := Result + sLim + sAdd

                      else Result := sAdd;

    end;

  end;

  { Если есть правая ветвь дерева }

  if maxEl <> nil then

  begin

    { Вычисляем строку  для этой ветви }

    sAdd := maxEl.GetElList(sLim,sInp,sOut);

    { Если она не пустая, добавляем ее через разделитель }

    if sAdd <> '' then

    begin

      if Result <> '' then Result := Result + sLim + sAdd

                      else Result := sAdd;

    end;

  end;

end;

 

procedure TVarInfo.SetInfo(pI: TAddVarInfo);

{ Функция заполнения  дополнительной информации элемента }

begin

  pInfo := pI;

end;

 

procedure TVarInfo.ClearInfo;

{ Функция удаления  дополнительной информации элемента }

begin

  pInfo.Free;

  pInfo := nil;

end;

 

procedure TVarInfo.ClearAllInfo;

{ Функция удаления  дополнительной информации элемента

  и его связок }

begin

  if minEl <> nil then minEl.ClearAllInfo;

  if maxEl <> nil then maxEl.ClearAllInfo;

  pInfo.Free;

  pInfo := nil;

end;

 

function TVarInfo.AddElCnt(const sAdd: string;

                           var iCnt: integer): TVarInfo;

{ Функция добавления элемента в бинарное дерево

  с учетом счетчика  сравнений }

var i: integer;

begin

  { Увеличиваем счетчик  сравнений }

  Inc(iCnt);

  { Сравниваем имена  нового и текущего элемента

    (одной функцией!) }

  i := StrComp(PChar(Upper(sAdd)),PChar(Upper(sName)));

  if i < 0 then

  { Если новый элемент  меньше, смотрим ссылку

    на меньший  элемент }

  begin

    { Если ссылка  не пустая, рекурсивно вызываем  функцию

      добавления элемента }

    if minEl <> nil then

     Result := minEl.AddElCnt(sAdd,iCnt)

    else

    { Если  ссылка пустая, создаем новый  элемент

      и запоминаем ссылку на него }

    begin

       Result := TVarInfo.Create(sAdd);

       minEl := Result;

    end;

  end

  else

  { Если новый  элемент больше, смотрим ссылку

    на больший элемент }

  if i > 0 then

  begin

    { Если ссылка  не пустая, рекурсивно вызываем  функцию

      добавления  элемента }

    if maxEl <> nil then

     Result := maxEl.AddElCnt(sAdd,iCnt)

    else

    { Если ссылка  пустая, создаем новый элемент

      и запоминаем  ссылку на него }

    begin

       Result := TVarInfo.Create(sAdd);

       maxEl := Result;

    end;

  end

  { Если имена совпадают,  то такой элемент уже есть

    в дереве - это  текущий элемент }

  else Result := Self;

end;

 

function TVarInfo.AddElem(const sAdd: string): TVarInfo;

{ Функция добавления  элемента в бинарное дерево

  без учета  счетчика сравнений }

var iCnt: integer;

begin

  Result := AddElCnt(sAdd,iCnt);

end;

 

function TVarInfo.FindElCnt(const sN: string;

                            var iCnt: integer): TVarInfo;

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

  с учетом счетчика  сравнений }

var i: integer;

begin

  { Увеличиваем счетчик  сравнений }

  Inc(iCnt);

  { Сравниваем имена  искомого и текущего элемента

   (одной функцией!) }

  i := StrComp(PChar(Upper(sN)),PChar(Upper(sName)));

  if i < 0 then

  { Если искомый элемент  меньше, смотрим ссылку

    на меньший  элемент }

  begin

    { Если ссылка  не пустая, рекурсивно вызываем  для нее

      функцию  поиска элемента, иначе элемент  не найден }

    if minEl <> nil then Result := minEl.FindElCnt(sN,iCnt)

                    else Result := nil;

  end

  else

  if i > 0 then

  { Если искомый элемент больше, смотрим ссылку

    на  больший элемент }

  begin

    { Если  ссылка не пустая, рекурсивно  вызываем для нее

      функцию поиска элемента, иначе элемент не найден }

    if maxEl <> nil then Result := maxEl.FindElCnt(sN,iCnt)

                    else Result := nil;

  end

  { Если имена  совпадают, то искомый элемент

    найден - это текущий  элемент }

  else Result := Self;

end;

 

function TVarInfo.FindElem(const sN: string): TVarInfo;

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

  без учета  счетчика сравнений }

var iCnt: integer;

begin

  Result := FindElCnt(sN,iCnt);

end;

 

end.

 

 

 

4. LexElem

 

unit LexElem;

 

interface

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

 

uses Classes, TblElem, LexType;

 

type

 

{ Структура  для информации о лексемах }

TLexInfo = record

  case LexType: TLexType of

    LEX_VAR: (VarInfo: TVarInfo);

    LEX_CONST: (ConstVal: integer);

    LEX_START: (szInfo: PChar);

end;

 

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

TLexem = class(TObject)

 protected

  { Информация о лексеме  }

  LexInfo: TLexInfo;

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

  iStr,iPos,iAllP: integer;

 public

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

  constructor CreateKey(LexKey: TLexType;

                        iA,iSt,iP: integer);

  constructor CreateVar(VarInf: TVarInfo;

                        iA,iSt,iP: integer);

  constructor CreateConst(iVal: integer;

                          iA,iSt,iP: integer);

  constructor CreateInfo(sInf: string;

                         iA,iSt,iP: integer);

  destructor Destroy; override;

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

  property LexType: TLexType read LexInfo.LexType;

  property VarInfo: TVarInfo read LexInfo.VarInfo;

  property ConstVal: integer read LexInfo.ConstVal;

  { Свойства для чтения позиции лексемы

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

  property StrNum: integer read iStr;

  property PosNum: integer read iPos;

  property PosAll: integer read iAllP;

  { Текстовая информация о типе лексемы }

  function LexInfoStr: string;

  { Имя для лексемы-переменной }

  function VarName: string;

end;

 

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

TLexList = class(TList)

 public

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

    при уничтожении списка }

  destructor Destroy; override;

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

  procedure Clear; override;

  { Процедура и свойство  для получения информации

    о лексеме по  ее номеру }

  function GetLexem(iIdx: integer): TLexem;

  property Lexem[iIdx: integer]: TLexem read GetLexem;

           default;

end;

 

implementation

 

uses SysUtils, LexAuto;

 

constructor TLexem.CreateKey(LexKey: TLexType;

                             iA,iSt,iP: integer);

{ Конструктор создания лексемы типа "ключевое слово" }

begin

  inherited Create;

  LexInfo.LexType := LexKey;

  { запоминаем тип ключевого слова }

  iStr := iSt; { запоминаем позицию лексемы }

  iPos := iP;

  iAllP := iA;

end;

 

constructor TLexem.CreateVar(VarInf: TVarInfo;

                             iA,iSt,iP: integer);

{ Конструктор создания  лексемы типа "ключевое слово" }

begin

  inherited Create;

  LexInfo.LexType := LEX_VAR; { тип  - "переменная" }

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

  LexInfo.VarInfo := VarInf;

  iStr := iSt; { запоминаем позицию лексемы }

  iPos := iP;

  iAllP := iA;

end;

 

constructor TLexem.CreateConst(iVal: integer;

                               iA,iSt,iP: integer);

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

begin

  inherited Create;

  LexInfo.LexType := LEX_CONST; { тип  - "константа" }

  { запоминаем значение константы }

  LexInfo.ConstVal := iVal;

  iStr := iSt; { запоминаем позицию лексемы }

  iPos := iP;

  iAllP := iA;

end;

 

constructor TLexem.CreateInfo(sInf: string;

                              iA,iSt,iP: integer);

{ Конструктор создания  информационной лексемы }

begin

  inherited Create;

  LexInfo.LexType := LEX_START; { тип  - "доп. лексема" }

  { выделяем память  для информации }

  LexInfo.szInfo :=  StrAlloc(Length(sInf)+1);

  { запоминаем  информацию }

  StrPCopy(LexInfo.szInfo,sInf);

  iStr := iSt; { запоминаем позицию лексемы }

  iPos := iP;

  iAllP := iA;

end;

 

destructor TLexem.Destroy;

begin

  { Освобождаем  занятую память,

    если  это информационная лексема }

  if LexType = LEX_START then StrDispose(LexInfo.szInfo);

  inherited Destroy;

end;

 

function TLexem.VarName: string;

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

begin

  Result := VarInfo.VarName;

end;

 

function TLexem.LexInfoStr: string;

{ Текстовая информация о типе лексемы }

begin

  case LexType of

    LEX_VAR:   Result := VarName;

    { для  переменной - ее имя  }

    LEX_CONST: Result := IntToStr(ConstVal);

    { для  константы - значение }

    LEX_START: Result := StrPas(LexInfo.szInfo);

    { для инф. лексемы - информация }

    else       Result := LexTypeInfo(LexType);

    { для остальных - имя типа }

  end;

end;

 

procedure TLexList.Clear;

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

<p class="dash041e_0431_044b_0447_043d_044b_0439"