The Ada Program: sort.adb

  1 -- sort.adb:  sort employee records in a file by name, id, salary, or dept
  2 
  3 with
  4   Ada.Command_Line,     -- Access to external execution env (Ada95 A.15)
  5   Ada.Text_IO,          -- Usual string oriented IO package
  6   Ada.Integer_Text_IO,  -- Preinstantiated text IO package for integers
  7   Generic_Selection_Sort;
  8 use Ada;
  9 
 10 procedure Sort is
 11 
 12    subtype Name_String_Type is String (1..10);
 13    subtype ID_Number_Type   is Integer range 1..999_999_999;
 14    subtype Salary_Type      is Integer range 0..9_999_999;
 15    subtype Department_Code  is Integer range 10..99;
 16 
 17    type Employee_Record is
 18       record
 19          Name       : Name_String_Type;
 20          ID         : ID_Number_Type;
 21          Salary     : Salary_Type;
 22          Department : Department_Code;
 23       end record;
 24 
 25    type Employee_Record_Pointer is access Employee_Record;
 26 
 27    type List_Type is
 28       array (Positive range <>) of Employee_Record_Pointer;
 29    Max_Number        : constant := 100;
 30    List              : List_Type (1..Max_Number);
 31    Number_Of_Records : Integer range 0 .. Max_Number := 0;
 32 
 33    procedure Print_Record (R: Employee_Record_Pointer) is
 34    begin
 35       Text_IO.Put (R.Name);
 36       Integer_Text_IO.Put (R.ID);
 37       Integer_Text_IO.Put (R.Salary);
 38       Integer_Text_IO.Put (R.Department);
 39       Text_IO.New_Line;
 40    end Print_Record;
 41 
 42    procedure Get_Data (File_Name        : in String;
 43                        List             : out List_Type;
 44                        Number_Of_Records: out Natural) is separate;
 45 
 46    type Key_Type is (Name, ID, Salary, Department);
 47 
 48    File_Name : constant String   := Command_Line.Argument (1);
 49    Key       : constant Key_Type :=
 50       Key_Type'Value (Command_Line.Argument(2));
 51 
 52    function "<" (Left, Right: Employee_Record_Pointer) return Boolean is
 53    begin
 54       case Key is
 55         when Name       => return (Left.Name < Right.Name);
 56         when ID         => return (Left.ID < Right.ID);
 57         when Salary     => return (Left.Salary < Right.Salary);
 58         when Department => return (Left.Department < Right.Department);
 59       end case;
 60    end "<";
 61 
 62    procedure Record_Sort is new Generic_Selection_Sort (
 63       Element_Type => Employee_Record_Pointer,
 64       Array_Type => List_Type);
 65 
 66 begin
 67    Get_Data (File_Name, List, Number_Of_Records);
 68    Record_Sort (List (1..Number_Of_Records));
 69    for I in 1..Number_Of_Records loop
 70       Print_Record (List(I));
 71    end loop;
 72 end Sort;