tpu/u_pilap.pas

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 
{ COMIENZO DE DESCRIPCION

Pilas de __TIPO_EN_ESPANOL__  por punteros. keywords: pila

FIN DE DESCRIPCION }
{ $Id: u_pilapi.pas,v 1.2 2002/04/25 16:06:10 mstorti Exp $}
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 

unit __UNIT__;

type
   tipo_elemento = __TIPO__
		
  p_tipo_celda = ^tipo_celda;

  tipo_celda = record
    elemento: tipo_elemento;
    sig:      p_tipo_celda
  end;

  pila = object
  private
    top : p_tipo_celda;
    procedure ERROR (s: string);
  public
    procedure ANULA;
    procedure METE (x:tipo_elemento);
    procedure SACA;
    function  VACIA : boolean;
    function  TOPE  : tipo_elemento;
    procedure IMPRIME (s : string) ;
  end;			    

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure __UNIT__.ANULA;
var
   p,q : p_tipo_celda;
begin
   if top=nil then new(top);
   q := top^.sig;
   while q <> nil do
   begin
      p:=q^.sig;
      dispose(q);
      q:=p;
   end;
   top^.sig := nil;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 
procedure __UNIT__.METE (x: tipo_elemento);
var
  aux: p_tipo_celda;
begin
   new(aux);
   aux^.elemento := x;
   aux^.sig := top^.sig;
   top^.sig := aux;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure __UNIT__.SACA;
var
   q : p_tipo_celda;
begin
   if (VACIA) then ERROR ('la pila esta vacia');
   q := top^.sig;
   top^.sig  := top^.sig^.sig ;
   dispose(q);
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 
function  __UNIT__.VACIA : boolean;
begin
  VACIA := ( top^.sig = nil );
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 
function  __UNIT__.TOPE : tipo_elemento;
begin
  if ( VACIA ) then ERROR (' la pila esta vacia');
  TOPE := top^.sig^.elemento ;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----} 
procedure __UNIT__.IMPRIME (s: string) ;
var
   q : p_tipo_celda;
begin
   if length (s) > 0 then
      write (s)
   else
      write ('pila: ');
   q := top^.sig;
   while q<>nil do
   begin
      __IMPRIME__;
      q := q^.sig;
   end ; {while}
   writeln ;
end;

end.