Сети ЭВМ и телекоммуникации

form1.StringGrid_UprTabl.Cells[6,0]:='P';

form1.StringGrid_UprTabl.Cells[7,0]:='(';

form1.StringGrid_UprTabl.Cells[8,0]:=')';

form1.StringGrid_UprTabl.Cells[9,0]:='+';

form1.StringGrid_UprTabl.Cells[10,0]:='*';

form1.StringGrid_UprTabl.Cells[11,0]:=';';

form1.StringGrid_UprTabl.Cells[12,0]:=':=';

form1.StringGrid_UprTabl.Cells[13,0]:=':';

form1.StringGrid_UprTabl.Cells[14,0]:=',';

form1.StringGrid_UprTabl.Cells[15,0]:='INTEGER';

form1.StringGrid_UprTabl.Cells[16,0]:='DOUBLE';

form1.StringGrid_UprTabl.Cells[17,0]:='e';

form1.StringGrid_UprTabl.Cells[18,0]:='';

form1.StringGrid_UprTabl.Cells[0,0]:='ñèìâîëû';

end;

 

 

Function GetString(s:string;var state:integer):string;

var i:char;max:integer;

begin

if s='' then

  begin

  GetString:='';state:=1;

  exit;

  end;

if s[1]=' ' then

  begin

  GetString:=' ';state:=2;

  exit;

  end;

if length(s)>1 then

if copy(s,1,2)=':=' then

  begin

  GetString:=':=';state:=3;

  exit;

  end;

if length(s)>1 then

if (copy(s,1,2)='<>')or(copy(s,1,2)='<=')or(copy(s,1,2)='>=') then

  begin

  GetString:=copy(s,1,2);state:=4;

  exit;

  end;

if (s[1]='(')or(s[1]=')') then

  begin

  GetString:=s[1];state:=8;

  exit;

  end;

if (s[1]='<')or(s[1]='>') then

  begin

  GetString:=s[1];state:=4;

  exit;

  end;

if (s[1]='/')or(s[1]='*')or(s[1]='-')or(s[1]='+')or(s[1]=';') or(s[1]=',')or(s[1]=':')or(s[1]=',')then

  begin

  GetString:=s[1];state:=5;

  exit;

  end;

 

if length(s)>1 then

if copy(s,1,2)='IF' then

  begin

  GetString:='IF';state:=9;

  exit;

  end;

if length(s)>3 then

if copy(s,1,4)='THEN' then

  begin

  GetString:='THEN';state:=9;

  exit;

  end;

  if length(s)>3 then

if copy(s,1,4)='ELSE' then

  begin

  GetString:='ELSE';state:=9;

  exit;

  end;

   if length(s)>2 then

  if copy(s,1,3)='VAR' then

  begin

  GetString:='VAR';state:=9;

  exit;

  end;

     if length(s)>6 then

  if copy(s,1,7)='INTEGER' then

  begin

  GetString:='INTEGER';state:=9;

  exit;

  end;

  if length(s)>5 then

  if copy(s,1,6)='DOUBLE' then

  begin

  GetString:='DOUBLE';state:=9;

  exit;

  end;

 

   if ((s[1]>='A')and(s[1]<='Z')) then

  begin

  max:=1000;

  for i:=#0 to #255 do

    begin

    if not(((i>='A')and(i<='Z'))or((i>='0')and(i<='9'))) then

      if (pos(i,s)>0)and(pos(i,s)<max) then max:=pos(i,s);

    end;

  if max=1000 then max:=length(s);

  GetString:=copy(s,1,max-1);state:=6;

  exit;

  end;

 

 

if (s[2]='.') then

  begin

  max:=1000;

  for i:=#0 to #255 do

    begin

    if not(((i>='0')and(i<='9'))or((i='.'))) then

      if (pos(i,s)>0)and(pos(i,s)<max) then max:=pos(i,s) ;

    end;

  if max=1000 then max:=length(s);

  GetString:=copy(s,1,max-1);state:=10;

  exit;

  end;

 

 

  if (s[1]='0')or(s[1]='1')or(s[1]='2')or(s[1]='3')or(s[1]='4')or(s[1]='5')or(s[1]='6')or(s[1]='7')or(s[1]='8')or(s[1]='9') then

  begin

  GetString:=s[1];state:=7;

  exit;

  end;

 

 

 

 

state:=0;

GetString:='error';

end;

 

 

 

 

procedure TForm1.BitBtn1Click(Sender: TObject);

var

s,s1:string;

i,state:integer;

begin

list_cur:=0;

stringgrid1.RowCount:=2;

