РГЗ построение компилятора (стр. 8 )

//========= := =======

  2005: case s[i] of

  '=': begin

  q:=2002;

  res:=res+s[i];

  inc(i);

  end;

  ' ','a'..'z','_':  begin

  q:=0;

  AddToMas(res,4);

  end;

  '0'..'9': begin

  q:=2003;

  AddToMas(res,4);

  res:=s[i];

  inc(i);

  end;

  else  begin

  q:=1000;

  res:=s[i];

  inc(i);

  end;

  end;

//=====Целые числа num======

  2003: case s[i] of

  '0'..'9': begin

  q:=2003;

  res:=res+s[i];

  inc(i);

  end;

  '.': begin

  q:=2011;

  res:=res+s[i];

  inc(i);

  end;

  ')',';',':','*','+','-','/','{','}','[',']': begin

  q:=0;

  AddtoMas(res,5);

  //inc(i);

  end;

  else  begin

  q:=1000;

  res:=s[i];

  inc(i);

  end;

  end;

//============Вещественные числа===

  2011: case s[i] of

  '0'..'9': begin

  q:=2011;

  res:=res+s[i];

  inc(i);

  end;

  ')',';',':','.': begin

  q:=0;

  AddtoMas(res,7);

  inc(i);

  end;

  else  begin

  q:=1000;

  res:=s[i];

  inc(i);

  end;

  end;

//=====Арифметические операции (ar)=== =

  2004: case s[i] of

  'a'..'z','_':  begin

  q:=0;

  AddToMas(res,6);

  end;

  '0'..'9': begin

  q:=2003;

  AddToMas(res,6);

  res:=s[i];

  inc(i);

  end;

  else  begin

  q:=1000;

  res:=s[i];

  inc(i);

  end;

  end;

//=====Ошибка=======

  1000: begin

  Form1.Memo5.Lines. Add('Обнаружена ошибка в позиции '+IntToStr(i-1)+'  "'+s[i-1]+'"');

  i:=j+1;

  otvet:=false;

  //while s[i]<>' ' do

  inc(i);

  q:=0;

  end;

  end;

//Заполнение таб

  if otvet then

  begin

  form1.StringGrid1.RowCount:=length(mas_k)+1;

  form1.StringGrid2.RowCount:=length(mas_o)+1;

  form1.StringGrid3.RowCount:=length(mas_i)+1;

  form1.StringGrid4.RowCount:=length(mas_r)+1;

  form1.StringGrid5.RowCount:=length(mas_n)+1;

  form1.StringGrid6.RowCount:=length(mas_a)+1;

  form1.StringGrid7.RowCount:=length(mas_v)+1;

  for i:=0 to length(mas_k)-1 do

  begin

  form1.StringGrid1.Cells[0,i+1]:=mas_k[i][0];

  form1.StringGrid1.Cells[1,i+1]:=mas_k[i][1];

  form1.StringGrid1.Cells[2,i+1]:=mas_k[i][2];

  end;

  for i:=0 to length(mas_o)-1 do

  begin

  form1.StringGrid2.Cells[0,i+1]:=mas_o[i][0];

  form1.StringGrid2.Cells[1,i+1]:=mas_o[i][1];

  form1.StringGrid2.Cells[2,i+1]:=mas_o[i][2];

  end;

  for i:=0 to length(mas_i)-1 do

  begin

  form1.StringGrid3.Cells[0,i+1]:=mas_i[i][0];

  form1.StringGrid3.Cells[1,i+1]:=mas_i[i][1];

  form1.StringGrid3.Cells[2,i+1]:=mas_i[i][2];

  end;

  for i:=0 to length(mas_r)-1 do

  begin

  form1.StringGrid4.Cells[0,i+1]:=mas_r[i][0];

  form1.StringGrid4.Cells[1,i+1]:=mas_r[i][1];

  form1.StringGrid4.Cells[2,i+1]:=mas_r[i][2];

  end;

  for i:=0 to length(mas_n)-1 do

  begin

  form1.StringGrid5.Cells[0,i+1]:=mas_n[i][0];

  form1.StringGrid5.Cells[1,i+1]:=mas_n[i][1];

  form1.StringGrid5.Cells[2,i+1]:=mas_n[i][2];

  end;

  for i:=0 to length(mas_a)-1 do

  begin

  form1.StringGrid6.Cells[0,i+1]:=mas_a[i][0];

  form1.StringGrid6.Cells[1,i+1]:=mas_a[i][1];

  form1.StringGrid6.Cells[2,i+1]:=mas_a[i][2];

  end;

  for i:=0 to length(mas_v)-1 do

  begin

  form1.StringGrid7.Cells[0,i+1]:=mas_v[i][0];

  form1.StringGrid7.Cells[1,i+1]:=mas_v[i][1];

  form1.StringGrid7.Cells[2,i+1]:=mas_v[i][2];

  end;

  end;

  result:=otvet;

end;

//=================

function DeleteCommentsInStr(kod_str:TStrings):string;

var str, new_str:string;

  i, j:integer;

  t, start, finish:boolean;

begin

for i:=0 to kod_str. Count-1 do

begin

  str:=kod_str[i];

  j:=1;

  if Length(str)>1 then

  begin

  if Length(str)=2 then

  begin

  if (not ((str[j]='/') and (str[j+1]='/'))) then

  str:=str

  else

  str:='';

  end

  else

  begin

  while (j<(Length(str)-1)) and (not ((str[j]='/') and (str[j+1]='/'))) do

  inc(j);

  if j=1 then str:=''

  else

  begin

  if (j<(Length(str))) and (str[j]='/') and (str[j+1]='/') then

  str:=copy(str,1,j-1);

  end;

  end;

  end;

  new_str:=new_str+str+' ';

  end;

