program bool;
uses crt;
Procedure UpChar ( var s : string);

var i: byte;
Begin
For i:= 1 to length(s) do
s[i]:=UpCase(s[i]);
end;
 
function finish:boolean;
var ch,scr:char;
begin
  writeln('   Prodolgit? (Y - Yes, N - Now)  ');
  ch:=readkey;
  if upcase(ch)='Y'
  then
  finish:=false
  else
  finish:=true;
  end;
function Bin(n, r: longint): string;
 var s: string;
 const
  d: string[16] = '0123456789ABCDEF';
 begin
  s := '';
  repeat
   s := d[(n mod r) + 1] + s;
   n := n div r;
  until n = 0;
  while length(s) < 2 do s := '0' + s;
   Bin := s;
 end;
function nul(s: string; n: integer): string;
 begin
  while length(s) < n do s := '0' + s;
  nul := s;
 end;
const  per: string[6] = 'ABCDEF';
var
 i, j, p, pp, vars_count,c,cc,f,ddd,g,dddd: integer;
 ch,d,ch1: char;
  l_v, st, bs,s, prs,k,w,result,s1,s2,s3,s4,s5,s6,s7: string;
 b_s, b_m: boolean;
begin
Repeat
Clrscr;

 Writeln('Vvedite Func: ');
 readln(s1);
 UpChar(s1);
 While pos('>',s1)>0 do
   Begin
      s1[pos('>',s1)]:='+';
      insert('\',s1,pos('>',s1)-2);
   End;
     s:=s1;
For ch1:='(' to ')' do               {Skobki}
    s3:=copy(s,pos('(',s2)+1,pos(')',s2)-pos('(',s2)-1);
    f:=length(s3);
   IF pos('+',s)=(pos('(',s)-1) then     {A+(A+B) A+(A*B)}
    begin
      delete(s,pos('(',s),1);
      delete(s,pos('(',s)+length(s),1);
    End;
   s5:=s;
   s7:=s;
    IF pos('\',s7)=(pos('(',s7)-1) then   {\(A+B)}
      Begin
        s6:=copy(s7,pos('(',s7)+1,pos(')',s7)-pos('(',s7)-1);
        While pos('+',s6)>0 do
         begin
           s6[pos('+',s6)]:='\';
         end;
        delete(s,pos('(',s)+1,length(s6)+1);
        insert(s6,s,pos('(',s)+1);
        delete(s,pos('(',s),1);
      End;

    for g:=1 to 100 do
    Begin
       IF pos(per[g],s)=(pos('(',s)-1) then
          begin
             If pos('+',s)>pos('(',s) then
              if pos('+',s)<pos(')',s) then {A*(A+B) }
                begin
                 insert(per[g],s,pos('+',s)+1);
                 delete(s,pos('(',s),1);
                 delete(s,pos('(',s)+length(s),1);
                End;
       IF pos(per[g],s)=(pos('(',s)-1) then    {A*(A*B)}
               begin
                 delete(s,pos('(',s),1);
                 delete(s,pos('(',s)+length(s),1);
               End;
          End;
    End;

   result:='';                  {Algoritm }
 for ch:='A' to 'Z' do
 if pos(ch,s)>0 then
  result:=result+ch;
w:=result;
 vars_count := 0; prs := '';
 for ch := 'A' to 'Z' do
 begin
  if pos(ch, s) > 0 then
  begin
   inc(vars_count);
   prs := prs + ch;
  end;
 end;
 for i := 0 to pred(1 shl vars_count) do
 begin
  l_v := nul(Bin(i, 2), vars_count);
  st := s + '+';
  b_s := false;
  repeat
   p := pos('+', st);
   if p > 0 then
   begin
    bs := copy(st, 1, pred(p));
    b_m := true;
    for j := 1 to length(prs) do
    begin
     pp := pos(prs[j], bs);
     if pp > 0 then
     begin
      if (pp > 1) and (bs[pp - 1] = '\') then
      begin
       b_m := b_m and not(l_v[j] = '1')
      end
     else
     begin
       b_m := b_m and (l_v[j] = '1');
      end;
     end;
   end;
  delete(st, 1, p);
  b_s := b_s or b_m;
  end
 until p = 0;
If b_s=true  Then
 begin
    For j:=1 to length (w) do
     Begin
      if l_v[j]='1' then write(w[j]);
      if l_v[j]='0' then write('\',w[j]);
     End;
    Write('+');
 End;
end;
Writeln('  ' );

until finish;
end.

Вот задача которая должна булевскую функцию к нормальной форме приводить. Она и приводит, только проблема при работу со скобками. Неправильно она работает в случае типа: (A+B)(\A+C). \ - отрицание. Помогите ее доработать что бы в таких случаех результат был верен.