1. with Ada.Command_Line;                  use Ada.Command_Line; 
  2. with Ada.Containers.Vectors;            use Ada.Containers; 
  3. --  with Ada.Exceptions;                    use Ada.Exceptions; 
  4. with Ada.Numerics.Discrete_Random;      use Ada.Numerics; 
  5. with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; 
  6. --  with Ada.Task_Identification;           use Ada.Task_Identification; 
  7. with Ada.Text_IO;                       use Ada.Text_IO; 
  8.  
  9. procedure Pipelined_Mergesort is 
  10.  
  11.    No_Of_Elements : constant Positive := Positive'Value (Argument (1)); 
  12.  
  13.    subtype Element is Natural; 
  14.  
  15.    package Random_Elements is new Discrete_Random (Result_Subtype => Element); 
  16.    use Random_Elements; 
  17.  
  18.    Random_Generator : Generator; 
  19.  
  20.    type Index is new Natural; 
  21.  
  22.    type Element_Array is array (Index range <>) of Element; 
  23.  
  24. begin 
  25.    Reset (Random_Generator); 
  26.  
  27.    declare 
  28.       Data : constant Element_Array (1 .. Index (No_Of_Elements)) := (others => Random (Random_Generator)); 
  29.  
  30.       function Is_Sorted (D : Element_Array) return Boolean is 
  31.         (for all i in D'First .. D'Last - 1 => D (i) <= D (i + 1)); 
  32.  
  33.       function Is_Permutation (Field_A, Field_B : Element_Array) return Boolean is 
  34.  
  35.          package Element_Vectors is new Vectors (Positive, Element); use Element_Vectors; 
  36.          package Sorting         is new Generic_Sorting;             use Sorting; 
  37.  
  38.          Vector_A, Vector_B : Vector := Empty_Vector; 
  39.  
  40.       begin 
  41.          for A of Field_A loop 
  42.             Append (Vector_A, A); 
  43.          end loop; 
  44.          for B of Field_B loop 
  45.             Append (Vector_B, B); 
  46.          end loop; 
  47.          Sort (Vector_A); 
  48.          Sort (Vector_B); 
  49.          return Vector_A = Vector_B; 
  50.       end Is_Permutation; 
  51.  
  52.       No_Of_Stages : constant Positive := Positive (Float'Ceiling (Log (Float (No_Of_Elements), 2.0))); 
  53.  
  54.             function Merge (A, B : Element_Array) return Element_Array is 
  55.  
  56.               (if    A'Length = 0 then B 
  57.                elsif B'Length = 0 then A 
  58.                elsif A (A'First) < B (B'First) 
  59.                then A (A'First) & Merge (A (Index'Succ (A'First) .. A'Last), B) 
  60.                else B (B'First) & Merge (A, B (Index'Succ (B'First) .. B'Last))) 
  61.  
  62.             with Pre  => Is_Sorted (A) and then Is_Sorted (B), 
  63.                  Post => Is_Sorted (Merge'Result) and then Is_Permutation (Merge'Result, A & B); 
  64.  
  65.             function Merge_Imperative (A, B : Element_Array) return Element_Array 
  66.  
  67.             with Pre  => Is_Sorted (A) and then Is_Sorted (B), 
  68.                  Post => Is_Sorted (Merge_Imperative'Result) and then Is_Permutation (Merge_Imperative'Result, A & B); 
  69.  
  70.             function Merge_Imperative (A, B : Element_Array) return Element_Array is 
  71.  
  72.             begin 
  73.                if A'Length = 0 then 
  74.                   return B; 
  75.                elsif B'Length = 0 then 
  76.                   return A; 
  77.                else 
  78.                   declare 
  79.                      Merged : Element_Array (A'First .. A'Last + B'Length); 
  80.  
  81.                      A_Index : Index range A'Range := A'First; 
  82.                      B_Index : Index range B'Range := B'First; 
  83.  
  84.                   begin 
  85.                      for M_Index in Merged'Range loop 
  86.  
  87.                         declare 
  88.                            Merge_Element : Element       renames Merged (M_Index); 
  89.                            Merge_Tail    : Element_Array renames Merged (Index'Succ (M_Index) .. Merged'Last); 
  90.  
  91.                            A_Element : constant Element := A (A_Index); 
  92.                            B_Element : constant Element := B (B_Index); 
  93.  
  94.                         begin 
  95.                            if A_Element < B_Element then 
  96.                               Merge_Element := A_Element; 
  97.                               if A_Index = A'Last then 
  98.                                  Merge_Tail := B (B_Index .. B'Last); return Merged; 
  99.                               else 
  100.                                  A_Index := Index'Succ (A_Index); 
  101.                               end if; 
  102.                            else 
  103.                               Merge_Element := B_Element; 
  104.                               if B_Index = B'Last then 
  105.                                  Merge_Tail := A (A_Index .. A'Last); return Merged; 
  106.                               else 
  107.                                  B_Index := Index'Succ (B_Index); 
  108.                               end if; 
  109.                            end if; 
  110.                         end; 
  111.                      end loop; 
  112.                      raise Program_Error with "Merge for-loop should never complete"; 
  113.                   end; 
  114.                end if; 
  115.             end Merge_Imperative; 
  116.  
  117.    begin 
  118.       Put_Line ("Original data is " & (if Is_Sorted (Data) then "sorted" else "not sorted")); 
  119.    end; 
  120. end Pipelined_Mergesort;