structk.~pa

编译原理-文法等价转换

        p:=form1.findindex(temp);
        if p=-1
          then
            begin
              act.act:=-3;
              exit;
            end;
        act.nextfuhao:=p;
      end;
  temp:='';
  i:=i+1;
  while (i<=length(s)) and (s[i]<>' ') do
    begin
      temp:=temp+s[i];
      i:=i+1;
    end;
  if temp=''
    then
      begin
        act.act:=-3;
        exit;
      end;
  try
    p:=strtoint(temp);
  except
    act.act:=-3;
    exit;
  end;
  act.act:=p;

  temp:='';
  i:=i+1;
  while (i<=length(s)) and (s[i]<>' ') do
    begin
      temp:=temp+s[i];
      i:=i+1;
    end;
  if temp=''
    then
      begin
        act.act:=-3;
        exit;
      end;
  p:=form1.findindex(temp);
  if p=-1
    then
      begin
        act.act:=-3;
        exit;
      end;
  parent:=mfuhao.init(p);

  temp:='';
  i:=i+1;
  while (i<=length(s)) do
    begin
      temp:=temp+s[i];
      i:=i+1;
    end;
  if temp=''
    then
      begin
        act.act:=-3;
        exit;
      end;
  inherited  init(temp);
  if now=nil
    then
      begin
        act.act:=-3;
        exit;
      end;
end;
destructor  item.done;
begin
  parent.done;
  inherited done;
end;
function item.isequal(p:item):boolean;     (*判断两个项目是否相同,相同返回TRUE,否则返回FALSE*)
var i:boolean;
begin
  if (parent.index=p.getparent.index) and (position=p.position) and ((self as fensensi).isequal(p))
    then
      begin
        isequal:=true;
      end
    else
      begin
        isequal:=false;
      end;
end;
function item.nextposition(var r:sword):boolean;  (*取出位置后的符号,若位置后无符号返回FALSE,否则返回TRUE*)
begin
  if position=0
    then
      begin
        setsi;
        r:=get;
        nextposition:=true;
      end
    else
      begin
        setposition(position);
        if ifeof
          then
            nextposition:=false
          else
            begin
              now:=now.link;
              nextposition:=true;
              r:=get;
            end;
      end;
end;
function item.gonext:boolean;
begin
  if position=0
    then
      begin
        position:=1;
        gonext:=true;
      end
    else
      begin
        if not ispositioneof
          then
            begin
              position:=position+1;
              gonext:=true;
            end
          else
            begin
              gonext:=false;
            end;
      end;
end;
function item.isnext(index:integer):boolean;     (*判断给出符号名是否为下一个位置的符号,不是返回FALSE,否则返回TRUE*)
begin
  if position=0
    then
      begin
        setsi;
        isnext:=(get.index=index);
      end
    else
      begin
        setposition(position);
        if ifeof
          then   isnext:=false
          else
            begin
              now:=now.link;
             isnext:=(get.index=index);
            end;
      end;

end;
function item.ispositioneof:boolean;        (*判断位置是否为产生式最后,是则返回TRUE,否则返回FALSE*)
begin
  if position=0
    then
      begin
        ispositioneof:=false;
      end
     else
       begin
         setposition(position);
         ispositioneof:=ifeof;
       end;
end;
function item.getposition:integer;          (*返回位置*)
begin
  getposition:=position;
end;
function item.getparent:sword;
begin
  getparent.index:=parent.index;
end;
function item.getaction:action;             (*返回动作*)
begin
  getaction:=act;
end;
procedure item.setaction(a:action);
begin
  act:=a;
end;
function  item.getstring:string;
var i,j:integer;
    temp:string;
begin
  now:=wordlist;
  i:=0;
  temp:='';
  temp:=form1.findname(parent.index)+'=';
  if i=position
    then
      begin
        temp:=temp+'∧';
      end;
  repeat
    i:=i+1;
    temp:=temp+'  '+form1.findname(now.index);
    if i=position
      then temp:=temp+'∧';
  until next;
  getstring:=temp;
end;
constructor state.init(cs:cansenjh);
begin
   count:=0;
   scansisi:=nil;
   now:=nil;
   link:=nil;
   ccss:=cs;
end;
procedure state.add(p:fensensi;par:Mfuhao);
var temp:item;
begin
if scansisi=nil
  then
    begin
      scansisi:=item.init(p,par);
      now:=scansisi;
      count:=1;
    end
  else
    begin
      temp:=item.init(p,par);
      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.done;
          end;
    end;
