structk.~pa

编译原理-文法等价转换

unit structk;
(*注意本单元与其它struct单元不同*)
interface
uses SysUtils;
  type
  cansenjh=class;
  rword=record
    index:integer;
    name:string[30];
    res:boolean;
   end;
  sword=record
    index:integer;
    res:boolean;
  end;
  action=record        (*动作记录*)
      nextfuhao:integer; (*下一个符号,-1为未处理*)
      act:integer;       (*动作,-1为规约,非-1为转移去向,-2为空白,-3为出错*)
   end;
  pointrec=class
      constructor init(sp:pointer);
      function   getpoint:pointer;
      destructor  done;
      function  ifequal(sp:pointer):boolean;
    public
      p:pointer;
      link:pointrec;
    end;

  Mfuhao=class       (*基本符号*)
      Constructor init(nindex:integer);
      procedure   setflag(f:boolean);   (*将res赋值*)
      Destructor  done;
    public
      index:integer;
     { name:string;}
      res:boolean;      (*表示从产生式是否可看见这个符号,即它之前的符号都可退出'空'*)
      link:Mfuhao;
  end;

  fensensi=class             (*单产生式对象(不含有或符号),或集合对象*)
    Constructor init(cansi:string);   (*将此对象初始化为单产生式对象(不含有或符号),cansi为产生式符号串*)
    Constructor init2(nindex:integer); (*将此对象初始化为集合对象,为了统一处理,即防止wordlist为空,加入此对象的左边符号*)
    Constructor init3(p:fensensi);     (*复制*)
    COnstructor init4(p:fensensi;i:integer);(*复制,i为演码*)
    Destructor  done;
    procedure setsi;virtual;          (*将指针now移向产生式右边第一个符号*)
    function get:sword;virtual;       (*取出now所指向的符号*)

    function next:boolean; virtual;   (*将now指向产生式中下一个符号,若已是最后符号,则返回TRUE,否则返回FALSE*)
    function pre:boolean;  virtual;   (*将now指向产生式中上一个符号,若已是第一个符号,则返回TRUE,否则返回FALSE*)
    function ifeof:boolean;virtual;   (*判断是否为产生式最后符号,是则返回TRUE,否则返回FALSE*)
    procedure setflag(f:boolean); virtual;    (*将now指向的节点res赋值*)
    function add(index:integer):boolean;virtual;(*针对集合型对象,加入一个符号,若已有此符号则返回FALSE,否则返回TRUE*)
    procedure add2(p:mfuhao);                 (*在产生式后加符号串*)
    function  ifhave(index:integer):boolean; virtual;(*针对集合型对象,判断是否有某个符号,有则返回TRUE,否则返回FALSE*)
    procedure clear;           virtual;       (*针对单产生式对象,将这个对象清空*)
    procedure emtry;           virtual;       (*针对集合型对象,将这个对象清空,但留第一个符号*)

    function getcanssi:string; virtual;       (*针对单产生式对象,返回产生式字符串*)
    function getnewcanssi:string;virtual;      (*针对单产生式对象,返回产生式字符串*)

    function isequal(p:fensensi):boolean;virtual;     (*针对单产生式对象,判断两产生式是否相同,相同返回TRUE*)
    function isequal2(p:fensensi):boolean;virtual;  (*针对集合对象,判断两集合式是否相同,相同返回TRUE*)
    function getcount:integer;                      (*针对集合对象,返回集合中的元素个数*)
    function setposition(p:integer):boolean;   (*针对单产生式对象,将now置于第p个位置,成功返回TRUE,否则FALSE*)
    function sub(index:integer):boolean;(*针对集合类型,减去一个元素,若无这个元素返回FALSE*)
    function subfuhao(index:integer):boolean;(*针对产生式类型,减去一个元素,减后为空返回TRUE*)
    function change(cs:cansenjh;var acount:integer):fensensi;
          (*在消除左递归中替换第一个非终结符,返回替换产生的最后的产生式*)
    private
      wordlist:mfuhao;
      now:mfuhao;
    public
     link:fensensi;
   end;
  (*******************************************)


  (*******************************************)
  cansensi=class                   (*产生式对象,含多个单产生式,但单产生式公用一个左边符号*)
    public
      parent:Mfuhao;               (*产生式左边符号*)
      first,fellow:fensensi;       (*FIRST,FELLOW集合*)
      synch:fensensi;              (*同步化入口集合*)
      entercan:fensensi;           (*入口集合链,链长与scansisi一样长,于scansisi对应位置为进入这个产生式的符号集*)
      enternow:fensensi;           (*指向入口集合链某个位置指针*)
      scansisi:fensensi;           (*单产生式链*)
      now:fensensi;                (*指向单产生式链某个位置指针*)
    public
      count:integer;                (*此产生式包含单产生式的个数*)
    Constructor init(cansi:string); (*初始化产生式,cansi为产生式符号串*)
    Constructor init2(p:integer); (*初始化产生式,但产生式为空*)
    COnstructor init3(p:cansensi);   (*复制*)
    procedure   add(p:fensensi;i:integer);     (*增加产生式,以i为演码*)
    procedure   add2(p:fensensi);  (*增加产生式,p可以被删除*)
    Destructor  Done;
    procedure setsi(index:integer); (*将now指针指向单产生式链的某个位置*)
    function get:sword;             (*返回now指针所指向的单产生式的当前符号*)
    function next:boolean;          (*将now指向产生式中下一个符号,若已是最后符号,则返回TRUE,否则返回FALSE*)
    function sunnext:boolean;       (*将now指向的单产生式的now指针指向下一个符号,若已是最后符号,则返回TRUE,否则返回FALSE*)
    function sunpre:boolean;        (*将now指向的单产生式的now指针指向上一个符号,若已是第一个符号,则返回TRUE,否则返回FALSE*)
    function ifeof:boolean;         (*判断now是否指向最后一个单产生式,是则返回TRUE,否则返回FALSE*)
    function sunifeof:boolean;      (*判断now指向的单产生式的当前指针是否指向最后一个单产生式,是则返回TRUE,否则返回FALSE*)
    procedure addfirst(index:integer);(*向FIRST集合添加符号*)
    procedure addfellow(index:integer);(*向FELOOW集合添加符号*)
    procedure setflag(f:boolean);   (*将now指向的单产生式的当前指针所指向的符号置res值*)
    procedure sunsetsi;             (*将now指向的单产生式的当前指针移到第一个节点*)
    procedure refreshff;            (*刷新first fellow集合*)

    function getcanssi:string;      (*返回产生式字符串*)
    function getnewcanssi:string;      (*返回产生式字符串*)

    procedure change(cs:cansenjh); (*在消除左递归中替换第一个非终结符,并使now指针指向产生的最后的产生式*)
    function change1(cs:cansenjh):integer; (*消除直接左递归*)
    function subfuhao(index:integer):boolean;(*针对产生式类型,减去一个元素,减后为空返回TRUE*)
   end;
  cansenjh=class                   (*产生式数组,最多为500个产生式*)
    Public
      cans:array[1..500]of cansensi;
    public
      count:integer;                (*产生式个数*)
      Constructor init;
      procedure   add(s:string);    (*增加产生式*)
      procedure   add2(p:cansensi); (*增加产生式,注意p不要被删除*)
      procedure   add3(p:cansensi); (*增加产生式,P可以被删除*)
      procedure   delete(d:integer);(*删除产生式,d 为第几个产生式*)
      procedure   exchange(h:integer;s:string); (*将第h个产生式换成s*)
      Destructor  done;
      function    ifhave(index:integer):boolean;   (*判断是否存在产生式左部为s的产生式,若有返回TRUE,否则为FALSE*)
      function    gofuhao(index:integer):integer;  (*返回左部为i的产生式号码*)
    end;
  item=class(fensensi)
      private
        parent:Mfuhao;
        {link:item;}
        act:action;
      public
        position:integer;
        constructor init(p:fensensi;par:mfuhao);  (*初始化项目,s 为单产生式,par为父符号*)
        constructor init2(p:item;o:integer);  (*初始化项目,p 为样本项目,o为位置*)
        constructor init3(s:string);
        (*初始化项目,s为存盘信息 ,s 结构position (int),nextfuhao (string),act (int),parent(string),产生式 (string)*)
        destructor  done;
        function isequal(p:item):boolean;virtual;     (*判断两个项目是否相同,相同返回TRUE,否则返回FALSE*)
        function nextposition(var r:sword):boolean;  (*取出位置后的符号,若位置后无符号返回FALSE,否则返回TRUE*)
        function gonext:boolean;               (*向后移动位置,若无法移动返回FALSE,否则返回TRUE*)
        function isnext(index:integer):boolean;     (*判断给出符号名是否为下一个位置的符号,不是返回FALSE,否则返回TRUE*)
        function ispositioneof:boolean;        (*判断位置是否为产生式最后,是则返回TRUE,否则返回FALSE*)
        function getposition:integer;          (*返回位置*)
        function getparent:sword;              (*返回左边符号*)
        function getaction:action;             (*返回动作*)
        procedure setaction(a:action);             (*设置动作*)
        function  getstring:string;             (*返回产生式字符串*)
     end;
