procd.pas

编译原理-文法等价转换

unit Procd;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls;

type
  TDprod = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    HelpBtn: TBitBtn;
    Bevel1: TBevel;
    Edit1: TEdit;
    procedure OKBtnClick(Sender: TObject);
    function  anaysis:integer;
    function  find(s:string):integer;
    procedure addstring(s:string);
    procedure FormActivate(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  state:integer;
  leftstring:string;
  pressnum:integer;
  public
  addfuhao:array[1..20] of string;
  addnum:integer;
  mode:integer;
    { Public declarations }
  end;

var
  Dprod: TDprod;

implementation
  uses unit1;
{$R *.DFM}

function TDprod.anaysis:integer;
  var temp:string;
      ss:string;
      i:integer;
      res:integer;
      oldch:char;
      sh:boolean;
      j:integer;
  begin
     state:=0;
     addnum:=0;
     leftstring:='';
     ss:=edit1.text;
     sh:=false;
     if ss=''
       then
         begin
           anaysis:=1;(****产生式为空********)
           exit;
         end;
     i:=1;
     temp:='';
     oldch:='a';
     anaysis:=0;
     while i<=length(ss) do
       begin
         case ss[i] of
           '=':begin
                 if (state=0) and (oldch<>'\')
                   then
                     begin
                       if i=1
                         then
                           begin
                             anaysis:=6;
                             exit;
                           end;
                       res:=find(temp);
                       if res=0
                         then
                           begin
                             addstring(temp);
                             temp:='';
                           end;
                       if res=2
                         then
                           begin
                             leftstring:=temp;
                             anaysis:=2;  (*左部为终结符*)
                             exit;
                           end;
                       j:=form1.findindex(temp);
                       if (j>0) and (form1.ccss.ifhave(j))
                         then
                           begin
                             anaysis:=8; (*****有重复的左部*******)
                           end;
                       state:=1;
                       temp:='';
                       oldch:='=';
                     end
                   else
                     begin
                       temp:=temp+'=';
                       sh:=false;
                       oldch:='a';
                     end;
                 end;
            '|':begin
                  if oldch='\'
                    then
                      begin
                        temp:=temp+'|';
                        sh:=false;
                      end
                    else
                      begin
                        if state=0
                          then
                            begin
                              anaysis:=3;  (*左部存在 | 符号*)
                              exit;
                            end
                          else
                            begin
                              if (temp='')
                                then
                                  begin
                                    if sh
                                      then
                                        begin
                                          anaysis:=7;
                                          exit;
                                        end;
                                    sh:=true;
                                  end
                                else
                                  begin
                                    res:=find(temp);
                                    if res=0
                                      then
                                        begin
                                          addstring(temp);
                                        end;
                                    sh:=true;
                                    temp:='';
                                  end;
                               end;
                        oldch:='|';
                      end;
                end;
            ' ':begin
                  if state=0
                     then
                       begin
                         anaysis:=4;  (*左部存在不止一个符号*)
                         exit;
                       end
                      else
                        begin
                          if temp<>''
                            then
                              begin
                                res:=find(temp);
                                if res=0
                                   then
                                     begin
                                       addstring(temp);
                                     end;
                              end;
                           temp:='';
                        end;
                  oldch:=' ';
                end;
           '\': begin
                  if oldch='\'
                    then
                      begin
                         temp:=temp+'\';
                         sh:=false;
                         oldch:='a';
                      end
                    else oldch:='\';
                end;
         (***************************************)
         else  begin
                 sh:=false;
                 temp:=temp+ss[i];
                 oldch:=ss[i];
               end;
         end;
        i:=i+1;
       end;
        if state=0
          then
            begin
              anaysis:=5;
              exit;
            end;
        if (state=1) and (oldch='=')
          then
            begin
              anaysis:=5;
              exit;
            end;
         if temp<>''
           then
             begin
               if find(temp)=0
                 then
                   begin
                      addstring(temp);
                   end;
             end;
  end;
(*********************************************)
function TDprod.find(s:string):integer;
var i:integer;
begin
  i:=1;
  while (i<=form1.zjnum) and (s<>form1.zjfuhao[i].name) do
    begin
      i:=i+1;
    end;
  if i<=form1.zjnum
    then
      begin
        find:=2;
        exit;
      end;
  i:=1;
  while (i<=form1.fzjnum) and (s<>form1.fzjfuhao[i].name) do
    begin
      i:=i+1;
    end;
  if i<=form1.fzjnum
    then
      begin
        find:=1;
        exit;
      end;
   find:=0;
end;
procedure TDprod.addstring(s:string);
var i:integer;

begin
  i:=1;
  while (i<=addnum) and (s<>addfuhao[i]) do
    begin
      i:=i+1;
    end;
  if i>addnum
    then
      begin
        addfuhao[i]:=s;
        addnum:=addnum+1;
      end;
end;

(*********************************************)
procedure TDprod.OKBtnClick(Sender: TObject);
var i,j:integer;
    temp,temp1:string;
begin
  i:=anaysis;
  if (mode=1)and (i=8)
    then i:=10;
  edit1.setFocus;
  case i of
    1:application.messagebox('请输入产生式','错误!',mb_ok+MB_ICONSTOP);
    2:application.messagebox('产生式左部应为非终结符号','错误!',mb_ok+MB_ICONSTOP);
    3:application.messagebox('请不要在产生式左部输入''或''符号', '错误!',mb_ok+MB_ICONSTOP);
    4:application.messagebox('请不要在产生式左部输入两个或两个以上符号(即左部不应有空格)', '错误!',mb_ok+MB_ICONSTOP);
    5:application.messagebox('请输入产生式', '错误!',mb_ok+MB_ICONSTOP);
    6:application.messagebox('请在产生式左部输入符号', '错误!',mb_ok+MB_ICONSTOP);
    7:application.messagebox('请在两个''或''符号之间输入其他符号', '错误!',mb_ok+MB_ICONSTOP);
    8:application.messagebox('已有关于左部的产生式,请用修改合并之', '错误!',mb_ok+MB_ICONSTOP);
   else
     begin
       if  addnum>0
         then
           begin
             temp:='';
             j:=1;
             while j<=addnum do
               begin
                 temp:=temp+addfuhao[j];
                 temp:=temp+' ';
                 j:=j+1;
               end;
            temp1:='产生式存在未定义的非终结符号,是否添加'+temp+'到非终结符号列表';
            temp1:=temp1+#0;
            if application.messagebox(pchar(@temp1[1]), '警告!',mb_okcancel+MB_ICONSTOP)=IDOK
                then
                  begin
                     j:=1;
                     while j<=addnum do
                       begin
                         form1.addfzjfuhao(addfuhao[j]);
                         j:=j+1;
                       end;
                    ModalResult := mrOK;
                  end;

           end
         else
           begin
             ModalResult := mrOK;
           end;
     end;
   end;
end;
{procedure TDprod.anaysys:boolean;
begin
  state:=0;
  while

end; }

procedure TDprod.FormActivate(Sender: TObject);
begin
  edit1.setFocus;
  pressnum:=0;
end;

procedure TDprod.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((Shift = [ssctrl]) and (Key >= 48 ) and (key<=57))
    then
      begin
        pressnum:=pressnum*10+key-48;
      end;

end;

procedure TDprod.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i:integer;
begin
  if (shift<>[ssctrl]) and (pressnum<>0)
    then
      begin
        i:=1;
        while (i<=form1.zjnum) and (form1.zjfuhao[i].index<>pressnum) do
          begin
            i:=i+1;
          end;
         if i<=form1.zjnum
           then
             begin
               edit1.text:=edit1.text+form1.zjfuhao[i].name;
             end
           else
             begin
               i:=1;
               while (i<=form1.fzjnum) and (form1.fzjfuhao[i].index<>pressnum) do
                 begin
                   i:=i+1;
                 end;
                if i<=form1.fzjnum
                  then
                    begin
                      edit1.text:=edit1.text+form1.fzjfuhao[i].name;
                    end
             end;
        pressnum:=0;
      end;
end;

end.