<> <> DIRECTORY TopoSort; TopoSortImpl: CEDAR PROGRAM EXPORTS TopoSort = BEGIN OPEN TopoSort; LNAT: TYPE ~ INT; Side: TYPE ~ {l, r}; ListSort: PUBLIC PROC [ alpha, omega: Handle, GetLink: PROC [Handle] RETURNS [Handle], SetLink: PROC [from, to: Handle], Compare: PROC [Handle, Handle] RETURNS [PartialComparison] ] ~ { WorkDown: PROC [start: Handle, limit: LNAT] RETURNS [head, tail, rest: Handle, done: LNAT] ~ { halimit: LNAT ~ limit/2; rest _ GetLink[head _ tail _ start]; done _ 1; IF rest=omega THEN RETURN; rest _ GetLink[tail _ rest]; IF Compare[head, tail]=greater THEN {x: Handle ~ head; head _ tail; tail _ x; SetLink[head, tail]; SetLink[tail, rest]}; done _ 2; WHILE rest#omega AND done<=halimit DO leftend: Handle ~ rest; heads: ARRAY Side OF Handle _ ALL[head]; tails: ARRAY Side OF Handle _ ALL[tail]; counts: ARRAY Side OF NATURAL _ ALL[done]; first: BOOL _ TRUE; Output: PROC [h, t: Handle] ~ { IF first THEN {first _ FALSE; head _ h} ELSE SetLink[tail, h]; tail _ t; RETURN}; [heads[r], tails[r], rest, counts[r]] _ WorkDown[rest, done]; done _ counts[l] + counts[r]; WHILE counts[l]#0 AND counts[r]#0 DO rn: Handle ~ GetLink[heads[r]]; prev: Handle _ alpha; FOR hl: Handle _ heads[l], GetLink[hl] WHILE hl#leftend DO SELECT Compare[hl, heads[r]] FROM less, equal => { ln: Handle ~ GetLink[hl]; Output[hl, hl]; IF prev=alpha THEN heads[l] _ ln ELSE SetLink[prev, ln]; IF hl=tails[l] THEN tails[l] _ prev; counts[l] _ counts[l]-1}; greater => {Output[heads[r], heads[r]]; EXIT}; incomparable => prev _ hl; ENDCASE => ERROR; REPEAT FINISHED => Output[heads[r], heads[r]]; ENDLOOP; counts[r] _ counts[r]-1; heads[r] _ rn; ENDLOOP; IF counts[l]#0 THEN Output[heads[l], tails[l]]; IF counts[r]#0 THEN Output[heads[r], tails[r]]; IF first THEN ERROR; SetLink[tail, rest]; ENDLOOP; RETURN}; first: Handle _ GetLink[alpha]; last: Handle; IF first = omega THEN RETURN; [first, last] _ WorkDown[first, LNAT.LAST]; SetLink[alpha, first]; RETURN}; END.