(********************************************************************)
   state=class(cansensi)
     public
       count:integer;
       {scansisi:item;           (*单产生式链*)
       now:item;}
       ccss:cansenjh;
       link:state;
     public
       constructor init(cs:cansenjh);
       procedure add(p:fensensi;par:Mfuhao);
       procedure add2(p:item;o:integer);
       function  ifequal(p:state):boolean;
       function  ifhave(p:item):boolean;
       Destructor done;
       procedure spread;
       function  newstate(p:state;var m:integer):boolean;
       (*输出一个新状态,(未扩展),m为转移符号,若有输出则返回TRUE,否则返回FALSE*)
       procedure fill(m,o:integer);(*将针对符号M的转移,添上o位置*)
     end;
(*************************************************************)
   stateset=class
     public
       states:state;
       nowstate:state;
       count:integer;
       ccss:cansenjh;
     public
       constructor init(cs:cansenjh);
       Destructor  done;
       procedure add(p:state);
       function  ifhave(p:state):integer;(*返回p的位置,若无则返回-1*)
       procedure clear;
       procedure setsi(index:integer);
       function next:boolean;  (*将nowstate向后移一个位置,若可以移返回FALSE,否则返回TRUE*)
   end;
(****************************************************************)
lr1item=class(item) (*为LR1分析设计的项目,增加了向后看项目back*)
  private
    ccss:cansenjh;
    back:fensensi;
  public
    constructor init(p:fensensi;par:mfuhao;bac:fensensi;cs:cansenjh);  (*初始化项目,s 为单产生式,par为父符号*)
    constructor init2(p:lr1item;o:integer;cs:cansenjh);  (*初始化项目,p 为样本项目,o为位置*)
    constructor init3(s:string;cs:cansenjh);
    (*初始化项目,s为存盘信息 ,s 结构position (int),nextfuhao (string),act (int),parent(string),产生式 (string)*)
    destructor  done;
    function  addback(index:integer):Boolean;           (*增加向后看集合*)
    function  isequal(p:lr1item):boolean;virtual;     (*判断两个项目是否相同,相同返回TRUE,否则返回FALSE*)
    function  getstring:string;             (*返回产生式字符串*)
    function  getback:fensensi;
    procedure getpfirst(var f:fensensi);    (*返回position后的first集合*)
    procedure backinit(s:string);           (*提取存盘信息back*)
    procedure emtryback;    (*将向后看集合清零*)
    function  subback(index:integer):boolean;   (*将向后看集合减去一个元素,若无这个元素返回FALSE*)
  end;
