unit1.~pa

编译原理-文法等价转换

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, StdCtrls, TabNotBk, Buttons,
  procd,dfuha, Menus,Daskstar,DWAIT2,aboutd,structk, VBXCtrl, Switch,
  ExtCtrls, Mytdemo;

type
  TForm1 = class(TForm)
    TabbedNotebook1: TTabbedNotebook;
    GroupBox1: TGroupBox;
    StringGrid1: TStringGrid;
    GroupBox2: TGroupBox;
    StringGrid2: TStringGrid;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn4: TBitBtn;
    GroupBox3: TGroupBox;
    StringGrid3: TStringGrid;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    New1: TMenuItem;
    Exit1: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Help1: TMenuItem;
    About1: TMenuItem;
    GroupBox4: TGroupBox;
    StringGrid4: TStringGrid;
    GroupBox5: TGroupBox;
    StringGrid5: TStringGrid;
    GroupBox6: TGroupBox;
    StringGrid6: TStringGrid;
    GroupBox7: TGroupBox;
    GroupBox8: TGroupBox;
    GroupBox9: TGroupBox;
    StringGrid7: TStringGrid;
    StringGrid8: TStringGrid;
    StringGrid9: TStringGrid;
    GroupBox10: TGroupBox;
    GroupBox11: TGroupBox;
    StringGrid10: TStringGrid;
    StringGrid11: TStringGrid;
    GroupBox12: TGroupBox;
    StringGrid12: TStringGrid;
    Save2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure addfzjfuhao(s:string);         (*添加非终结符号*)
    procedure adddisplay(s:string);          (*添加产生式到显示*)
    procedure deletedisplay(d:integer);      (*删除产生式显示*)
    procedure BitBtn2Click(Sender: TObject);
    function  findzjfuhao(f:integer):boolean;
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure deleteall;                      (*初始化所有结构*)
    procedure Save1Click(Sender: TObject);
    procedure saveas;                         (*改存语法*)
    function  saveall(w:boolean):boolean;     (*存语法,成功返回TRUE,否则返回FALSE*)
    function  savenew:boolean;                (*存新语法,成功返回TRUE,否则返回FALSE*)
    procedure Saveas1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    function  openf:boolean;                  (*打开语法,成功返回TRUE,否则返回FALSE*)
    procedure BitBtn3Click(Sender: TObject);
    (****************************************)
    function fzjhave:string;
    procedure prepare;
    procedure compute;
    procedure setview;
    procedure seteview;
    procedure setnewview;
    procedure setnewview1;
   (*******************读写分析表**************)
    procedure savefxas;                       (*改存分析表*)
    function  savefxall(w:boolean):boolean;   (*存分析表,成功返回TRUE,否则返回FALSE*)
    procedure Save2Click(Sender: TObject);
    procedure Saveas2Click(Sender: TObject);
    function openfxf:boolean;                 (*打开分析表,成功返回TRUE,否则返回FALSE*)
    procedure Open2Click(Sender: TObject);
    (********************************************)
    procedure About1Click(Sender: TObject);
    function  findindex(name:string):integer;
    function  findname(index:integer):string;
    function  findnewname(index:integer):string;
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    zjfuhao:array[1..100]of rword;        (*终结符号数组,最多为100个*)
    zjnum:integer;                        (*终结符号个数*)
    fzjfuhao:array[1..200] of rword;      (*非终结符号数组,最多为200个*)
    fzjnum:integer;                       (*非终结符号个数*)
    fzjfuhaonew:array[1..200] of  rword;  (*新非终结符号数组,最多为200个*)
    fzjnumnew:integer;                    (*新非终结符号个数*)

    fzjfuhaonew1:array[1..200] of  rword;  (*新非终结符号数组,最多为200个*)
    fzjnumnew1:integer;                    (*新非终结符号个数*)

    ccss:cansenjh;                        (*产生式数组对象*)
    ccss300:cansenjh;                     (*除去'空'的产生式数组对象*)
    ccssnew:cansenjh;                     (*新产生式数组对象*)
    ccssnew1:cansenjh;                     (*新产生式数组对象*)

    startnum:integer;                     (*文法开始符号号码*)
    filename:string;                      (*当前操作文件*)
    cansave:boolean;                      (*是否可以存盘*)
    emtry:fensensi;                       (*可能为空集合*)
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
  (*****************************************)
