implement Alphabet, Copy;
include "sys.m";
	sys: Sys;
include "draw.m";
include "readdir.m";
include "sh.m";
	sh: Sh;
	n_BLOCK, n_SEQ, n_LIST, n_ADJ, n_WORD, n_VAR, n_BQ2, n_PIPE: import Sh;
include "sets.m";
	sets: Sets;
	Set: import sets;
include "alphabet/reports.m";
	reports: Reports;
	Report: import reports;
	Modulecmd, Typescmd: import Proxy;
include "alphabet.m";
	evalmod: Eval;
	Context: import evalmod;

Mainsubtypes: module {
	proxy: fn(): chan of ref Proxy->Typescmd[ref Alphabet->Value];
};

# to do:
# - sort out concurrent access to alphabet.
# - if multiple options are given where only one is expected,
#	most modules ignore some values, where they should
#	discard them correctly. this could cause a malicious user
#	to hang up an alphabet expression (waiting for report to end)
# - proper implementation of endpointsrv:
#	- resilience to failures
#	- security of endpoints
#	- no need for write(0)... (or maybe there is)
# - proper implementation of rexecsrv:
#	- should be aware of user

Debug: con 0;
autodeclare := 0;

Module: adt {
	modname:	string;		# used when loading on demand.
	typeset:		ref Typeset;
	sig:			string;
	c:			chan of ref Modulecmd[ref Value];
	m:			Mainmodule;
	def:			ref Sh->Cmd;
	defmods:		ref Strhash[cyclic ref Module];
	refcount:		int;

	find:		fn(ctxt: ref Evalctxt, s: string): (ref Module, string);
	typesig:	fn(m: self ref Module): string;
	run:		fn(m: self ref Module, ctxt: ref Evalctxt,
					errorc: chan of string,
					opts: list of (int, list of ref Value),
					args: list of ref Value): ref Value;
	typename2c:	fn(s: string): int;
	mks:		fn(ctxt: ref Evalctxt, s: string): ref Value;
	mkc:		fn(ctxt: ref Evalctxt, c: ref Sh->Cmd): ref Value;
	ensureloaded:	fn(m: self ref Module): string;
	cvt:		fn(ctxt: ref Evalctxt, v: ref Value, tc: int, errorc: chan of string): ref Value;
};

Evalctxt: adt {
	modules:	ref Strhash[ref Module];
	drawctxt: ref Draw->Context;
	report: ref Report;
#	stopc: chan of int;
};

# used for rewriting expressions.
Rvalue: adt {
	i: ref Sh->Cmd;
	tc: int;
	refcount: int;
	opts: list of (int, list of ref Rvalue);
	args: list of ref Rvalue;

	dup:		fn(t: self ref Rvalue): ref Rvalue;
	free:		fn(v: self ref Rvalue, used: int);
	isstring:	fn(v: self ref Rvalue): int;
	gets:		fn(t: self ref Rvalue): string;
	type2s:	fn(tc: int): string;
	typec:	fn(t: self ref Rvalue): int;
};

Rmodule: adt {
	m: ref Module;

	cvt:		fn(ctxt: ref Revalctxt, v: ref Rvalue, tc: int, errorc: chan of string): ref Rvalue;
	find:		fn(nil: ref Revalctxt, s: string): (ref Rmodule, string);
	typesig:	fn(m: self ref Rmodule): string;
	run:		fn(m: self ref Rmodule, ctxt: ref Revalctxt, errorc: chan of string,
				opts: list of (int, list of ref Rvalue), args: list of ref Rvalue): ref Rvalue;
	mks:		fn(ctxt: ref Revalctxt, s: string): ref Rvalue;
	mkc:		fn(ctxt: ref Revalctxt, c: ref Sh->Cmd): ref Rvalue;
	typename2c:	fn(s: string): int;
};

Revalctxt: adt {
	modules: ref Strhash[ref Module];
	used: ref Strhash[ref Module];
	defs:	int;
	vals: list of ref Rvalue;
};

Renv: adt {
	items: list of ref Rvalue;
	n: int;
};

Typeset: adt {
	name: string;
	c: chan of ref Typescmd[ref Value];
	types: ref Table[cyclic ref Type];		# indexed by external type character
	parent: ref Typeset;

	gettype:	fn(ts: self ref Typeset, tc: int): ref Type;
};

Type: adt {
	id:	int;
	tc:	int;
	transform: list of ref Transform;
	typeset: ref Typeset;
	qname:	string;
	name:	string;
};

Transform: adt {
	dst: int;				# which type we're transforming into.
	all: Set;				# set of all types this transformation can lead to.
	expr: ref Sh->Cmd;		# transformation operation.
};

Table: adt[T] {
	items:	array of list of (int, T);
	nilval:	T;

	new: fn(nslots: int, nilval: T): ref Table[T];
	add:	fn(t: self ref Table, id: int, x: T): int;
	del:	fn(t: self ref Table, id: int): int;
	find:	fn(t: self ref Table, id: int): T;
};

Strhash: adt[T] {
	items:	array of list of (string, T);
	nilval:	T;

	new: fn(nslots: int, nilval: T): ref Strhash[T];
	add:	fn(t: self ref Strhash, id: string, x: T);
	del:	fn(t: self ref Strhash, id: string);
	find:	fn(t: self ref Strhash, id: string): T;
};

Copy: module {
	initcopy: fn(
		typesets: list of ref Typeset,
		roottypeset: ref Typeset,
		modules: ref Strhash[ref Module],
		typebyname: ref Strhash[ref Type],
		typebyc: ref Table[ref Type],
		types: array of ref Type,
		currtypec: int
	): Alphabet;
};

typesets: list of ref Typeset;
roottypeset: ref Typeset;
modules: ref Strhash[ref Module];
typebyname: ref Strhash[ref Type];
typebyc: ref Table[ref Type];	# indexed by internal type character.
types: array of ref Type;		# indexed by id.
currtypec := 16r25a0;		# pretty graphics.

checkload[T](m: T, path: string): T
{
	if(m != nil)
		return m;
	sys->fprint(sys->fildes(2), "alphabet: cannot load %s: %r\n", path);
	raise "fail:bad module";
}

