arbre_binaire.adb

with Ada.Text_Io; use Ada.Text_Io;
with Ada.Unchecked_Deallocation;

package body Arbre_Binaire is

   procedure Liberer is new Ada.Unchecked_Deallocation(T_Noeud,T_Arbre);

   procedure Position(A         : in     T_Arbre;
                      Cle       : in     Integer;
                      Nd,Parent : in out T_Arbre) is
   begin
      if A = null then
         raise ARBRE_VIDE;
      end if;
      while Nd.Cle /= Cle loop
         if Cle < Nd.Cle then
            exit when Nd.Gauche = null;
            Parent := Nd;
            Nd     := Nd.Gauche;
         else
            exit when Nd.Droite = null;
            Parent := Nd;
            Nd     := Nd.Droite;
         end if;
      end loop;
   end Position;

   procedure Insert(A : in out T_Arbre; Cle : in Integer) is
      Parent : T_Arbre := null;
      Nd     : T_Arbre := A;
   begin
      Position(A,Cle,Nd,Parent);
      if Cle < Nd.Cle then
         Nd.Gauche := new T_Noeud'(Cle,null,null);
      elsif Cle > Nd.Cle then
         Nd.Droite := new T_Noeud'(Cle,null,null);
      else
         raise CLE_PRESENTE;
      end if;
   exception
      when ARBRE_VIDE => A := new T_Noeud'(Cle,null,null);
   end Insert;

   procedure Delete(A : in out T_Arbre; Cle : in Integer) is
      Parent, Tmp : T_Arbre := null;
      Nd          : T_Arbre := A;
   begin
      Position(A,Cle,Nd,Parent);
      if Cle /= Nd.Cle then
         raise CLE_ABSENTE;
      end if;
      if Nd.Gauche /= null then
         Parent := Nd;
         Tmp    := Nd.Gauche;
         Position(Nd.Gauche,Cle,Tmp,Parent);
      elsif Nd.Droite /= null then
         Parent := Nd;
         Tmp    := Nd.Droite;
         Position(Nd.Droite,Cle,Tmp,Parent);
      end if;
      Nd.Cle := Tmp.Cle;
      if Parent = null then
         A := null;
      elsif Parent.Gauche = Tmp then
         Parent.Gauche := Tmp.Gauche;
      else
         Parent.Droite := Tmp.Droite;
      end if;
      Liberer(Tmp);
   end Delete;

   function Search(A : T_Arbre; Cle : Integer) return T_Arbre is
      Parent : T_Arbre := null;
      Nd     : T_Arbre := A;
   begin
      Position(A,Cle,Nd,Parent);
      if Cle /= Nd.Cle then
         raise CLE_ABSENTE;
      end if;
      return Nd;
   end Search;

end Arbre_Binaire;