=================================== ============ .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;