::
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]