Пример 2. Таблица имен.

Type EnumKey = (KeyProc,   KeyMain,  KeyEnd,  KeyInt,
                KeyRecord, KeyIf,    KeyThen, KeyElse,
                KeyClose,  KeyWhile, KeyDo,   KeyPrint);
var CommonTop : integer;
procedure Compile;
begin
    Scan;
    (* Сначала считаем описания переменных,
       доступных всей программе
    *)
    while LexType  LexKey
      or  LexVal  KeyProc do
        Declare;
    ProgInit;  (* Вывести стандартный
          заголовок программы на Паскале *)
    CommonTop := TabLen;
    while not LogEOF do
        ThisProc; (* Одна процедура *)
    ProgClose;   (* Вывести стандартное
           окончание программы на Паскале *)
end;

(* Скомпилировать одну процедуру *)
procedure ThisProc;
begin
    TabLen := ThisProc;
    while (LexType = LexKey) and
          (LexVal = ord (KeyInt)
            or LexVal = ord (KeyRecord)) do
        Declare;
    ProcInit; (* Заголовок процедуры *)
    Code;
    ProcClose; (* Окончание процедуры *)
end;

(* Обработать одно описание *)
procedure Declare;
var Y:integer;
begin
    if (LexType=LexKey)
        and (LexVal=ord (KeyInt)
     then NameList (TagInt,0)
     else if (LexType=LexKey)
        and (LexVal=ord (LexRecord))
     then begin
              PutIn ('');
              TableOfNames [TabLen].Fields := 0;
              Y := TabLen;
              ReadFields (Y);
              NameList (TagRecord,Y);
          end;
end;

(* Считать список имен переменных после описателя
    и запихнуть эти имена в таблицу имен*)
procedure NameList (TagVal, FldVal : integer);
begin
    repeat
        Scan;
        With TableOfNames [LexVal] do
         begin
            Tag := TagVal;
            Fields := FldVal;
            Ref := 0;
         end;
        Scan;
      until  (LexType=LexSpecs)
          and (LexVal=ord (SemiColn));
end;

(* Обработать поля записи *)
procedure ReadFields (Y0 : integer);
var X,Y,Pre : integer;
begin
    Y := Y0;
    repeat
        Pre := Y;
        Dcl1 (X,Y);
        TableOfNames [Pre].Ref := X;
      until (LexType=LexKey)
         and (LexVal=ord (KeyEnd));
    Table OfNames [Y].Ref := 0;
end;

(* Dcl1 делает почти тоже, что и Declare,
     только описание, которое он считывает,
     является полем записи.
     Поэтому вместо NameList используется
     другая процедура
*)
procedure Dcl1 (var X,Y : integer);
var C:integer;
begin
    if (LexType=LexKey)
        and (LexVal=ord (KeyInt))
     then NameList1 (TagInt,0)
     else if (LexType=LexKey)
        and (LexVal=ord (LexRecord))
     then begin
              PutIn ('');
              TableOfNames [TabLen].Fields := 0;
              C := TabLen;
              ReadFields (C);
              NameList1 (TagRecord,C,X,Y);
          end;
end;

(*  Разница между NameList и NameList1 в том,
    что последняя устанавливает "указатели" Ref.
*)
procedure NameList1 (TagVal,FldVal : integer;
                        var X,Y : integer);
begin
    X:=0;
    Pre:=0;
    repeat
        Scan;
        if X=0 then X:=LexVal;
        Y:=LexVal;
        With TableOfNames [LexVal] do
         begin
            Tag :=TagVal;
            Fields :=FldVal;
         end;
        if Pre0 then
            TableOfNames [Pre].Ref := LexVal;
        Pre:=LexVal;
        Scan;
      until (LexType=LexSpecs)
         and (LexVal=ord (SemiColn));
end;

(* Скомпилировать все операторы в процедуре *)
procedure Code;
begin
    repeat
       Statement;
     until (LexType=LexKey)
        and (LexVal=ord (KeyEnd));
end;

(* Скомпилировать один оператор *)
procedure Statement;
begin
    if LexType = LexKey then
         (*Большинство операторов можно распознать
         по первому ключевому слову*)
     begin
         if LexVal = ord (KeyIf)
             then SempIf
         else if LexVal = ord (KeyElse)
             then SempElse
         else if LexVal = ord (KeyWhile)
             then SempWhile
         else if LexVal = ord (KeyClose)
             then SempClose
         else if LexVal = ord (KeyPrint)
             then SempPrint
     end
       else if (LexType=LexNames)
             then SempAssignOrCall;
                 (* Присваивание или вызов процедуры *)
end;

(* Семантические подпрограммы *)

(* If...then *)
procedure SempIf;
begin
    WriteLn ('if');
    Scan;
    WriteLn (Buf);
    WriteLn ('then begin');
    Scan;  (**)
    Scan;
end;

(* Else *)
procedure SempElse;
begin
    WriteLn ('end else begin');
    Scan;
end;

(* Print...*)
procedure SempPrint;
begin
    Scan;
    Write ('WriteLn');
    id := TableOfNames [LexVal].Pname;
    Write ('(','''',id,' = ','''',',',id,')');
    Scan;   (*;*)
    Scan;
end;

(* По первой лексеме нельзя отличить
   вызов процедуры от присваивания.
   Поэтому отлдичаем одно от другого
   в одной семантической подпрограмме
   по ходу дела
*)
procedure SempAssignOrCall;
begin
    Write (TableOfNames [LexVal].Pname);
    Scan; (*:=*)
    if (LexType = LexSpecs) and (LexVal = ord (Assign))
        (* Присваивание *)
    then begin Scan;
               WriteLn (' := ',Buf,';');
               Scan; (*;*)
         end
    else if (LexType = LexSpecs) and (LExVal = ord (SemiColn))
    then  WriteLn (';'); (*  Вызов процедуры *)
    Scan;
end;

(* While...do *)
procedure SempWhile;
begin
    WriteLn ('While');
    Scan;
    WriteLn (Buf);
    WriteLn ('do begin');
    Scan;
    Scan;
end;

(* Close *)
procedure SempClose;
begin
    WriteLn ('end;');
    Scan;
end;

        Краткий обзор языка SIMPLE

    Программа на языке SIMPLE есть:
      описания переменных,
      общих для всей программы;
      procedure имя;
      begin
         описание переменных процедуры;
         операторы;
      end;
      ....
      procedure имя;
      ....

    Одна из процедур носит имя main.
    Эта процедура и есть программа.

    Описание

    int список переменных через запятую;
    record описание;
             ....
           описание;
        end список переменных через запятую;

    Описание

    Присваивание: Имя := [....];
    Вызов процедуры: Имя;
    Печать: Print имя;
    Условный: if [....] then операторы else операторы close;
    Цикла: while [....] do операторы close;

  Ключевые слова
(LexType = LexKey)

procedure then
main      else
end       close
int       while
record    do
if        print

  Имена
(LexType = LexNames)

  Например:
sight
gh218
slow1a6

  Числа
(LexType = LexNumber)

  Например:
17
0218
33
1

  Спецсимволы
(LexType = LexSpecs)

:=
,
:

  "Нечто в []"
(LexType = LexExpr)

  Например:
[a*(8+d)}
[d mod h + 12]