Курсовая работа2 / SLR_Grammar / Udm_Action

//  Авторы студенты группы 2382: Щербинская О. Ю., Мирошникова Н. Л.,  Костыгова Д. М.

unit Udm_Action;


{=}INTERFACE


uses SysUtils, Classes, Graphics, xmldom, XMLIntf, msxmldom, XMLDoc;


type Tdm_Action = class(TDataModule)
published
    xml_Action: TXMLDocument;
private
   m_StillSLR: boolean;
   function  AddAction( i_State: IXMLNode; i_XTerm: IXMLNode; i_Action,i_Data: string ): boolean;
   procedure InitActionTable;
   procedure ResolveAccept;
   procedure ResolveShift;
   procedure ResolveReduce;
   procedure ResolveEpsilon;
   procedure VerifyStates;
public
   procedure BuildActionFunction;
end;


var dm_Action: Tdm_Action;


{=}IMPLEMENTATION

uses Ufrm_Main, Udm_Grammar, Udm_Follow, Udm_Goto, Umsc_StrSetUtils, Udm_First,
  Udm_Vpod;


{$R *.dfm}


(*
    Состоянию i_State добавляется действие [i_Action,i_Data] по терминалу
    i_XTerm
    FALSE, если при этом возникает конфликт действия
*)
function  Tdm_Action.AddAction( i_State: IXMLNode; i_XTerm: IXMLNode;
                                i_Action, i_Data: string ): boolean;
var nAct: integer; ActNode: IXMLNode;
begin
   for nAct := 0 to i_State.ChildNodes.Count - 1 do
   begin
      ActNode := i_State.ChildNodes[nAct];
      if ( ActNode.Attributes['NAME'] = i_XTerm.Attributes['NAME'] ) and
         ( ActNode.Attributes['TYPE'] = i_XTerm.Attributes['TYPE'] ) then
         begin

            frm_Main.Log('Конфликт расстановки функции действия состояния ' + i_State.Attributes['NAME'], clRed);
            frm_Main.Log('Текущая запись: ' + ActNode.Attributes['TYPE'] + '_' + ActNode.Attributes['NAME'] +
                         ' ' + ActNode.Attributes['ACTION'] + '_' + ActNode.Attributes['DATA'], clRed);
            frm_Main.Log('Новая запись: ' + i_XTerm.Attributes['TYPE'] + '_' + i_XTerm.Attributes['NAME'] +
                         ' ' + i_Action + '_' + i_Data, clRed);



            Result := FALSE;  Exit;
         end;
   end;

   ActNode := i_State.AddChild('ACTION');
   ActNode.Attributes['NAME']   := i_XTerm.Attributes['NAME'];
   ActNode.Attributes['TYPE']   := i_XTerm.Attributes['TYPE'];
   ActNode.Attributes['ACTION'] := i_Action;
   ActNode.Attributes['DATA']   := i_Data;
   Result := TRUE;
end;


(*
    Инициализация таблицы состояний
    Все состояния копируются из dm_Goto.xml_States
*)

procedure Tdm_Action.InitActionTable;
var nState: integer;  StateNode, NewNode: IXMLNode;
begin
   xml_Action.LoadFromFile( frm_Main.GetTemplatePath + '\Template.xml' );

   for nState := 0 to dm_Goto.xml_States.DocumentElement.ChildNodes.Count - 1 do
   begin
      StateNode := dm_Goto.xml_States.DocumentElement.ChildNodes[nState];
      NewNode   := xml_Action.DocumentElement.AddChild('STATE');

      NewNode.Attributes['NAME'] := StateNode.Attributes['NAME'];
      NewNode.Attributes['CODE'] := StateNode.Attributes['CODE'];
   end;

end;


(*
    Расстановка допусков
    Допуск ставится там, где начальное состояние входит
    в композитное состояние, а входной терминал - маркер конца ленты
*)

procedure Tdm_Action.ResolveAccept;
var nState: integer; StateNode: IXMLNode; Marker: IXMLNode;
begin
   Marker := dm_First.xml_XTerms.DocumentElement.ChildNodes[0];

   for nState := 0 to xml_Action.DocumentElement.ChildNodes.Count - 1 do
   begin
      StateNode := xml_Action.DocumentElement.ChildNodes[nState];

      if ( HasElement(StateNode.Attributes['CODE'], 1) ) then
         if not Self.AddAction( StateNode, Marker, 'ACCEPT', 'x' ) then
         begin
            frm_Main.Log('[ОШИБКА] по допускам - грамматика не SLR(1)', clRed );
            Self.m_StillSLR := FALSE;  Exit;
         end;
   end;
end;


(*
    Расстановка переносов
    Переносить положено те терминалы, для которых пределена функция переходов GoTo
*)

procedure Tdm_Action.ResolveShift;
var nState, nGoto: integer;  GotoNode, ActNode: IXMLNode;
begin
   for nState := 0 to xml_Action.DocumentElement.ChildNodes.Count - 1 do
   begin
      GotoNode := dm_Goto.xml_States.DocumentElement.ChildNodes[nState];
      ActNode  := xml_Action.DocumentElement.ChildNodes[nState];

      for nGoto := 0 to GotoNode.ChildNodes.Count - 1 do
      begin
         if GotoNode.ChildNodes[nGoto].Attributes['TYPE'] = 'term' then
            if not Self.AddAction( ActNode, GotoNode.ChildNodes[nGoto], 'SHIFT', 'x' )
            then
            begin
               frm_Main.Log('[ОШИБКА] по переносам - грамматика не SLR(1)', clRed);
               Self.m_StillSLR := FALSE;  Exit;
            end;
      end;
   end;
end;