t:=true;

while t do

begin

  t:=false;

  str:=new_str;

  j:=1;

  start:=false;

  finish:=false;

  if (Length(str)>1) then

  begin

  while (j<Length(str)) and (str[j]<>'/') and (str[j+1]<>'*') do

  inc(j);

  if (str[j]='/')and(str[j+1]='*') then

  start:=true;

  if start and (j<Length(str)) then

  begin

  i:=j+2;

  while (i<=Length(str)) and (str[i]<>'*')and(str[i+1]<>'/') do

  inc(i);

  if (str[i]='*')and(str[i+1]='/') then

  finish:=true;

  if start and finish then

  begin

  t:=true;

  new_str:='';

  if (j=1) and (i+1=Length(str)) then

  begin

  new_str:='';

  end

  else

  begin

  if (j<>1) and (i+1<>length(str)) then

  begin

  new_str:=new_str+copy(str,1,j-2)+' ';

  new_str:=new_str+copy(str, i+2,Length(str)-i-1);

  end

  else

  begin

  if j=1 then

  new_str:=new_str+copy(str, i+2,Length(str)-i-1);

  if (i=length(str)) then

  new_str:=new_str+copy(str,1,j-2);

  end;

  end;

  end;

  end;

  end;

  end;

result:=str;

end;

//вызов процедуры лексического анализа

function Analiz(Mem1:TMemo;Mem2:TMemo):boolean;

var

  i, j:integer;

  kod:Tstrings;

  res:string;

  osh:boolean;

begin

  kod:=TStringList. Create;

  kod:=Mem1.Lines;

  if Mem1.Text<>'' then

  begin

  res:=DeleteCommentsInStr(kod);

  if (res<>'') then

  res:=DeleteSpace(res);

  end

  else

  ShowMessage('Введите данные');

  Mem2.Text:=res;

  if (res<>'') then

  osh:=Razbor(res);

  result:=osh;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  Memo2.Clear;

  Memo3.Clear;

  Memo4.Clear;

  Memo5.Clear;

  MakeStringrid;

  //Memo10.Text:

  if Analiz(Memo1,Memo4) then

  begin

  Memo4.Text:=copy(Memo4.Text,1,length(Memo4.Text)-1);

  ShowMessage('Анализ закончен');

  Memo5.Lines. Add('Анализ завершен успешно, без ошибок')

  end

  else

  begin

  ShowMessage('Внимание выявлены ошибки!');

  Memo2.Clear;

  Memo3.Clear;

  end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

Close;

end;

procedure TForm1.Button2Click(Sender: TObject);

var stroka:string;

begin

Form2.show;

//stroka:=form1.Memo2.Text;

//form2.Edit1.Clear;

//Delete(stroka, Length(form1.Memo2.Text),1);

//form1.Memo2.Text:=stroka;

Form2.Edit1.Text:=form1.Memo2.Text;

end;

end.

unit Unit2;

interface

uses

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

  Dialogs, Grids, StdCtrls, jpeg, ExtCtrls, ComCtrls, dxorgchr;

type

  TForm2 = class(TForm)

  PageControl1: TPageControl;

  TabSheet1: TTabSheet;

  TabSheet2: TTabSheet;

  Panel1: TPanel;

  Button4: TButton;

  Button5: TButton;

  Button6: TButton;

  Button8: TButton;

  Memo2: TMemo;

  StringGrid6: TStringGrid;

  Memo1: TMemo;

  ListBox1: TListBox;

  Label2: TLabel;

  Label1: TLabel;

  Label13: TLabel;

  Label12: TLabel;

  Label10: TLabel;

  Edit1: TEdit;

  CheckBox1: TCheckBox;

  dxOrgChart1: TdxOrgChart;

  procedure FormCreate(Sender: TObject);

  procedure Button4Click(Sender: TObject);

  procedure Button6Click(Sender: TObject);

  procedure Button5Click(Sender: TObject);

  procedure Button8Click(Sender: TObject);

  private

  { Private declarations }

  public

  { Public declarations }

  end;

var

  Form2: TForm2;

  q, d,j, i,count:integer;

  s, st, ss, sss, poz:string;

  f:textfile;

  Table: array of array of String;

  flag:boolean;

  mast: Array [0..100] of string;

  prav, Mas_of_Net: array of string;

  po:^string;

  coun_e1:integer;

  q1:TdxOcNode;

  coun_e, c1,c2,c3,c4,c5,c6,kkkk, bbbbb:integer;

  t, t1,t2,t3,t4,t5,t6,pred_level, count_t, da:integer;

  flagsign, flagdel:boolean;

  StringGridX:TStringGrid;

  vh1,st1,stack, vhod:string;

implementation

uses Unit1, Unit3, Unit4;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

begin

Button5.Enabled:=false;

Button8.Enabled:=false;

count:=0;

q:=0;

d:=0;

t1:=0;

t2:=0;

t3:=0;

t4:=0;

t5:=0;

Stringgrid6.Cells[0,0]:='№';

Stringgrid6.Cells[1,0]:='Входная строка';

Stringgrid6.Cells[2,0]:='Стек';

Stringgrid6.Cells[3,0]:='Действие';