init()
{
	sys = load Sys Sys->PATH;
	sh = load Sh Sh->PATH;
	sets = checkload(load Sets Sets->PATH, Sets->PATH);
	evalmod = checkload(load Eval Eval->PATH, Eval->PATH);
	evalmod->init();
	reports = checkload(load Reports Reports->PATH, Reports->PATH);

	roottypeset = ref Typeset("/", nil, Table[ref Type].new(5, nil), nil);
	typesets = roottypeset :: typesets;
	types = array[] of {
		ref Type(-1, 'c', nil, roottypeset, "/cmd", "cmd"),
		ref Type(-1, 's', nil, roottypeset, "/string", "string"),
		ref Type(-1, 'r', nil, roottypeset, "/status", "status"),
		ref Type(-1, 'f', nil, roottypeset, "/fd", "fd"),
		ref Type(-1, 'w', nil, roottypeset, "/wfd", "wfd"),
		ref Type(-1, 'd', nil, roottypeset, "/data", "data"),
	};
	typebyname = typebyname.new(11, nil);
	typebyc = typebyc.new(11, nil);
	for(i := 0; i < len types; i++){
		types[i].id = i;
		typebyc.add(types[i].tc, types[i]);
		typebyname.add(types[i].qname, types[i]);
		roottypeset.types.add(types[i].tc, types[i]);
	}
#	typebyc.add('a', ref Type(-1, 'a', nil, nil, "/any", "any"));		# not sure about this anymore
	modules = modules.new(3, nil);
}

initcopy(
		xtypesets: list of ref Typeset,
		xroottypeset: ref Typeset,
		xmodules: ref Strhash[ref Module],
		xtypebyname: ref Strhash[ref Type],
		xtypebyc: ref Table[ref Type],
		xtypes: array of ref Type,
		xcurrtypec: int): Alphabet
{
	# XXX must do copy-on-write, and refcounting on typesets.
	typesets = xtypesets;
	roottypeset = xroottypeset;
	modules = xmodules;
	typebyname = xtypebyname;
	typebyc = xtypebyc;
	types = xtypes;
	currtypec = xcurrtypec;
	return load Alphabet "$self";
}

copy(): Alphabet
{
	a := load Copy Alphabet->PATH;
	if(a == nil)
		return nil;
	return a->initcopy(typesets, roottypeset, modules, typebyname, typebyc, types, currtypec);
}

setautodeclare(x: int)
{
	autodeclare = x;
}

quit()
{
	for(ts := typesets; ts != nil; ts = tl ts)
		if((hd ts).c != nil)
			(hd ts).c <-= nil;
	delmods(modules);
}

delmods(mods: ref Strhash[ref Module])
{
	for(i := 0; i < len mods.items; i++){
		for(l := mods.items[i]; l != nil; l = tl l){
			m := (hd l).t1;
			if(--m.refcount == 0){
				if(m.c != nil){
					m.c <-= nil;
					m.c = nil;
				}else if(m.defmods != nil)
					delmods(m.defmods);
				else if(m.m != nil){
					m.m->quit();
					m.m = nil;
				}
			}
		}
	}
}

# XXX could do some more checking to see whether it looks vaguely like
# a valid alphabet expression.
parse(expr: string): (ref Sh->Cmd, string)
{
	return sh->parse(expr);
}

eval(expr: ref Sh->Cmd,
	drawctxt: ref Draw->Context,
	args: list of ref Value): string
{
	spawn reports->reportproc(reportc := chan of string, nil, reply := chan of ref Report);
	r := <-reply;
	reply = nil;
	stderr := sys->fildes(2);
	spawn eval0(expr, "/status", drawctxt, r, reports->r.start("eval"), args, vc := chan of ref Value);
	reports->r.enable();
	v: ref Value;
wait:
	for(;;)alt{
	v = <-vc =>
		if(v != nil)
			v.r().i <-= nil;
	msg := <-reportc =>
		if(msg == nil)
			break wait;
		sys->fprint(stderr, "alphabet: %s\n", msg);
	}
	# we'll always get the value before the report ends.
	if(v == nil)
		return "no value";
	return <-v.r().i;
}

eval0(expr: ref Sh->Cmd,
	dsttype: string,
	drawctxt: ref Draw->Context,
	r: ref Report,
	errorc: chan of string,
	args: list of ref Value,
	vc: chan of ref Value)
{
	c: Eval->Context[ref Value, ref Module, ref Evalctxt];
	ctxt := ref Evalctxt(modules, drawctxt, r);
	tc := -1;
	if(dsttype != nil && (tc = Module.typename2c(dsttype)) == -1){
		report(errorc, "error: unknown type "+dsttype);
		vc <-= nil;
		reports->quit(errorc);
	}

	v := c.eval(expr, ctxt, errorc, args);
	if(tc != -1)
		v = Module.cvt(ctxt, v, tc, errorc);
	vc <-= v;
	reports->quit(errorc);
}

define(name: string, expr: ref Sh->Cmd, errorc: chan of string): string
{
	if(name == nil || name[0] == '/')
		return "bad module name";
	m := modules.find(name);
	if(m != nil)
		return "module already declared";
	sig: string;
	used: ref Strhash[ref Module];
	used = used.new(11, nil);
	(expr, sig) = rewrite0(expr, -1, errorc, used);
	if(sig == nil)
		return "cannot rewrite";
	modules.add(name, ref Module(name, roottypeset, sig, nil, nil, expr, used, 1));
	return nil;
}

typecompat(t0, t1: string): (int, string)
{
	m: ref Module;
	(sig0, err) := evalmod->usage2sig(m, t0);
	if(err != nil)
		return (0, sys->sprint("bad usage %q: %s", t0, err));
	sig1: string;
	(sig1, err) = evalmod->usage2sig(m, t1);
	if(err != nil)
		return (0, sys->sprint("bad usage %q: %s", t1, err));
	return (evalmod->typecompat(sig0, sig1), nil);
}

rewrite(expr: ref Sh->Cmd, dsttype: string, errorc: chan of string): (ref Sh->Cmd, string)
{
	v: ref Value;
	tc := -1;
	if(dsttype != nil){
		tc = Module.typename2c(dsttype);
		if(tc == -1){
			report(errorc, "error: unknown type "+dsttype);
			return (nil, nil);
		}
	}
	sig: string;
	(expr, sig) = rewrite0(expr, tc, errorc, nil);
	if(sig == nil)
		return (nil, nil);

	return (expr, evalmod->cmdusage(v, sig));
}

# XXX different kinds of rewrite:
# could rewrite forcing all names to qualified
# or just leave names as they are.

