--***********************************************************************
--									*
--									*
--   This software was written by Bevin Brett, of Digital Equipment	*
--   Corporation.							*
--									*
--   Digital assumes no responsibility AT ALL for the use or reliability*
--   of this software.							*
--									*
--   Redistribution and use in source and binary forms are permitted	*
--   provided that the above copyright notice and this paragraph are	*
--   duplicated in all such forms and that any documentation,		*
--   advertising materials, and other materials related to such		*
--   distribution and use acknowledge that the software was developed	*
--   by Digital Equipment Corporation. The name of Digital Equipment	*
--   Corporation may not be used to endorse or promote products derived	*
--   from this software without specific prior written permission.	*
--									*
--   THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR	*
--   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED	*
--   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.*
--									*
--***********************************************************************

-- modified for use with Adabindx 10.8.1997
-- Hans-Frieder Vogt (vogt@ilaws6.luftfahrt.uni-stuttgart.de)

package body TOPO_SORT is

    procedure SWAP(X, Y : in out ELEMENT) is
	TMP : ELEMENT := X;
    begin
	X := Y;
	Y := TMP;
    end;

    function "+"(LHS : INDEX_TYPE; RHS : INTEGER) return INDEX_TYPE is
    begin
	return INDEX_TYPE'val(INDEX_TYPE'pos(LHS)+RHS);
    end;

    procedure SORT(ITEMS : in out ITEMS_TYPE) is
	REJECTED : BOOLEAN;
    begin

	-- try to find an item no-one objects too being after
	-- and place it at the beginning
	--
	for DESPARATE in BOOLEAN loop
	    for I in ITEMS'range loop
		REJECTED := FALSE;
		for J in ITEMS'range loop
		    if I /= J and then
			(not MAY_PRECEDE(ITEMS(I),ITEMS(J),DESPARATE))
		    then
			REJECTED := TRUE;
			exit;
		    end if;
		end loop;
		if not REJECTED then
		    SWAP(ITEMS(I), ITEMS(ITEMS'first));
		    exit;
		end if;
	    end loop;
    
	    -- abort if bad
	    exit when not REJECTED;
	    WARN;
	    if DESPARATE then PUT(ITEMS); end if;
	end loop;

	-- recurse to sort head
	if ITEMS'length > 2 then
	    SORT(ITEMS(ITEMS'first+1..ITEMS'last));
	end if;

   end;

end;