aritme_pil.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

  Evalua expresiones aritm\'eticas en notaci\'on postfija
  utilizando una pila. keywords: pila

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: aritme_pil.pas 2002/04/25 10:00 mstorti Exp mstorti$ }

program aritme_pil;

uses u_pilapr;

type
  pila = pilapr;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ERROR (s: string);
begin
   write ('error: ');
   writeln (s);
   halt;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure METE_PUEDE_SER (var s: string; var P: pila);
var
  code : integer;
  r    :  real;
begin
  if ( length (s) > 0 ) then begin
    val (s,r,code);
    P.METE (r);
    s := '';
  end;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
   P        : pila;
   op1, op2 : real;
   c        : char;
   s        : string;
begin
   {inicializa la pila}
   P.ANULA;
   s := '';
   while (true) do begin
     write ('> ');
     while (true) do begin
       read (c);
       case (c) of
       '*', '-', '+', '/':
            begin
            METE_PUEDE_SER (s,P);
            op2 := P.TOPE;
            P.SACA;
            op1 := P.TOPE;
            P.SACA;
              case (c) of
              '*' : P.METE (op1*op2);
              '+' : P.METE (op1+op2);
              '-' : P.METE (op1-op2);
              '/' : P.METE (op1/op2);
              end;
            end;
       #10: begin {nueva linea}
            METE_PUEDE_SER (s,P);
            op1 := P.TOPE;
            P.IMPRIME ('pila: ');
            break ;
            end;
       '0' .. '9', '.': begin
            s := s + c ;
            end;
       ' ': begin
            METE_PUEDE_SER (s,P);
            end;
       #13: {para retorno de carro en DOS}
       else
            ERROR ('not valid character.');
       end; {case}
     end; {while}
   end; {while}
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}