Program KP;
Uses TpCrt,Graph,GrText,DataUnit;
Const Txt='По заданной КС-грамматике построить отношение простого'+
' или операторного предшествования и функцию предшествования,'+
' используя граф линеаризации и алгоритм пересчета с визуализацией'+
' шагов построения графа';
Errors : array [0..10] of String[34] ={ошибки}
(' КС-грамматика синтаксически верна',{0}
' Ожидается ~"<"', {1}
' Ожидается ~">"', {2}
' Ожидается ~":="', {3}
' Требуется нетерминал', {4}
' Требуется терминал', {5}
' Неопределенный нетерминал', {6}
' Неиспользуемый нетерминал', {7}
' Требуется терминал или нетерминал',{8}
' Многоопределенный нетерминал', {9}
' Найдены недопустимые символы'); {10}
menu:array[1..5] of string[10]=
('Открыть','Сохранить','Запуск','Информация','Выход');
Type
notTerm=^List;
List=Record{список терминалов и нетерминалов}
Name:Str10;{терминал или нетерминал}
Next:notTerm;
End;
strBuf=array [1..800] of Char;
matrixPr=array [1..20,1..20] of 0..4;
Var i:Byte;{текущая позиция}
s:String;{текущая строка}
Len:Byte absolute s;
str_:strBuf;{общий буфер для текста}
LenStr:Integer;{всего символов в буфере}
CLine,{кол-во строк}
y:Byte;{текущая строка}
CTerm:Byte;{кол-во нетерминалов}
CTrmNotTrm:Byte;{кол-во нетерминалов и терминалов}
notTerminalS:NotTerm;{нетерминалы встречающиеся в правых частях}
notTerminalL:NotTerm;{нетерминалы в левой части}
Trm_notTrm:NotTerm;{список терминалов и нетерминалов}
LTN:NotTerm;{левые}
RTN:NotTerm;{правые}
tmp:NotTerm;{временная переменная}
matrixPrecede:matrixPr;
LenWin:Byte;{ширина окна}
{$I Dinamic.inc} {процедуры для работы с динамическими переменными}
{$I GraphPr.inc} {графический интерфейс}
{$I ServFunc.inc} {дополнительные процедуры обработки строки}
{----------------------------------------------------------------------------}
Procedure Blank;
(* пропуск управляющих символов и пробелов *)
Begin
While (i<=Len) and (S[i] = #32) do inc(i);
End;
{}
Function Let(s:Char):Boolean;
(* контроль букв *)
Begin
Let:=((s) >= 'A') and ((s) <= 'Z') or (s in RusLetters);
End;
{}
Function Dig (s:Char;Var n:Byte):Boolean;
(* контроль цифр *)
Begin
If (s >= '0') and (s <= '9') Then
Begin
n:=ord(s)-48;
Dig:=true
End
Else Dig:=false
End;
{}
Function Terminal (Var term:String):Boolean;
(* поиск терминала *)
Begin
term:='';
If i<=Len Then
While (i<=Len) and (S[i] in Digits+LatLetters+Punctuation+Service+RusLetters)
and not (s[i]='<') and not (s[i]='>') and not (s[i]='|') Do
Begin
term:=term+s[i];
inc(i);
End;
Terminal:=term > '';
End;
{}
Function notTerminal (Var term:String):Boolean;
(* поиск нетерминала *)
Var
j:word;
n:Byte;
Ex:Boolean;
Begin
Blank;
j:=i;
term:='';
Ex:=True;
If i<=Length(s) Then
If Let(S[i]) Then
Begin
While (i<=Length(s)) and Let(S[i]) or Dig(S[i],n) do
Begin
If (i-j) < 9 Then term:=term+S[i];
inc(i);
End;
If (i-j) > 8 Then
Ex:=False
Else
Blank;
End
Else
Ex:=False
Else
Ex:=False;
notTerminal:=Ex;
End;
{}
Procedure Check;
Var term:String;
Exist,Ex:Boolean;
notT:List;
k:Byte;
Label notTerminalOrTerminal,
OrS,LineS,EndS,Start,New,Gluk;
Begin
Goto Start;
New:{при возникновении ошибки}
DeleteList(NotTerminalS);
DeleteList(NotTerminalL);
DeleteList(Trm_NotTrm);
If not InputText Then Exit;
Start:{один раз}
i:=1;
y:=1;
k:=1;
CTerm:=0;
CTrmNotTrm:=0;
PosStr(1,s);{первая строка}
If s='' Then
Goto New;
LineS:{новая строка}
GotoXY(1,10);Write(s+' Длина анализ.строки ',Length(s),' '+#13#10,'y=',y,' всего строк ',Cline);
Blank;
If not (s[i]='<') Then
Begin
Error(1);
Goto New;
End
Else
Begin
inc(i);
Blank;
If not notTerminal(term) Then
Begin
Error(4);
Goto New;
End
Else
Begin{есть нетерминал}
Blank;
If not (s[i]='>') Then
Begin
Error(2);
Goto New;
End
Else{записываем нетерминал}
Begin
NotT.Name:='<'+term+'>';
If Search(NotTerminalL,NotT)>0 Then
Begin{многоопределенный}
Error(9);
Goto New;
End;
If Search(Trm_NotTrm,NotT)=0 Then
Begin
Complete(Trm_NotTrm,NotT);{в общий список теминалов&нетерминалов}
inc(CTrmNotTrm);
End;
Complete(NotTerminalL,NotT);{лев. часть}
inc(CTerm);
inc(i);
Blank;
If not (Copy(s,i,2)=':=') Then
Begin
Error(3);
Goto New;
End
Else
Begin{есть :=}
inc(i,2);
notTerminalOrTerminal:{после := обязательный терминал или нетерминал}
Blank;
If s[i]='<' Then{нетерминал}
Begin
inc(i);
Blank;
If notTerminal(term) Then
Begin{есть нетерминал}
Blank;
If s[i]='>' Then{записываем нетерминал}
Begin
NotT.Name:='<'+term+'>';
Complete(NotTerminalS,NotT);
If Search(Trm_NotTrm,NotT)=0 Then
Begin
Complete(Trm_NotTrm,NotT);{в общий список теминалов&нетерминалов}
inc(CTrmNotTrm);
End;
inc(i);
Blank;
Goto OrS;{может быть знак ИЛИ}
End
Else
Begin
Error(2);{нет >}
Goto New;
End
End
Else
Begin
Error(4);{нет нетерминала, но < есть}
Goto New;
End
End
Else{терминал}
If Terminal(term) Then{записываем терминал}
Begin
NotT.Name:=term;
If Search(Trm_NotTrm,NotT)=0 Then
Begin
Complete(Trm_NotTrm,NotT);{в общий список теминалов&нетерминалов}
inc(CTrmNotTrm);
End;
Blank;
Goto OrS;
End
Else
Begin
Error(8);{нет нетерминала или терминала}
Goto New;
End;
OrS: If i>Len Then Goto Gluk;{обходим глюк}
If s[i]='|' Then{знак ИЛИ}
Begin
inc(i);
Goto notTerminalOrTerminal
End
Else{знака ИЛИ нет}
Begin
Blank;
If i>Len Then{конец строки ?}
Gluk: If y<CLine Then{дошли до конца строки}
Begin
{следующ. стр}
inc(y);
posStr(y,s);
If s='' Then Goto EndS;
i:=1;
Goto LineS;
End
Else{конец файла}
Goto EndS
Else Goto notTerminalOrTerminal;{знака ИЛИ нет}
End;
End;
End;
End;
End;
EndS:
{проверка нетерминалов}
tmp:=NotTerminalL^.Next;{пропускаем первый}
exist:=True;
y:=2;
While (tmp<>Nil) and Exist Do
Begin
NotT:=tmp^;
Exist:=Search(NotTerminalS,NotT)>0;
tmp:=tmp^.Next;
inc(y);
End;
dec(y);
i:=1;
While (i<=y) Do
Begin{позицианируем на нужную строку}
{в s строка с ошибкой}
posStr(y,s);
inc(i);
End;
If not Exist Then{неиспользуемый нетерминал}
Begin
i:=1;
Error(7);
Goto New;
End;
{----------------}
tmp:=NotTerminalS;
exist:=True;
While (tmp<>Nil) and Exist Do
Begin
NotT:=tmp^;
Exist:=Search(NotTerminalL,NotT)>0;
tmp:=tmp^.Next;
End;
If not Exist Then{неопределенный нетерминал}
Begin
i:=1;
y:=0;
Ex:=False;
While not Ex Do
Begin{позицианируем на нужную строку}
inc(y);
PosStr(y,s);{в s строка с ошибкой}
i:=Pos(NotT.name,s);
Ex:=i>0;
End;
Error(6);
Goto New;
End;
Window(5,21,59,25);
TextColor(15);
TextBackGround(1);
WriteLN(Errors[0]);
readkey;
End;
Procedure SearchLR;
Function SearchInBlock(n:Byte;l:NotTerm;inf:List):Byte;
Var j:Byte;
Ex:Boolean;
Begin
If l<>Nil Then
Begin
j:=1;
While (l<>Nil) and (n<>j) Do
Begin
If l^.Name=#0 Then inc(j);
l:=l^.Next;
End;
Ex:=False;
While (l<>nil) and (l^.Name<>inf.Name) and Not Ex Do
Begin
inc(j);
If l^.Name=#0 Then Ex:=True;
l:=l^.next;
End;
End;
If (l=Nil) or Ex Then SearchInBlock:=0
Else SearchInBlock:=j;
End;
Procedure InsListInBlock(n:Byte; l:NotTerm;x,d:List);
Var q:NotTerm;
j:Byte;
Begin
If l=Nil Then WriteLN('Внимание! Внутренняя ошибка 03')
Else
Begin
j:=1;
While (l<>Nil) and (n<>j) Do
Begin
If l^.Name=#0 Then inc(j);
l:=l^.Next;
End;
While (l<>Nil) and (l^.Name<>x.Name) Do
l:=l^.Next;
If l<>Nil Then
Begin
new(q);
q^.Name:=d.Name;
q^.Next:=l^.Next;
l^.Next:=q;
End;
End;
End;
Procedure Add_(ListLR:NotTerm);
Var tmp,p:NotTerm;
tmp2:NotTerm;
tmpName:Str10;
y,j:Byte;
inf:List;
inf2:List;
Begin
y:=1;
tmp:=ListLR;{список с разделителями}
p:=tmp;
Repeat
{ищем нетерминал (в левых или правых)}
tmp:=p;
tmp2:=NotTerminalL;
While (tmp<>Nil) and (Pos('<',tmp^.Name)<>1) Do
Begin
If tmp^.Name=#0 Then inc(y);
tmp:=tmp^.Next;
End;
If tmp=Nil Then p:=Nil
Else If tmp^.Next<>Nil Then
p:=tmp^.Next{сохраняем позицию указатель на следующий}
Else p:=Nil;
tmpName:=tmp^.Name;
i:=1;
{ищем tmpName в правых или левых}
If tmp<>Nil Then Seek(tmpName,ListLR,tmp);
{tmp указывает на элемент с которого нужно начать добавлять}
inf2.Name:=tmpName;
While (tmp<>Nil) and (tmp^.Name<>#0) Do
Begin
inf.Name:=tmp^.Name;{!!! нужно проверить на повторяющиеся !!!}
If SearchInBlock(y,ListLR,inf)=0 Then
InsListInBlock(y,ListLR,inf2,inf);
tmp:=tmp^.Next;
End;
Until p=Nil;
End;
Var tmp:List;
term:String;
Label More,Next;
Begin
{предполагаем что грамматика не содержит ошибок}
{анализ грамматики без отслеживания ошибок}
y:=1;
i:=1;
Repeat
PosStr(y,s);
Blank;
i:=Pos('=',S)+1;{i ставим после :=}
More:Blank;
If s[i]='<' Then
Begin
inc(i);
Blank;
Terminal(term);
tmp.Name:='<'+term+'>';
If (SearchInBlock(y,LTN,tmp)=0) and (term>'') Then
Complete(LTN,tmp);{добавляем левый}
Blank;
inc(i);
End
Else
Begin
Terminal(term);
tmp.Name:=term;
If (SearchInBlock(y,LTN,tmp)=0) and (term>'') Then
Complete(LTN,tmp);{добавляем левый}
If (i-1)=Len Then {после := или после | только один терминал}
Complete(RTN,tmp);
End;
If i>Len Then Goto Next;{последний в строке был терминал}
While (i<Len) and (S[i+1]<>'|') Do inc(i);{до конца правила}
If s[i]='>' Then {последний в правиле нетерминал}
Begin
While (i>1) and (s[i]<>'<') Do dec(i);
inc(i);
Blank;
Terminal(term);{последний нетерминал}
tmp.Name:='<'+term+'>';
If (SearchInBlock(y,RTN,tmp)=0) and (term>'') Then
Complete(RTN,tmp);{добавляем правый}
inc(i);{пропуск >}
If s[i]='|' Then
Begin
inc(i);
Goto More;
End;
End
Else{последний в правиле терминал}
Begin
While (i>1) and not((s[i]=' ') or (s[i]='|') or (s[i]='>')) Do dec(i);
inc(i);
Blank;
Terminal(term);
tmp.Name:=term;
If (SearchInBlock(y,RTN,tmp)=0) and (term>'') Then
Complete(RTN,tmp);{добавляем правый}
If s[i]='|' Then
Begin
inc(i);
Goto More;
End;
End;
If i<Len Then{прошли не всю строку}
Goto More;
next:inc(y);
tmp.Name:=#0;{после каждой строки ставим разделитель}
Complete(LTN,tmp);{добавляем левый}
Complete(RTN,tmp);{добавляем правый}
Until y>CLine;
{после цикла получили "предварительные" левые и правые, их еще надо дополнить}
For y:=1 To 10 Do
Begin
Add_(LTn);
Add_(RTn);
End;
{получили левые и правые, разделенные #0}
End;
Procedure Matrix;
Procedure Precede;
Label More,Next;
Var mi,mj:Byte;
tmp:List;
p:NotTerm;
term,term2:String;
Ex:Boolean;
Begin
y:=1;
i:=1;
Repeat
PosStr(y,s);
Blank;
i:=Pos('=',S)+1;{i ставим после :=}
More:Blank;
If s[i]='<' Then
Begin
inc(i);
Blank;
Terminal(term);
tmp.Name:='<'+term+'>';
term2:=tmp.Name;
Blank;
inc(i);
mi:=Search(Trm_notTrm,tmp);
If Terminal(term) Then{нетерминал за ним терминал}