tpu/u_lispif.pas

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

 Lista de enteros por punteros. Incluye un puntero a la
 celda final, para reducir el orden de las operaciones en
 la funci\'on FIN. Tambi\'en hace los dispose de las celdas
 liberadas tanto en SUPRIME como en ANULA.
 keywords: lista, punteros

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_lispif.pas,v 1.1 2002/04/25 15:57:09 mstorti Exp mstorti $   }

unit u_lispif ;

interface

type

  tipo_elemento = integer;

  ptipo_celda = ^tipo_celda;
  tipo_celda = record
    elemento: tipo_elemento;
    sig     : ptipo_celda
  end;

  posicion = ptipo_celda;

  lispif = object
  private
    cab, final : posicion;
    procedure ERROR (s: string);
  public
    procedure INSERTA   (x: tipo_elemento; p: posicion);
    function  LOCALIZA  (x: tipo_elemento): posicion;
    function  RECUPERA  (p: posicion) : tipo_elemento;
    procedure SUPRIME   (p: posicion) ;
    function  SIGUIENTE (p: posicion) : posicion;
    function  ANTERIOR  (p: posicion) : posicion;
    function  ANULA   : posicion;
    function  PRIMERO : posicion;
    function  FIN     : posicion;
    procedure IMPRIME (s: string) ;
  end ;			    

  implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure lispif.INSERTA (x: tipo_elemento; p: posicion);
var
   temp : posicion;
begin
   temp := p^.sig;
   new (p^.sig);
   { Si la celda se inserta en FIN(L) entonces hay que
     actualizar la posicion `final'}
   if (p = final) then final := p^.sig;
   p^.sig^.elemento := x;
   p^.sig^.sig := temp;
end; {INSERTA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.LOCALIZA (x: tipo_elemento): posicion;
var
  q: posicion;
begin
  q := PRIMERO;
  while (q^.sig <> nil) and (q^.sig^.elemento <> x )
    do q := q^.sig;
  LOCALIZA := q;
end; {LOCALIZA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.RECUPERA (p: posicion): tipo_elemento;
begin
  RECUPERA := p^.sig^.elemento;
end; {RECUPERA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure lispif.SUPRIME (p: posicion);
var
   temp :  posicion;
begin
   temp := p^.sig;
   p^.sig := p^.sig^.sig;
   { Actualizar `final' si borramos la ultima celda }
   if (p^.sig = nil) then final := p;
   dispose (temp);
end; {SUPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.SIGUIENTE (p: posicion): posicion;
begin
  SIGUIENTE := p^.sig;
end; {SIGUIENTE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.ANTERIOR (p: posicion): posicion;
var
  q, r : posicion;
begin
  r := PRIMERO ;
  q := PRIMERO ;
  while (q <> p) and (q^.sig <> nil) do begin
    r := q;
    q := q^.sig;
  end;
  ANTERIOR := r;
end; {ANTERIOR}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.ANULA : posicion;
var
   q1,q2 : posicion;
begin
   { Inicializa la lista que no fue inicializada }
   if (cab = nil) then begin
      new (cab);
      cab^.sig := nil;
   end;
   { Hace dispose de celdas, si la lista tenia elementos }
   q1 := cab^.sig;
   while (q1 <> nil) do begin
      q2 := q1^.sig;
      dispose (q1);
      q1 := q2;
   end;
   final := cab;
   ANULA := cab;
   cab^.sig := nil;
end; {ANULA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.PRIMERO : posicion;
begin
  PRIMERO := cab;
end; {PRIMERO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function lispif.FIN : posicion;
begin
  FIN := final;
end; {FIN}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure lispif.IMPRIME (s: string) ;
var
  q : ptipo_celda;
begin
  if length (s) > 0 then
     write (s)
  else
     write ('lista: ');

  q := PRIMERO ;
  while ( q <> final ) do begin {aqui usamos puntero al final}
    write ( RECUPERA (q), ' ');
    q := SIGUIENTE (q);
  end ; {while}
  writeln ;
end; {IMPRIME}

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}