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

  TabSheet1: TTabSheet;

  PageControl2: TPageControl;

  TabSheet2: TTabSheet;

  TabSheet3: TTabSheet;

  GroupBox1: TGroupBox;

  GroupBox2: TGroupBox;

  GroupBox3: TGroupBox;

  GroupBox4: TGroupBox;

  GroupBox5: TGroupBox;

  GroupBox6: TGroupBox;

  GroupBox7: TGroupBox;

  Memo2: TMemo;

  Memo3: TMemo;

  Memo4: TMemo;

  Memo5: TMemo;

  Button2: TButton;

  procedure Button1Click(Sender: TObject);

  procedure Button4Click(Sender: TObject);

  procedure Button2Click(Sender: TObject);

  private

  { Private declarations }

  public

  { Public declarations }

  end;

  type

  mas_zn=array [0..2] of string;

var

  Form1: TForm1;

  LexTable: array of string;

  mas_k, mas_i, mas_o, mas_r, mas_n, mas_a, mas_v :array of mas_zn;

  rav1,rav2:integer;

implementation

uses Unit2;

{$R *.dfm}

procedure MakeStringrid;

var

  i, j:integer;

begin

  for i:=1 to 7 do

  begin

  TStringGrid(form1.FindComponent('StringGrid' + IntToStr(i))).RowCount := 2;

  for j:=0 to 2 do

  TStringGrid(form1.FindComponent('StringGrid' + IntToStr(i))).Cells[j,1] := '';

  TStringGrid(form1.FindComponent('StringGrid' + IntToStr(i))).Cells[0,0] := 'N';

  TStringGrid(form1.FindComponent('StringGrid' + IntToStr(i))).Cells[1,0] := 'Знач.';

  TStringGrid(form1.FindComponent('StringGrid' + IntToStr(i))).Cells[2,0] := 'Kод';

  end;

end;

function MakeString(kod:TStrings):string;

var

  i:integer;

  s:string;

begin

  for i:=0 to kod. Count-1 do s:=s+kod[i]+' ';

  result:=s;

end;

function DeleteSpace(s:string):string;

var

  i, j:integer;

  new_s:string;

begin

  new_s:='';

  for i:=1 to length(s) do

  if length(new_s)>0 then

  begin

  if (s[i]=' ') and (new_s[length(new_s)]<>' ') then

  new_s:=new_s+s[i]

  else

  if (s[i]<>' ') then

  new_s:=new_s+s[i];

  end

  else

  new_s:=new_s+s[i];

  if new_s[1]=' ' then

  new_s:=copy(new_s,2,length(new_s));

  if new_s<>'' then

  if new_s[length(new_s)]=' ' then

  new_s:=copy(new_s,1,length(new_s)-1);

  result:=new_s;

end;

procedure AddToMas(str:string;num:integer);

var

  p1,p2,p3:integer;

  b:boolean;

  s1,s2:string;

