Cod sursa(job #160170)

Utilizator vanila_CPPIonescu Victor Cristian vanila_CPP Data 14 martie 2008 20:10:01
Problema Evaluarea unei expresii Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 2.94 kb
program evaluare;
var f,g:text;
    st:array[1..100001] of longint;
    oper:array[1..100001] of char;
    stlen,olen,x:longint;
    defx:boolean;



function prio(c:char):longint;
begin
        if (c='+') or (c='-') then prio:=1 else prio:=2;
end;



procedure iofile;
begin
        assign(f,'evaluare.in');reset(f);
        assign(g,'evaluare.out');rewrite(g);
end;


procedure operatie(c:char);
var x:longint;
begin
        if (c='+') then x:=st[stlen]+st[stlen-1] else
        if (c='-') then x:=st[stlen-1]-st[stlen] else
        if (c='*') then x:=st[stlen-1]*st[stlen] else
        x:=st[stlen-1] div st[stlen];
        dec(stlen);
        st[stlen]:=x;
end;

procedure erase_oper_high;
begin
        while (olen>0)and(oper[olen]<>'(')and(prio(oper[olen])=2) do
                begin
                        operatie(oper[olen]);
                        dec(olen);
                end;
end;


procedure erase_oper;
var i:longint;
begin
        while (olen>0 ) and ( oper[olen]<>'(') do
                begin
                        operatie(oper[olen]);
                        dec(olen);
                end;
        if olen>0 then dec(olen);
end;


procedure prel_char(c:char);
begin
        if c='(' then
                begin
                        inc(olen);
                        oper[olen]:=c;
                end else
                        if c=')' then begin
                                if (defx) then
                                        begin
                                                inc(stlen);
                                                st[stlen]:=x;
                                                x:=0;
                                                defx:=false;
                                        end;
                                       erase_oper;
                                        end
                                                else
                        if (c>='0')and(c<='9') then begin x:=x*10+ord(c)-ord('0');defx:=true; end  else
                        begin
                                if (defx) then
                                begin
                                        inc(stlen);
                                        st[stlen]:=x;
                                        x:=0;
                                        defx:=false;
                                end;
                                if prio(c)=1 then erase_oper_high;
                                inc(olen);
                                oper[olen]:=c;
                        end;
end;


procedure solve;
var i:longint;
        c:char;
begin
        defx:=false;
        olen:=0;
        stlen:=0;
        while not eoln(f) do
                begin
                        read(f,c);
                prel_char(c);end;
        if defx then begin
                inc(stlen);
                st[stlen]:=x;
                end;
        erase_oper;
        writeln(g,st[1]);
        close(g);
end;


begin
        iofile;
        solve;
end.