# return (expr, sig).
# add all modules used by the expression to mods if non-nil.
rewrite0(expr: ref Sh->Cmd, tc: int, errorc: chan of string, used: ref Strhash[ref Module]): (ref Sh->Cmd, string)
{
	m: ref Rmodule;
	ctxt := ref Revalctxt(modules, used, 1, nil);
	(sig, err) := evalmod->blocksig(m, ctxt, expr);
	if(sig == nil){
		report(errorc, "error: cannot get expr type: "+err);
		return (nil, nil);
	}
	args: list of ref Rvalue;
	for(i := len sig - 1; i >= 1; i--)
		args = ref Rvalue(mk(-1, nil, nil), sig[i], 1, nil, nil) :: args;	# N.Vb. cmd node is never used.

	c: Eval->Context[ref Rvalue, ref Rmodule, ref Revalctxt];
	v := c.eval(expr, ctxt, errorc, args);
	if(v != nil && tc != -1)
		v = Rmodule.cvt(ctxt, v, tc, errorc);
	if(v == nil)
		return (nil, nil);
	sig[0] = v.tc;
	v.refcount++;
	expr = gen(v, ref Renv(nil, 0));
	if(len sig > 1){
		t := mkw(Value.type2s(sig[1]));
		for(i = 2; i < len sig; i++)
			t = mk(n_ADJ, t, mkw(Value.type2s(sig[i])));
		expr = mk(n_BLOCK, mk(n_SEQ, mk(n_LIST, t, nil), expr.left), nil);
	}
	return (expr, sig);
}

# generate the expression that gave rise to v.
# it puts in parentenv any values referred to externally.
gen(v: ref Rvalue, parentenv: ref Renv): ref Sh->Cmd
{
	v.refcount--;
	if(v.refcount > 0)
		return mk(n_VAR, mkw(string addenv(parentenv, v)), nil);
	c := v.i;
	(opts, args) := (v.opts, v.args);
	if(opts == nil && args == nil)
		return c;
	env := parentenv;
	if(genblock := needblock(v))
		env = ref Renv(nil, 0);
	for(; opts != nil; opts = tl opts){
		c = mk(n_ADJ, c, mkw(sys->sprint("-%c", (hd opts).t0)));
		for(a := (hd opts).t1; a != nil; a = tl a)
			c = mk(n_ADJ, c, gen(hd a, env));
	}
	if(args != nil && len (hd args).i.word > 1 && (hd args).i.word[0] == '-')
		c = mk(n_ADJ, c, mkw("--"));		# XXX potentially dodgy; some sigs don't interpret "--"?

	# use pipe notation when possible
	arg0: ref Sh->Cmd;
	if(args != nil){
		if((arg0 = gen(hd args, env)).ntype != n_BLOCK){
			c = mk(n_ADJ, c, arg0);
			arg0 = nil;
		}
		args = tl args;
	}
	for(; args != nil; args = tl args)
		c = mk(n_ADJ, c, gen(hd args, env));
	if(arg0 != nil)
		c = mk(n_PIPE, arg0.left, c);
	if(genblock){
		args = rev(env.items);
		m := mkw(Value.type2s((hd args).tc));
		for(a := tl args; a != nil; a = tl a)
			m = mk(n_ADJ, m, mkw(Value.type2s((hd a).tc)));
		c = mk(n_BLOCK, mk(n_SEQ, mk(n_LIST, m, nil), c), nil);
		return gen(ref Rvalue(c, v.tc, 1, nil, args), parentenv);
	}
	return mk(n_BLOCK, c, nil);
}

addenv(env: ref Renv, v: ref Rvalue): int
{
	for(i := env.items; i != nil; i = tl i)
		if(hd i == v)
			return len i;
	env.items = v :: env.items;
	v.refcount++;
	return ++env.n;
}

# need a new block if we have any duplicated values we can resolve locally.
# i.e. for a particular value, if we're the only thing pointing to that value
# and its refcount is > 1 to start with.
needblock(v: ref Rvalue): int
{
	dups := getdups(v, nil);
	for(d := dups; d != nil; d = tl d)
		--(hd d).refcount;
	r := 0;
	for(d = dups; d != nil; d = tl d)
		if((hd d).refcount++ == 0)
			r = 1;
	return r;
}

# find all values which need $ referencing (but don't go any deeper)
getdups(v: ref Rvalue, onto: list of ref Rvalue): list of ref Rvalue
{
	if(v.refcount > 1)
		return v :: onto;
	for(o := v.opts; o != nil; o = tl o)
		for(a := (hd o).t1; a != nil; a = tl a)
			onto = getdups(hd a, onto);
	for(a = v.args; a != nil; a = tl a)
		onto = getdups(hd a, onto);
	return onto;
}

loadtypeset(qname: string, c: chan of ref Typescmd[ref Value], errorc: chan of string): string
{
	tsname := canon(qname);
	if(gettypeset(tsname) != nil)
		return nil;
	(parent, name) := splitqname(tsname);
	if((pts := gettypeset(parent)) == nil)
		return "parent typeset not found";

	if(pts.c != nil){
		if(c != nil)
			return "typecmd channel may only be provided for top-level typesets";
		reply := chan of (chan of ref Typescmd[ref Value], string);
		pts.c <-= ref Typescmd[ref Value].Loadtypes(name, reply);
		err: string;
		(c, err) = <-reply;
		if(c == nil)
			return err;
	}else if(c == nil){
		tsmod := load Mainsubtypes "/dis/alphabet/"+name+"types.dis";
		if(tsmod == nil)
			return sys->sprint("cannot load %q: %r", name+"types.dis");
		c = tsmod->proxy();
	}

	reply := chan of string;
	c <-= ref Typescmd[ref Value].Alphabet(reply);
	a := <-reply;
	ts := ref Typeset(tsname, c, Table[ref Type].new(7, nil), pts);
	typesets = ts :: typesets;
	newtypes: list of ref Type;
	for(i := 0; i < len a; i++){
		tc := a[i];
		if((t := ts.parent.gettype(tc)) == nil){
			t = ref Type(-1, -1, nil, ts, nil, nil);
			sreply := chan of string;
			c <-= ref Typescmd[ref Value].Type2s(tc, sreply);
			t.name = <-sreply;
			# XXX check that type name is syntactically valid.
			t.qname = mkqname(tsname, t.name);
			if(typebyname.find(t.qname) != nil)
				report(errorc, sys->sprint("warning: oops: typename clash on %q", t.qname));
			else
				typebyname.add(t.qname, t);
			newtypes = t :: newtypes;
		}
		ts.types.add(tc, t);
	}
	id := len types;
	types = (array[len types + len newtypes] of ref Type)[0:] = types;
	for(; newtypes != nil; newtypes = tl newtypes){
		types[id] = hd newtypes;
		typebyc.add(currtypec, hd newtypes);
		types[id].tc = currtypec++;
		types[id].id = id;
		id++;
	}
	return nil;
}