lr1state=class(state)
  public
    constructor init(cs:cansenjh);
    procedure add(p:fensensi;par:Mfuhao;bac:fensensi);
    procedure add2(p:lr1item;o:integer);
    function  ifequal(p:lr1state):boolean;
    function  ifhave(p:lr1item):boolean;
    Destructor done;
    procedure spread;
    function  newstate(p:lr1state;var m:integer):boolean;
    (*输出一个新状态,(未扩展),m为转移符号,若有输出则返回TRUE,否则返回FALSE*)
  end;
 lr1stateset=class
   public
     states:lr1state;
     nowstate:lr1state;
     count:integer;
     ccss:cansenjh;
   public
     constructor init(cs:cansenjh);
     Destructor  done;
     procedure add(p:lr1state);
     function  ifhave(p:lr1state):integer;(*返回p的位置,若无则返回-1*)
     procedure clear;
     procedure setsi(index:integer);
     function next:boolean;  (*将nowstate向后移一个位置,若可以移返回FALSE,否则返回TRUE*)
  end;
(*********************************************)
pointset=class     (*指针集合*)
  private
    points:pointrec;
    now:pointrec;
  public
    constructor init;
    destructor done;
    procedure  add(p:pointer);
    function ifhave(p:pointer):boolean;
    function next:boolean;
    procedure setsi;
    function  getpoint:pointer;
    function ifemtry:boolean;
  end;
(******************************************************)
lalritem=class(lr1item)
   constructor init(p:fensensi;par:mfuhao;bac:fensensi;cs:cansenjh);  (*初始化项目,s 为单产生式,par为父符号*)
   constructor init2(p:lr1item;o:integer;cs:cansenjh);  (*初始化项目,p 为样本项目,o为位置*)
   constructor init3(s:string;cs:cansenjh);
   (*初始化项目,s为存盘信息 ,s 结构position (int),nextfuhao (string),act (int),parent(string),产生式 (string)*)
   destructor  done;
   procedure spreadnext;    (*将搜索符传给同集合的项目*)
   function  addback(index:integer):boolean;
  public
   carrierp:pointset;
   ifnew:boolean;
 end;
(**********************************************)
lalrstate=class(lr1state)
  public
    constructor init(cs:cansenjh);
    function add(p:fensensi;par:Mfuhao;bac:fensensi):lalritem;
    function add2(p:lr1item;o:integer):lalritem;
    Destructor done;
    procedure spread;
    (*输出一个新状态,(未扩展),m为转移符号,若有输出则返回TRUE,否则返回FALSE*)
    function  newstate(p:lalrstate;var m:integer):boolean;
  end;