for i:=0 to memo1.Lines.Count do

  begin

  s:=' ';

  s1:=memo1.Lines[i];

  while (s<>'')and(s<>'error') do

    begin

    s:=GetString(UpperCase(s1),state);

    if (length(s)<=length(s1))and(length(s)>0) then

    begin

      delete(s1,1,length(s));

      if (s<>' ')and(s<>'error') then

        begin

        stringgrid1.Cols[0][stringgrid1.RowCount-1]:=typ[state];

        stringgrid1.Cols[1][stringgrid1.RowCount-1]:=s;

        stringgrid1.RowCount:=stringgrid1.RowCount+1;

        inc(list_cur);

        list[list_cur]:=s;

        listZ[list_cur]:=state;

        end;

      end;

    if s='error' then messagebox(0,'error',0,0);

    end;

  end;

end;

  Function Find(x,y:string):string;

var i,j,bi,bj:integer;

begin

  form1.AT.RecNo:=1;

  bi:=100;bj:=100;

  for i:=1 to form1.at.FieldCount-1 do

    if x=form1.AT.Fields.Fields[i].FieldName then bi:=i;

  for j:=1 to form1.at.RecordCount do begin

    if j>1 then form1.AT.RecNo:=form1.AT.RecNo+1;

    if y=form1.at.Fields.Fields[0].AsString then bj:=j;

    end;

  form1.AT.RecNo:=bj;

  if (bi<100)and(bj<100) then

    Find:=form1.at.Fields.Fields[bi].AsString

    else Find:='Error';

    globalX:=bi;

    GlobalY:=bj;

end;

 

 

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

stringgrid1.Cols[0][0]:='Type';

stringgrid1.Cols[1][0]:='Value';

LoadTiGrid();

 

end;

procedure TForm1.Button2Click(Sender: TObject);

var

  st:string;

  Rez,inP:string;

  stek:array [1..100] of string;

  stek_cur,i,j,k,m{,s_c}:integer;

  bExt,bDel,bRez:boolean;

  cur,cur1,cu,cu1:TTreeNode;

     m_i:integer;

     s_temp_stek,s_temp_str,s_temp_rules:string;

     ruls:integer;

begin

s_temp_rules:='';

  BitBtn1Click(Sender);

  bRez:=True;

  tv.Items.Clear;

  tv.Items.Add(nil,'Äåðåâî  âûâîäà');

  cur:=tv.Items.Item[0];

  cu:=tvv.Items.Item[0];

 

  Stek[1]:='$';

  Stek[2]:='START';

  Stek_cur:=2;

 

  inc(list_cur);

  list[list_cur]:='e';

  i:=1;

  bExt:=false;

  while not(bExt) do begin

     case listz[i] of

        4:inP:='ZN';

        6,7,10:inP:='P';

         5:begin

        if List[i]=';' then inp:=';';

        if List[i]=',' then inp:=',';

        if List[i]=':' then inp:=':';

         if (List[i]='+')or(List[i]='-') then inp:='+';

          if (List[i]='/')or(List[i]='*') then inp:='*';

          end;

        else inP:=List[i];

        end;

 

     Rez:= Find(inP,Stek[stek_cur]);  //s_temp_stek,s_temp_str

      //////////////////////////////////////

      s_temp_stek:='';

      s_temp_str:='';

       for m_i:=1 to stek_cur do s_temp_stek:=s_temp_stek+Stek[m_i];

       for m_i:=i to list_cur-1 do s_temp_str:=s_temp_str+list[m_i];

 

        //form1.Memo2.Lines.Add(s_temp_str+'  -  '+s_temp_stek+'    -    '+inP);// íàéäåííûé ýëåìåíò  inP

        //form1.Memo2.Lines.Add(s_temp_str+'  -  '+s_temp_stek+'    -    '+inttostr(listz[stek_cur]));

      //////////////////////////////////////////

     if (Rez='Error')or(Rez='') then begin

              bExt:=True;

              bRez:=False;

              MessageBox(0,'Îøèáêà àíàëèçà òåêñòà','',0);

              end;

     if (Rez='DOPUSK') then begin

              bExt:=True;

              bRez:=True;

              form1.Memo2.Lines.Add('['+s_temp_str+'e'+','+s_temp_stek+','+ s_temp_rules+']');

             // MessageBox(0,'Òåêñò ïðîàíàëèçèðîâàí','',0);

              end;

     if (Rez='VYBROS') then begin

              cur.Text:=list[i];

              inc(i);

              dec(stek_cur);

              cur1:=cur.GetNext;

              cur:=cur1;

             form1.Memo2.Lines.Add('['+s_temp_str+','+s_temp_stek+','+ s_temp_rules+']');

              end

      else if not(bExt) then begin

 

 

              dec(stek_cur);

              k:=2;

              for j:=1 to length(rez) do

                if rez[j]=' ' then k:=k+1;

 

              m:=stek_cur;

              if Rez[1]<>'e' then begin

 

                 if  (globaly = 18) then globaly:=7;

                 if  (globaly = 19) then globaly:=8;

 

                s_temp_rules:=s_temp_rules+' '+inttostr(globaly);

 

                while pos(' ',rez)>0 do begin

                  inc(stek_cur);

                  Stek[k+m+m-stek_cur]:=copy(rez,1,pos(' ',rez)-1);

                  delete(rez,1,pos(' ',rez));

                  end;

                inc(stek_cur);

                Stek[{stek_cur}m+1]:=rez;

              for j:=stek_cur downto m+1 do

                 cur1:=tv.Items.AddChild(cur,Stek[j]);

              cur:=cur1.Parent.getFirstChild;

              end

              else begin

                tv.Items.AddChild(cur,'e');

                cur:=cur.GetNext.GetNext;

 

                end;

              end;

    end;

