Topological sort

Today I had to implement a topological sort for arrays of classes under the partial order of class inclusion. Since the arrays in question are never large I used a rather naive algorithm. I think it looks nice:

: largest-class ( seq -- n elt )
    dup [ swap [ class< ] subset-with length 1 = ] find-with ;

: (sort-classes) ( vec -- )
    dup empty?
    [ drop ]
    [ dup largest-class , over delete-nth (sort-classes) ] if ;

: sort-classes ( seq -- newseq )
    [ >vector (sort-classes) ] { } make ;

The first word takes a sequence and finds a class which is only a subclass of itself. Such a class always exists, since classes form a lattice.

The second word is the main iterative loop here. It repeatedly removes the largest class and tucks it away by calling , - then deletes it from the sequence. The recursion stops when the sequence is empty.

The last word does the setup and teardown for the algorithm. It copies the input sequence into a fresh mutable vector, and wraps the whole thing in a make so that objects passed to , are collected into a new sequence which is returned at the end.