lalrstateset=class
   public
     states:lalrstate;
     nowstate:lalrstate;
     count:integer;
     ccss:cansenjh;
   public
     constructor init(cs:cansenjh);
     Destructor  done;
     procedure add(p:lalrstate);
     function  ifhave(p:lalrstate):integer;(*返回p的位置,若无则返回-1*)
     procedure clear;
     procedure setsi(index:integer);
     function next:boolean;  (*将nowstate向后移一个位置,若可以移返回FALSE,否则返回TRUE*)

  end;

(******************************************)
implementation
uses unit1;
Constructor mfuhao.init(nindex:integer);
  begin
    res:=false;
    index:=nindex;
    link:=nil;
  end;
 procedure mfuhao.setflag(f:boolean);
 begin
   res:=f;
 end;
 Destructor  mfuhao.Done;
 begin
   inherited destroy;
 end;
(***************************************)
constructor pointrec.init(sp:pointer);
begin
  p:=sp;
  link:=nil;
end;
function   pointrec.getpoint:pointer;
begin
  getpoint:=p;
end;
function  pointrec.ifequal(sp:pointer):boolean;
begin
  ifequal:=(p=sp);
end;
destructor  pointrec.done;
begin
  inherited destroy;
end;
(***************************************)
Constructor fensensi.init4(p:fensensi;i:integer);
var j:integer;
    t1,t2:integer;
begin
  p.setsi;
  wordlist:=nil;
  now:=nil;
  j:=0;
  repeat
    if (p.get.res)
      then
        begin
          t1:=1;
          t1:=t1 shl j;
          t2:=t1 and i;
          if t2<>0
            then
              begin
                if wordlist=nil
                  then
                    begin
                      wordlist:=mfuhao.init(p.get.index);
                      now:=wordlist;
                    end
                  else
                    begin
                      now:=wordlist;
                      while now.link<>nil do
                        begin
                          now:=now.link;
                        end;
                      now.link:=mfuhao.init(p.get.index);
                    end;
              end;
          j:=j+1;
        end
      else
        begin
          if wordlist=nil
            then
              begin
                wordlist:=mfuhao.init(p.get.index);
                now:=wordlist;
              end
            else
              begin
                now:=wordlist;
                while now.link<>nil do
                   begin
                     now:=now.link;
                   end;
                now.link:=mfuhao.init(p.get.index);
              end;
        end;
  until p.next;
end;
Constructor fensensi.init3(p:fensensi);
begin
  p.setsi;
  wordlist:=Mfuhao.init(p.get.index);
  now:=wordlist;
  while not p.next do
    begin
      now.link:=Mfuhao.init(p.get.index);
      now:=now.link;
    end;
end;
constructor fensensi.init2(nindex:integer);
begin
  wordlist:=Mfuhao.init(nindex);
  now:=wordlist;
  link:=NIL;
end;
Constructor fensensi.init(cansi:string);
var i:integer;
    temp:string;
    j:integer;
begin
  link:=NIL;
  wordlist:=Nil;
  i:=1;
  temp:='';
  while i<=length(cansi) do
    begin
      if cansi[i]=' '
        then
          begin
           if temp<>''
             then
               begin
                   if wordlist=nil
                     then begin
                       j:=form1.findindex(temp);
                       if j=-1
                         then
                           begin
                             now:=nil;
                             exit;
                           end;
                       wordlist:=Mfuhao.init(j);
                       now:=wordlist;
                      end
                     else
                       begin
                         j:=form1.findindex(temp);
                         if j=-1
                           then
                             begin
                               now:=nil;
                               exit;
                             end;
                         now.link:=Mfuhao.init(j);
                         now:=now.link;
                       end;
                     temp:='';
               end;
           end
         else
           begin
             temp:=temp+cansi[i];
           end;
      i:=i+1;
    end;
  if temp<>''
    then
      begin
        if wordlist=nil
          then begin
            j:=form1.findindex(temp);
            if j=-1
              then
                begin
                  now:=nil;
                  exit;
                end;
            wordlist:=Mfuhao.init(j);
            now:=wordlist;
          end else begin
            j:=form1.findindex(temp);
            if j=-1
              then
                begin
                  now:=nil;
                  exit;
                end;
            now.link:=Mfuhao.init(j);
            now:=now.link;
          end;
      end;
end;
Destructor  fensensi.done;
  var temp:Mfuhao;
  begin
    if wordlist<>nil
      then
        begin
          now:=wordlist;
          while now.link<>Nil do
            begin
              temp:=now.link;
              now.Done;
              now:=temp;
            end;
          now.Done;
        end;
    inherited destroy;
  end;
procedure fensensi.setsi;
  begin