unit1.~pa

编译原理-文法等价转换

        dprod.edit1.text:=stringGrid2.cells[1,h];
        dprod.mode:=1;
        cansave:=false;
        if dprod.ShowModal=mrok
          then begin
            ccss.exchange(h,dprod.edit1.text);
            stringGrid2.cells[1,h]:=dprod.edit1.text;
          end;
       end;
end;

procedure TForm1.New1Click(Sender: TObject);
begin
  deleteall;
  filename:='Project1';
  caption:='文法转换器-'+filename;
end;
procedure TForm1.deleteall;
var i:integer;
begin
  for i:=ccss.count downto 1 do
    begin
      ccss.delete(i);
    end;
  ccss.count:=0;
  fzjnum:=0;

  stringgrid1.rowcount:=2;
  stringgrid2.rowcount:=2;
  stringgrid3.rowcount:=3;
  stringgrid1.cells[0,1]:='';
  stringgrid1.cells[1,1]:='';
  stringgrid2.cells[0,1]:='';
  stringgrid2.cells[1,1]:='';
  zjnum:=2;
  zjfuhao[1].index:=0;
  zjfuhao[1].name:='$';
  zjfuhao[2].index:=300;
  zjfuhao[2].name:='ε';
  stringgrid3.cells[0,1]:='0';
  stringgrid3.cells[1,1]:='$';
  stringgrid3.cells[0,2]:='300';
  stringgrid3.cells[1,2]:='ε';
  edit1.text:='0';
 end;
procedure Tform1.saveas;
var f:file of string;
    oldname:string;
begin
  SaveDialog1.Filter := 'WF files (*.WF)|*.WF';
    if SaveDialog1.execute
      then
        begin
          oldname:=filename;
          filename:=SaveDialog1.filename;
          if not saveall(true)
            then
              begin
                filename:=oldname;
              end;
          caption:='文法转换器'+'-'+filename;
        end;
end;
function Tform1.saveall(w:boolean):boolean;
var f:textFile;
    i:integer;
    temp:string;
 begin
if fileexists(filename) and w
  then
    begin
      temp:='是否覆盖文件'+filename+'?'+#0;
        if application.Messagebox(pchar(@temp[1]), '警告!', mb_YESNO)=IDNO
           then
              begin
                saveall:=false;
                exit;   {!!!!!!!!!!!!!!!}
               end;
    end;
  AssignFile(F,FileName);
  {$i+}
    try
      rewrite(f);
    except
      application.Messagebox('文件打不开!', '中止', mb_Ok);
      saveall:=false;
      exit;
    end;
     rewrite(f);
     for i:=1 to zjnum do
        begin
          writeln(f,stringgrid3.cells[0,i]);
          writeln(f,stringgrid3.cells[1,i]);
        end;
     writeln(f,'[文法]');
     for i:=1 to ccss.count do
       begin
         writeln(f,stringgrid2.cells[1,i]);
       end;
     saveall:=true;
     CloseFile(F);
end;
function  Tform1.savenew:boolean;
var f:textFile;
    i:integer;
    temp:string;
    filename:string;
begin
SaveDialog1.Filter := 'WF files (*.WF)|*.WF';
if SaveDialog1.execute
  then
    begin
      filename:=SaveDialog1.filename;
    end
  else   exit;
if fileexists(filename)
  then
    begin
      temp:='是否覆盖文件'+filename+'?'+#0;
        if application.Messagebox(pchar(@temp[1]), '警告!', mb_YESNO)=IDNO
           then
              begin
                savenew:=false;
                exit;   {!!!!!!!!!!!!!!!}
               end;
    end;
  AssignFile(F,FileName);
  {$i+}
    try
      rewrite(f);
    except
      application.Messagebox('文件打不开!', '中止', mb_Ok);
      savenew:=false;
      exit;
    end;
     rewrite(f);
     for i:=1 to zjnum do
        begin
          writeln(f,stringgrid11.cells[0,i]);
          writeln(f,stringgrid11.cells[1,i]);
        end;
     writeln(f,'[文法]');
     for i:=1 to ccssnew.count do
       begin
         writeln(f,stringgrid12.cells[1,i]);
       end;
     savenew:=true;
     CloseFile(F);
end;
procedure TForm1.Save1Click(Sender: TObject);
begin
  if (filename='Project1') or ( ExtractFileExt(FileName)<>'WF')
    then saveas
    else saveall(false);
end;


procedure TForm1.Saveas1Click(Sender: TObject);
begin
  saveas;
end;

procedure TForm1.Open1Click(Sender: TObject);
var
  i,j,k:integer;
  res:boolean;

begin
  OpenDialog1.Filter := 'WF files (*.WF)|*.WF';
  zjnum:=0;
  fzjnum:=0;
  for i:=ccss.count downto 1 do
    begin
      ccss.delete(i);
    end;
  stringgrid1.rowcount:=2;
  stringgrid2.rowcount:=2;
  stringgrid3.rowcount:=3;

  stringgrid1.cells[0,1]:='';
  stringgrid1.cells[1,1]:='';

  stringgrid2.cells[0,1]:='';
  stringgrid2.cells[1,1]:='';

  if OpenDialog1.execute
    then
      begin
        filename:=OpenDialog1.filename;
        caption:='文法转换器'+'-'+filename;
        res:=openf;
        k:=ccss.count;
        ccss.count:=0;
        for i:=1 to k do
          begin
            Dprod.edit1.text:=stringGrid2.cells[1,i];
            Dprod.anaysis;
            if Dprod.addnum>0
              then
                begin
                  j:=1;
                  while j<=Dprod.addnum do
                    begin
                      addfzjfuhao(Dprod.addfuhao[j]);
                      j:=j+1;
                    end;
                end;
             ccss.add(dprod.edit1.text);
           end;
        if not res
          then
            begin
              application.Messagebox('不正确打开文件!', '警告', mb_Ok);
            end;
      end;
