structk.~pa

编译原理-文法等价转换

  inherited init2(p,o);
  back:=fensensi.init3(p.getback);
  ccss:=cs;
end;

constructor lr1item.init3(s:string;cs:cansenjh);
(*初始化项目,s为存盘信息 ,s 结构 position (int),nextfuhao (string),act (int),parent(string),产生式 (string)*)
var i,m:integer;
    temp:string;
begin
  ccss:=cs;
  back:=nil;
  i:=1;
  temp:='';
  back:=fensensi.init2(0);
  while (i<=length(s)) do
    begin
      temp:=temp+s[i];
      i:=i+1;
    end;
  inherited init3(temp);
end;
function  lr1item.getback:fensensi;
begin
  getback:=back;
end;

destructor  lr1item.done;
begin
  if back<>nil
    then back.done;
  inherited done;
end;
function lr1item.isequal(p:lr1item):boolean;     (*判断两个项目是否相同,相同返回TRUE,否则返回FALSE*)
begin
  isequal:=(back.isequal2(p.back)) and (inherited isequal(p));
end;
function  lr1item.getstring:string;             (*返回产生式字符串*)
var temp:string;
begin
  temp:=inherited getstring;
  temp:=temp+'  ，';
  back.setsi;
  while not back.next do
    begin
      temp:=temp+form1.findname(back.now.index)+'/';
    end;
  getstring:=temp;
end;
procedure lr1item.getpfirst(var f:fensensi);    (*返回position后的first集合*)
var res:boolean;
    i,j:integer;
begin
  now:=wordlist;
  i:=1;
  while (i<=position) and (now.link<>nil) do
    begin
      now:=now.link;
      i:=i+1;
    end;
  res:=true;
  while (now.link<>nil) and res do
    begin
      now:=now.link;
      if now.index>300
        then
          begin
            j:=ccss.gofuhao(now.index);
            ccss.cans[j].first.setsi;
            while not ccss.cans[j].first.next do
              begin
                f.add(ccss.cans[j].first.now.index);
              end;
            if not ccss.cans[j].first.ifhave(300)
              then
                begin
                  res:=false;
                end;
          end
        else
          begin
            f.add(now.index);
            res:=false;
          end;
    end;
  if res
    then
      begin
        back.setsi;
        while not back.next do
          begin
            f.add(back.now.index);
          end;
      end;
end;
function lr1item.addback(index:integer):boolean;
begin
  addback:=back.add(index);
end;
procedure lr1item.backinit(s:string);
var i:integer;
    temp:string;
begin
  i:=1;
  temp:='';
  while i<length(s) do
    begin
      if (s[i]=' ') and (temp<>'')
        then
          begin
            back.add(form1.findindex(temp));
            temp:='';
          end
        else
          begin
            temp:=temp+s[i];
          end;
      i:=i+1;
    end;
 if temp<>''
   then back.add(form1.findindex(temp));

 end;
 procedure lr1item.emtryback;
 begin
   back.emtry;
 end;
function  lr1item.subback(index:integer):boolean;   (*将向后看集合减去一个元素,若无这个元素返回FALSE*)
begin
  subback:=back.sub(index);
end;
 (**************************)
 constructor lr1state.init(cs:cansenjh);
 begin
   inherited init(cs);
 end;
 procedure lr1state.add(p:fensensi;par:Mfuhao;bac:fensensi);
 var temp:lr1item;
 begin
 if scansisi=nil
  then
    begin
      scansisi:=lr1item.init(p,par,bac,ccss);
      now:=scansisi;
      count:=1;
    end
  else
    begin
      temp:=lr1item.init(p,par,bac,ccss);
      inherited setsi(1);
      repeat
      until (now as item).isequal(temp) or next;
      if not (now as item).isequal(temp)
        then
          begin
          setsi(count);
          now.link:=temp;
          count:=count+1;
          end
        else
          begin
            temp.back.setsi;
            while not temp.back.next do
              begin
                (now as lr1item).addback(temp.back.get.index);
              end;
            temp.done;
          end;
    end;
end;





 procedure lr1state.add2(p:lr1item;o:integer);
 var temp:lr1item;
 begin
  if scansisi=nil
    then
      begin
        scansisi:=lr1item.init2(p,o,ccss);
        now:=scansisi;
        count:=1;
      end
    else
      begin
         setsi(1);
         temp:=lr1item.init2(p,o,ccss);
         repeat
         until (now as item).isequal(temp) or next;
         if not (now as item).isequal(temp)
           then
             begin
               setsi(count);
               now.link:=temp;
               count:=count+1;
             end
           else
             begin
               temp.back.setsi;
               while not temp.back.next do
                 begin
                  (now as lr1item).addback(temp.back.get.index);
                 end;
               temp.done;
             end;
      end;
end;
function  lr1state.ifequal(p:lr1state):boolean;
var resb:boolean;
begin
  if count<>p.count
    then
      begin
        ifequal:=false;
      end
    else
      begin
        p.setsi(1);
        resb:=false;
        repeat
          resb:=ifhave((p.now as lr1item));
        until not(resb) or p.next;
        ifequal:=resb
      end;
end;
function  lr1state.ifhave(p:lr1item):boolean;
var resb:boolean;
begin
  setsi(1);
  resb:=false;
  repeat
    resb:=(now as lr1item).isequal(p);
  until resb or next;
  ifhave:=resb;
end;
Destructor lr1state.done;
 var temp:lr1item;
begin
  if scansisi<>nil
    then
      begin
        now:=scansisi;
        temp:=now as lr1item;
        while now.link<>nil do
          begin
            now:=now.link;
            temp.done;
            temp:=now as lr1item;
          end;
        (now as lr1item).done;
      end;
  scansisi:=nil;
  now:=nil;
  count:=0;
  inherited done;