autoconvert(src, dst: string, expr: ref Sh->Cmd, errorc: chan of string): string
{
	tdst := typebyname.find(dst);
	if(tdst == nil)
		return "unknown type " + dst;
	tsrc := typebyname.find(src);
	if(tsrc == nil)
		return "unknown type " + src;
	if(tdst.typeset != tsrc.typeset && tdst.typeset != roottypeset && tsrc.typeset != roottypeset)
		return "conversion between incompatible typesets";
	if(expr != nil && expr.ntype == n_WORD){
		# mod -> {(srctype); mod $1}
		expr = mk(n_BLOCK,
			mk(n_SEQ,
				mk(n_LIST, mkw(src), nil),
				mk(n_ADJ,
					mkw(expr.word),
					mk(n_VAR, mkw("1"), nil)
				)
			),
			nil
		);
	}
				
	(e, sig) := rewrite0(expr, tdst.tc, errorc, nil);
	if(sig == nil)
		return "cannot rewrite transformation "+sh->cmd2string(expr);
	if(!evalmod->typecompat(sys->sprint("%c%c", tdst.tc, tsrc.tc), sig))
		return "incompatible module type";
	err := addconversion(tsrc, tdst, e);
	if(err != nil)
		return sys->sprint("bad auto-conversion %s->%s via %s: %s",
					tsrc.qname, tdst.qname, sh->cmd2string(expr), err);
	return nil;
}

mk(ntype: int, left, right: ref Sh->Cmd): ref Sh->Cmd
{
	return ref Sh->Cmd(ntype, left, right, nil, nil);
}
mkw(w: string): ref Sh->Cmd
{
	return ref Sh->Cmd(n_WORD, nil, nil, w, nil);
}

declare(qname: string, usig: string, flags: int): string
{
	return declare0(qname, usig, flags).t1;
}

# declare a module.
# if (flags&ONDEMAND), then we don't need to actually load
# the module (although we do if (flags&CHECK) or if sig==nil,
# in order to check or find out the type signature)
declare0(qname: string, usig: string, flags: int): (ref Module, string)
{
	sig, err: string;
	m: ref Module;
	if(usig != nil){
		(sig, err) = evalmod->usage2sig(m, usig);
		if(sig == nil)
			return (nil, "bad type sig: " + err);
	}
	# if not a qualified name, declare it virtually
	if(qname != nil && qname[0] != '/'){
		if(sig == nil)
			return (nil, "virtual module declaration must include signature");
		m = ref Module(qname, nil, sig, nil, nil, nil, nil, 0);
	}else{
		qname = canon(qname);
		(typeset, mod) := splitqname(qname);
		if((ts := gettypeset(typeset)) == nil)
			return (nil, "unknown typeset");
		if((m = modules.find(qname)) != nil){
			if(m.typeset == ts)
				return (m, nil);
			return (nil, "already imported");
		}
		m = ref Module(mod, ts, sig, nil, nil, nil, nil, 0);
		if(sig == nil || (flags&CHECK) || (flags&ONDEMAND)==0){
			if((e := m.ensureloaded()) != nil)
				return (nil, e);
			if(flags&ONDEMAND){
				if(m.c != nil){
					m.c <-= nil;
					m.c = nil;
				}
				m.m = nil;
			}
		}
	}

	modules.add(qname, m);
	m.refcount++;
	return (m, nil);
}

undeclare(name: string): string
{
	m := modules.find(name);
	if(m == nil)
		return "module not declared";
	modules.del(name);
	if(--m.refcount == 0){
		if(m.c != nil){
			m.c <-= nil;
			m.c = nil;
		}else if(m.defmods != nil){
			delmods(m.defmods);
		}
	}
	return nil;
}

# get info on a module.
# return (qname, usage, def)
getmodule(name: string): (string, string, ref Sh->Cmd)
{
	(qname, sig, def) := getmodule0(name);
	if(sig == nil)
		return (qname, sig, def);
	v: ref Value;
	return (qname, evalmod->cmdusage(v, sig), def);
}

getmodule0(name: string): (string, string, ref Sh->Cmd)
{
	m: ref Module;
	if(name != nil && name[0] != '/'){
		if((m = modules.find(name)) == nil)
			return (nil, nil, nil);
		# XXX could add path searching here.
	}else{
		name = canon(name);
		(typeset, mod) := splitqname(name);
		if((m = modules.find(name)) == nil){
			if(autodeclare == 0)
				return (nil, nil, nil);
			ts := gettypeset(typeset);
			if(ts == nil)
				return (nil, nil, nil);
			m = ref Module(mod, ts, nil, nil, nil, nil, nil, 0);
			if((e := m.ensureloaded()) != nil)
				return (nil, nil, nil);
			if(m.c != nil)
				m.c <-= nil;
		}
	}

	qname := m.modname;
	if(m.def == nil && m.typeset != nil)
		qname = mkqname(m.typeset.name, qname);
	return (qname, m.sig, m.def);
}

getmodules(): list of string
{
	r: list of string;
	for(i := 0; i < len modules.items; i++)
		for(ml := modules.items[i]; ml != nil; ml = tl ml)
			r = (hd ml).t0 :: r;
	return r;
}

#Cmpdeclts: adt {
#	gt: fn(nil: self ref Cmpdeclts, d1, d2: ref Decltypeset): int
#};
#Cmpdeclts.gt(nil: self ref Cmpdeclts, d1, d2: ref Decltypeset)
#{
#	return d1.name > d2.name;
#}
#Cmpstring: adt {
#	gt: fn(nil: self ref Cmpdeclts, d1, d2: string): int
#};
#Cmpstring.gt(nil: self ref Cmpstring, d1, d2: string): int
#{
#	return d1 > d2;
#}
#Cmptype: adt {
#	gt: fn(nil: self ref Cmptype, d1, d2: ref Type): int
#};
#Cmptype.gt(nil: self ref Cmptype, d1, d2: ref Type): int
#{
#	return d1.name > d2.name;
#}
#
#getdecls(): ref Declarations
#{
#	cmptype: ref Cmptype;
#	d := ref Declarations(array[len typesets] of ref Decltypeset);
#	i := 0;
#	ta := array[len types] of ref Type;
#	for(tsl := typesets; tsl != nil; tsl = tl tsl){
#		t := hd tsl;
#		ts := ref Decltypeset;
#		ts.name = t.name;
#
#		# all types in the typeset, in alphabetical order.
#		j := 0;
#		for(k := 0; k < len t.types.items; k++)
#			for(tt := t.types.items[k]; tt != nil; tt = tl tt)
#				ta[j++] = hd tt;
#		sort(cmptype, ta[0:j]);
#		ts.types = array[j] of string;
#		for(k = 0; k < j; k++){
#			ts.types[k] = ta[k].name;
#			ts.alphabet[k] = ta[k].tc;
#		}
#
#		# all modules in the typeset
#		c := gettypesetmodules(ts.name);
#		while((m := <-c) != nil){
#			
#
#	d.types = array[len types] of string;
#	for(i := 0; i < len types; i++){
#		d.alphabet[i] = types[i].tc;
#		d.types[i] = types[i].qname;
#	}
#	

