Смекни!
smekni.com

Построение функции предшествования по заданной КС-грамматике (стр. 3 из 4)

5. Текст программы

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{нетерминал за ним терминал}