没写过几次这么繁琐的code..
贴一下
var
s:ansistring;
p2:array[1..1000] of char;
p1:array[0..1000] of char;
j,k,k1,k2,num,i,top1,top2,top3,z:longint;
f:array[0..5,1..5] of char;
p3:array[1..1000] of string;
function pop1:char;
begin
pop1:=p1[top1];
end;
procedure push1(x:char);
begin
top1:=top1+1;
p1[top1]:=x;
end;
procedure push2(x:char);
begin
top2:=top2+1;
p2[top2]:=x;
end;
function exch(x:char):longint;
var
i,j:longint;
begin
for i:=0 to 4 do
for j:=1 to 2 do
if f[i,j]=x then exit(i);
end;
begin
readln(s);
f[1,1]:='(';f[2,1]:='+';f[2,2]:='-';f[3,1]:='*';f[3,2]:='/';
f[0,1]:='@';f[4,1]:='^';
p1[0]:='@';
for i:=1 to length(s) do
begin
if (s[i]>='0')and(s[i]<='9') then
push2(s[i])
else
begin
if s[i]='(' then push1(s[i])
else
if s[i]=')' then
begin
while pop1<>'(' do
begin
push2(pop1);
top1:=top1-1;
end;
top1:=top1-1;
end
else
begin
if exch(s[i])>exch(pop1)then
push1(s[i])
else
begin
while (exch(s[i])<=exch(pop1))
and(pop1<>'(')and(top1>0) do
begin
push2(pop1);
top1:=top1-1;
end;
push1(s[i]);
end;
end;
end;
end;
num:=top1;
for i:=top2+1 to top1+top2 do
begin
p2[i]:=p1[num];
num:=num-1;
end;
top2:=top1+top2;
for i:=1 to top2-1 do
write(p2[i],' ');
writeln(p2[top2]);
for i:=1 to top2 do
p3[i]:=p3[i]+p2[i];
top3:=top2;
while top3>1 do
begin
for i:=1 to top3 do
if (p3[i]='+')or(p3[i]='-')or(p3[i]='/')or(p3[i]='*')or(p3[i]='^')
then break;
val(p3[i-2],k1);val(p3[i-1],k2);
if p3[i]='+' then k:=k1+k2;
if p3[i]='-' then k:=k1-k2;
if p3[i]='*' then k:=k1*k2;
if p3[i]='/' then k:=k1 div k2;
if p3[i]='^' then begin
k:=1;
for z:=1 to k2 do
k:=k*k1;
end;
str(k,p3[i-2]);
for j:=i-1 to top3-2 do
p3[j]:=p3[j+2];
top3:=top3-2;
for j:=1 to top3-1 do
write(p3[j],' ');
writeln(p3[top3]);
end;
end.