end;
function Tform1.openf:boolean;
var f:textfile;
    temp,temp1:String;
    ifend:boolean;
begin
  if fileexists(filename)
     then
       begin
         AssignFile(F,FileName);
         try
           reset(f);
         except
           application.Messagebox('文件打不开!', '中止', mb_Ok);
           openf:=false;
           exit;
         end;
         try
           ifend:=eoln(f);
         except
           application.Messagebox('文件格式不对!', '中止', mb_Ok);
           closefile(f);
           openf:=false;
           exit;
         end;
         while not ifend and (temp<>'[文法]') do
           begin
             try
               readln(f,temp);
             except
               application.Messagebox('文件格式不对!', '中止', mb_Ok);
               closefile(f);
               openf:=false;
               exit;
             end;
             if temp<>'[文法]'
               then
                 begin
                   try
                     readln(f,temp1);
                   except
                     application.Messagebox('文件格式不对!', '中止', mb_Ok);
                     closefile(f);
                     openf:=false;
                     exit;
                   end;
                   try
                     zjfuhao[zjnum+1].index:=strtoint(temp);
                   except
                     application.Messagebox('文件格式不对!', '中止', mb_Ok);
                     closefile(f);
                     openf:=false;
                     exit;
                   end;
                   zjnum:=zjnum+1;
                   zjfuhao[zjnum].name:=temp1;
                   stringgrid3.rowcount:=zjnum+1;
                   stringgrid3.cells[0,zjnum]:=temp;
                   stringgrid3.cells[1,zjnum]:=temp1;
                 end;
                 ifend:=eoln(f);
              end;
             while not eoln(f) do
               begin
                 try
                   readln(f,temp);
                 except
                   application.Messagebox('文件格式不对!', '中止', mb_Ok);
                   closefile(f);
                   openf:=false;
                   exit;
                 end;
                 ccss.count:=ccss.count+1;
                 stringgrid2.rowcount:=ccss.count+1;
                 stringgrid2.cells[0,ccss.count]:=inttostr(ccss.count);
                 stringgrid2.cells[1,ccss.count]:=temp;
              end;
       closefile(f);
       openf:=true;
     end
   else
     begin
       application.Messagebox('文件不存在!', '中止', mb_Ok);
       openf:=false;
     end;
end;
(*************************************)
procedure Tform1.savefxas;
var f:file of string;
    oldname:string;
begin
  SaveDialog1.Filter := 'LL1 files (*.LL1)|*.LL1';
    if SaveDialog1.execute
      then
        begin
          oldname:=filename;
          filename:=SaveDialog1.filename;
          if not savefxall(true)
            then
              begin
                filename:=oldname;
              end;
          caption:='文法转换器'+'-'+filename;
        end;
end;
function Tform1.savefxall(w:boolean):boolean;
var f:textFile;
    i:integer;
    temp:string;
    temp1:string;
 begin
if fileexists(filename) and w
  then
    begin
      temp:='是否覆盖文件'+filename+'?'+#0;
        if application.Messagebox(pchar(@temp[1]), '警告!', mb_YESNO)=IDNO
           then
              begin
                savefxall:=false;
                exit;   {!!!!!!!!!!!!!!!}
               end;
    end;
  AssignFile(F,FileName);
  {$i+}
    try
      rewrite(f);
    except
      application.Messagebox('文件打不开!', '中止', mb_Ok);
      savefxall:=false;
      exit;
    end;
     rewrite(f);
     writeln(f,'[终结符号]');
     for i:=1 to zjnum do
        begin
          write(f,stringgrid3.cells[0,i]);
          write(f,' ');
          writeln(f,stringgrid3.cells[1,i]);
        end;
     writeln(f,'[LL1文法]');
     for i:=1 to ccss.count do
       begin
         writeln(f,stringgrid2.cells[1,i]);
       end;
     writeln(f,'[LL1分析表]');
     for i:=1 to ccss.count do
       begin
         ccss.cans[i].setsi(1);
         repeat
           temp:='';
           ccss.cans[i].enternow.setsi;
           while not (ccss.cans[i].enternow.next) do
             begin
               temp1:=findname(ccss.cans[i].enternow.get.index);
               temp:=temp+temp1+' ';
             end;
           writeln(f,temp);
         until ccss.cans[i].next;


         temp:='';
         ccss.cans[i].synch.setsi;
         while not (ccss.cans[i].synch.next) do
           begin
             temp1:=findname(ccss.cans[i].synch.get.index);
             temp:=temp+temp1+' ';
           end;
         writeln(f,temp);
       end;
     writeln(f,'[First Fellow 集合]');
     savefxall:=true;
     CloseFile(F);
end;



procedure TForm1.BitBtn3Click(Sender: TObject);
var temp:string;
begin
  temp:=fzjhave;
  if temp<>''
    then
      begin
        temp:='存在没有产生式的非终结符号'+temp+#0;
        application.messagebox(pchar(@temp[1]),'中止', mb_Ok);
        exit;
      end;

  askstart.edit1.text:='';
  if askstart.ShowModal=mrok
    then
      begin
        startnum:=strtoint(askstart.edit1.text);
        waitd.show;
        waitd.BiGauge1.value:=0;
        waitd.update;