//Модуль разбивающий код на лексемы
unit LexParse;

interface

uses Classes, LexType, SysUtils;

type
//Запись для хранения информации о лексеме
  TLexItem = record
    LexType : TLexType; //Тип лексемы
    LexValue: String;   //Значение лексемы
    LexPos  : Integer;  //Позиция лексемы в коде программы (номер строки)
end;

type
//Перечень всех возможных состояний конечного автомата
TAutoPos = (
  AP_START,AP_THEN1,AP_THEN2,AP_THEN3,AP_THEN4,
  AP_ELSE1,AP_ELSE2,AP_ELSE3,AP_ELSE4,AP_IF1,AP_IF2,
  AP_ASSIGN,AP_VAR,AP_CONST_NORM,AP_CONST_DROB,AP_CONST_DROB2,
  AP_CONST_LOG,AP_CONST_LOG2,AP_CONST_LOG3,AP_COMM1,AP_COMM2,AP_ERR);

function ParseText(sIshodnik: TStrings): Integer;
procedure CheckLexem(chNext: Char; PosNext: TAutoPos);
procedure FinishLexem(LexType: TLexType);
procedure FinishConstNorm;
procedure FinishConstDrob;
procedure FinishConstLog;
procedure AddLexemToList(LexType: TLexType; LexStart, LexFinish, LexPos: Integer);
procedure CreateError(sName: String; ErrorPos: Integer);

var
  LexemList: array of TLexItem; //Массив лексем

  AutoPos       : TAutoPos;     //Текущее состояние конечного автомата
  i, j,
  iCurPos,                      //Текущая позиция в тексте программы
  iStartPos,                    //Позиция с которой началась текущая лексема
  iLenStr,                      //Длина обрабатываемой строки
  iErrorRow     : Integer;      //Номер строки в которой ошибка
  s             : String;
implementation