//if bRez then BuildSintaxTree;

end;

 

procedure TForm1.RecBuildTree(T: TTreeNode; i :integer);

var

   j :integer;

begin

     if T.Count=0 then

     begin

       if T.Text = 'e' then

         Exit;

       if T.Text = ')' then

         Exit;

       if T.Text = '(' then

         Exit;

      if T.Text = ';' then

         Exit;

      if T.Text = ',' then

         Exit;

     if T.Text = ':' then

         Exit;

 

   if T.Text = 'VAR' then

         Exit;

 

   if T.Text = 'INTEGER' then

         Exit;

 

   if T.Text = 'DOUBLE' then

         Exit;

 

 

   if T.Text = 'THEN' then

         Exit;

 

   if T.Text = 'ELSE' then

         Exit;

 

       Inc(StrCount);

       Pri[StrCount]:=i;

       Str[StrCount]:=T.Text;

     end

     else

       for j:=T.Count-1 downto 0 do

         RecBuildTree(T.Item[j], i+1);

end;

 

procedure TForm1.BuildSintaxTree;

var i: integer;

    T: TTreeNode;

begin

     StrCount:=0;

     RecBuildTree(TV.TopItem, 0);

     for i:= 1 to StrCount do

      if (Str[i]<>'+')and(Str[i]<>'*')and(Str[i]<>'-')and(Str[i]<>'/')and(Str[i]<>'IF')and(Str[i][1]<>'>')and(Str[i][1]<>'<') then Pri[i]:=0;

     TVV.Items.Clear;

     if StrCount = 1 then TVV.Items.AddChild(nil,str[1])

     else

     begin

       T:= nil;

       SintaxTree(T,1,StrCount);

     end;

end;

 

procedure TForm1.SintaxTree(T: TTreenode; l, r: integer);

var i, min,m,mmin,ii,jj: integer;

    T1,T2: TTreeNode;

begin

  if r-l < 2 then

   begin

     T.Text:=str[l];

   end

   else

   begin

     min:=maxInt;

     for i:= l to r do

      if (pri[i] <= min)and(pri[i]<>0) then begin

        min:= pri[i];

        m:=i;

        end;

     i:=m;

     if T = nil then

     begin

       T1:=TVV.Items.AddChild(T,str[i]);

       TVV.Items.AddChild(T1,'');

       TVV.Items.AddChild(T1,'');

       T:= T1;

     end

     else

     begin

       T.Text:=str[i];

       TVV.Items.AddChild(T,'');

       TVV.Items.AddChild(T,'');

     end;

     if T.Text<>'IF'  then begin

       if T.Text<>':=' then begin

        SintaxTree(T.Item[1],l,i-1);

        SintaxTree(T.Item[0],i+1,r);

        end else begin

        SintaxTree(T.Item[0],i+1,r);

        mmin:=0;

        for ii:=l to i-1 do

          if str[ii]=':=' then mmin:=ii;

        if mmin>0 then begin

          SintaxTree(T.Item[1],mmin+2,i-1);

          T2:=TVV.Items.AddChild(T.Parent,'');

          SintaxTree(T2,l,mmin+1);

          end

          else SintaxTree(T.Item[1],l,i-1);

        end;

     end else begin

        jj:=1;

        while(pri[jj]>0)or(pri[jj+1]>0) do inc(jj);

        SintaxTree(T.Item[0],l,{l+2}jj);

        SintaxTree(T.Item[1],{l+3}jj+1,r-1);

 

     end;

 

      end;

   end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

if OpenDialog1.Execute then memo1.Lines.LoadFromFile(OpenDialog1.FileName);

end;

 

 

 

end.

7. Результаты работы программы

 

 

 

 

 

 
8. Список литературы

 

1. Иванченко А.Н., Гавриков М.М., Гринченков Д.В. Теоретические основы разработки компиляторов. Учеб. пос. – Новочеркасск: ЮРГТУ, 2006.