Курсовая работа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.