code: purgatorio

ref: ec35f468e0eba87c9f09cbbe5fa8af2591e6f914
dir: /appl/cmd/tsort.b/

implement Tsort;

#
# tsort -- topological sort
#
# convert a partial ordering into a linear ordering
#
# Copyright © 2004 Vita Nuova Holdings Limited
#

include "sys.m";
	sys: Sys;

include "draw.m";

include "bufio.m";
	bufio: Bufio;
	Iobuf: import bufio;

Tsort: module
{
	init:	fn(nil: ref Draw->Context, nil: list of string);
};

Item: adt {
	name:	string;
	mark:	int;
	succ:	cyclic list of ref Item;	# node's successors

	precede:	fn(a: self ref Item, b: ref Item);
};

Q: adt {
	item:	ref Item;
	next:	cyclic ref Q;
};

items, itemt: ref Q;	# use a Q not a list only to keep input order
nitem := 0;
bout: ref Iobuf;

init(nil: ref Draw->Context, nil: list of string)
{
	sys = load Sys Sys->PATH;
	bufio = load Bufio Bufio->PATH;

	bout = bufio->fopen(sys->fildes(1), Sys->OWRITE);
	input();
	output();
	bout.flush();
}

error(s: string)
{
	sys->fprint(sys->fildes(2), "tsort: %s\n", s);
	raise "fail:error";
}

input()
{
	b := bufio->fopen(sys->fildes(0), Sys->OREAD);
	while((line := b.gets('\n')) != nil){
		(nil, fld) := sys->tokenize(line, " \t\n");
		if(fld != nil){
			a := finditem(hd fld);
			while((fld = tl fld) != nil)
				a.precede(finditem(hd fld));
		}
	}
}

Item.precede(a: self ref Item, b: ref Item)
{
	if(a != b){
		for(l := a.succ; l != nil; l = tl l)
			if((hd l) == b)
				return;
		a.succ = b :: a.succ;
	}
}

finditem(s: string): ref Item
{
	# would use a hash table for large sets
	for(il := items; il != nil; il = il.next)
		if(il.item.name == s)
			return il.item;
	i := ref Item;
	i.name = s;
	i.mark = 0;
	if(items != nil)
		itemt = itemt.next = ref Q(i, nil);
	else
		itemt = items = ref Q(i, nil);
	nitem++;
	return i;
}

dep: list of ref Item;

output()
{
	for(k := items; k != nil; k = k.next)
		if((q := k.item).mark == 0)
			visit(q, nil);
	for(; dep != nil; dep = tl dep)
		bout.puts((hd dep).name+"\n");
}

# visit q's successors depth first
# parents is only used to print any cycles, and since it matches
# the stack, the recursion could be eliminated
visit(q: ref Item, parents: list of ref Item)
{
	q.mark = 2;
	parents = q :: parents;
	for(sl := q.succ; sl != nil; sl = tl sl)
		if((s := hd sl).mark == 0)
			visit(s, parents);
		else if(s.mark == 2){
			sys->fprint(sys->fildes(2), "tsort: cycle in input\n");
			rl: list of ref Item;
			for(l := parents;; l = tl l){	# reverse to be closer to input order
				rl = hd l :: rl;
				if(hd l == s)
					break;
			}
			for(l = rl; l != nil; l = tl l)
				sys->fprint(sys->fildes(2), "tsort: %s\n", (hd l).name);
		}
	q.mark = 1;
	dep = q :: dep;
}