program list_d_c;  (* listes doublement chaînées *)

uses crt;

type TDonnee=INTEGER;

type PCellule = ^Cellule;
     Cellule = record
                 nb:integer;
                 prec,suiv:PCellule;
               end;

function init_liste:PCellule;
(* fonction qui retourne une liste vide *)
begin
init_liste:=nil;
end;

function insere(l:PCellule;elem:TDonnee):PCellule;
(* fonction insérant un élément elem devant la cellule pointée par l et
retourne le pointeur de la nouvelle liste ainsi crée *)
var temp:PCellule;
begin
  new(temp);         (* création nouvelle cellule *)
  temp^.nb:=elem;        (* affectation *)
  temp^.suiv:=l;      (* recollement avec la suite *)
  if l<>nil       (*  si liste vide  *)
    then  begin
          temp^.prec:=l^.prec;     (* on crée un liste... *)
          l^.prec:=temp;           (* ...à un élément *)
          end
    else temp^.prec:=nil;     (* s'il y a des cellules derriere *)
  if temp^.prec<>nil           (* on recolle alors aussi ... *)
    then temp^.prec^.suiv:=temp; (* ...de l'autre coté *)
  insere:=temp;
end;

function supp_prec(l:PCellule):PCellule;
(* fonction supprimant la cellule précédant celle pointée par l *)
(* Est retourné un pointeur pointant sur la nouvelle liste *)
var ptr,ptr_prec:PCellule;
begin
  if (l=nil) or (l^.prec=nil)    (* si pas de précédente ou liste vide *)
    then supp_prec:=l             (* on change rien *)
    else begin                   (* sinon *)
         ptr:=l^.prec;            (* on garde trace... *)
         ptr_prec:=ptr^.prec;     (* ...de ce qui précède... *)
         ptr_prec^.suiv:=l;       (* ...de ce qui suit... *)
         l^.prec:=ptr_prec;       (* ...on recolle... *)
         dispose(ptr);            (* ...puis enfin on fait du ménage! *)
         supp_prec:=l;
         end;
end;

function supp_suiv(l:PCellule):PCellule;
(* pareil que la précédente mais de l'autre coté (donc no comment!) *)
var ptr,ptr_suiv:PCellule;
begin
  if (l=nil) or (l^.suiv=nil)
    then supp_suiv:=l
    else begin
         ptr:=l^.suiv;
         ptr_suiv:=ptr^.suiv;
         l^.suiv:=ptr_suiv;
         ptr_suiv^.prec:=l;
         dispose(ptr);
         supp_suiv:=l;
         end;
end;

function debut(l:PCellule):PCellule;
(* fonction retrouvant le pointeur de la première cellule *)
(* notez que c'est exeptionellement de l'itératif ! *)
begin
  if l<>nil then while (l^.prec<>nil) do l:=l^.prec; (* dur à comprendre ? *)
  debut:=l;
end;


procedure aff(l:PCellule);
(* procédure d'affichage de tous les éléments... également itératif pour
changer un peu ! *)
begin
  l:=debut(l);
  while l<>nil do
    begin
      writeln(l^.nb);
      l:=l^.suiv;
    end;
end;

(* ce qui suit montre comment utiliser les fonctions précédentes... *)

var l,p:PCellule;

BEGIN
clrscr;
l:=nil;
l:=insere(l,1);
l:=insere(l,2);
l:=insere(l,5);
l:=insere(l,6);
aff(l);
writeln;
l:=supp_prec(l^.suiv);
aff(l);
writeln;
l:=supp_suiv(l);
aff(l);
END.