Вводится логическое выражение из 0, 1, скобок и знаков логических операций. Транслятор переводит выражение в постфиксную запись а затем вычисляет его значение. Почти готовая курсовая работа.

Uses CRT;

{
Транслятор логических выражений.
Вводится логическое выражение из 0, 1, скобок и знаков логических операций.
Транслятор переводит выражение в постфиксную запись а затем вычисляет его значение.
}

Const OperSet:set of char= ['+','&','*','!','(',')','A','V','>'];

Var S : String;
 OutputString : String;

Function DelSpase(S:String):String;
Var T : String;
 I : Word;
Begin
 T := '';
 For I := 1 To Length(S) Do Begin
 If S[I] <> ' ' Then T := T + S[I];
 End;
 DelSpase := T;
End;

Function InfixPostfix(N:String):String;
Var T : String;
 I,TopStack : Word;
 Stack : array [1..10] of Char;
 SymbTmp,Symb : Char;
 
 Function ChToInt(C:Char):Integer;
 Var Result : Integer;
 Begin
 Case C Of
 '(': Result := 0;
 ')': Result := 1;
 '+': Result := 2;
 'V': Result := 2;
 '*': Result := 3;
 '&': Result := 3;
 '>': Result := 3;
 'A': Result := 3;
 '!': Result := 4;
 End;
 ChToInt := Result;
 End;

 Function PRCD(Ch1, Ch2 : Char):Boolean;
 Var Result : Boolean;
 Begin
 If ChToInt(Ch1) >= ChToInt(Ch2) Then Result := True
 Else Result := False;
 If Ch2='(' Then Result := False;
 If Ch1='(' Then Result := False;
 If (Ch2=')') And (Ch1<>'(') Then Result := True;
 If (Ch2='(') And (Ch1=')') Then Result := False;
 PRCD := Result;
 End;

 Function Empty:Boolean;
 Var Result : Boolean;
 Begin
 If TopStack = 0 Then Result := True
 Else Result := False;
 Empty := Result;
 End;

 Function TopStackSymb:Char;
 Begin
 TopStackSymb := Stack[TopStack];
 End;

 Procedure Push(Ch : Char);
 Begin
 Inc(TopStack);
 Stack[TopStack] := Ch;
 End;

 Function Pop:Char;
 Begin
 Pop := Stack[TopStack];
 Stack[TopStack] := ' ';
 Dec(TopStack);
 End;

Begin
 T := '';
 TopStack := 0;
 For I := 1 To 10 Do Stack[I] := ' ';
 For I := 1 To Length(N) Do Begin
 Symb := N[I];
 If Symb IN OperSet
 Then Begin
 While Not(Empty) And PRCD(TopStackSymb,Symb) Do Begin 
 SymbTmp := Pop;
 T := T + SymbTmp;
 End;
 If (Empty) Or (Symb<>')') Then Push(Symb) 
 Else SymbTmp := Pop;
 End Else T := T + Symb;
 End;
 While Not(Empty) Do Begin
 SymbTmp := Pop;
 T := T + SymbTmp;
 End;
 InfixPostfix := T;
End;


Function Sintax:Boolean;
Var Skobka : Word;
 I : Word;
 F : Boolean;

 Function Lexica(C:Char):Byte;
 Var Result : Byte;
 Begin
 Case C Of
 '(': Result := 2;
 ')': Result := 3;
 '+': Result := 1;
 'V': Result := 1;
 '*': Result := 1;
 '&': Result := 1;
 'A': Result := 1;
 '>': Result := 1;
 '!': Result := 0;
 '0': Result := 4;
 '1': Result := 4;
 Else Result := 5
 End;
 Lexica := Result;
 End;

 Procedure ERROR;
 Begin
 F := False;
 End;

 Procedure SOU; Forward; {унарный оператор}
 Procedure SOB; Forward; {бинарный оператор}
 Procedure SRO; Forward; {разделитель открывающий}
 Procedure SRZ; Forward; {разделитель закрывающий}
 Procedure SC; Forward; {число}

 Procedure SC;
 Begin
 Inc(I);
 If F AND (I <= Length(S))
 Then Case Lexica(S[I]) Of
 1: SOB;
 3: SRZ;
 Else ERROR
 End;
 End;

 Procedure SOU;
 Begin
 Inc(I);
 If F AND (I <= Length(S))
 Then Case Lexica(S[I]) Of
 2: SRO;
 4: SC;
 Else ERROR
 End
 Else ERROR;
 End;

 Procedure SOB;
 Begin
 Inc(I);
 If F AND (I <= Length(S))
 Then Case Lexica(S[I]) Of
 0: SOU;
 2: SRO;
 4: SC;
 Else ERROR
 End
 Else ERROR;
 End;

 Procedure SRO;
 Begin
 Inc(Skobka);
 Inc(I);
 If F AND (I <= Length(S))
 Then Case Lexica(S[I]) Of
 0: SOU;
 2: SRO;
 4: SC;
 Else ERROR
 End
 Else ERROR;
 End;

 Procedure SRZ;
 Begin
 Dec(Skobka);
 Inc(I);
 If F AND (I <= Length(S))
 Then Case Lexica(S[I]) Of
 1: SOB;
 3: SRZ;
 Else ERROR
 End;
 End;

Begin
 F := True;
 Skobka := 0;
 I := 1;
 If F Then Case Lexica(S[I]) Of
 0: SOU;
 2: SRO;
 4: SC;
 Else ERROR
 End;
 If Skobka <> 0 Then F := False;
 Sintax := F;
End;

Function Calc(St:String):Boolean;
Var I : Integer;
 Top : Integer;
 Stack : Array[1..10] Of Boolean;

 Function CharToBool(N:Char):Boolean;
 Begin
 If N = '0' Then CharToBool := FALSE;
 If N = '1' Then CharToBool := TRUE;
 End;

Begin
 Top := 1;
 Stack[Top] := CharToBool(St[1]);

 For I := 2 To Length(St) Do Begin
 If St[I] IN OperSet
 Then Begin
 Case St[I] Of
{инверсия} '!': Stack[Top] := NOT(Stack[Top]);
{конъюнкция} '&','A','*': Begin
 Stack[Top-1] := Stack[Top-1] AND Stack[Top];
 Dec(Top);
 End;
{дизъюнкция} '+','V': Begin
 Stack[Top-1] := Stack[Top-1] OR Stack[Top];
 Dec(Top);
 End;
{импликация} '>': Begin
 Stack[Top-1] := NOT(Stack[Top-1]) OR Stack[Top];
 Dec(Top);
 End; {begin}
 End; {case}
 End {then}
 Else Begin
 Inc(Top);
 Stack[Top] := CharToBool(St[I]);
 End; {else}
 End;
 Calc := Stack[Top];
End;

Begin
 ClrScr;
 OutputString := '';
 Write('Введите логическое выражение из 0 и 1 : ');
 ReadLn(S);

{удаляем пробелы}
 S := DelSpase(S);
 Write('Введеное выражение без пробелов : ');
 WriteLn(S);

{проверяем на наличие ошибок}
 If Sintax Then Begin
 OutputString := InfixPostfix(S);

 Write('Постфиксная запись выражения : ');
 WriteLn(OutputString);

 Write('Значение выражения : ');
 WriteLn(Calc(OutputString));

 End Else WriteLn('Синтаксическая ошибка');
 ReadLn;
End.