end;
procedure state.add2(p:item;o:integer);
var temp:item;
begin
  if scansisi=nil
    then
      begin
        scansisi:=item.init2(p,o);
        now:=scansisi;
        count:=1;
      end
    else
      begin
         setsi(1);
         temp:=item.init2(p,o);
         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.done;
             end;
      end;
end;
function  state.ifequal(p:state):boolean;
var resa,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 item));
        until not(resb) or p.next;
        ifequal:=resb
      end;
end;
function  state.ifhave(p:item):boolean;
var resb:boolean;
begin
  setsi(1);
  resb:=false;
  repeat
    resb:=(now as item).isequal(p);
  until resb or next;
  ifhave:=resb;
end;
Destructor state.done;
var temp:item;
begin
  if scansisi<>nil
    then
      begin
        now:=scansisi;
        temp:=now as item;
        while now.link<>nil do
          begin
            now:=now.link;
            temp.done;
            temp:=now as item;
          end;
        (now as item).done;
      end;
  scansisi:=nil;
  now:=nil;
  count:=0;
  inherited done;
 end;
 procedure state.spread;
 var i,j:integer;
 temp:item;
 r:sword;
 begin
   i:=1;
   temp:=scansisi as item;
   while i<=count do
     begin
       if temp.nextposition(r)
         then
           begin
             if r.index>300
               then
                 begin
                   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);
                   until ccss.cans[j].next;
                 end;
           end;
         temp:=temp.link as item;
         i:=i+1;
     end;
 end;
function  state.newstate(p:state;var m:integer):boolean;
var s:sword;
begin
  now:=scansisi;
  while (((now as item).getaction.nextfuhao<>-1) or (now as item).ispositioneof) and (now.link<>nil) do
    begin
      now:=now.link;
    end;
  if ((now as item).getaction.nextfuhao=-1) and (not ((now as item).ispositioneof))
    then
      begin
         (now as item).nextposition(s);
         m:=s.index;
         p.add2((now as item),(now as item).position+1);
         while now.link<>nil do
           begin
             now:=now.link;
             if (now as item).isnext(s.index)
               then
                 begin
                   p.add2(now as item,(now as item).position+1);
                 end;
           end;
        newstate:=true;
      end
    else
      begin
        newstate:=false;
      end;
 end;
 procedure state.fill(m,o:integer);(*将针对符号M的转移,添上o位置*)
   var a:action;
   begin
     now:=scansisi;
     a.nextfuhao:=m;
     a.act:=o;
     while now<>nil do
       begin
         if (now as item).isnext(m)
           then
             begin
               (now as item).setaction(a);
             end;
         now:=now.link;
       end;
   end;
 (*****************************************)
constructor stateset.init(cs:cansenjh);
begin
  states:=nil;
  nowstate:=nil;
  count:=0;
  ccss:=cs;
end;
procedure stateset.add(p:state);
begin
  if count=0
    then
      begin
        states:=state.init(ccss);
        nowstate:=states;
      end
     else
       begin
         setsi(count);
         nowstate.link:=state.init(ccss);
         nowstate:=nowstate.link;
       end;
  p.setsi(1);
  repeat
    nowstate.add2(p.now as item,(p.now as item).position);
  until p.next;
  count:=count+1;
end;

function  stateset.ifhave(p:state):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 stateset.clear;
var temp:state;
    i:integer;
begin
  nowstate:=states;
  for i:=1 to count do
    begin
      temp:=nowstate;
      nowstate:=nowstate.link;
      temp.done;
    end;
  count:=0;
  states:=nil;
  nowstate:=nil;
end;
function stateset.next:boolean;  (*将nowstate向后移一个位置,若可以移返回FALSE,否则返回TRUE*)
begin
  if nowstate.link=nil
    then next:=true
    else
      begin
        next:=false;
        nowstate:=nowstate.link;
      end;
end;
procedure stateset.setsi(index:integer);
var i:integer;
begin
  nowstate:=states;
  for i:=2 to index do
    begin
      nowstate:=nowstate.link;
    end;
    nowstate.setsi(1);
 end;
Destructor  stateset.done;
var temp:state;
    i:integer;
begin
  nowstate:=states;
  for i:=1 to count do
    begin
      temp:=nowstate;
      nowstate:=nowstate.link;
      temp.done;
    end;
  inherited destroy;
end;
(******************************************************)
constructor lr1item.init(p:fensensi;par:mfuhao;bac:fensensi;cs:cansenjh);  (*初始化项目,s 为单产生式,par为父符号*)
begin
  inherited init(p,par);
  ccss:=cs;
  back:=fensensi.init3(bac);
end;
constructor lr1item.init2(p:lr1item;o:integer;cs:cansenjh);  (*初始化项目,p 为样本项目,o为位置*)
begin