end;
procedure lr1state.spread;
 var i,j:integer;
 temp:lr1item;
 r:sword;
 f:fensensi;
 begin
   i:=1;
   temp:=scansisi as lr1item;
   f:=fensensi.init2(0);
   while i<=count do
     begin
       if temp.nextposition(r)
         then
           begin
             if r.index>300
               then
                 begin
                   f.emtry;
                   temp.getpfirst(f);
                   j:=1;
                   while (ccss.cans[j].parent.index<>r.index) do
                     begin
                       j:=j+1;
                     end;
                   ccss.cans[j].setsi(1);
                   repeat
                     add(ccss.cans[j].now,ccss.cans[j].parent,f);
                   until ccss.cans[j].next;
                 end;
           end;
         temp:=temp.link as lr1item;
         i:=i+1;
     end;
 end;



function  lr1state.newstate(p:lr1state;var m:integer):boolean;
var s:sword;
begin
  now:=scansisi;
  while (((now as lr1item).getaction.nextfuhao<>-1) or (now as lr1item).ispositioneof) and (now.link<>nil) do
    begin
      now:=now.link;
    end;
  if ((now as lr1item).getaction.nextfuhao=-1) and (not ((now as lr1item).ispositioneof))
    then
      begin
         (now as lr1item).nextposition(s);
         m:=s.index;
         p.add2((now as lr1item),(now as lr1item).position+1);
         while now.link<>nil do
           begin
             now:=now.link;
             if (now as lr1item).isnext(s.index)
               then
                 begin
                   p.add2(now as lr1item,(now as lr1item).position+1);
                 end;
           end;
        newstate:=true;
      end
    else
      begin
        newstate:=false;
      end;
 end;
(**********************************************************)
constructor lr1stateset.init(cs:cansenjh);
begin
  states:=nil;
  nowstate:=nil;
  count:=0;
  ccss:=cs;
end;
procedure lr1stateset.add(p:lr1state);
begin
  if count=0
    then
      begin
        states:=lr1state.init(ccss);
        nowstate:=states;
      end
     else
       begin
         setsi(count);
         nowstate.link:=lr1state.init(ccss);
         nowstate:=(nowstate.link as lr1state);
       end;
  p.setsi(1);
  repeat
    nowstate.add2(p.now as lr1item,(p.now as lr1item).position);
  until p.next;
  count:=count+1;
end;

function  lr1stateset.ifhave(p:lr1state):integer;
var resb:boolean;
    i:integer;
begin
  nowstate:=states;
  resb:=false;
  i:=0;
  repeat
    i:=i+1;
    resb:=nowstate.ifequal(p);
  until resb or next;
  if resb
    then ifhave:=i
    else ifhave:=-1;
end;
procedure lr1stateset.clear;
var temp:lr1state;
    i:integer;
begin
  nowstate:=states;
  for i:=1 to count do
    begin
      temp:=nowstate;
      nowstate:=(nowstate.link as lr1state);
      temp.done;
    end;
  count:=0;
  states:=nil;
  nowstate:=nil;
end;
function lr1stateset.next:boolean;  (*将nowstate向后移一个位置,若可以移返回FALSE,否则返回TRUE*)
begin
  if nowstate.link=nil
    then next:=true
    else
      begin
        next:=false;
        nowstate:=(nowstate.link as lr1state);
      end;
end;
procedure lr1stateset.setsi(index:integer);
var i:integer;
begin
  nowstate:=states;
  for i:=2 to index do
    begin
      nowstate:=(nowstate.link as lr1state);
    end;
    nowstate.setsi(1);
 end;
Destructor  lr1stateset.done;
var temp:state;
    i:integer;
begin
  nowstate:=states;
  for i:=1 to count do
    begin
      temp:=nowstate;
      nowstate:=(nowstate.link as lr1state);
      temp.done;
    end;
  inherited destroy;
end;
(*************************************************)
constructor pointset.init;
begin
  points:=nil;
  now:=nil;
end;

destructor pointset.done;
var temp:pointrec;
begin
  now:=points;
  while  now<>nil do
    begin
      temp:=now.link;
      now.done;
      now:=temp;
    end;
  inherited destroy;
end;
procedure  pointset.add(p:pointer);
var temp:pointrec;
begin
  temp:=pointrec.init(p);
  if points=nil
    then points:=temp
    else
      begin
        now:=points;
        while now.link<>nil do
          begin
            now:=now.link;
          end;
        now.link:=temp;
      end;
end;
function pointset.ifhave(p:pointer):boolean;
begin
  now:=points;
  while not (now.ifequal(p)) and (now.link<>nil) do
    begin
      next;
    end;
ifhave:=now.ifequal(p);
end;
function pointset.next:boolean;
begin
  if now=nil
    then
      begin
        next:=true;
        exit;
      end;
  next:=(now.link=nil);
  if now.link<>nil
    then now:=now.link;
end;
procedure pointset.setsi;
begin
  now:=points;
end;
function  pointset.getpoint:pointer;
begin
  getpoint:=now.getpoint;
end;
function pointset.ifemtry:boolean;
begin
  ifemtry:=(points=nil);
end;
(*****************************************************************)
constructor lalritem.init(p:fensensi;par:mfuhao;bac:fensensi;cs:cansenjh);  (*初始化项目,s 为单产生式,par为父符号*)
begin
  inherited init(p,par,bac,cs);
  if bac.getcount>0
    then ifnew:=true
    else ifnew:=false;
  carrierp:=pointset.init;
end;
constructor lalritem.init2(p:lr1item;o:integer;cs:cansenjh);  (*初始