kantis

===================================
============ .ads =================
===================================

generic
   type Data_Type is private;
   type Key_Type is private;
   with function Get_Key(Object : in Data_Type) return Key_Type;
   with procedure Put(Object : in Data_Type);
   with function ">"(Left : in Data_Type; Right : in Data_Type) return Boolean;
   with function "="(Left : in Data_Type; Right : in Data_Type) return Boolean;

package Generic_Sorted_List is
   type Element_Type is private;
   type List_Type is private;

   function Empty(List : in List_Type) return Boolean;

   function Member(Object  : in Data_Type;
                   List : in List_Type) return Boolean;
   procedure Insert(Object : in Data_Type; List : in out List_Type);
   procedure Put(List : in List_Type);
   procedure Remove(Key : in Key_Type; List : in out List_Type);
   procedure Delete(List : out List_Type);
   function Find(Object : in Key_Type;
                 List : in List_Type) return Data_Type;
   procedure Find(New_List : out Data_Type;
                  Object : in Key_Type;
                  List : in List_Type);
   function Length(List : in List_Type) return Integer;

   Element_Not_Found : exception;

private
   type List_Type is
     access Element_Type;

   type Element_Type is
      record
         Data : Data_Type;
         Next : List_Type;
      end record;
end Generic_Sorted_List;


===================================
============ .adb =================
===================================


with Ada.Unchecked_Deallocation;

package body Generic_Sorted_List is

   procedure Free is
      new Ada.Unchecked_Deallocation(Object => Element_Type,
                                     Name => List_Type);

   function Empty(List : in List_Type) return Boolean is
   begin
      if List = null then
         return True;
      else
         return False;
      end if;
   end Empty;

   function Member(Object : in Data_Type;
                   List : in List_Type) return Boolean is
      Iterator : List_Type;
   begin
      Iterator := List;
      while not Empty(Iterator) loop
         if Object = Iterator.Data then
            return True;
         end if;
         Iterator := Iterator.Next;
      end loop;
      return False;
   end Member;

   procedure Insert(Object : in Data_Type;
                    List : in out List_Type) is
      Iterator,Prev_Element : List_Type;
      Changed : Boolean := False;
      E : List_Type;
   begin
      Iterator := List;
      Prev_Element := null;

      while not Empty(Iterator) and not Changed loop
         if Iterator.Data > Object then
            E := new Element_Type'(Data => Object, Next => Iterator);
            if Prev_Element /= null then
               Prev_Element.Next := E;
            else
               List := E;
            end if;
            Changed := True;
         elsif Iterator.Data = Object then
            Changed := True;

         else
            Prev_Element := Iterator;
            Iterator := Iterator.Next;
         end if;
      end loop;

      if not Changed then
         E := new Element_Type'(Data => Object, Next => null);
         if Empty(List) then
            List := E;
         else
            Prev_Element.Next := E;
         end if;
      end if;
   end Insert;

   procedure Put(List : in List_Type) is
      Iterator : List_Type;
   begin
      Iterator := List;
      for I in 1..Length(List) loop
         Put(Iterator.Data);
         Iterator := Iterator.Next;
      end loop;
   end Put;

   procedure Remove(Key : in Key_Type; List : in out List_Type) is
      Current_Element : List_Type;
      Prev_Element : List_Type;
   begin

      if not Empty(List) then
         Current_Element := List;
         Prev_Element := null;

         While not Empty(Current_Element) loop
            if Get_Key(Current_Element.Data) = Key then
               if Prev_Element /= null then
                  Prev_Element.Next := Current_Element.Next;
               end if;
               Free(Current_Element);
               Current_Element := null;
            else
                 Prev_Element := Current_Element;
                 Current_Element := Current_Element.Next;
            end if;

         end loop;

         if not Empty(Current_Element) then
            raise Element_Not_Found;
         end if;

      end if;
   end Remove;

   procedure Delete(List : out List_Type) is
      Current_Element : List_Type;
      Next_Element : List_Type;
   begin
      if not Empty(List) then
         Current_Element := List.Next;
         Free(List);
         for I in 1..Length(Current_Element) loop
            Next_Element := Current_Element.Next;
            Free(Current_Element);
            Current_Element := Next_Element;
         end loop;
      end if;
   end Delete;

   function Find(Object : in Key_Type; List : in List_Type) return Data_Type is
      Iterator : List_Type;
   begin
      Iterator := List;
      while not Empty(Iterator) loop
         if Object = Get_Key(Iterator.Data) then
            return Iterator.Data;
         end if;
         Iterator := Iterator.Next;
      end loop;
      raise Element_Not_Found;
   end Find;

   procedure Find(New_List : out Data_Type; Object : in Key_Type; List : in List_Type) is
   begin
      New_List := Find(Object,List);
   end Find;

   function Length(List : in List_Type) return Integer is
      Iterator : List_Type;
      Resultat : Integer := 0;
   begin
      Iterator := List;

      while not Empty(Iterator) loop
         Resultat := Resultat + 1;
         Iterator := Iterator.Next;
      end loop;
      return Resultat;
   end Length;
end Generic_Sorted_List;