function  TForm1.findindex(name:string):integer;
  var i:integer;
  begin
    i:=1;
    while (i<=fzjnum)and (fzjfuhao[i].name<>name)  do
      i:=i+1;
    if i<=fzjnum
      then
        begin
          findindex:=fzjfuhao[i].index;
          exit;
        end;
    i:=1;
     while (i<=zjnum)and (zjfuhao[i].name<>name)  do
      i:=i+1;
    if i<=zjnum
      then
        begin
          findindex:=zjfuhao[i].index;
        end
      else
        begin
          findindex:=-1;
        end;
  end;
procedure TForm1.Button1Click(Sender: TObject);
 var i:integer;
begin
  stringgrid2.cols[0].add('asad');
  stringgrid2.cols[0].add('asad');
  stringgrid2.cols[1].add('asad');
  stringgrid2.cols[1].add('asad');
  stringgrid2.rowCount:=4;
  stringgrid2.ColCount:=4;
  stringgrid2.rows[0].add('asad');
  stringgrid2.rows[0].add('asad');
  stringgrid2.rows[1].add('asad');
  stringgrid2.rows[1].add('asad');
  for i:=2 to 200 do
    begin
      zjfuhao[i].index:=0;
      zjfuhao[i].name:='';
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  cansave:=false;
  ccss:=cansenjh.init;
  ccssnew:=cansenjh.init;
  ccssnew1:=cansenjh.init;
  ccss300:=cansenjh.init;
  emtry:=fensensi.init2(0);

  fzjnumnew:=0;
  fzjnumnew1:=0;

  filename:='Project1';
  stringgrid1.cols[0].add('号码');
  stringgrid1.cols[1].add('非终结符号');
  edit1.text:='0';

  stringgrid2.cols[0].add('号码');
  stringgrid2.cols[1].add('产生式');

  stringgrid3.cols[0].add('号码');
  stringgrid3.cols[1].add('终结符号');

  stringgrid3.cols[0].add('0');
  stringgrid3.cols[1].add('$');

  stringgrid3.cols[0].add('300');
  stringgrid3.cols[1].add('ε');

  for i:=2 to 200 do
    begin
      zjfuhao[i].index:=0;
      zjfuhao[i].name:='';
    end;
  zjfuhao[1].index:=0;
  zjfuhao[1].name:='$';
  zjfuhao[2].index:=300;
  zjfuhao[2].name:='ε';
  zjnum:=2;
  fzjnum:=0;
  edit1.text:='0';
  caption:= caption+'-'+filename;
  end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  cansave:=false;
  dprod.mode:=0;
  dprod.edit1.text:='';
  if dprod.ShowModal=mrok
    then begin

      ccss.add(dprod.edit1.text);
      adddisplay(dprod.edit1.text);
      {add(dprod.edit1.text);}
    end;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
  if fuhaod.showModal=mrOK
    then begin
      cansave:=false;
      if zjnum>0
        then stringGrid3.RowCount:=stringGrid3.RowCount+1;

      stringgrid3.cells[0,stringGrid3.RowCount-1]:=fuhaod.edit1.text;
      stringgrid3.cells[1,stringGrid3.RowCount-1]:=fuhaod.edit2.text;

      zjnum:=zjnum+1;
      zjfuhao[zjnum].index:=strtoint(fuhaod.edit1.text);
      zjfuhao[zjnum].name:=fuhaod.edit2.text;
      if zjnum=1
        then
          begin
            stringgrid3.fixedRows:=1;
          end;
    end;