gettypesetmodules(tsname: string): chan of string
{
	ts := gettypeset(tsname);
	if(ts == nil)
		return nil;
	r := chan of string;
	if(ts.c == nil)
		spawn mainmodules(r);
	else
		ts.c <-= ref Typescmd[ref Value].Modules(r);
	return r;
}

mainmodules(r: chan of string)
{
	if((readdir := load Readdir Readdir->PATH) != nil){
		(a, nil) := readdir->init("/dis/alphabet/main", Readdir->NAME|Readdir->COMPACT);
		for(i := 0; i < len a; i++){
			m := a[i].name;
			if((a[i].mode & Sys->DMDIR) == 0 && len m > 4 && m[len m - 4:] == ".dis")
				r <-= m[0:len m - 4];
		}
	}
	r <-= nil;
}

gettypes(ts: string): list of string
{
	r: list of string;
	for(i := 0; i < len types; i++){
		if(ts == nil)
			r = Value.type2s(types[i].tc) :: r;
		else if (types[i].typeset.name == ts)
			r = types[i].name :: r;
	}
	return r;
}

gettypesets(): list of string
{
	r: list of string;
	for(t := typesets; t != nil; t = tl t)
		r = (hd t).name :: r;
	return r;
}

getautoconversions(): list of (string, string, ref Sh->Cmd)
{
	cl: list of (string, string, ref Sh->Cmd);
	for(i := 0; i < len types; i++){
		if(types[i] == nil)
			continue;
		srct := Value.type2s(types[i].tc);
		for(l := types[i].transform; l != nil; l = tl l)
			cl = (srct, Value.type2s(types[(hd l).dst].tc), (hd l).expr) :: cl;
	}
	return cl;
}

importmodule(qname: string): string
{
	qname = canon(qname);
	(typeset, mod) := splitqname(qname);
	if(typeset == nil)
		return "unknown typeset";
	if((m := modules.find(mod)) != nil){
		if(m.typeset == nil)
			return "already defined";
		if(m.typeset.name == typeset)
			return nil;
		return "already imported from "+m.typeset.name;
	}
	if((m = modules.find(qname)) == nil){
		if(autodeclare == 0)
			return "module not declared";
		err: string;
		(m, err) = Module.find(nil, qname);
		if(m == nil)
			return "cannot import: "+ err;
		modules.add(qname, m);
		m.refcount++;
	}
	modules.add(mod, m);
	return nil;
}


gettypeset(name: string): ref Typeset
{
	name = canon(name);
	for(l := typesets; l != nil; l = tl l)
		if((hd l).name == name)
			break;
	if(l == nil)
		return nil;
	return hd l;
}

importtype(qname: string): string
{
	qname = canon(qname);
	(typeset, tname) := splitqname(qname);
	if((ts := gettypeset(typeset)) == nil)
		return "unknown typeset";
	t := typebyname.find(tname);
	if(t != nil){
		if(t.typeset == ts)
			return nil;
		return "type already imported from " + t.typeset.name;
	}
	t = typebyname.find(qname);
	if(t == nil)
		return sys->sprint("%s does not hold type %s", typeset, tname);
	typebyname.add(tname, t);
	return nil;
}

importvalue(v: ref Value, tname: string): (ref Value, string)
{
	if(v == nil || tagof v != tagof Value.Vz)
		return (v, nil);
	if(tname == nil || tname[0] == '/')
		tname = canon(tname);
	t := typebyname.find(tname);
	if(t == nil)
		return (nil, "no such type");
	pick xv := v {
	Vz =>
		if(t.typeset.types.find(xv.i.typec) != t)
			return (nil, "value appears to be of different type");
		xv.i.typec = t.tc;
	}
	return (v, nil);
}

gettype(tc: int): ref Type
{
	return typebyc.find(tc);
}

Typeset.gettype(ts: self ref Typeset, tc: int): ref Type
{
	return ts.types.find(tc);
}

Module.find(ctxt: ref Evalctxt, name: string): (ref Module, string)
{
	mods := modules;
	if(ctxt != nil)
		mods = ctxt.modules;
	m := mods.find(name);
	if(m == nil){
		if(autodeclare == 0 || name == nil || name[0] != '/')
			return (nil, "module not declared");
		err: string;
		(m, err) = declare0(name, nil, 0);
		if(m == nil)
			return (nil, err);
	}else if((err := m.ensureloaded()) != nil)
		return (nil, err);
	return (m, nil);
}

Module.ensureloaded(m: self ref Module): string
{
	if(m.c != nil || m.m != nil || m.def != nil || m.typeset == nil)
		return nil;

	sig: string;
	if(m.typeset.c == nil){
		p := "/dis/alphabet/main/" + m.modname + ".dis";
		mod := load Mainmodule p;
		if(mod == nil)
			return sys->sprint("cannot load %q: %r", p);
		{
			mod->init();
		} exception e {
		"fail:*" =>
			return sys->sprint("init %q failed: %s", m.modname, e[5:]);
		}
		m.m = mod;
		sig = mod->typesig();
	}else{
		reply := chan of (chan of ref Modulecmd[ref Value], string);
		m.typeset.c <-= ref Typescmd[ref Value].Load(m.modname, reply);
		(mc, err) := <-reply;
		if(mc == nil)
			return sys->sprint("cannot load: %s", err);
		m.c = mc;
		sig = gettypesig(m);
	}
	if(m.sig == nil)
		m.sig = sig;
	else if(!evalmod->typecompat(m.sig, sig)){
		v: ref Value;
		if(m.c != nil){
			m.c <-= nil;
			m.c = nil;
		}
		m.m = nil;
		return sys->sprint("%q not compatible with %q (%q vs %q, %d)",
			m.modname+" "+evalmod->cmdusage(v, sig),
			evalmod->cmdusage(v, m.sig), m.sig, sig, m.sig==sig);
	}
	return nil;
}

