--------------- -- mergesort -- --------------- with gnat.io; use gnat.io; procedure main is N : constant positive := 1000; subtype index is positive range 1..N; type sort_array is array (index) of integer; procedure merge ( arr : in out sort_array; lower, upper : integer; temp : in out sort_array; i : integer) is enditem, list1, list2 : integer; begin list1 := lower; list2 := lower + i; if list2 > upper then list2 := upper; end if; for j in 1 .. ((upper-lower+1)/(i*2))+1 loop enditem := list2 + i - 1; if enditem > upper then enditem := upper; end if; for k in list1 .. enditem loop if arr(list1) <= arr(list2) then temp(k) := arr(list1); arr(list1) := integer'last; list1 := list1 + 1; else temp(k) := arr(list2); arr(list2) := integer'last; list2 := list2 + 1; if list2 > enditem then list2 := enditem; end if; end if; end loop; list1 := enditem + 1; list2 := list1 + i; if list2 > upper then list2:=upper; end if; end loop; end merge; procedure mergesort (arr: in out sort_array; lower, upper: integer) is temp : sort_array; begin discrete i := 1 in 1.. upper - lower + 1 new i := i * 4 loop merge (arr, lower, upper, temp, i); merge (temp, lower, upper, arr, i * 2); i := i * 4; end loop; end mergesort; procedure putarr (arr: in sort_array; lower, upper: integer) is begin for i in lower .. upper loop if i > lower then put (" "); end if; put (arr(i)); end loop; end putarr; arr : sort_array; celements : natural := 0; begin put ("----------"); new_line; put ("merge sort"); new_line; put ("----------"); new_line (2); while celements < N loop put ("key to insert (0 to quit) ? "); get (arr(celements + 1)); exit when arr(celements + 1) = 0; celements := celements + 1; end loop; if celements > 0 then new_line; put ("--> "); putarr (arr, 1, celements); new_line; put ("--> sorting... "); mergesort (arr, 1, celements); put ("done."); new_line; put ("--> "); putarr (arr, 1, celements); new_line; end if; new_line; put ("Good bye!"); new_line; end main;