end;
procedure TForm1.addfzjfuhao(s:string);
begin
  fzjnum:=fzjnum+1;
  fzjfuhao[fzjnum].name:=s;
  fzjfuhao[fzjnum].index:=fzjnum+300;
  if (fzjnum>1)or (stringgrid1.rowCount=1)
    then  stringGrid1.RowCount:=stringGrid1.RowCount+1;
  stringgrid1.cells[0,stringGrid1.RowCount-1]:=inttostr(fzjnum+300);
  stringgrid1.cells[1,stringGrid1.RowCount-1]:=s;
  edit1.text:=inttostr(fzjnum);
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
var h,i:integer;
begin
  if zjnum>2
    then begin
       h:=stringgrid3.row;
       if h<=2
         then
           begin
               application.messagebox('不允许这个终结符号被删除！','错误!',mb_ok+MB_ICONSTOP);
               exit;
           end;
       if findzjfuhao(strtoint(stringgrid3.cells[0,h]))
         then
           begin
             application.messagebox('产生式含有这个终结符号，所以不应删除！','错误!',mb_ok+MB_ICONSTOP);
           end
         else
           begin
             cansave:=false;
             for i:=h to zjnum-1 do
               begin
                 zjfuhao[i].index:=zjfuhao[i+1].index;
                 zjfuhao[i].name:=zjfuhao[i+1].name;
                 stringgrid3.cells[0,i]:=stringgrid3.cells[0,i+1];
                 stringgrid3.cells[1,i]:=stringgrid3.cells[1,i+1];
               end;
            zjnum:=zjnum-1;
            if zjnum>0
              then stringgrid3.rowCount:=stringgrid3.rowCount-1
              else
                begin
                  stringgrid3.cells[0,1]:='';
                  stringgrid3.cells[1,1]:='';
                end
           end;
    end;
 end;
procedure Tform1.adddisplay(s:string);
  begin
    if (ccss.count>1) or (stringGrid2.RowCount=1)
      then  stringGrid2.RowCount:=stringGrid2.RowCount+1;
    stringGrid2.cells[0,ccss.count]:=inttostr(ccss.count);
    stringGrid2.cells[1,ccss.count]:=s;
  end;
procedure Tform1.deletedisplay(d:integer);
  var i:integer;
  begin
    if d<ccss.count
      then
        begin
          for i:=d to ccss.count-1 do
            begin
              stringGrid2.cells[1,i]:= stringGrid2.cells[1,i+1];
            end;
          stringGrid2.rowcount:=stringGrid2.RowCount-1;
        end
      else
        begin
          if ccss.count>1
            then  stringGrid2.rowcount:=stringGrid2.RowCount-1;
        end;
  end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var h,i:integer;
begin
if ccss.count>0
    then begin
       cansave:=false;
       h:=stringgrid2.row;
       ccss.delete(h);
       for i:=h to ccss.count do
         begin
           stringgrid2.cells[1,i]:=stringgrid2.cells[1,i+1];
         end;
      if stringgrid2.rowCount>2
        then  stringgrid2.rowCount:=stringgrid2.rowCount-1
        else  stringgrid2.cells[1,1]:='';
    end;
end;
function Tform1.findzjfuhao(f:integer):boolean;
var res:boolean;
    i:integer;
begin
   res:=false;
   i:=1;
   while (not (res)) and (i<=ccss.count) do
     begin
       ccss.cans[i].setsi(1);
       repeat
         repeat
           if ccss.cans[i].get.index=f
             then res:=true;
         until res or ccss.cans[i].sunnext;
       until res or ccss.cans[i].next;
       i:=i+1;
     end;
    findzjfuhao:=res;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var i,j,k:integer;
begin
  cansave:=false;
  fzjnum:=0;
  stringGrid1.RowCount:=2;
  stringGrid1.cells[1,1]:='';
  k:=ccss.count;
  if ccss.count>0
    then
      begin
        for i:=ccss.count downto 1 do
          ccss.delete(i);
      end;
  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;
 end;

procedure TForm1.BitBtn7Click(Sender: TObject);
var h:integer;
begin
  h:=stringgrid2.row;
  if (ccss.count>0)and (h>0)
    then
      begin