home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / ada_1 / Examples_ada_SHELL_ < prev    next >
Encoding:
Text File  |  1994-08-14  |  1.8 KB  |  55 lines

  1. -- ++
  2. -- A generic shell sort. This is an implementation of the classical shell sort
  3. -- function. The function is fully parameterisable with the items to be sorted,
  4. -- the index range type of the array, the array type of the items and a compare
  5. -- function. The array of items can be different sizes providing this package
  6. -- is instantiated with an unconstrained array type.
  7. -- --
  8.  
  9. generic
  10.    type Item is private;
  11.    type Index is (<>);
  12.    type Items is array (Index range <>) of Item;
  13.    with function "<" (Left : in Item; Right : in Item) return Boolean;
  14. package Shell_Sort is
  15.    procedure Sort (The_Items : in out Items);
  16. end Shell_Sort;
  17.  
  18. package body Shell_Sort is
  19.    function "+" (Left : in Index; Right : in Positive) return Index is
  20.    begin
  21.       return Index'Val(Index'Pos(Left) + Right);
  22.    end;
  23.  
  24.    function "-" (Left : in Index; Right : in Positive) return Index is
  25.    begin
  26.       return Index'Val(Index'Pos(Left) - Right);
  27.    end;
  28.  
  29.    pragma INLINE ("+","-");
  30.  
  31.    procedure Sort (The_Items : in out Items) is
  32.       Temporary_Item : Item;
  33.       Inner_Index    : Index;
  34.       Increment         : Positive := 1;
  35.    begin
  36.       while Increment * 3 + 1 < The_Items'Length loop
  37.          Increment := Increment * 3 + 1;
  38.       end loop;
  39.       loop
  40.          for Outer_Index in Index range The_Items'First + Increment .. The_Items'Last loop
  41.         Temporary_Item := The_Items(Outer_Index);
  42.         Inner_Index := Outer_Index;
  43.         while Temporary_Item < The_Items(Inner_Index - Increment) loop
  44.            The_Items(Inner_Index) := The_Items(Inner_Index - Increment);
  45.            Inner_Index := Inner_Index - Increment;
  46.            exit when Inner_Index < The_Items'First + Increment;
  47.         end loop;
  48.         The_Items(Inner_Index) := Temporary_Item;
  49.          end loop;
  50.          exit when Increment = 1;
  51.      Increment := Increment / 3;
  52.       end loop;
  53.    end Sort;
  54. end Shell_Sort;
  55.