Ada 95 :: x21_sor3.ada

generic
  type T         is private;          -- Any non limited type
  type Vec_range is (<>);             -- Any discrete type
  type Vec       is array( Vec_range ) of T;
  with function  ">"( first, second:in T ) return Boolean is <>;
procedure sort( items:in out Vec );

procedure sort( items:in out Vec ) is
  swaps : Boolean := TRUE;
  tmp   : T;
begin
  while swaps loop
    swaps := false;
    for i in items'First .. Vec_range'Pred(items'Last) loop
      if items( i ) > items( Vec_range'Succ(i) ) then
        swaps := TRUE;
        tmp := items( Vec_range'Succ(i) );
        items( Vec_range'Succ(i) ) := items( i );
        items( i ) := tmp;
      end if;
    end loop;
  end loop;
end sort;

with Ada.Text_io, sort;
use  Ada.Text_io;
procedure main1 is

  type Chs_range is range 1 .. 6;
  type Chs       is array( Chs_range ) of Character; 

  procedure sort_chs is new sort (
    T         => Character,
    Vec_range => Chs_range,
    Vec       => Chs,
    ">"       => ">" );
  some_characters : Chs := ( 'q', 'w', 'e', 'r', 't', 'y' );
begin
  sort_chs( some_characters );
  for i in Chs_range loop
    put( some_characters( i ) ); put( " " );
  end loop;
  new_line;
end main1;


with Simple_io, sort;
use  Simple_io;
procedure main2 is
  type Chs_range is ( RED, BLUE, GREEN );
  type Chs is array( Chs_range ) of Character; 

  procedure sort_chs is new sort (
    T         => Character,
    Vec_range => Chs_range,
    Vec       => Chs,
    ">"       => ">" );
  some_items : Chs := ( 'q', 'w', 'e' );
begin
  sort_chs( some_items );
  for i in Chs_range loop
    put( some_items( i ) ); put( " " );
  end loop;
  new_line;
end main2;


with Simple_io, sort;
use  Simple_io;
procedure main3 is
  MAX_CHS : CONSTANT := 7;
  type Height_cm is range 0 .. 300;
  type Person is record
    name   : String( 1 .. MAX_CHS );  -- Name as a String
    height : Height_cm := 0;          -- Height in cm.
  end record;
  type People_range is (FIRST, SECOND, THIRD, forTH );
  type People       is array( People_range ) of Person; 

  function cmp_height(first, second:in Person) return Boolean is
  begin
    return first.height > second.height;
  end cmp_height;

  function cmp_name( first, second:in Person ) return Boolean is
  begin
    return first.name > second.name;
  end cmp_name;

  procedure sort_people_height is new sort (
    T         => Person,
    Vec_range => People_range,
    Vec       => People,
    ">"       => cmp_height );

  procedure sort_people_name is new sort (
    T         => Person,
    Vec_range => People_range,
    Vec       => People,
    ">"       => cmp_name );

  friends : People := ( ("Paul   ", 146 ), ("Carol  ", 147 ), 
                        ("Mike   ", 183 ), ("Corinna", 171 ) );
begin
  sort_people_name( friends );                    -- Name order
  put( "The first in ascending name order is   " );
  put( friends( FIRST ).name ); new_line;
  sort_people_height( friends );                  -- Height order
  put( "The first in ascending height order is " );
  put( friends( FIRST ).name ); new_line;
end main3;

with Simple_io, sort;
use  Simple_io;
procedure main4 is
begin
  null;
end main4;

with Simple_io, main1, main2, main3, main4;
use  Simple_io;
procedure main is
begin
  put("Example 1 "); new_line; main1;
  put("Example 2 "); new_line; main2;
  put("Example 3 "); new_line; main3;
  put("Example 4 "); new_line; main4;
end main;


© M.A.Smith University of Brighton. Created September 1995 last modified May 1997.
Comments, suggestions, etc. M.A.Smith@brighton.ac.uk * [Home page]