begin

  setlength(LexTable, length(LexTable)+1);

  LexTable[length(LexTable)-1]:=str;

  case num of

  1:  begin

  b:=false;

  if length(mas_k)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_k[p1][1]=str then

  begin

  b:=false;

  s1:='('+'key,'+inttostr(p1+1)+')';

  s2:=mas_k[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_k, length(mas_k)+1);

  mas_k[length(mas_k)-1][0]:=inttostr(length(mas_k));

  mas_k[length(mas_k)-1][1]:=str;

  mas_k[length(mas_k)-1][2]:=str;

  s1:='('+'key,'+mas_k[length(mas_k)-1][0]+')';

  s2:=mas_k[length(mas_k)-1][2];

  end

  end;

  2:  begin

  b:=false;

  if length(mas_o)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_o[p1][1]=str then

  begin

  b:=false;

  s1:='('+'oper,'+inttostr(p1+1)+')';

  s2:=mas_o[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_o, length(mas_o)+1);

  mas_o[length(mas_o)-1][0]:=inttostr(length(mas_o));

  mas_o[length(mas_o)-1][1]:=str;

  mas_o[length(mas_o)-1][2]:=str;

  s1:='('+'oper,'+mas_o[length(mas_o)-1][0]+')';

  s2:=mas_o[length(mas_o)-1][2];

  end

  end;

  3:  begin

  b:=false;

  if length(mas_i)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_i[p1][1]=str then

  begin

  b:=false;

  s1:='('+'id,'+inttostr(p1+1)+')';

  s2:=mas_i[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_i, length(mas_i)+1);

  mas_i[length(mas_i)-1][0]:=inttostr(length(mas_i));

  mas_i[length(mas_i)-1][1]:=str;

  mas_i[length(mas_i)-1][2]:='id';

  s1:='('+'id,'+mas_i[length(mas_i)-1][0]+')';

  s2:=mas_i[length(mas_i)-1][2];

  end

  end;

  4:  begin

  b:=false;

  if length(mas_r)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_r[p1][1]=str then

  begin

  b:=false;

  s1:='('+'razd,'+inttostr(p1+1)+')';

  s2:=mas_r[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_r, length(mas_r)+1);

  mas_r[length(mas_r)-1][0]:=inttostr(length(mas_r));

  mas_r[length(mas_r)-1][1]:=str;

  mas_r[length(mas_r)-1][2]:=str;

  s1:='('+'razd,'+mas_r[length(mas_r)-1][0]+')';

  s2:=mas_r[length(mas_r)-1][2];

  end

  end;

  5:  begin

  b:=false;

  if length(mas_n)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_n[p1][1]=str then

  begin

  b:=false;

  s1:='('+'num,'+inttostr(p1+1)+')';

  s2:=mas_n[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_n, length(mas_n)+1);

  mas_n[length(mas_n)-1][0]:=inttostr(length(mas_n));

  mas_n[length(mas_n)-1][1]:=str;

  mas_n[length(mas_n)-1][2]:='num';

  s1:='('+'num,'+mas_n[length(mas_n)-1][0]+')';

  s2:=mas_n[length(mas_n)-1][2];

  end

  end;

  6:  begin

  b:=false;

  if length(mas_a)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_a[p1][1]=str then

  begin

  b:=false;

  s1:='('+'ar,'+inttostr(p1+1)+')';

  s2:=mas_a[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_a, length(mas_a)+1);

  mas_a[length(mas_a)-1][0]:=inttostr(length(mas_a));

  mas_a[length(mas_a)-1][1]:=str;

  mas_a[length(mas_a)-1][2]:='ar';

  s1:='('+'ar,'+mas_a[length(mas_a)-1][0]+')';

  s2:=mas_a[length(mas_a)-1][2];

  end

  end;

  7:  begin

  b:=false;

  if length(mas_v)=0 then

  b:=true

  else

  begin

  b:=true;

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

  if mas_v[p1][1]=str then

  begin

  b:=false;

  s1:='('+'id,'+inttostr(p1+1)+')';

  s2:=mas_v[p1][2];

  end;

  end;

  if b then

  begin

  SetLength(mas_v, length(mas_v)+1);

  mas_v[length(mas_v)-1][0]:=inttostr(length(mas_v));

  mas_v[length(mas_v)-1][1]:=str;

  mas_v[length(mas_v)-1][2]:='real';

  s1:='('+'id,'+mas_v[length(mas_v)-1][0]+')';

  s2:=mas_v[length(mas_v)-1][2];

  end

  end;

  end;

  Form1.Memo2.Text:=Form1.Memo2.Text+s2+' ';

  Form1.Memo3.Text:=Form1.Memo3.Text+s1;

end;

//лексический  разбор

function Razbor(s:string):boolean;

var

  i, j,q:integer;

  res:string;

  str:string;

  chr:char;

  otvet:boolean;

begin

  setlength(LexTable,0);

  SetLength(mas_k,0);

  SetLength(mas_o,0);

  SetLength(mas_i,0);

  SetLength(mas_r,0);

  SetLength(mas_n,0);

  SetLength(mas_a,0);

  SetLength(mas_v,0);

  Form1.Memo2.Clear;

  otvet:=true;

  q:=0;

  i:=1;

  s:=LowerCase(s);

  j:=length(s);

  res:='';

  while i<=j do

  case q of

  0: case s[i] of

  'p':  begin  //public private protected published

  q:=1;

  res:=s[i];

  inc(i);

  end;

  'c':  begin  //class

  q:=20;

  res:=s[i];

  inc(i);

  end;

  'i':  begin  //int

  q:=50;

  res:=s[i];

  inc(i);

  end;

  'r':  begin  //real

  q:=54;

  res:=s[i];

  inc(i);

  end;

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

  '=':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,2);

  res:='';

  inc(i);

  end;

  '<':  begin

  q:=24;

  res:=s[i];

  inc(i);

  end;

  '>':  begin

  q:=25;

  res:=s[i];

  inc(i);

  end;

  ';':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,4);

  res:='';

  inc(i);

  end;

  '.':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,4);

  res:='';

  inc(i);

  end;

  ',':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,4);

  res:='';

  inc(i);

  end;

  ':':  begin

  q:=2005;

  res:=s[i];

  inc(i);

  end;

  '(':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,4);

  res:='';

  inc(i);

  end;

  ')':  begin

  q:=0;

  res:=s[i];

  AddToMas(res,4);

  res:='';

  inc(i);

  end;