Module.typesig(m: self ref Module): string
{
	return m.sig;
}

# get the type signature of a module in its native typeset.
# it's not valid to call this on defined or virtually declared modules.
gettypesig(m: ref Module): string
{
	reply := chan of string;
	m.c <-= ref Modulecmd[ref Value].Typesig(reply);
	sig := <-reply;
	origsig := sig;
	for(i := 0; i < len sig; i++){
		tc := sig[i];
		if(tc == '-'){
			i++;
			continue;
		}
		if(tc != '*'){
			t := m.typeset.gettype(sig[i]);
			if(t == nil){
sys->print("no type found for '%c' in sig %q\n", sig[i], origsig);
				return nil;		# XXX is it alright to break here?
			}
			sig[i] = t.tc;
		}
	}
	return sig;
}

Module.run(m: self ref Module, ctxt: ref Evalctxt, errorc: chan of string, opts: list of (int, list of ref Value), args: list of ref Value): ref Value
{
	if(m.c != nil){
		reply := chan of ref Value;
		m.c <-= ref Modulecmd[ref Value].Run(ctxt.drawctxt, ctxt.report, errorc, opts, args, reply);
		if((v := <-reply) != nil){
			pick xv := v {
			Vz =>
				xv.i.typec = m.typeset.types.find(xv.i.typec).tc;
			}
		}
		return v;
	}else if(m.def != nil){
		c: Eval->Context[ref Value, ref Module, ref Evalctxt];
		return c.eval(m.def, ref Evalctxt(m.defmods, ctxt.drawctxt, ctxt.report), errorc, args);
	}else if(m.typeset != nil){
		v := m.m->run(ctxt.drawctxt, ctxt.report, errorc, opts, args);
		free(opts, args, v != nil);
		return v;
	}
	report(errorc, "error: cannot run a virtually declared module");
	return nil;
}

free[V](opts: list of (int, list of V), args: list of V, used: int)
	for{
	V =>
		free: fn(v: self V, used: int);
	}
{
	for(; args != nil; args = tl args)
		(hd args).free(used);
	for(; opts != nil; opts = tl opts)
		for(args = (hd opts).t1; args != nil; args = tl args)
			(hd args).free(used);
}

Module.typename2c(s: string): int
{
	if((t := typebyname.find(s)) == nil)
		return -1;
	return t.tc;
}

Module.cvt(ctxt: ref Evalctxt, v: ref Value, tc: int, errorc: chan of string): ref Value
{
	if(v == nil)
		return nil;
	srctc := v.typec();
	dstid := gettype(tc).id;
	while((vtc := v.typec()) != tc){
		# XXX assumes v always returns a valid typec: might that be dangerous?
		for(l := gettype(vtc).transform; l != nil; l = tl l)
			if((hd l).all.holds(dstid))
				break;
		if(l == nil){
			report(errorc, sys->sprint("error: no way to get from %s to %s", gettype(v.typec()).qname,
					types[dstid].qname));
			v.free(0);
			return nil;		# should only happen the first time.
		}
		t := hd l;
		c: Eval->Context[ref Value, ref Module, ref Evalctxt];
		nv := c.eval(t.expr, ctxt, errorc, v::nil);
		if(nv == nil){
			report(errorc, sys->sprint("error: autoconvert %q failed", sh->cmd2string(t.expr)));
			return nil;
		}
		v = nv;
	}
	return v;
}

Module.mks(nil: ref Evalctxt, s: string): ref Value
{
	return ref Value.Vs(s);
}

Module.mkc(nil: ref Evalctxt, c: ref Sh->Cmd): ref Value
{
	return ref Value.Vc(c);
}

show()
{
	for(i := 0; i < len types; i++){
		if(types[i] == nil)
			continue;
		sys->print("%s =>\n", types[i].qname);
		for(l := types[i].transform; l != nil; l = tl l)
			sys->print("\t%s -> %s {%s}\n", set2s((hd l).all), types[(hd l).dst].qname, sh->cmd2string((hd l).expr));
	}
}

set2s(set: Set): string
{
	s := "{";
	for(i := 0; i < len types; i++){
		if(set.holds(i)){
			if(len s > 1)
				s[len s] = ' ';
			s += types[i].qname;
		}
	}
	return s + "}";
}

Value.dup(v: self ref Value): ref Value
{
	if(v == nil)
		return nil;
	pick xv := v {
	Vr =>
		return nil;
	Vd =>
		return nil;
	Vf or
	Vw =>
		return nil;
	Vz =>
		rc := chan of ref Value;
		gettype(xv.i.typec).typeset.c <-= ref Typescmd[ref Value].Dup(xv, rc);
		nv := <-rc;
		if(nv == nil)
			return nil;
		if(nv == v)
			return v;
		pick nxv := nv {
		Vz =>
			if(nxv.i.typec == xv.i.typec)
				return nxv;
		}
		sys->print("oh dear, invalid duplicated value from typeset %s\n",  gettype(xv.i.typec).typeset.name);
		return nil;
	}
	return v;
}

Value.typec(v: self ref Value): int
{
	pick xv := v {
	Vc =>
		return 'c';
	Vs =>
		return 's';
	Vr =>
		return 'r';
	Vf =>
		return 'f';
	Vw =>
		return 'w';
	Vd =>
		return 'd';
	Vz =>
		return xv.i.typec;
	}
}

Value.typename(v: self ref Value): string
{
	return Value.type2s(v.typec());
}

Value.free(v: self ref Value, used: int)
{
	if(v == nil)
		return;
	pick xv := v {
	Vr =>
		if(!used)
			xv.i <-= "stop";
	Vf or
	Vw=>
		if(!used){
			<-xv.i;
			xv.i <-= nil;
		}
	Vd =>
		if(!used){
			alt{
			xv.i.stop <-= 1 =>
				;
			* =>
				;
			}
		}
	Vz =>
		gettype(xv.i.typec).typeset.c <-= ref Typescmd[ref Value].Free(xv, used, reply := chan of int);
		<-reply;
	}
}

