Ну воощем задача на арифметику, через стеки, правда поддерживает тока, пока, + - * /

var i,uk,uk1,n:integer;
    q,q1:array[1..100] of string;
    s,s1,s2:string;
procedure add(n:string);
begin
  inc(uk);
  q[uk]:=n;
end;
procedure add1(n:string);
begin
  inc(uk1);
  q1[uk1]:=n;
end;
Function extr:string;
begin
  extr:=q[uk];
  dec(uk);
end;
Function extr1:string;
begin
  extr1:=q1[uk1];
  dec(uk1);
end;
Function f(a,b,c:string):string;
var a1,b1,code:integer;
    a2:real;
    cc:string;
begin
   val(a,a1,code);
   val(b,b1,code);
    case c[1] of
     '+':str(a1+b1,cc);
     '-':str(a1-b1,cc);
     '*':str(a1*b1,cc);
    end;
    f:=cc;
end;
Begin
readln(s);
i:=1; uk:=0; uk1:=0;
  while i<=length(s) do
   begin
    s1:='';
     while s[i] in ['0'..'9'] do
      begin
       s1:=s1+s[i];
       inc(i);
      end;
     if length(s1)<>0 then add(s1) else
      begin
       case s[i] of
        '(':add1('(');
        ')':begin s1:=extr1;
             while s1<>'(' do
              begin
                add(s1);
                s1:=extr1;
              end;
            end;
        '+':begin
                  {while (q1[uk1][1] in ['+','-','*']) do  add(extr1);}
                  add1(s[i]);
            end;
        '-':begin
{                  while (q1[uk1][1] in ['+','-','*']) do  add(extr1);  }
                  add1(s[i]);
                end;
        '*':begin
{                 while (q1[uk1][1]='*') do  add(extr1);}
                  add1(s[i]);
                end;
       end;
       inc(i);
      end;
   end;

if uk1<>0 then
  for i:=1 to uk1 do
   add(extr1);

s1:='';
for i:=1 to uk do
  add1(extr);

while (uk1<>0) do
  begin
   s1:=extr1;
    case s1[1] of
     '0'..'9':add(s1);
     '+','-','*','/':
      begin
       s2:=f(extr,extr,s1);
       add(s2);
      end;
    end;
  end;
write(extr);

end.