(*==============================================================================
Проверка следующего символа лексемы *)
procedure CheckLexem(chNext: Char; PosNext: TAutoPos);
begin
  if s[j] in [';','<','>','=',':','/',' ',#9,#10,#13] then begin
    AddLexemToList(LEX_VAR, iStartPos, j - 1, i + 1);
    iStartPos := j;
  end;

  case s[j] of
    ';': AddLexemToList(LEX_SEMI, j, j, i + 1);
    '<': AddLexemToList(LEX_MEN,  j, j, i + 1);
    '>': AddLexemToList(LEX_BOL,  j, j, i + 1);
    '=': AddLexemToList(LEX_EQ,   j, j, i + 1);
    ':': AutoPos := AP_ASSIGN;
    '/': AutoPos := AP_COMM1;
    ' ',#9,#10,#13: ;

    //Если ни одно условие из вышеперечисленных не выполнилось
    else
      if s[j] = chNext then
        AutoPos := PosNext
      else if s[j] in ['0'..'9','A'..'Z','a'..'z','_'] then
        AutoPos := AP_VAR
      else
        AutoPos := AP_ERR;
  end;
end;

(*==============================================================================
Процедура проверки завершения лексемы *)
procedure FinishLexem(LexType: TLexType);
begin
  if s[j] in [';','<','>','=',':','/',' ',#9,#10,#13] then begin
    AddLexemToList(LexType, iStartPos, j - 1, i + 1);
    iStartPos := j;
  end;

  case s[j] of
    ';': AddLexemToList(LEX_SEMI, j, j, i + 1);
    '<': AddLexemToList(LEX_MEN,  j, j, i + 1);
    '>': AddLexemToList(LEX_BOL,  j, j, i + 1);
    '=': AddLexemToList(LEX_EQ,   j, j, i + 1);
    ':': AutoPos := AP_ASSIGN;
    '/': AutoPos := AP_COMM1;
    '0'..'9','A'..'Z','a'..'z','_': AutoPos := AP_VAR;
    ' ',#9,#10,#13: ;

    //Если ни одно условие из вышеперечисленных не выполнилось
    else
      AutoPos := AP_ERR;
  end;
end;

(*==============================================================================
Процедура проверки завершения константы в нормальной форме *)
procedure FinishConstNorm;
begin
  if s[j] in [';','<','>','=',':','/',' ',#9,#10,#13] then begin
    AddLexemToList(LEX_CONST_NORM, iStartPos, j - 1, i + 1);
    iStartPos := j;
  end;

  case s[j] of
    ';': AddLexemToList(LEX_SEMI, j, j, i + 1);
    '<': AddLexemToList(LEX_MEN,  j, j, i + 1);
    '>': AddLexemToList(LEX_BOL,  j, j, i + 1);
    '=': AddLexemToList(LEX_EQ,   j, j, i + 1);
    ':': AutoPos := AP_ASSIGN;
    '/': AutoPos := AP_COMM1;
    '0'..'9': AutoPos := AP_CONST_NORM;
    ',': AutoPos := AP_CONST_DROB;
    'E','e': AutoPos := AP_CONST_LOG;
    ' ',#9,#10,#13: ;

    //Если ни одно условие из вышеперечисленных не выполнилось
    else
      AutoPos := AP_ERR;
  end;
end;

(*==============================================================================
Процедура проверки завершения константы в дробной форме *)
procedure FinishConstDrob;
begin
  if (AutoPos = AP_CONST_DROB2) and
     (s[j] in [';','<','>','=',':','/',' ',#9,#10,#13]) then begin
    AddLexemToList(LEX_CONST_DROB, iStartPos, j - 1, i + 1);
    iStartPos := j;
  end;

  case s[j] of
    ';': AddLexemToList(LEX_SEMI, j, j, i + 1);
    '<': AddLexemToList(LEX_MEN,  j, j, i + 1);
    '>': AddLexemToList(LEX_BOL,  j, j, i + 1);
    '=': AddLexemToList(LEX_EQ,   j, j, i + 1);
    ':': AutoPos := AP_ASSIGN;
    '/': AutoPos := AP_COMM1;
    '0'..'9': AutoPos := AP_CONST_DROB2;
    'E','e': AutoPos := AP_CONST_LOG;
    ' ',#9,#10,#13: ;

    //Если ни одно условие из вышеперечисленных не выполнилось
    else
      AutoPos := AP_ERR;
  end;
end;

(*==============================================================================
Процедура проверки завершения константы в логарифмической форме *)
procedure FinishConstLog;
begin
  if (AutoPos = AP_CONST_LOG3) and
     (s[j] in [';','<','>','=',':','/',' ',#9,#10,#13]) then begin
    AddLexemToList(LEX_CONST_LOG, iStartPos, j - 1, i + 1);
    iStartPos := j;
  end;

  case AutoPos of
    AP_CONST_LOG: begin
      case s[j] of
        '-', '+': AutoPos := AP_CONST_LOG2;
        else
          AutoPos := AP_ERR;
      end;
    end;

    AP_CONST_LOG2: begin
      case s[j] of
        '0'..'9': AutoPos := AP_CONST_LOG3;
        else
          AutoPos := AP_ERR;
      end;
    end;

    else
      case s[j] of
        ';': AddLexemToList(LEX_SEMI, j, j, i + 1);
        '<': AddLexemToList(LEX_MEN,  j, j, i + 1);
        '>': AddLexemToList(LEX_BOL,  j, j, i + 1);
        '=': AddLexemToList(LEX_EQ,   j, j, i + 1);
        ':': AutoPos := AP_ASSIGN;
        '/': AutoPos := AP_COMM1;
        '0'..'9': ;
        ' ',#9,#10,#13: ;

        //Если ни одно условие из вышеперечисленных не выполнилось
        else
          AutoPos := AP_ERR;
      end;
  end{case AutoPos};
end;

(*==============================================================================
Добавление лексемы в список *)
procedure AddLexemToList(LexType: TLexType; LexStart, LexFinish, LexPos: Integer);
var
  n: Integer;
begin
  n := Length(LexemList);
  SetLength(LexemList, n + 1);
  LexemList[n].LexType  := LexType;
  LexemList[n].LexValue := copy(s, LexStart, LexFinish - LexStart + 1);
  LexemList[n].LexPos   := LexPos;

  AutoPos := AP_START;
end;

(*==============================================================================
Создание информации об ошибке в нулевом элементе таблицы лексем *)
procedure CreateError(sName: String; ErrorPos: Integer);
begin
  if Length(LexemList) = 0 then
    SetLength(LexemList, 1);
  LexemList[0].LexType  := LEX_ERR;
  LexemList[0].LexValue := sName;
  LexemList[0].LexPos   := ErrorPos;
end;

(*==============================================================================
Разбор текста на лексемы *)
function ParseText(sIshodnik: TStrings): Integer;
begin
  Result := 0;           //Результат 0

  LexemList := nil;      //Очищаем массив лексем
  iErrorRow := -1;       //Изначально ошибочной строки нету
  AutoPos   := AP_START; //Начальное значение автомата
  iCurPos   := 0;        //Текущая позиция в тексте программы

//Цикл перебора каждого символа исходного текста
  for i := 0 to sIshodnik.Count - 1 do begin
    //Считываем строку с номером i и определяем ее длину
    s := sIshodnik.Strings[i];
    iLenStr := Length(s);

    //Цикл посимвольно читающий строку
    for j := 1 to iLenStr do begin
      Inc(iCurPos);

      case AutoPos of
        AP_START: begin
          iStartPos := j;
          case s[j] of
            'i': AutoPos := AP_IF1;
            't': AutoPos := AP_THEN1;
            'e': AutoPos := AP_ELSE1;
            ':': AutoPos := AP_ASSIGN;
            '/': AutoPos := AP_COMM1;
            ';': AddLexemToList(LEX_SEMI, iStartPos, j, i + 1);
            '<': AddLexemToList(LEX_MEN,  iStartPos, j, i + 1);
            '>': AddLexemToList(LEX_BOL,  iStartPos, j, i + 1);
            '=': AddLexemToList(LEX_EQ,   iStartPos, j, i + 1);
            'A'..'Z',
            'a'..'d',
            'f'..'h',
            'j'..'s',
            'u'..'z', '_' : AutoPos := AP_VAR;
            '0'..'9'      : AutoPos := AP_CONST_NORM;
            ' ',#9,#10,#13: ;
            else
              AutoPos := AP_ERR;
          end{case s[iCurPos]};
        end;
        AP_IF1  : CheckLexem('f', AP_IF2);
        AP_IF2  : FinishLexem(LEX_IF);
        AP_THEN1: CheckLexem('h', AP_THEN2);
        AP_THEN2: CheckLexem('e', AP_THEN3);
        AP_THEN3: CheckLexem('n', AP_THEN4);
        AP_THEN4: FinishLexem(LEX_THEN);
        AP_ELSE1: CheckLexem('l', AP_ELSE2);
        AP_ELSE2: CheckLexem('s', AP_ELSE3);
        AP_ELSE3: CheckLexem('e', AP_ELSE4);
        AP_ELSE4: FinishLexem(LEX_ELSE);

        AP_ASSIGN:
          case s[j] of
            '=': AddLexemToList(LEX_ASSIGN, j - 1, j, i + 1);
            else
              Result := i + 1;
              iStartPos := j - 1;
              break;
          end;
        AP_VAR       : FinishLexem(LEX_VAR);
        AP_CONST_NORM: FinishConstNorm;

        AP_CONST_DROB,
        AP_CONST_DROB2: FinishConstDrob;

        AP_CONST_LOG,
        AP_CONST_LOG2,
        AP_CONST_LOG3 : FinishConstLog;
        AP_COMM1:
          case s[j] of
            '/': begin
              AutoPos := AP_START;
              Inc(iCurPos, iLenStr - j);
              break;
            end;
            else
              Result := i + 1;
              iStartPos := j - 1;
              break;
          end;
      end{case AutoPos};

      //Если достигнут конец строки - значит конец текцщей лексемы
      if j = iLenStr then
      begin
        case AutoPos of
          AP_IF2        : AddLexemToList(LEX_IF, iStartPos, j, i + 1);
          AP_THEN4      : AddLexemToList(LEX_THEN, iStartPos, j, i + 1);
          AP_ELSE4      : AddLexemToList(LEX_ELSE, iStartPos, j, i + 1);
          AP_CONST_NORM : AddLexemToList(LEX_CONST_NORM, iStartPos, j, i + 1);
          AP_CONST_DROB : AutoPos := AP_ERR;
          AP_CONST_DROB2: AddLexemToList(LEX_CONST_DROB, iStartPos, j, i + 1);
          AP_CONST_LOG,
          AP_CONST_LOG2 : AutoPos := AP_ERR;
          AP_CONST_LOG3 : AddLexemToList(LEX_CONST_LOG, iStartPos, j, i + 1);
          AP_IF1,
          AP_THEN1,
          AP_THEN2,
          AP_THEN3,
          AP_ELSE1,
          AP_ELSE2,
          AP_ELSE3,
          AP_VAR        : AddLexemToList(LEX_VAR, iStartPos, j, i + 1);
        end{case AutoPos};
      end;

      if Result <> 0 then
        Break;

      //Если была ошибка в лексемах, то останавливаемся
      if AutoPos = AP_ERR then begin
        Result := i + 1;
        Break;
      end;
    end{for j};

    if Result <> 0 then
      Break;

    Inc(iCurPos, 2);//Увеличиваем общий счетчик символов на 2
  end{for i};

////Генерация ошибок
  if AutoPos = AP_ASSIGN then begin
    CreateError('Незавершенный знак присваивания', iCurPos);
    exit;
  end;

  if AutoPos = AP_COMM1 then begin
    CreateError('Незавершенный комментарий', iCurPos);
    exit;
  end;

  if AutoPos = AP_ERR then begin
    CreateError('Незавершенная лексема', iCurPos);
    exit;
  end;
end;

end.