Value.isstring(v: self ref Value): int
{
	return tagof v == tagof Value.Vs;
}
Value.gets(v: self ref Value): string
{
	return v.s().i;
}
Value.c(v: self ref Value): ref Value.Vc
{
	pick xv :=v {Vc => return xv;}
	raise "type error";
}
Value.s(v: self ref Value): ref Value.Vs
{
	pick xv :=v {Vs => return xv;}
	raise "type error";
}
Value.r(v: self ref Value): ref Value.Vr
{
	pick xv :=v {Vr => return xv;}
	raise "type error";
}
Value.f(v: self ref Value): ref Value.Vf
{
	pick xv :=v {Vf => return xv;}
	raise "type error";
}
Value.w(v: self ref Value): ref Value.Vw
{
	pick xv :=v {Vw => return xv;}
	raise "type error";
}
Value.d(v: self ref Value): ref Value.Vd
{
	pick xv :=v {Vd => return xv;}
	raise "type error";
}
Value.z(v: self ref Value): ref Value.Vz
{
	pick xv :=v {Vz => return xv;}
	raise "type error";
}

Value.type2s(tc: int): string
{
	t := gettype(tc);
	if(t == nil)
		return "unknown";
	if(typebyname.find(t.name) == t)
		return t.name;
	return t.qname;
}

Rmodule.find(ctxt: ref Revalctxt, s: string): (ref Rmodule, string)
{
	m := ctxt.modules.find(s);
	if(m == nil){
		if(autodeclare == 0 || s == nil || s[0] != '/')
			return (nil, "module not declared");
		if(ctxt.modules != modules)
			return (nil, "shouldn't happen: module not found in defined block");
		err: string;
		(m, err) = declare0(s, nil, ONDEMAND);
		if(m == nil)
			return (nil, err);
	}
	return (ref Rmodule(m), nil);
}

Rmodule.cvt(ctxt: ref Revalctxt, v: ref Rvalue, tc: int, errorc: chan of string): ref Rvalue
{
	if(v == nil)
		return nil;
	srctc := v.typec();
	dstid := gettype(tc).id;
	while((vtc := v.typec()) != tc){
		# XXX assumes v always returns a valid typec: might that be dangerous?
		for(l := gettype(vtc).transform; l != nil; l = tl l)
			if((hd l).all.holds(dstid))
				break;
		if(l == nil){
			report(errorc, sys->sprint("error: no way to get from %s to %s", gettype(v.typec()).qname,
					types[dstid].qname));
			return nil;		# should only happen the first time.
		}
		t := hd l;
		c: Eval->Context[ref Rvalue, ref Rmodule, ref Revalctxt];
		v = c.eval(t.expr, ctxt, errorc, v::nil);
	}
	return v;
}

Rmodule.typesig(m: self ref Rmodule): string
{
	return m.m.sig;
}

Rmodule.typename2c(name: string): int
{
	return Module.typename2c(name);
}

Rmodule.mks(ctxt: ref Revalctxt, s: string): ref Rvalue
{
	v := ref Rvalue(mkw(s), 's', 0, nil, nil);
	ctxt.vals = v :: ctxt.vals;
	return v;
}

Rmodule.mkc(ctxt: ref Revalctxt, c: ref Sh->Cmd): ref Rvalue
{
	v := ref Rvalue(mk(n_BQ2, c, nil), 'c', 0, nil, nil);
	ctxt.vals = v :: ctxt.vals;
	return v;
}

Rmodule.run(m: self ref Rmodule, ctxt: ref Revalctxt, errorc: chan of string,
		opts: list of (int, list of ref Rvalue), args: list of ref Rvalue): ref Rvalue
{
	if(ctxt.defs && m.m.def != nil){
		c: Eval->Context[ref Rvalue, ref Rmodule, ref Revalctxt];
		nctxt := ref Revalctxt(m.m.defmods, ctxt.used, ctxt.defs, ctxt.vals);
		v := c.eval(m.m.def, nctxt, errorc, args);
		ctxt.vals = nctxt.vals;
		return v;
	}
	name := mkqname(m.m.typeset.name, m.m.modname);
	if(ctxt.used != nil){
		ctxt.used.add(name, m.m);
		m.m.refcount++;
	}
	v := ref Rvalue(mkw(name), m.m.sig[0], 0, opts, args);
	if(args == nil && opts == nil)
		v.i = mk(n_BLOCK, v.i, nil);
	for(; args != nil; args = tl args)
		(hd args).refcount++;
	for(; opts != nil; opts = tl opts)
		for(args = (hd opts).t1; args != nil; args = tl args)
			(hd args).refcount++;
	ctxt.vals = v :: ctxt.vals;
	return v;
}

Rvalue.dup(v: self ref Rvalue): ref Rvalue
{
	return v;
}
	
Rvalue.free(nil: self ref Rvalue, nil: int)
{
	# XXX perhaps there should be some way of finding out whether a particular
	# type will allow duplication of values or not.
}

Rvalue.isstring(v: self ref Rvalue): int
{
	return v.tc == 's';
}

Rvalue.gets(t: self ref Rvalue): string
{
	return t.i.word;
}

Rvalue.type2s(tc: int): string
{
	return Value.type2s(tc);
}

Rvalue.typec(t: self ref Rvalue): int
{
	return t.tc;
}

addconversion(src, dst: ref Type, expr: ref Sh->Cmd): string
{
	# allow the same transform to be added again
	for(l := src.transform; l != nil; l = tl l)
		if((hd l).all.holds(dst.id)){
			if((hd l).dst == dst.id && sh->cmd2string((hd l).expr) == sh->cmd2string(expr))
				return nil;
		}

	reached := array[len types/8+1] of {* => byte 0};
	if((at := ambiguous(dst, reached)) != nil)
		return sys->sprint("ambiguity: %s", at);

	src.transform = ref Transform(dst.id, sets->bytes2set(reached), expr) :: src.transform;
	# check we haven't created ambiguity in nodes that point to src.
	for(i := 0; i < len types; i++){
		for(l = types[i].transform; l != nil; l = tl l){
			if((hd l).all.holds(src.id) && (at = ambiguous(types[i], array[len types/8+1] of {* => byte 0})) != nil){
				src.transform = tl src.transform;
				return sys->sprint("ambiguity: %s", at);
			}
		}
	}
	all := (Sets->None).add(dst.id);
	for(l = types[dst.id].transform; l != nil; l = tl l)
		all = all.X(Sets->A|Sets->B, (hd l).all);
	# add everything pointed to by dst to the all sets of those types
	# that had previously pointed (indirectly) to src
	for(i = 0; i < len types; i++)
		for(l = types[i].transform; l != nil; l = tl l)
			if((hd l).all.holds(src.id))
				(hd l).all = (hd l).all.X(Sets->A|Sets->B, all);
	return nil;
}