(*
    Расстановка свёртки
    Сворачивать положено, если состояние содержит крайнюю
    часть какого-либо правила, а терминал - принадлежит СЛЕД от порождающего
    нетерминала этого правила
  *)

procedure Tdm_Action.ResolveReduce;
var nProd, nState, nXTerm, ItemNum: integer; 
    ProdNode,StateNode, XTermNode: IXMLNode;   CodeFollow: string;
begin
   // Перебор по всем правилам грамматики
   for nProd := 0 to dm_Grammar.node_Prod.ChildNodes.Count - 1 do
   begin
      ProdNode := dm_Grammar.node_Prod.ChildNodes[nProd];
      if ProdNode.ChildNodes.Count = 0 then continue;

      // Получаем требуемое множество след по нетерминалу, порождающему правило
      CodeFollow := dm_Follow.GetFollowCode( ProdNode.Attributes['START'] );

      // Получаем номер грамматического вхождения последнего символа правила
      ItemNum := dm_Vpod.GetItemNum( ProdNode.ChildNodes[ProdNode.ChildNodes.Count - 1] );

      // Прооняем по всем доступным состояниям и смотрим есть ли среди них грамвхождение
      for nState := 0 to xml_Action.DocumentElement.ChildNodes.Count - 1 do
      begin
         StateNode := xml_Action.DocumentElement.ChildNodes[nState];
         if not HasElement( StateNode.Attributes['CODE'], ItemNum ) then continue;

         // Теперь к полученному вхождению надо добавить свёртки
         for nXTerm := 0 to dm_First.xml_Xterms.DocumentElement.ChildNodes.Count - 1 do
         begin
            XTermNode := dm_First.xml_Xterms.DocumentElement.ChildNodes[nXTerm];

            if HasElement( CodeFollow, nXTerm ) then
               if not Self.AddAction( StateNode, XTermNode, 'REDUCE', IntToStr(nProd) ) then
               begin
                  frm_Main.Log('[ОШИБКА] по свёрткам - грамматика не SLR(1)', clRed);
                  Self.m_StillSLR := FALSE;  Exit;
               end;
         end;
      end;
   end;
end;


(*
    Добавляет свёртки по epsilon-правилам
    Вставлять свёрнутый по epsilon нектерминал
    имеет смысл тогда, когда функция переходов от такой свёртки не выдаст ошибки,
    т.е, когда значение функции переходов состояния от сворачиваемого нетерминала
    не равно ошибке
*)

procedure Tdm_Action.ResolveEpsilon;
var nProd,nState: integer; ProdNode, GotoState, ActState, XTermNode: IXMLNode;
    StartName,CodeFollow: string; Iter: TStrSetIterator; Num: TStrSetElement;
begin
    for nProd := 0 to dm_Grammar.node_Prod.ChildNodes.Count - 1 do
    begin
       ProdNode := dm_Grammar.node_Prod.ChildNodes[ nProd ];
       if ProdNode.ChildNodes.Count > 0 then continue;

       StartName  := ProdNode.Attributes['START'];
       CodeFollow := dm_Follow.GetFollowCode( StartName );

       for nState := 0 to dm_Goto.xml_States.DocumentElement.ChildNodes.Count - 1 do
       begin
          GotoState := dm_Goto.xml_States.DocumentElement.ChildNodes[ nState ];
          ActState  := xml_Action.DocumentElement.ChildNodes[ nState ];

          if dm_Goto.IsGotoDefined( GotoState, StartName ) then
          begin
             // для ActState добавить свёртку для всех из follow(startname)
             InitStrSetIterator(Iter);
             while HasMoreElements( CodeFollow, Iter) do
             begin
                Num := GetNextElement( CodeFollow, Iter );
                XTermNode := dm_First.xml_XTerms.DocumentElement.ChildNodes[Num];

                if not Self.AddAction( ActState, XTermNode, 'REDUCE', IntToStr(nProd) ) then
                begin
                   frm_Main.Log('[ОШИБКА] по свёрткам - грамматика не SLR(1)', clRed);
                   Self.m_StillSLR := FALSE;  Exit;
                end;
             end;
          end;
       end;
    end;
end;


(*
    Заключительная верификация построенной функции.
    Не должно присутствовать
    состояний, для которых вообще не определено никаких действий
*)

procedure Tdm_Action.VerifyStates;
var nState: integer; StateNode: IXMLNode;
begin
   for nState := 0 to xml_Action.DocumentElement.ChildNodes.Count - 1 do
   begin
      StateNode := xml_Action.DocumentElement.ChildNodes[nState];
      if StateNode.ChildNodes.Count = 0 then
      begin
         frm_Main.Log('[ОШИБКА] Обнаружено состояние без допустимых действий - грамматика не SLR(1)', clRed);
         Self.m_StillSLR := FALSE;  Exit;
      end;
   end;
end;


{==============================================================================}

//Построение функции действия конечного автомата
procedure Tdm_Action.BuildActionFunction;
begin
   try

   //  Инициализация таблицы действий
     Self.InitActionTable;

    frm_Main.Log('Определение ДОПУСК, ПЕРЕНОС, СВЁРТКА', clBlack);

   //Определение операции "ДОПУСК"
     m_StillSLR := TRUE;
     Self.ResolveAccept;
     //Определение операции "ПЕРЕНОС"
     if m_StillSLR then
        Self.ResolveShift;

     //Определение операции "СВЁРТКА"
     if m_StillSLR then
         Self.ResolveReduce;

     //Анализ Epsilon-правил грамматики
     if m_StillSLR then
         Self.ResolveEpsilon;

     //Верификация полученной функции действия
     if m_StillSLR then
         Self.VerifyStates;


     frm_Main.Log('', clBlack);
   except
     frm_Main.Log('[ОШИБКА] Обнаружена критическая ошибка', clRed);
   end
end;


end.