ambiguous(t: ref Type, reached: array of byte): string
{
	if((dt := ambiguous1(t, reached)) == nil)
		return nil;
	(nil, at) := findambiguous(t, dt, array[len reached] of {* =>byte 0}, "self "+types[t.id].qname);
	s := hd at;
	for(at = tl at; at != nil; at = tl at)
		s += ", " + hd at;
	return s;
}

# a conversion is ambiguous if there's more than one
# way of reaching the same type.
# return the type at which the ambiguity is found.
ambiguous1(t: ref Type, reached: array of byte): ref Type
{
	if(bsetholds(reached, t.id))
		return t;
	bsetadd(reached, t.id);
	for(l := t.transform; l != nil; l = tl l)
		if((at := ambiguous1(types[(hd l).dst], reached)) != nil)
			return at;
	return nil;
}

findambiguous(t: ref Type, dt: ref Type, reached: array of byte, s: string): (int, list of string)
{
	a: list of string;
	if(t == dt)
		a = s :: nil;
	if(bsetholds(reached, t.id))
		return (1, a);
	bsetadd(reached, t.id);
	for(l := t.transform; l != nil; l = tl l){
		(found, at) := findambiguous(types[(hd l).dst], dt, reached,
				sys->sprint("%s|%s", s, sh->cmd2string((hd l).expr)));	# XXX rewite correctly
		for(; at != nil; at = tl at)
			a = hd at :: a;
		if(found)
			return (1, a);
	}
	return (0, a);
}

bsetholds(x: array of byte, n: int): int
{
	return int x[n >> 3] & (1 << (n & 7));
}

bsetadd(x: array of byte, n: int)
{
	x[n >> 3] |= byte (1 << (n & 7));
}

mkqname(parent, child: string): string
{
	if(parent == "/")
		return parent+child;
	return parent+"/"+child;
}

# splits a canonical qname into typeset and name components.
splitqname(name: string): (string, string)
{
	if(name == nil)
		return (nil, nil);
	for(i := len name - 1; i >= 0; i--)
		if(name[i] == '/')
			break;
	if(i == 0)
		return ("/", name[1:]);
	return (name[0:i], name[i+1:]);
}

# compress multiple slashes into single; remove trailing slashes.
canon(name: string): string
{
	if(name == nil || name[0] != '/')
		return nil;

	slash := nonslash := 0;
	s := "";
	for(i := 0; i < len name; i++){
		c := name[i];
		if(c == '/')
			slash = 1;
		else{
			if(slash){
				s[len s] = '/';
				nonslash++;
				slash = 0;
			}
			s[len s] = c;
		}
	}
	if(slash && !nonslash)
		s[len s] = '/';
	return s;
}

report(errorc: chan of string, s: string)
{
	if(Debug || errorc == nil)
		sys->fprint(sys->fildes(2), "%s\n", s);
	if(errorc != nil)
		errorc <-= s;
}

Table[T].new(nslots: int, nilval: T): ref Table[T]
{
	if(nslots == 0)
		nslots = 13;
	return ref Table[T](array[nslots] of list of (int, T), nilval);
}

Table[T].add(t: self ref Table[T], id: int, x: T): int
{
	slot := id % len t.items;
	for(q := t.items[slot]; q != nil; q = tl q)
		if((hd q).t0 == id)
			return 0;
	t.items[slot] = (id, x) :: t.items[slot];
	return 1;
}

Table[T].del(t: self ref Table[T], id: int): int
{
	slot := id % len t.items;
	
	p: list of (int, T);
	r := 0;
	for(q := t.items[slot]; q != nil; q = tl q){
		if((hd q).t0 == id){
			p = joinip(p, tl q);
			r = 1;
			break;
		}
		p = hd q :: p;
	}
	t.items[slot] = p;
	return r;
}

Table[T].find(t: self ref Table[T], id: int): T
{
	for(p := t.items[id % len t.items]; p != nil; p = tl p)
		if((hd p).t0 == id)
			return (hd p).t1;
	return t.nilval;
}

hashfn(s: string, n: int): int
{
	h := 0;
	m := len s;
	for(i:=0; i<m; i++){
		h = 65599*h+s[i];
	}
	return (h & 16r7fffffff) % n;
}

Strhash[T].new(nslots: int, nilval: T): ref Strhash[T]
{
	if(nslots == 0)
		nslots = 13;
	return ref Strhash[T](array[nslots] of list of (string, T), nilval);
}

Strhash[T].add(t: self ref Strhash, id: string, x: T)
{
	slot := hashfn(id, len t.items);
	t.items[slot] = (id, x) :: t.items[slot];
}

Strhash[T].del(t: self ref Strhash, id: string)
{
	slot := hashfn(id, len t.items);

	p: list of (string, T);
	for(q := t.items[slot]; q != nil; q = tl q)
		if((hd q).t0 != id)
			p = hd q :: p;
	t.items[slot] = p;
}

Strhash[T].find(t: self ref Strhash, id: string): T
{
	for(p := t.items[hashfn(id, len t.items)]; p != nil; p = tl p)
		if((hd p).t0 == id)
			return (hd p).t1;
	return t.nilval;
}

rev[T](x: list of T): list of T
{
	l: list of T;
	for(; x != nil; x = tl x)
		l = hd x :: l;
	return l;
}

# join x to y, leaving result in arbitrary order.
join[T](x, y: list of T): list of T
{
	if(len x > len y)
		(x, y) = (y, x);
	for(; x != nil; x = tl x)
		y = hd x :: y;
	return y;
}

# join x to y, leaving result in arbitrary order.
joinip[T](x, y: list of (int, T)): list of (int, T)
{
	if(len x > len y)
		(x, y) = (y, x);
	for(; x != nil; x = tl x)
		y = hd x :: y;
	return y;
}

sort[S, T](s: S, a: array of T)
	for{
	S =>
		gt: fn(s: self S, x, y: T): int;
	}
{
	mergesort(s, a, array[len a] of T);
}

mergesort[S, T](s: S, a, b: array of T)
	for{
	S =>
		gt: fn(s: self S, x, y: T): int;
	}
{
	r := len a;
	if (r > 1) {
		m := (r-1)/2 + 1;
		mergesort(s, a[0:m], b[0:m]);
		mergesort(s, a[m:], b[m:]);
		b[0:] = a;
		for ((i, j, k) := (0, m, 0); i < m && j < r; k++) {
			if(s.gt(b[i], b[j]))
				a[k] = b[j++];
			else
				a[k] = b[i++];
		}
		if (i < m)
			a[k:] = b[i:m];
		else if (j < r)
			a[k:] = b[j:r];
	}
}