code: 9ferno

ref: 6d69f6fba35087686f79adb2ea0d67944a62ca7b
dir: /appl/cmd/limbo/types.b/

kindname := array [Tend] of
{
	Tnone =>	"no type",
	Tadt =>		"adt",
	Tadtpick =>	"adt",
	Tarray =>	"array",
	Tbig =>		"big",
	Tbyte =>	"byte",
	Tchan =>	"chan",
	Treal =>	"real",
	Tfn =>		"fn",
	Tint =>		"int",
	Tlist =>	"list",
	Tmodule =>	"module",
	Tref =>		"ref",
	Tstring =>	"string",
	Ttuple =>	"tuple",
	Texception => "exception",
	Tfix => "fixed point",
	Tpoly => "polymorphic",

	Tainit =>	"array initializers",
	Talt =>		"alt channels",
	Tany =>		"polymorphic type",
	Tarrow =>	"->",
	Tcase =>	"case int labels",
	Tcasel =>	"case big labels",
	Tcasec =>	"case string labels",
	Tdot =>		".",
	Terror =>	"type error",
	Tgoto =>	"goto labels",
	Tid =>		"id",
	Tiface =>	"module interface",
	Texcept =>	"exception handler table",
	Tinst =>	"instantiated type",
};

tattr = array[Tend] of
{
	#		     isptr	refable	conable	big	vis
	Tnone =>	Tattr(0,	0,	0,	0,	0),
	Tadt =>		Tattr(0,	1,	1,	1,	1),
	Tadtpick =>	Tattr(0,	1,	0,	1,	1),
	Tarray =>	Tattr(1,	0,	0,	0,	1),
	Tbig =>		Tattr(0,	0,	1,	1,	1),
	Tbyte =>	Tattr(0,	0,	1,	0,	1),
	Tchan =>	Tattr(1,	0,	0,	0,	1),
	Treal =>	Tattr(0,	0,	1,	1,	1),
	Tfn =>		Tattr(0,	1,	0,	0,	1),
	Tint =>		Tattr(0,	0,	1,	0,	1),
	Tlist =>	Tattr(1,	0,	0,	0,	1),
	Tmodule =>	Tattr(1,	0,	0,	0,	1),
	Tref =>		Tattr(1,	0,	0,	0,	1),
	Tstring =>	Tattr(1,	0,	1,	0,	1),
	Ttuple =>	Tattr(0,	1,	1,	1,	1),
	Texception => Tattr(0,	0,	0,	1,	1),
	Tfix =>		Tattr(0,	0,	1,	0,	1),
	Tpoly =>	Tattr(1,	0,	0,	0,	1),

	Tainit =>	Tattr(0,	0,	0,	1,	0),
	Talt =>		Tattr(0,	0,	0,	1,	0),
	Tany =>		Tattr(1,	0,	0,	0,	0),
	Tarrow =>	Tattr(0,	0,	0,	0,	1),
	Tcase =>	Tattr(0,	0,	0,	1,	0),
	Tcasel =>	Tattr(0,	0,	0,	1,	0),
	Tcasec =>	Tattr(0,	0,	0,	1,	0),
	Tdot =>		Tattr(0,	0,	0,	0,	1),
	Terror =>	Tattr(0,	1,	1,	0,	0),
	Tgoto =>	Tattr(0,	0,	0,	1,	0),
	Tid =>		Tattr(0,	0,	0,	0,	1),
	Tiface =>	Tattr(0,	0,	0,	1,	0),
	Texcept =>	Tattr(0,	0,	0,	1,	0),
	Tinst =>	Tattr(0,	1,	1,	1,	1),
};

eqclass:	array of ref Teq;

ztype:		Type;
eqrec:		int;
eqset:		int;
adts:		array of ref Decl;
nadts:		int;
anontupsym:	ref Sym;
unifysrc:	Src;

addtmap(t1: ref Type, t2: ref Type, tph: ref Tpair): ref Tpair
{
	tp: ref Tpair;

	tp = ref Tpair;
	tp.t1 = t1;
	tp.t2 = t2;
	tp.nxt = tph;
	return tp;
}

valtmap(t: ref Type, tp: ref Tpair): ref Type
{
	for( ; tp != nil; tp = tp.nxt)
		if(tp.t1 == t)
			return tp.t2;
	return t;
}

addtype(t: ref Type, hdl: ref Typelist): ref Typelist
{
	tll := ref Typelist;
	tll.t = t;
	tll.nxt = nil;
	if(hdl == nil)
		return tll;
	for(p := hdl; p.nxt != nil; p = p.nxt)
		;
	p.nxt = tll;
	return hdl;
}

typeinit()
{
	anontupsym = enter(".tuple", 0);

	ztype.sbl = -1;
	ztype.ok = byte 0;
	ztype.rec = byte 0;

	tbig = mktype(noline, noline, Tbig, nil, nil);
	tbig.size = IBY2LG;
	tbig.align = IBY2LG;
	tbig.ok = OKmask;

	tbyte = mktype(noline, noline, Tbyte, nil, nil);
	tbyte.size = 1;
	tbyte.align = 1;
	tbyte.ok = OKmask;

	tint = mktype(noline, noline, Tint, nil, nil);
	tint.size = IBY2WD;
	tint.align = IBY2WD;
	tint.ok = OKmask;

	treal = mktype(noline, noline, Treal, nil, nil);
	treal.size = IBY2FT;
	treal.align = IBY2FT;
	treal.ok = OKmask;

	tstring = mktype(noline, noline, Tstring, nil, nil);
	tstring.size = IBY2WD;
	tstring.align = IBY2WD;
	tstring.ok = OKmask;

	texception = mktype(noline, noline, Texception, nil, nil);
	texception.size = IBY2WD;
	texception.align = IBY2WD;
	texception.ok = OKmask;

	tany = mktype(noline, noline, Tany, nil, nil);
	tany.size = IBY2WD;
	tany.align = IBY2WD;
	tany.ok = OKmask;

	tnone = mktype(noline, noline, Tnone, nil, nil);
	tnone.size = 0;
	tnone.align = 1;
	tnone.ok = OKmask;

	terror = mktype(noline, noline, Terror, nil, nil);
	terror.size = 0;
	terror.align = 1;
	terror.ok = OKmask;

	tunknown = mktype(noline, noline, Terror, nil, nil);
	tunknown.size = 0;
	tunknown.align = 1;
	tunknown.ok = OKmask;

	tfnptr = mktype(noline, noline, Ttuple, nil, nil);
	id := tfnptr.ids = mkids(nosrc, nil, tany, nil);
	id.store = Dfield;
	id.offset = 0;
	id.sym = enter("t0", 0);
	id.src = Src(0, 0);
	id = tfnptr.ids.next = mkids(nosrc, nil, tint, nil);
	id.store = Dfield;
	id.offset = IBY2WD;
	id.sym = enter("t1", 0);
	id.src = Src(0, 0);

	rtexception = mktype(noline, noline, Tref, texception, nil);
	rtexception.size = IBY2WD;
	rtexception.align = IBY2WD;
	rtexception.ok = OKmask;
}

typestart()
{
	descriptors = nil;
	nfns = 0;
	adts = nil;
	nadts = 0;
	selfdecl = nil;
	if(tfnptr.decl != nil)
		tfnptr.decl.desc = nil;

	eqclass = array[Tend] of ref Teq;

	typebuiltin(mkids(nosrc, enter("int", 0), nil, nil), tint);
	typebuiltin(mkids(nosrc, enter("big", 0), nil, nil), tbig);
	typebuiltin(mkids(nosrc, enter("byte", 0), nil, nil), tbyte);
	typebuiltin(mkids(nosrc, enter("string", 0), nil, nil), tstring);
	typebuiltin(mkids(nosrc, enter("real", 0), nil, nil), treal);
}

modclass(): ref Teq
{
	return eqclass[Tmodule];
}

mktype(start: Line, stop: Line, kind: int, tof: ref Type, args: ref Decl): ref Type
{
	t := ref ztype;
	t.src.start = start;
	t.src.stop = stop;
	t.kind = kind;
	t.tof = tof;
	t.ids = args;
	return t;
}

nalt: int;
mktalt(c: ref Case): ref Type
{
	t := mktype(noline, noline, Talt, nil, nil);
	t.decl = mkdecl(nosrc, Dtype, t);
	t.decl.sym = enter(".a"+string nalt++, 0);
	t.cse = c;
	return usetype(t);
}

#
# copy t and the top level of ids
#
copytypeids(t: ref Type): ref Type
{
	last: ref Decl;

	nt := ref *t;
	for(id := t.ids; id != nil; id = id.next){
		new := ref *id;
		if(last == nil)
			nt.ids = new;
		else
			last.next = new;
		last = new;
	}
	return nt;
}

#
# make each of the ids have type t
#
typeids(ids: ref Decl, t: ref Type): ref Decl
{
	if(ids == nil)
		return nil;

	ids.ty = t;
	for(id := ids.next; id != nil; id = id.next)
		id.ty = t;
	return ids;
}

typebuiltin(d: ref Decl, t: ref Type)
{
	d.ty = t;
	t.decl = d;
	installids(Dtype, d);
}

fielddecl(store: int, ids: ref Decl): ref Node
{
	n := mkn(Ofielddecl, nil, nil);
	n.decl = ids;
	for(; ids != nil; ids = ids.next)
		ids.store = store;
	return n;
}

typedecl(ids: ref Decl, t: ref Type): ref Node
{
	if(t.decl == nil)
		t.decl = ids;
	n := mkn(Otypedecl, nil, nil);
	n.decl = ids;
	n.ty = t;
	for(; ids != nil; ids = ids.next)
		ids.ty = t;
	return n;
}

typedecled(n: ref Node)
{
	installids(Dtype, n.decl);
}

adtdecl(ids: ref Decl, fields: ref Node): ref Node
{
	n := mkn(Oadtdecl, nil, nil);
	t := mktype(ids.src.start, ids.src.stop, Tadt, nil, nil);
	n.decl = ids;
	n.left = fields;
	n.ty = t;
	t.decl = ids;
	for(; ids != nil; ids = ids.next)
		ids.ty = t;
	return n;
}

adtdecled(n: ref Node)
{
	d := n.ty.decl;
	installids(Dtype, d);
	if(n.ty.polys != nil){
		pushscope(nil, Sother);
		installids(Dtype, n.ty.polys);
	}
	pushscope(nil, Sother);
	fielddecled(n.left);
	n.ty.ids = popscope();
	if(n.ty.polys != nil)
		n.ty.polys = popscope();
	for(ids := n.ty.ids; ids != nil; ids = ids.next)
		ids.dot = d;
}

fielddecled(n: ref Node)
{
	for(; n != nil; n = n.right){
		case n.op{
		Oseq =>
			fielddecled(n.left);
		Oadtdecl =>
			adtdecled(n);
			return;
		Otypedecl =>
			typedecled(n);
			return;
		Ofielddecl =>
			installids(Dfield, n.decl);
			return;
		Ocondecl =>
			condecled(n);
			gdasdecl(n.right);
			return;
		Oexdecl =>
			exdecled(n);
			return;
		Opickdecl =>
			pickdecled(n);
			return;
		* =>
			fatal("can't deal with "+opname[n.op]+" in fielddecled");
		}
	}
}

pickdecled(n: ref Node): int
{
	if(n == nil)
		return 0;
	tag := pickdecled(n.left);
	pushscope(nil, Sother);
	fielddecled(n.right.right);
	d := n.right.left.decl;
	d.ty.ids = popscope();
	installids(Dtag, d);
	for(; d != nil; d = d.next)
		d.tag = tag++;
	return tag;
}

#
# make the tuple type used to initialize adt t
#
mkadtcon(t: ref Type): ref Type
{
	last: ref Decl;

	nt := ref *t;
	nt.ids = nil;
	nt.kind = Ttuple;
	for(id := t.ids; id != nil; id = id.next){
		if(id.store != Dfield)
			continue;
		new := ref *id;
		new.cyc = byte 0;
		if(last == nil)
			nt.ids = new;
		else
			last.next = new;
		last = new;
	}
	last.next = nil;
	return nt;
}

#
# make the tuple type used to initialize t,
# an adt with pick fields tagged by tg
#
mkadtpickcon(t, tgt: ref Type): ref Type
{
	last := mkids(tgt.decl.src, nil, tint, nil);
	last.store = Dfield;
	nt := mktype(t.src.start, t.src.stop, Ttuple, nil, last);
	for(id := t.ids; id != nil; id = id.next){
		if(id.store != Dfield)
			continue;
		new := ref *id;
		new.cyc = byte 0;
		last.next = new;
		last = new;
	}
	for(id = tgt.ids; id != nil; id = id.next){
		if(id.store != Dfield)
			continue;
		new := ref *id;
		new.cyc = byte 0;
		last.next = new;
		last = new;
	}
	last.next = nil;
	return nt;
}

#
# make an identifier type
#
mkidtype(src: Src, s: ref Sym): ref Type
{
	t := mktype(src.start, src.stop, Tid, nil, nil);
	if(s.unbound == nil){
		s.unbound = mkdecl(src, Dunbound, nil);
		s.unbound.sym = s;
	}
	t.decl = s.unbound;
	return t;
}

#
# make a qualified type for t->s
#
mkarrowtype(start: Line, stop: Line, t: ref Type, s: ref Sym): ref Type
{
	t = mktype(start, stop, Tarrow, t, nil);
	if(s.unbound == nil){
		s.unbound = mkdecl(Src(start, stop), Dunbound, nil);
		s.unbound.sym = s;
	}
	t.decl = s.unbound;
	return t;
}

#
# make a qualified type for t.s
#
mkdottype(start: Line, stop: Line, t: ref Type, s: ref Sym): ref Type
{
	t = mktype(start, stop, Tdot, t, nil);
	if(s.unbound == nil){
		s.unbound = mkdecl(Src(start, stop), Dunbound, nil);
		s.unbound.sym = s;
	}
	t.decl = s.unbound;
	return t;
}

mkinsttype(src: Src, tt: ref Type, tyl: ref Typelist): ref Type
{
	t := mktype(src.start, src.stop, Tinst, tt, nil);
	t.tlist = tyl;
	return t;
}

#
# look up the name f in the fields of a module, adt, or tuple
#
namedot(ids: ref Decl, s: ref Sym): ref Decl
{
	for(; ids != nil; ids = ids.next)
		if(ids.sym == s)
			return ids;
	return nil;
}

#
# complete the declaration of an adt
# methods frames get sized in module definition or during function definition
# place the methods at the end of the field list
#
adtdefd(t: ref Type)
{
	next, aux, store, auxhd, tagnext: ref Decl;

	if(debug['x'])
		print("adt %s defd\n", typeconv(t));
	d := t.decl;
	tagnext = nil;
	store = nil;
	for(id := t.polys; id != nil; id = id.next){
		id.store = Dtype;
		id.ty = verifytypes(id.ty, d, nil);
	}
	for(id = t.ids; id != nil; id = next){
		if(id.store == Dtag){
			if(t.tags != nil)
				error(id.src.start, "only one set of pick fields allowed");
			tagnext = pickdefd(t, id);
			next = tagnext;
			if(store != nil)
				store.next = next;
			else
				t.ids = next;
			continue;
		}else{
			id.dot = d;
			next = id.next;
			store = id;
		}
	}
	aux = nil;
	store = nil;
	auxhd = nil;
	seentags := 0;
	for(id = t.ids; id != nil; id = next){
		if(id == tagnext)
			seentags = 1;

		next = id.next;
		id.dot = d;
		id.ty = topvartype(verifytypes(id.ty, d, nil), id, 1, 1);
		if(id.store == Dfield && id.ty.kind == Tfn)
			id.store = Dfn;
		if(id.store == Dfn || id.store == Dconst){
			if(store != nil)
				store.next = next;
			else
				t.ids = next;
			if(aux != nil)
				aux.next = id;
			else
				auxhd = id;
			aux = id;
		}else{
			if(seentags)
				error(id.src.start, "pick fields must be the last data fields in an adt");
			store = id;
		}
	}
	if(aux != nil)
		aux.next = nil;
	if(store != nil)
		store.next = auxhd;
	else
		t.ids = auxhd;

	for(id = t.tags; id != nil; id = id.next){
		id.ty = verifytypes(id.ty, d, nil);
		if(id.ty.tof == nil)
			id.ty.tof = mkadtpickcon(t, id.ty);
	}
}

#
# assemble the data structure for an adt with a pick clause.
# since the scoping rules for adt pick fields are strange,
# we have a customized check for overlapping definitions.
#
pickdefd(t: ref Type, tg: ref Decl): ref Decl
{
	lasttg : ref Decl = nil;
	d := t.decl;
	t.tags = tg;
	tag := 0;
	while(tg != nil){
		tt := tg.ty;
		if(tt.kind != Tadtpick || tg.tag != tag)
			break;
		tt.decl = tg;
		lasttg = tg;
		for(; tg != nil; tg = tg.next){
			if(tg.ty != tt)
				break;
			tag++;
			lasttg = tg;
			tg.dot = d;
		}
		for(id := tt.ids; id != nil; id = id.next){
			xid := namedot(t.ids, id.sym);
			if(xid != nil)
				error(id.src.start, "redeclaration of "+declconv(id)+
					" previously declared as "+storeconv(xid)+" on line "+lineconv(xid.src.start));
			id.dot = d;
		}
	}
	if(lasttg == nil){
		error(t.src.start, "empty pick field declaration in "+typeconv(t));
		t.tags = nil;
	}else
		lasttg.next = nil;
	d.tag = tag;
	return tg;
}

moddecl(ids: ref Decl, fields: ref Node): ref Node
{
	n := mkn(Omoddecl, mkn(Oseq, nil, nil), nil);
	t := mktype(ids.src.start, ids.src.stop, Tmodule, nil, nil);
	n.decl = ids;
	n.left = fields;
	n.ty = t;
	return n;
}

moddecled(n: ref Node)
{
	d := n.decl;
	installids(Dtype, d);
	isimp := 0;
	for(ids := d; ids != nil; ids = ids.next){
		for(im := impmods; im != nil; im = im.next){
			if(ids.sym == im.sym){
				isimp = 1;
				d = ids;
				dm := ref Dlist;
				dm.d = ids;
				dm.next = nil;
				if(impdecls == nil)
					impdecls = dm;
				else{
					for(dl := impdecls; dl.next != nil; dl = dl.next)
						;
					dl.next = dm;
				}
			}
		}
		ids.ty = n.ty;
	}
	pushscope(nil, Sother);
	fielddecled(n.left);

	d.ty.ids = popscope();

	#
	# make the current module the . parent of all contained decls.
	#
	for(ids = d.ty.ids; ids != nil; ids = ids.next)
		ids.dot = d;

	t := d.ty;
	t.decl = d;
	if(debug['m'])
		print("declare module %s\n", d.sym.name);

	#
	# add the iface declaration in case it's needed later
	#
	installids(Dglobal, mkids(d.src, enter(".m."+d.sym.name, 0), tnone, nil));

	if(isimp){
		for(ids = d.ty.ids; ids != nil; ids = ids.next){
			s := ids.sym;
			if(s.decl != nil && s.decl.scope >= scope){
				dot := s.decl.dot;
				if(s.decl.store != Dwundef && dot != nil && dot != d && isimpmod(dot.sym) && dequal(ids, s.decl, 0))
					continue;
				redecl(ids);
				ids.old = s.decl.old;
			}else
				ids.old = s.decl;
			s.decl = ids;
			ids.scope = scope;
		}
	}
}

#
# for each module in id,
# link by field ext all of the decls for
# functions needed in external linkage table
# collect globals and make a tuple for all of them
#
mkiface(m: ref Decl): ref Type
{
	iface := last := ref Decl;
	globals := glast := mkdecl(m.src, Dglobal, mktype(m.src.start, m.src.stop, Tadt, nil, nil));
	for(id := m.ty.ids; id != nil; id = id.next){
		case id.store{
		Dglobal =>
			glast = glast.next = dupdecl(id);
			id.iface = globals;
			glast.iface = id;
		Dfn =>
			id.iface = last = last.next = dupdecl(id);
			last.iface = id;
		Dtype =>
			if(id.ty.kind != Tadt)
				break;
			for(d := id.ty.ids; d != nil; d = d.next){
				if(d.store == Dfn){
					d.iface = last = last.next = dupdecl(d);
					last.iface = d;
				}
			}
		}
	}
	last.next = nil;
	iface = namesort(iface.next);

	if(globals.next != nil){
		glast.next = nil;
		globals.ty.ids = namesort(globals.next);
		globals.ty.decl = globals;
		globals.sym = enter(".mp", 0);
		globals.dot = m;
		globals.next = iface;
		iface = globals;
	}

	#
	# make the interface type and install an identifier for it
	# the iface has a ref count if it is loaded
	#
	t := mktype(m.src.start, m.src.stop, Tiface, nil, iface);
	id = enter(".m."+m.sym.name, 0).decl;
	t.decl = id;
	id.ty = t;

	#
	# dummy node so the interface is initialized
	#
	id.init = mkn(Onothing, nil, nil);
	id.init.ty = t;
	id.init.decl = id;
	return t;
}

joiniface(mt, t: ref Type)
{
	iface := t.ids;
	globals := iface;
	if(iface != nil && iface.store == Dglobal)
		iface = iface.next;
	for(id := mt.tof.ids; id != nil; id = id.next){
		case id.store{
		Dglobal =>
			for(d := id.ty.ids; d != nil; d = d.next)
				d.iface.iface = globals;
		Dfn =>
			id.iface.iface = iface;
			iface = iface.next;
		* =>
			fatal("unknown store "+storeconv(id)+" in joiniface");
		}
	}
	if(iface != nil)
		fatal("join iface not matched");
	mt.tof = t;
}

addiface(m: ref Decl, d: ref Decl)
{
	t: ref Type;
	id, last, dd, lastorig: ref Decl;

	if(d == nil || !local(d))
		return;
	modrefable(d.ty);
	if(m == nil){
		if(impdecls.next != nil)
			for(dl := impdecls; dl != nil; dl = dl.next)
				if(dl.d.ty.tof != impdecl.ty.tof)	# impdecl last
					addiface(dl.d, d);
		addiface(impdecl, d);
		return;
	}
	t = m.ty.tof;
	last = nil;
	lastorig = nil;
	for(id = t.ids; id != nil; id = id.next){
		if(d == id || d == id.iface)
			return;
		last = id;
		if(id.tag == 0)
			lastorig = id;
	}
	dd = dupdecl(d);
	if(d.dot == nil)
		d.dot = dd.dot = m;
	d.iface = dd;
	dd.iface = d;
	if(last == nil)
		t.ids = dd;
	else
		last.next = dd;
	dd.tag = 1;	# mark so not signed
	if(lastorig == nil)
		t.ids = namesort(t.ids);
	else
		lastorig.next = namesort(lastorig.next);
}

#
# eliminate unused declarations from interfaces
# label offset within interface
#
narrowmods()
{
	id: ref Decl;
	for(eq := modclass(); eq != nil; eq = eq.eq){
		t := eq.ty.tof;

		if(t.linkall == byte 0){
			last : ref Decl = nil;
			for(id = t.ids; id != nil; id = id.next){
				if(id.refs == 0){
					if(last == nil)
						t.ids = id.next;
					else
						last.next = id.next;
				}else
					last = id;
			}

			#
			# need to resize smaller interfaces
			#
			resizetype(t);
		}

		offset := 0;
		for(id = t.ids; id != nil; id = id.next)
			id.offset = offset++;

		#
		# rathole to stuff number of entries in interface
		#
		t.decl.init.c = ref Const;
		t.decl.init.c.val = big offset;
	}
}

#
# check to see if any data field of module m if referenced.
# if so, mark all data in m
#
moddataref()
{
	for(eq := modclass(); eq != nil; eq = eq.eq){
		id := eq.ty.tof.ids;
		if(id != nil && id.store == Dglobal && id.refs)
			for(id = eq.ty.ids; id != nil; id = id.next)
				if(id.store == Dglobal)
					modrefable(id.ty);
	}
}

#
# move the global declarations in interface to the front
#
modglobals(mod, globals: ref Decl): ref Decl
{
	#
	# make a copy of all the global declarations
	# 	used for making a type descriptor for globals ONLY
	# note we now have two declarations for the same variables,
	# which is apt to cause problems if code changes
	#
	# here we fix up the offsets for the real declarations
	#
	idoffsets(mod.ty.ids, 0, 1);

	last := head := ref Decl;
	for(id := mod.ty.ids; id != nil; id = id.next)
		if(id.store == Dglobal)
			last = last.next = dupdecl(id);

	last.next = globals;
	return head.next;
}

#
# snap all id type names to the actual type
# check that all types are completely defined
# verify that the types look ok
#
validtype(t: ref Type, inadt: ref Decl): ref Type
{
	if(t == nil)
		return t;
	bindtypes(t);
	t = verifytypes(t, inadt, nil);
	cycsizetype(t);
	teqclass(t);
	return t;
}

usetype(t: ref Type): ref Type
{
	if(t == nil)
		return t;
	t = validtype(t, nil);
	reftype(t);
	return t;
}

internaltype(t: ref Type): ref Type
{
	bindtypes(t);
	t.ok = OKverify;
	sizetype(t);
	t.ok = OKmask;
	return t;
}

#
# checks that t is a valid top-level type
#
topvartype(t: ref Type, id: ref Decl, tyok: int, polyok: int): ref Type
{
	if(t.kind == Tadt && t.tags != nil || t.kind == Tadtpick)
		error(id.src.start, "cannot declare "+id.sym.name+" with type "+typeconv(t));
	if(!tyok && t.kind == Tfn)
		error(id.src.start, "cannot declare "+id.sym.name+" to be a function");
	if(!polyok && (t.kind == Tadt || t.kind == Tadtpick) && ispolyadt(t))
		error(id.src.start, "cannot declare " + id.sym.name + " of a polymorphic type");
	return t;
}

toptype(src: Src, t: ref Type): ref Type
{
	if(t.kind == Tadt && t.tags != nil || t.kind == Tadtpick)
		error(src.start, typeconv(t)+", an adt with pick fields, must be used with ref");
	if(t.kind == Tfn)
		error(src.start, "data cannot have a fn type like "+typeconv(t));
	return t;
}

comtype(src: Src, t: ref Type, adtd: ref Decl): ref Type
{
	if(adtd == nil && (t.kind == Tadt || t.kind == Tadtpick) && ispolyadt(t))
		error(src.start, "polymorphic type " + typeconv(t) + " illegal here");
	return t;
}

usedty(t: ref Type)
{
	if(t != nil && (t.ok | OKmodref) != OKmask)
		fatal("used ty " + stypeconv(t) + " " + hex(int t.ok, 2));
}

bindtypes(t: ref Type)
{
	id: ref Decl;

	if(t == nil)
		return;
	if((t.ok & OKbind) == OKbind)
		return;
	t.ok |= OKbind;
	case t.kind{
	Tadt =>
		if(t.polys != nil){
			pushscope(nil, Sother);
			installids(Dtype, t.polys);
		}
		if(t.val != nil)
			mergepolydecs(t);
		if(t.polys != nil){
			popscope();
			for(id = t.polys; id != nil; id = id.next)
				bindtypes(id.ty);
		}
	Tadtpick or
	Tmodule or
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tiface or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Texcept or
	Tfix or
	Tpoly =>
		break;
	Tarray or
	Tarrow or
	Tchan or
	Tdot or
	Tlist or
	Tref =>
		bindtypes(t.tof);
	Tid =>
		id = t.decl.sym.decl;
		if(id == nil)
			id = undefed(t.src, t.decl.sym);
		# save a little space
		id.sym.unbound = nil;
		t.decl = id;
	Ttuple or
	Texception =>
		for(id = t.ids; id != nil; id = id.next)
			bindtypes(id.ty);
	Tfn =>
		if(t.polys != nil){
			pushscope(nil, Sother);
			installids(Dtype, t.polys);
		}
		for(id = t.ids; id != nil; id = id.next)
			bindtypes(id.ty);
		bindtypes(t.tof);
		if(t.val != nil)
			mergepolydecs(t);
		if(t.polys != nil){
			popscope();
			for(id = t.polys; id != nil; id = id.next)
				bindtypes(id.ty);
		}
	Tinst =>
		bindtypes(t.tof);
		for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
			bindtypes(tyl.t);
	* =>
		fatal("bindtypes: unknown type kind "+string t.kind);
	}
}

#
# walk the type checking for validity
#
verifytypes(t: ref Type, adtt: ref Decl, poly: ref Decl): ref Type
{
	id: ref Decl;

	if(t == nil)
		return nil;
	if((t.ok & OKverify) == OKverify)
		return t;
	t.ok |= OKverify;
if((t.ok & (OKverify|OKbind)) != (OKverify|OKbind))
fatal("verifytypes bogus ok for " + stypeconv(t));
	cyc := t.flags&CYCLIC;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tiface or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Texcept =>
		break;
	Tfix =>
		n := t.val;
		ok: int;
		max := 0.0;
		if(n.op == Oseq){
			(ok, nil) = echeck(n.left, 0, 0, n);
			(ok1, nil) := echeck(n.right, 0, 0, n);
			if(!ok || !ok1)
				return terror;
			if(n.left.ty != treal || n.right.ty != treal){
				error(t.src.start, "fixed point scale/maximum not real");
				return terror;
			}
			n.right = fold(n.right);
			if(n.right.op != Oconst){
				error(t.src.start, "fixed point maximum not constant");
				return terror;
			}
			if((max = n.right.c.rval) <= 0.0){
				error(t.src.start, "non-positive fixed point maximum");
				return terror;
			}
			n = n.left;
		}
		else{
			(ok, nil) = echeck(n, 0, 0, nil);
			if(!ok)
				return terror;
			if(n.ty != treal){
				error(t.src.start, "fixed point scale not real");
				return terror;
			}
		}
		n = t.val = fold(n);
		if(n.op != Oconst){
			error(t.src.start, "fixed point scale not constant");
			return terror;
		}
		if(n.c.rval <= 0.0){
			error(t.src.start, "non-positive fixed point scale");
			return terror;
		}
		ckfix(t, max);
	Tref =>
		t.tof = comtype(t.src, verifytypes(t.tof, adtt, nil), adtt);
		if(t.tof != nil && !tattr[t.tof.kind].refable){
			error(t.src.start, "cannot have a ref " + typeconv(t.tof));
			return terror;
		}
		if(0 && t.tof.kind == Tfn && t.tof.ids != nil && int t.tof.ids.implicit)
			error(t.src.start, "function references cannot have a self argument");
		if(0 && t.tof.kind == Tfn && t.polys != nil)
			error(t.src.start, "function references cannot be polymorphic");
	Tchan or
	Tarray or
	Tlist =>
		t.tof = comtype(t.src, toptype(t.src, verifytypes(t.tof, adtt, nil)), adtt);
	Tid =>
		t.ok &= ~OKverify;
		t = verifytypes(idtype(t), adtt, nil);
	Tarrow =>
		t.ok &= ~OKverify;
		t = verifytypes(arrowtype(t, adtt), adtt, nil);
	Tdot =>
		#
		# verify the parent adt & lookup the tag fields
		#
		t.ok &= ~OKverify;
		t = verifytypes(dottype(t, adtt), adtt, nil);
	Tadt =>
		#
		# this is where Tadt may get tag fields added
		#
		adtdefd(t);
	Tadtpick =>
		for(id = t.ids; id != nil; id = id.next){
			id.ty = topvartype(verifytypes(id.ty, id.dot, nil), id, 0, 1);
			if(id.store == Dconst)
				error(t.src.start, "cannot declare a con like "+id.sym.name+" within a pick");
		}
		verifytypes(t.decl.dot.ty, nil, nil);
	Tmodule =>
		for(id = t.ids; id != nil; id = id.next){
			id.ty = verifytypes(id.ty, nil, nil);
			if(id.store == Dglobal && id.ty.kind == Tfn)
				id.store = Dfn;
			if(id.store != Dtype && id.store != Dfn)
				topvartype(id.ty, id, 0, 0);
		}
	Ttuple or
	Texception =>
		if(t.decl == nil){
			t.decl = mkdecl(t.src, Dtype, t);
			t.decl.sym = anontupsym;
		}
		i := 0;
		for(id = t.ids; id != nil; id = id.next){
			id.store = Dfield;
			if(id.sym == nil)
				id.sym = enter("t"+string i, 0);
			i++;
			id.ty = toptype(id.src, verifytypes(id.ty, adtt, nil));
		}
	Tfn =>
		last : ref Decl = nil;
		for(id = t.ids; id != nil; id = id.next){
			id.store = Darg;
			id.ty = topvartype(verifytypes(id.ty, adtt, nil), id, 0, 1);
			if(id.implicit != byte 0){
				if(poly != nil)
					selfd := poly;
				else
					selfd = adtt;
				if(selfd == nil)
					error(t.src.start, "function is not a member of an adt, so can't use self");
				else if(id != t.ids)
					error(id.src.start, "only the first argument can use self");
				else if(id.ty != selfd.ty && (id.ty.kind != Tref || id.ty.tof != selfd.ty))
					error(id.src.start, "self argument's type must be "+selfd.sym.name+" or ref "+selfd.sym.name);
			}
			last = id;
		}
		for(id = t.polys; id != nil; id = id.next){
			if(adtt != nil){
				for(id1 := adtt.ty.polys; id1 != nil; id1 = id1.next){
					if(id1.sym == id.sym)
						id.ty = id1.ty;
				}
			}
			id.store = Dtype;
			id.ty = verifytypes(id.ty, adtt, nil);
		}
		t.tof = comtype(t.src, toptype(t.src, verifytypes(t.tof, adtt, nil)), adtt);
		if(t.varargs != byte 0 && (last == nil || last.ty != tstring))
			error(t.src.start, "variable arguments must be preceded by a string");
		if(t.varargs != byte 0 && t.polys != nil)
			error(t.src.start, "polymorphic functions must not have variable arguments");
	Tpoly =>
		for(id = t.ids; id != nil; id = id.next){
			id.store = Dfn;
			id.ty = verifytypes(id.ty, adtt, t.decl);
		}
	Tinst =>
		t.ok &= ~OKverify;
		t.tof = verifytypes(t.tof, adtt, nil);
		for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
			tyl.t = verifytypes(tyl.t, adtt, nil);
		(t, nil) = insttype(t, adtt, nil);
		t = verifytypes(t, adtt, nil);
	* =>
		fatal("verifytypes: unknown type kind "+string t.kind);
	}
	if(int cyc)
		t.flags |= CYCLIC;
	return t;
}

#
# resolve an id type
#
idtype(t: ref Type): ref Type
{
	id := t.decl;
	if(id.store == Dunbound)
		fatal("idtype: unbound decl");
	tt := id.ty;
	if(id.store != Dtype && id.store != Dtag){
		if(id.store == Dundef){
			id.store = Dwundef;
			error(t.src.start, id.sym.name+" is not declared");
		}else if(id.store == Dimport){
			id.store = Dwundef;
			error(t.src.start, id.sym.name+"'s type cannot be determined");
		}else if(id.store != Dwundef)
			error(t.src.start, id.sym.name+" is not a type");
		return terror;
	}
	if(tt == nil){
		error(t.src.start, stypeconv(t)+" not fully defined");
		return terror;
	}
	return tt;
}

#
# resolve a -> qualified type
#
arrowtype(t: ref Type, adtt: ref Decl): ref Type
{
	id := t.decl;
	if(id.ty != nil){
		if(id.store == Dunbound)
			fatal("arrowtype: unbound decl has a type");
		return id.ty;
	}

	#
	# special hack to allow module variables to derive other types
	# 
	tt := t.tof;
	if(tt.kind == Tid){
		id = tt.decl;
		if(id.store == Dunbound)
			fatal("arrowtype: Tid's decl unbound");
		if(id.store == Dimport){
			id.store = Dwundef;
			error(t.src.start, id.sym.name+"'s type cannot be determined");
			return terror;
		}

		#
		# forward references to module variables can't be resolved
		#
		if(id.store != Dtype && (id.ty.ok & OKbind) != OKbind){
			error(t.src.start, id.sym.name+"'s type cannot be determined");
			return terror;
		}

		if(id.store == Dwundef)
			return terror;
		tt = id.ty = verifytypes(id.ty, adtt, nil);
		if(tt == nil){
			error(t.tof.src.start, typeconv(t.tof)+" is not a module");
			return terror;
		}
	}else
		tt = verifytypes(t.tof, adtt, nil);
	t.tof = tt;
	if(tt == terror)
		return terror;
	if(tt.kind != Tmodule){
		error(t.src.start, typeconv(tt)+" is not a module");
		return terror;
	}
	id = namedot(tt.ids, t.decl.sym);
	if(id == nil){
		error(t.src.start, t.decl.sym.name+" is not a member of "+typeconv(tt));
		return terror;
	}
	if(id.store == Dtype && id.ty != nil){
		t.decl = id;
		return id.ty;
	}
	error(t.src.start, typeconv(t)+" is not a type");
	return terror;
}

#
# resolve a . qualified type
#
dottype(t: ref Type, adtt: ref Decl): ref Type
{
	if(t.decl.ty != nil){
		if(t.decl.store == Dunbound)
			fatal("dottype: unbound decl has a type");
		return t.decl.ty;
	}
	t.tof = tt := verifytypes(t.tof, adtt, nil);
	if(tt == terror)
		return terror;
	if(tt.kind != Tadt){
		error(t.src.start, typeconv(tt)+" is not an adt");
		return terror;
	}
	id := namedot(tt.tags, t.decl.sym);
	if(id != nil && id.ty != nil){
		t.decl = id;
		return id.ty;
	}
	error(t.src.start, t.decl.sym.name+" is not a pick tag of "+typeconv(tt));
	return terror;
}

insttype(t: ref Type, adtt: ref Decl, tp: ref Tpair): (ref Type, ref Tpair)
{
	src := t.src;
	if(t.tof.kind != Tadt && t.tof.kind != Tadtpick){
		error(src.start, typeconv(t.tof) + " is not an adt");
		return (terror, nil);
	}
	if(t.tof.kind == Tadt)
		ids := t.tof.polys;
	else
		ids = t.tof.decl.dot.ty.polys;
	if(ids == nil){
		error(src.start, typeconv(t.tof) + " is not a polymorphic adt");
		return (terror, nil);
	}
	for(tyl := t.tlist; tyl != nil && ids != nil; tyl = tyl.nxt){
		tt := tyl.t;
		if(!tattr[tt.kind].isptr){
			error(src.start, typeconv(tt) + " is not a pointer type");
			return (terror, nil);
		}
		unifysrc = src;
		(ok, nil) := tunify(ids.ty, tt);
		if(!ok){
			error(src.start, "type " + typeconv(tt) + " does not match " + typeconv(ids.ty));
			return (terror, nil);
		}
		# usetype(tt);
		tt = verifytypes(tt, adtt, nil);
		tp = addtmap(ids.ty, tt, tp);
		ids = ids.next;
	}
	if(tyl != nil){
		error(src.start, "too many actual types in instantiation");
		return (terror, nil);
	}
	if(ids != nil){
		error(src.start, "too few actual types in instantiation");
		return (terror, nil);
	}
	tt := t.tof;
	(t, nil) = expandtype(tt, t, adtt, tp);
	if(t == tt && adtt == nil)
		t = duptype(t);
	if(t != tt)
		t.tmap = tp;
	t.src = src;
	return (t, tp);
}

#
# walk a type, putting all adts, modules, and tuples into equivalence classes
#
teqclass(t: ref Type)
{
	id: ref Decl;

	if(t == nil || (t.ok & OKclass) == OKclass)
		return;
	t.ok |= OKclass;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tiface or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Texcept or
	Tfix or
	Tpoly =>
		return;
	Tref =>
		teqclass(t.tof);
		return;
	Tchan or
	Tarray or
	Tlist =>
		teqclass(t.tof);
#ZZZ elim return to fix recursive chans, etc
		if(!debug['Z'])
			return;
	Tadt or
	Tadtpick or
	Ttuple or
	Texception =>
		for(id = t.ids; id != nil; id = id.next)
			teqclass(id.ty);
		for(tg := t.tags; tg != nil; tg = tg.next)
			teqclass(tg.ty);
		for(id = t.polys; id != nil; id = id.next)
			teqclass(id.ty);
	Tmodule =>
		t.tof = mkiface(t.decl);
		for(id = t.ids; id != nil; id = id.next)
			teqclass(id.ty);
	Tfn =>
		for(id = t.ids; id != nil; id = id.next)
			teqclass(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			teqclass(id.ty);
		teqclass(t.tof);
		return;
	* =>
		fatal("teqclass: unknown type kind "+string t.kind);
	}

	#
	# find an equivalent type
	# stupid linear lookup could be made faster
	#
	if((t.ok & OKsized) != OKsized)
		fatal("eqclass type not sized: " + stypeconv(t));

	for(teq := eqclass[t.kind]; teq != nil; teq = teq.eq){
		if(t.size == teq.ty.size && tequal(t, teq.ty)){
			t.eq = teq;
			if(t.kind == Tmodule)
				joiniface(t, t.eq.ty.tof);
			return;
		}
	}

	#
	# if no equiv type, make one
	#
	eqclass[t.kind] = t.eq = ref Teq(0, t, eqclass[t.kind]);
}

#
# record that we've used the type
# using a type uses all types reachable from that type
#
reftype(t: ref Type)
{
	id: ref Decl;

	if(t == nil || (t.ok & OKref) == OKref)
		return;
	t.ok |= OKref;
	if(t.decl != nil && t.decl.refs == 0)
		t.decl.refs++;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tiface or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Texcept or
	Tfix or
	Tpoly =>
		break;
	Tref or
	Tchan or
	Tarray or
	Tlist =>
		if(t.decl != nil){
			if(nadts >= len adts){
				a := array[nadts + 32] of ref Decl;
				a[0:] = adts;
				adts = a;
			}
			adts[nadts++] = t.decl;
		}
		reftype(t.tof);
	Tadt or
	Tadtpick or
	Ttuple or
	Texception =>
		if(t.kind == Tadt || t.kind == Ttuple && t.decl.sym != anontupsym){
			if(nadts >= len adts){
				a := array[nadts + 32] of ref Decl;
				a[0:] = adts;
				adts = a;
			}
			adts[nadts++] = t.decl;
		}
		for(id = t.ids; id != nil; id = id.next)
			if(id.store != Dfn)
				reftype(id.ty);
		for(tg := t.tags; tg != nil; tg = tg.next)
			reftype(tg.ty);
		for(id = t.polys; id != nil; id = id.next)
			reftype(id.ty);
		if(t.kind == Tadtpick)
			reftype(t.decl.dot.ty);
	Tmodule =>
		#
		# a module's elements should get used individually
		# but do the globals for any sbl file
		#
		if(bsym != nil)
			for(id = t.ids; id != nil; id = id.next)
				if(id.store == Dglobal)
					reftype(id.ty);
		break;
	Tfn =>
		for(id = t.ids; id != nil; id = id.next)
			reftype(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			reftype(id.ty);
		reftype(t.tof);
	* =>
		fatal("reftype: unknown type kind "+string t.kind);
	}
}

#
# check all reachable types for cycles and illegal forward references
# find the size of all the types
#
cycsizetype(t: ref Type)
{
	id: ref Decl;

	if(t == nil || (t.ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
		return;
	t.ok |= OKcycsize;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tiface or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Texcept or
	Tfix or
	Tpoly =>
		t.ok |= OKcyc;
		sizetype(t);
	Tref or
	Tchan or
	Tarray or
	Tlist =>
		cyctype(t);
		sizetype(t);
		cycsizetype(t.tof);
	Tadt or
	Ttuple or
	Texception =>
		cyctype(t);
		sizetype(t);
		for(id = t.ids; id != nil; id = id.next)
			cycsizetype(id.ty);
		for(tg := t.tags; tg != nil; tg = tg.next){
			if((tg.ty.ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
				continue;
			tg.ty.ok |= (OKcycsize|OKcyc|OKsized);
			for(id = tg.ty.ids; id != nil; id = id.next)
				cycsizetype(id.ty);
		}
		for(id = t.polys; id != nil; id = id.next)
			cycsizetype(id.ty);
	Tadtpick =>
		t.ok &= ~OKcycsize;
		cycsizetype(t.decl.dot.ty);
	Tmodule =>
		cyctype(t);
		sizetype(t);
		for(id = t.ids; id != nil; id = id.next)
			cycsizetype(id.ty);
		sizeids(t.ids, 0);
	Tfn =>
		cyctype(t);
		sizetype(t);
		for(id = t.ids; id != nil; id = id.next)
			cycsizetype(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			cycsizetype(id.ty);
		cycsizetype(t.tof);
		sizeids(t.ids, MaxTemp);
#ZZZ need to align?
	* =>
		fatal("cycsizetype: unknown type kind "+string t.kind);
	}
}

# check for circularity in type declarations
# - has to be called before verifytypes
#
tcycle(t: ref Type)
{
	id: ref Decl;
	tt: ref Type;
	tll: ref Typelist;

	if(t == nil)
		return;
	case(t.kind){
	* =>
		;
	Tchan or
	Tarray or
	Tref or
	Tlist or
	Tdot =>
		tcycle(t.tof);
	Tfn or
	Ttuple =>
		tcycle(t.tof);
		for(id = t.ids; id != nil; id = id.next)
			tcycle(id.ty);
	Tarrow =>
		if(int(t.rec&TRvis)){
			error(t.src.start, "circularity in definition of " + typeconv(t));
			*t = *terror;	# break the cycle
			return;
		}
		tt = t.tof;
		t.rec |= TRvis;
		tcycle(tt);
		if(tt.kind == Tid)
			tt = tt.decl.ty;
		id = namedot(tt.ids, t.decl.sym);
		if(id != nil)
			tcycle(id.ty);
		t.rec &= ~TRvis;
	Tid =>
		if(int(t.rec&TRvis)){
			error(t.src.start, "circularity in definition of " + typeconv(t));
			*t = *terror;	# break the cycle
			return;
		}
		t.rec |= TRvis;
		tcycle(t.decl.ty);
		t.rec &= ~TRvis;
	Tinst =>
		tcycle(t.tof);
		for(tll = t.tlist; tll != nil; tll = tll.nxt)
			tcycle(tll.t);
	}
}

#
# marks for checking for arcs
#
	ArcValue,
	ArcList,
	ArcArray,
	ArcRef,
	ArcCyc,			# cycle found
	ArcPolycyc:
		con 1 << iota;

cyctype(t: ref Type)
{
	if((t.ok & OKcyc) == OKcyc)
		return;
	t.ok |= OKcyc;
	t.rec |= TRcyc;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tfn or
	Tchan or
	Tarray or
	Tref or
	Tlist or
	Tfix or
	Tpoly =>
		break;
	Tadt or
	Tmodule or
	Ttuple or
	Texception =>
		for(id := t.ids; id != nil; id = id.next)
			cycfield(t, id);
		for(tg := t.tags; tg != nil; tg = tg.next){
			if((tg.ty.ok & OKcyc) == OKcyc)
				continue;
			tg.ty.ok |= OKcyc;
			for(id = tg.ty.ids; id != nil; id = id.next)
				cycfield(t, id);
		}
	* =>
		fatal("cyctype: unknown type kind "+string t.kind);
	}
	t.rec &= ~TRcyc;
}

cycfield(base: ref Type, id: ref Decl)
{
	if(!storespace[id.store])
		return;
	arc := cycarc(base, id.ty);

	if((arc & (ArcCyc|ArcValue)) == (ArcCyc|ArcValue)){
		if(id.cycerr == byte 0)
			error(base.src.start, "illegal type cycle without a reference in field "
				+id.sym.name+" of "+stypeconv(base));
		id.cycerr = byte 1;
	}else if(arc & ArcCyc){
		if((arc & ArcArray) && oldcycles && id.cyc == byte 0 && !(arc & ArcPolycyc)){
			if(id.cycerr == byte 0)
				error(base.src.start, "illegal circular reference to type "+typeconv(id.ty)
					+" in field "+id.sym.name+" of "+stypeconv(base));
			id.cycerr = byte 1;
		}
		id.cycle = byte 1;
	}else if(id.cyc != byte 0){
		if(id.cycerr == byte 0)
			error(id.src.start, "spurious cyclic qualifier for field "+id.sym.name+" of "+stypeconv(base));
		id.cycerr = byte 1;
	}
}

cycarc(base, t: ref Type): int
{
	if(t == nil)
		return 0;
	if((t.rec & TRcyc) == TRcyc){
		if(tequal(t, base)){
			if(t.kind == Tmodule)
				return ArcCyc | ArcRef;
			else
				return ArcCyc | ArcValue;
		}
		return 0;
	}
	t.rec |= TRcyc;
	me := 0;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tchan or
	Tfn or
	Tfix or
	Tpoly =>
		break;
	Tarray =>
		me = cycarc(base, t.tof) & ~ArcValue | ArcArray;
	Tref =>
		me = cycarc(base, t.tof) & ~ArcValue | ArcRef;
	Tlist =>
		me = cycarc(base, t.tof) & ~ArcValue | ArcList;
	Tadt or
	Tadtpick or
	Tmodule or
	Ttuple or
	Texception =>
		me = 0;
		arc: int;
		for(id := t.ids; id != nil; id = id.next){
			if(!storespace[id.store])
				continue;
			arc = cycarc(base, id.ty);
			if((arc & ArcCyc) && id.cycerr == byte 0)
				me |= arc;
		}
		for(tg := t.tags; tg != nil; tg = tg.next){
			arc = cycarc(base, tg.ty);
			if((arc & ArcCyc) && tg.cycerr == byte 0)
				me |= arc;
		}

		if(t.kind == Tmodule)
			me = me & ArcCyc | ArcRef | ArcPolycyc;
		else
			me &= ArcCyc | ArcValue | ArcPolycyc;
	* =>
		fatal("cycarc: unknown type kind "+string t.kind);
	}
	t.rec &= ~TRcyc;
	if(int (t.flags&CYCLIC))
		me |= ArcPolycyc;
	return me;
}

#
# set the sizes and field offsets for t
# look only as deeply as needed to size this type.
# cycsize type will clean up the rest.
#
sizetype(t: ref Type)
{
	id: ref Decl;
	sz, al, s, a: int;

	if(t == nil)
		return;
	if((t.ok & OKsized) == OKsized)
		return;
	t.ok |= OKsized;
if((t.ok & (OKverify|OKsized)) != (OKverify|OKsized))
fatal("sizetype bogus ok for " + stypeconv(t));
	case t.kind{
	* =>
		fatal("sizetype: unknown type kind "+string t.kind);
	Terror or
	Tnone or
	Tbyte or
	Tint or
	Tbig or
	Tstring or
	Tany or
	Treal =>
		fatal(typeconv(t)+" should have a size");
	Tref or
	Tchan or
	Tarray or
	Tlist or
	Tmodule or
	Tfix or
	Tpoly =>
		t.size = t.align = IBY2WD;
	Tadt or
	Ttuple or
	Texception =>
		if(t.tags == nil){
#ZZZ
			if(!debug['z']){
				(sz, t.align) = sizeids(t.ids, 0);
				t.size = align(sz, t.align);
			}else{
				(sz, nil) = sizeids(t.ids, 0);
				t.align = IBY2LG;
				t.size = align(sz, IBY2LG);
			}
			return;
		}
#ZZZ
		if(!debug['z']){
			(sz, al) = sizeids(t.ids, IBY2WD);
			if(al < IBY2WD)
				al = IBY2WD;
		}else{
			(sz, nil) = sizeids(t.ids, IBY2WD);
			al = IBY2LG;
		}
		for(tg := t.tags; tg != nil; tg = tg.next){
			if((tg.ty.ok & OKsized) == OKsized)
				continue;
			tg.ty.ok |= OKsized;
#ZZZ
			if(!debug['z']){
				(s, a) = sizeids(tg.ty.ids, sz);
				if(a < al)
					a = al;
				tg.ty.size = align(s, a);
				tg.ty.align = a;
			}else{
				(s, nil) = sizeids(tg.ty.ids, sz);
				tg.ty.size = align(s, IBY2LG);
				tg.ty.align = IBY2LG;
			}			
		}
	Tfn =>
		t.size = 0;
		t.align = 1;
	Tainit =>
		t.size = 0;
		t.align = 1;
	Talt =>
		t.size = t.cse.nlab * 2*IBY2WD + 2*IBY2WD;
		t.align = IBY2WD;
	Tcase or
	Tcasec =>
		t.size = t.cse.nlab * 3*IBY2WD + 2*IBY2WD;
		t.align = IBY2WD;
	Tcasel =>
		t.size = t.cse.nlab * 6*IBY2WD + 3*IBY2WD;
		t.align = IBY2LG;
	Tgoto =>
		t.size = t.cse.nlab * IBY2WD + IBY2WD;
		if(t.cse.iwild != nil)
			t.size += IBY2WD;
		t.align = IBY2WD;
	Tiface =>
		sz = IBY2WD;
		for(id = t.ids; id != nil; id = id.next){
			sz = align(sz, IBY2WD) + IBY2WD;
			sz += len array of byte id.sym.name + 1;
			if(id.dot.ty.kind == Tadt)
				sz += len array of byte id.dot.sym.name + 1;
		}
		t.size = sz;
		t.align = IBY2WD;
	Texcept =>
		t.size = 0;
		t.align = IBY2WD;
	}
}

sizeids(id: ref Decl, off: int): (int, int)
{
	al := 1;
	for(; id != nil; id = id.next){
		if(storespace[id.store]){
			sizetype(id.ty);
			#
			# alignment can be 0 if we have
			# illegal forward declarations.
			# just patch a; other code will flag an error
			#
			a := id.ty.align;
			if(a == 0)
				a = 1;

			if(a > al)
				al = a;

			off = align(off, a);
			id.offset = off;
			off += id.ty.size;
		}
	}
	return (off, al);
}

align(off, align: int): int
{
	if(align == 0)
		fatal("align 0");
	while(off % align)
		off++;
	return off;
}

#
# recalculate a type's size
#
resizetype(t: ref Type)
{
	if((t.ok & OKsized) == OKsized){
		t.ok &= ~OKsized;
		cycsizetype(t);
	}
}

#
# check if a module is accessable from t
# if so, mark that module interface
#
modrefable(t: ref Type)
{
	id: ref Decl;

	if(t == nil || (t.ok & OKmodref) == OKmodref)
		return;
	if((t.ok & OKverify) != OKverify)
		fatal("modrefable unused type "+stypeconv(t));
	t.ok |= OKmodref;
	case t.kind{
	Terror or
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tnone or
	Tany or
	Tfix or
	Tpoly =>
		break;
	Tchan or
	Tref or
	Tarray or
	Tlist =>
		modrefable(t.tof);
	Tmodule =>
		t.tof.linkall = byte 1;
		t.decl.refs++;
		for(id = t.ids; id != nil; id = id.next){
			case id.store{
			Dglobal or
			Dfn =>
				modrefable(id.ty);
			Dtype =>
				if(id.ty.kind != Tadt)
					break;
				for(m := id.ty.ids; m != nil; m = m.next)
					if(m.store == Dfn)
						modrefable(m.ty);
			}
		}
	Tfn or
	Tadt or
	Ttuple or
	Texception =>
		for(id = t.ids; id != nil; id = id.next)
			if(id.store != Dfn)
				modrefable(id.ty);
		for(tg := t.tags; tg != nil; tg = tg.next){
			# if((tg.ty.ok & OKmodref) == OKmodref)
			#	continue;
			tg.ty.ok |= OKmodref;
			for(id = tg.ty.ids; id != nil; id = id.next)
				modrefable(id.ty);
		}
		for(id = t.polys; id != nil; id = id.next)
			modrefable(id.ty);
		modrefable(t.tof);
	Tadtpick =>
		modrefable(t.decl.dot.ty);
	* =>
		fatal("modrefable: unknown type kind "+string t.kind);
	}
}

gendesc(d: ref Decl, size: int, decls: ref Decl): ref Desc
{
	if(debug['D'])
		print("generate desc for %s\n", dotconv(d));
	if(ispoly(d))
		addfnptrs(d, 0);
	desc := usedesc(mkdesc(size, decls));
	return desc;
}

mkdesc(size: int, d: ref Decl): ref Desc
{
	pmap := array[(size+8*IBY2WD-1) / (8*IBY2WD)] of { * => byte 0 };
	n := descmap(d, pmap, 0);
	if(n >= 0)
		n = n / (8*IBY2WD) + 1;
	else
		n = 0;
	return enterdesc(pmap, size, n);
}

mktdesc(t: ref Type): ref Desc
{
usedty(t);
	if(debug['D'])
		print("generate desc for %s\n", typeconv(t));
	if(t.decl == nil){
		t.decl = mkdecl(t.src, Dtype, t);
		t.decl.sym = enter("_mktdesc_", 0);
	}
	if(t.decl.desc != nil)
		return t.decl.desc;
	pmap := array[(t.size+8*IBY2WD-1) / (8*IBY2WD)] of {* => byte 0};
	n := tdescmap(t, pmap, 0);
	if(n >= 0)
		n = n / (8*IBY2WD) + 1;
	else
		n = 0;
	d := enterdesc(pmap, t.size, n);
	t.decl.desc = d;
	return d;
}

enterdesc(map: array of byte, size, nmap: int): ref Desc
{
	last : ref Desc = nil;
	for(d := descriptors; d != nil; d = d.next){
		if(d.size > size || d.size == size && d.nmap > nmap)
			break;
		if(d.size == size && d.nmap == nmap){
			c := mapcmp(d.map, map, nmap);
			if(c == 0)
				return d;
			if(c > 0)
				break;
		}
		last = d;
	}

	d = ref Desc(-1, 0, map, size, nmap, nil);
	if(last == nil){
		d.next = descriptors;
		descriptors = d;
	}else{
		d.next = last.next;
		last.next = d;
	}
	return d;
}

mapcmp(a, b: array of byte, n: int): int
{
	for(i := 0; i < n; i++)
		if(a[i] != b[i])
			return int a[i] - int b[i];
	return 0;
}

usedesc(d: ref Desc): ref Desc
{
	d.used = 1;
	return d;
}

#
# create the pointer description byte map for every type in decls
# each bit corresponds to a word, and is 1 if occupied by a pointer
# the high bit in the byte maps the first word
#
descmap(decls: ref Decl, map: array of byte, start: int): int
{
	if(debug['D'])
		print("descmap offset %d\n", start);
	last := -1;
	for(d := decls; d != nil; d = d.next){
		if(d.store == Dtype && d.ty.kind == Tmodule
		|| d.store == Dfn
		|| d.store == Dconst)
			continue;
		if(d.store == Dlocal && d.link != nil)
			continue;
		m := tdescmap(d.ty, map, d.offset + start);
		if(debug['D']){
			if(d.sym != nil)
				print("descmap %s type %s offset %d returns %d\n", d.sym.name, typeconv(d.ty), d.offset+start, m);
			else
				print("descmap type %s offset %d returns %d\n", typeconv(d.ty), d.offset+start, m);
		}
		if(m >= 0)
			last = m;
	}
	return last;
}

tdescmap(t: ref Type, map: array of byte, offset: int): int
{
	i, e, bit: int;

	if(t == nil)
		return -1;

	m := -1;
	if(t.kind == Talt){
		lab := t.cse.labs;
		e = t.cse.nlab;
		offset += IBY2WD * 2;
		for(i = 0; i < e; i++){
			if(lab[i].isptr){
				bit = offset / IBY2WD % 8;
				map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
				m = offset;
			}
			offset += 2*IBY2WD;
		}
		return m;
	}
	if(t.kind == Tcasec){
		e = t.cse.nlab;
		offset += IBY2WD;
		for(i = 0; i < e; i++){
			bit = offset / IBY2WD % 8;
			map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
			offset += IBY2WD;
			bit = offset / IBY2WD % 8;
			map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
			m = offset;
			offset += 2*IBY2WD;
		}
		return m;
	}

	if(tattr[t.kind].isptr){
		bit = offset / IBY2WD % 8;
		map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
		return offset;
	}
	if(t.kind == Tadtpick)
		t = t.tof;
	if(t.kind == Ttuple || t.kind == Tadt || t.kind == Texception){
		if(debug['D'])
			print("descmap adt offset %d\n", offset);
		if(t.rec != byte 0)
			fatal("illegal cyclic type "+stypeconv(t)+" in tdescmap");
		t.rec = byte 1;
		offset = descmap(t.ids, map, offset);
		t.rec = byte 0;
		return offset;
	}

	return -1;
}

tcomset: int;

#
# can a t2 be assigned to a t1?
# any means Tany matches all types,
# not just references
#
tcompat(t1, t2: ref Type, any: int): int
{
	if(t1 == t2)
		return 1;
	if(t1 == nil || t2 == nil)
		return 0;
	if(t2.kind == Texception && t1.kind != Texception)
		t2 = mkextuptype(t2);
	tcomset = 0;
	ok := rtcompat(t1, t2, any, 0);
	v := cleartcomrec(t1) + cleartcomrec(t2);
	if(v != tcomset)
		fatal("recid t1 "+stypeconv(t1)+" and t2 "+stypeconv(t2)+" not balanced in tcompat: "+string v+" "+string tcomset);
	return ok;
}

rtcompat(t1, t2: ref Type, any: int, inaorc: int): int
{
	if(t1 == t2)
		return 1;
	if(t1 == nil || t2 == nil)
		return 0;
	if(t1.kind == Terror || t2.kind == Terror)
		return 1;
	if(t2.kind == Texception && t1.kind != Texception)
		t2 = mkextuptype(t2);

	t1.rec |= TRcom;
	t2.rec |= TRcom;
	case t1.kind{
	* =>
		fatal("unknown type "+stypeconv(t1)+" v "+stypeconv(t2)+" in rtcompat");
		return 0;
	Tstring =>
		return t2.kind == Tstring || t2.kind == Tany;
	Texception =>
		if(t2.kind == Texception && t1.cons == t2.cons){
			if(assumetcom(t1, t2))
				return 1;
			return idcompat(t1.ids, t2.ids, 0, inaorc);
		}
		return 0;
	Tnone or
	Tint or
	Tbig or
	Tbyte or
	Treal =>
		return t1.kind == t2.kind;
	Tfix =>
		return t1.kind == t2.kind && sametree(t1.val, t2.val);
	Tany =>
		if(tattr[t2.kind].isptr)
			return 1;
		return any;
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		if(t1.kind != t2.kind){
			if(t2.kind == Tany)
				return 1;
			return 0;
		}
		if(t1.kind != Tref && assumetcom(t1, t2))
			return 1;
		return rtcompat(t1.tof, t2.tof, 0, t1.kind == Tarray || t1.kind == Tchan || inaorc);
	Tfn =>
		break;
	Ttuple =>
		if(t2.kind == Tadt && t2.tags == nil
		|| t2.kind == Ttuple){
			if(assumetcom(t1, t2))
				return 1;
			return idcompat(t1.ids, t2.ids, any, inaorc);
		}
		if(t2.kind == Tadtpick){
			t2.tof.rec |= TRcom;
			if(assumetcom(t1, t2.tof))
				return 1;
			return idcompat(t1.ids, t2.tof.ids.next, any, inaorc);
		}
		return 0;
	Tadt =>
		if(t2.kind == Ttuple && t1.tags == nil){
			if(assumetcom(t1, t2))
				return 1;
			return idcompat(t1.ids, t2.ids, any, inaorc);
		}
		if(t1.tags != nil && t2.kind == Tadtpick && !inaorc)
			t2 = t2.decl.dot.ty;
	Tadtpick =>
		#if(t2.kind == Ttuple)
		#	return idcompat(t1.tof.ids.next, t2.ids, any, inaorc);
		break;
	Tmodule =>
		if(t2.kind == Tany)
			return 1;
	Tpoly =>
		if(t2.kind == Tany)
			return 1;
	}
	return tequal(t1, t2);
}

#
# add the assumption that t1 and t2 are compatable
#
assumetcom(t1, t2: ref Type): int
{
	r1, r2: ref Type;

	if(t1.tcom == nil && t2.tcom == nil){
		tcomset += 2;
		t1.tcom = t2.tcom = t1;
	}else{
		if(t1.tcom == nil){
			r1 = t1;
			t1 = t2;
			t2 = r1;
		}
		for(r1 = t1.tcom; r1 != r1.tcom; r1 = r1.tcom)
			;
		for(r2 = t2.tcom; r2 != nil && r2 != r2.tcom; r2 = r2.tcom)
			;
		if(r1 == r2)
			return 1;
		if(r2 == nil)
			tcomset++;
		t2.tcom = t1;
		for(; t2 != r1; t2 = r2){
			r2 = t2.tcom;
			t2.tcom = r1;
		}
	}
	return 0;
}

cleartcomrec(t: ref Type): int
{
	n := 0;
	for(; t != nil && (t.rec & TRcom) == TRcom; t = t.tof){
		t.rec &= ~TRcom;
		if(t.tcom != nil){
			t.tcom = nil;
			n++;
		}
		if(t.kind == Tadtpick)
			n += cleartcomrec(t.tof);
		if(t.kind == Tmodule)
			t = t.tof;
		for(id := t.ids; id != nil; id = id.next)
			n += cleartcomrec(id.ty);
		for(id = t.tags; id != nil; id = id.next)
			n += cleartcomrec(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			n += cleartcomrec(id.ty);
	}
	return n;
}

#
# id1 and id2 are the fields in an adt or tuple
# simple structural check; ignore names
#
idcompat(id1, id2: ref Decl, any: int, inaorc: int): int
{
	for(; id1 != nil; id1 = id1.next){
		if(id1.store != Dfield)
			continue;
		while(id2 != nil && id2.store != Dfield)
			id2 = id2.next;
		if(id2 == nil
		|| id1.store != id2.store
		|| !rtcompat(id1.ty, id2.ty, any, inaorc))
			return 0;
		id2 = id2.next;
	}
	while(id2 != nil && id2.store != Dfield)
		id2 = id2.next;
	return id2 == nil;
}

#
# structural equality on types
# t->recid is used to detect cycles
# t->rec is used to clear t->recid
#
tequal(t1, t2: ref Type): int
{
	eqrec = 0;
	eqset = 0;
	ok := rtequal(t1, t2);
	v := cleareqrec(t1) + cleareqrec(t2);
	if(0 && v != eqset)
		fatal("recid t1 "+stypeconv(t1)+" and t2 "+stypeconv(t2)+" not balanced in tequal: "+string v+" "+string eqset);
	eqset = 0;
	return ok;
}

rtequal(t1, t2: ref Type): int
{
	#
	# this is just a shortcut
	#
	if(t1 == t2)
		return 1;

	if(t1 == nil || t2 == nil)
		return 0;
	if(t1.kind == Terror || t2.kind == Terror)
		return 1;

	if(t1.kind != t2.kind)
		return 0;

	if(t1.eq != nil && t2.eq != nil)
		return t1.eq == t2.eq;

	t1.rec |= TReq;
	t2.rec |= TReq;
	case t1.kind{
	* =>
		fatal("bogus type "+stypeconv(t1)+" vs "+stypeconv(t2)+" in rtequal");
		return 0;
	Tnone or
	Tbig or
	Tbyte or
	Treal or
	Tint or
	Tstring =>
		#
		# this should always be caught by t1 == t2 check
		#
		fatal("bogus value type "+stypeconv(t1)+" vs "+stypeconv(t2)+" in rtequal");
		return 1;
	Tfix =>
		return sametree(t1.val, t2.val);
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		if(t1.kind != Tref && assumeteq(t1, t2))
			return 1;
		return rtequal(t1.tof, t2.tof);
	Tfn =>
		if(t1.varargs != t2.varargs)
			return 0;
		if(!idequal(t1.ids, t2.ids, 0, storespace))
			return 0;
		# if(!idequal(t1.polys, t2.polys, 1, nil))
		if(!pyequal(t1, t2))
			return 0;
		return rtequal(t1.tof, t2.tof);
	Ttuple or
	Texception =>
		if(t1.kind != t2.kind || t1.cons != t2.cons)
			return 0;
		if(assumeteq(t1, t2))
			return 1;
		return idequal(t1.ids, t2.ids, 0, storespace);
	Tadt or
	Tadtpick or
	Tmodule =>
		if(assumeteq(t1, t2))
			return 1;

		#
		# compare interfaces when comparing modules
		#
		if(t1.kind == Tmodule)
			return idequal(t1.tof.ids, t2.tof.ids, 1, nil);

		#
		# picked adts; check parent,
		# assuming equiv picked fields,
		# then check picked fields are equiv
		#
		if(t1.kind == Tadtpick && !rtequal(t1.decl.dot.ty, t2.decl.dot.ty))
			return 0;

		#
		# adts with pick tags: check picked fields for equality
		#
		if(!idequal(t1.tags, t2.tags, 1, nil))
			return 0;

		# if(!idequal(t1.polys, t2.polys, 1, nil))
		if(!pyequal(t1, t2))
			return 0;
		return idequal(t1.ids, t2.ids, 1, storespace);
	Tpoly =>
		if(assumeteq(t1, t2))
			return 1;
		if(t1.decl.sym != t2.decl.sym)
			return 0;
		return idequal(t1.ids, t2.ids, 1, nil);
	}
}

assumeteq(t1, t2: ref Type): int
{
	r1, r2: ref Type;

	if(t1.teq == nil && t2.teq == nil){
		eqrec++;
		eqset += 2;
		t1.teq = t2.teq = t1;
	}else{
		if(t1.teq == nil){
			r1 = t1;
			t1 = t2;
			t2 = r1;
		}
		for(r1 = t1.teq; r1 != r1.teq; r1 = r1.teq)
			;
		for(r2 = t2.teq; r2 != nil && r2 != r2.teq; r2 = r2.teq)
			;
		if(r1 == r2)
			return 1;
		if(r2 == nil)
			eqset++;
		t2.teq = t1;
		for(; t2 != r1; t2 = r2){
			r2 = t2.teq;
			t2.teq = r1;
		}
	}
	return 0;
}

#
# checking structural equality for modules, adts, tuples, and fns
#
idequal(id1, id2: ref Decl, usenames: int, storeok: array of int): int
{
	#
	# this is just a shortcut
	#
	if(id1 == id2)
		return 1;

	for(; id1 != nil; id1 = id1.next){
		if(storeok != nil && !storeok[id1.store])
			continue;
		while(id2 != nil && storeok != nil && !storeok[id2.store])
			id2 = id2.next;
		if(id2 == nil
		|| usenames && id1.sym != id2.sym
		|| id1.store != id2.store
		|| id1.implicit != id2.implicit
		|| id1.cyc != id2.cyc
		|| (id1.dot == nil) != (id2.dot == nil)
		|| id1.dot != nil && id2.dot != nil && id1.dot.ty.kind != id2.dot.ty.kind
		|| !rtequal(id1.ty, id2.ty))
			return 0;
		id2 = id2.next;
	}
	while(id2 != nil && storeok != nil && !storeok[id2.store])
		id2 = id2.next;
	return id1 == nil && id2 == nil;
}


pyequal(t1: ref Type, t2: ref Type): int
{
	pt1, pt2: ref Type;
	id1, id2: ref Decl;

	if(t1 == t2)
		return 1;
	id1 = t1.polys;
	id2 = t2.polys;
	for(; id1 != nil; id1 = id1.next){
		if(id2 == nil)
			return 0;
		pt1 = id1.ty;
		pt2 = id2.ty;
		if(!rtequal(pt1, pt2)){
			if(t1.tmap != nil)
				pt1 = valtmap(pt1, t1.tmap);
			if(t2.tmap != nil)
				pt2 = valtmap(pt2, t2.tmap);
			if(!rtequal(pt1, pt2))
				return 0;
		}
		id2 = id2.next;
	}
	return id1 == nil && id2 == nil;
}

cleareqrec(t: ref Type): int
{
	n := 0;
	for(; t != nil && (t.rec & TReq) == TReq; t = t.tof){
		t.rec &= ~TReq;
		if(t.teq != nil){
			t.teq = nil;
			n++;
		}
		if(t.kind == Tadtpick)
			n += cleareqrec(t.decl.dot.ty);
		if(t.kind == Tmodule)
			t = t.tof;
		for(id := t.ids; id != nil; id = id.next)
			n += cleareqrec(id.ty);
		for(id = t.tags; id != nil; id = id.next)
			n += cleareqrec(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			n += cleareqrec(id.ty);
	}
	return n;
}

raisescompat(n1: ref Node, n2: ref Node): int
{
	if(n1 == n2)
		return 1;
	if(n2 == nil)
		return 1;	# no need to repeat in definition if given in declaration
	if(n1 == nil)
		return 0;
	for((n1, n2) = (n1.left, n2.left); n1 != nil && n2 != nil; (n1, n2) = (n1.right, n2.right)){
		if(n1.left.decl != n2.left.decl)
			return 0;
	}
	return n1 == n2;
}

# t1 a polymorphic type
fnunify(t1: ref Type, t2: ref Type, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
	id, ids: ref Decl;
	sym: ref Sym;
	ok: int;

	for(ids = t1.ids; ids != nil; ids = ids.next){
		sym = ids.sym;
		(id, nil) = fnlookup(sym, t2);
		if(id != nil)
			usetype(id.ty);
		if(id == nil){
			if(dowarn)
				error(unifysrc.start, "type " + typeconv(t2) + " does not have a '" + sym.name + "' function");
			return (0, tp);
		}
		else if(id.ty.kind != Tfn){
			if(dowarn)
				error(unifysrc.start, typeconv(id.ty) + " is not a function");
			return (0, tp);
		}
		else{
			(ok, tp) = rtunify(ids.ty, id.ty, tp, !swapped);
			if(!ok){
				if(dowarn)
					error(unifysrc.start, typeconv(ids.ty) + " and " + typeconv(id.ty) + " are not compatible wrt " + sym.name);
				return (0, tp);
			}
		}
	}
	return (1, tp);
}

fncleareqrec(t1: ref Type, t2: ref Type): int
{
	id, ids: ref Decl;
	n: int;

	n = 0;
	n += cleareqrec(t1);
	n += cleareqrec(t2);
	for(ids = t1.ids; ids != nil; ids = ids.next){
		(id, nil) = fnlookup(ids.sym, t2);
		if(id == nil)
			continue;
		else{
			n += cleareqrec(ids.ty);
			n += cleareqrec(id.ty);
		}
	}
	return n;
}

tunify(t1: ref Type, t2: ref Type): (int, ref Tpair)
{
	v: int;
	p: ref Tpair;

	eqrec = 0;
	eqset = 0;
	(ok, tp) := rtunify(t1, t2, nil, 0);
	v = cleareqrec(t1) + cleareqrec(t2);
	for(p = tp; p != nil; p = p.nxt)
		v += fncleareqrec(p.t1, p.t2);
	if(0 && v != eqset)
		fatal("recid t1 " + stypeconv(t1) + " and t2 " + stypeconv(t2) + " not balanced in tunify: " + string v + " " + string eqset);
	return (ok, tp);
}

rtunify(t1: ref Type, t2: ref Type, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
	ok: int;

	t1 = valtmap(t1, tp);
	t2 = valtmap(t2, tp);
	if(t1 == t2)
		return (1, tp);
	if(t1 == nil || t2 == nil)
		return (0, tp);
	if(t1.kind == Terror || t2.kind == Terror)
		return (1, tp);
	if(t1.kind != Tpoly && t2.kind == Tpoly){
		(t1, t2) = (t2, t1);
		swapped = !swapped;
	}
	if(t1.kind == Tpoly){
		# if(typein(t1, t2))
		# 	 return (0, tp);
		if(!tattr[t2.kind].isptr)
			return (0, tp);
		if(t2.kind != Tany)
			tp = addtmap(t1, t2, tp);
		return fnunify(t1, t2, tp, swapped);
	}
	if(t1.kind != Tany && t2.kind == Tany){
		(t1, t2) = (t2, t1);
		swapped = !swapped;
	}
	if(t1.kind == Tadt && t1.tags != nil && t2.kind == Tadtpick && !swapped)
		t2 = t2.decl.dot.ty;
	if(t2.kind == Tadt && t2.tags != nil && t1.kind == Tadtpick && swapped)
		t1 = t1.decl.dot.ty;
	if(t1.kind != Tany && t1.kind != t2.kind)
		return (0, tp);
	t1.rec |= TReq;
	t2.rec |= TReq;
	case(t1.kind){
	* =>
		return (tequal(t1, t2), tp);
	Tany =>
		return (tattr[t2.kind].isptr, tp);
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		if(t1.kind != Tref && assumeteq(t1, t2))
			return (1, tp);
		return rtunify(t1.tof, t2.tof, tp, swapped);
	Tfn =>
		(ok, tp) = idunify(t1.ids, t2.ids, tp, swapped);
		if(!ok)
			return (0, tp);
		(ok, tp) = idunify(t1.polys, t2.polys, tp, swapped);
		if(!ok)
			return (0, tp);
		return rtunify(t1.tof, t2.tof, tp, swapped);
	Ttuple =>
		if(assumeteq(t1, t2))
			return (1, tp);
		return idunify(t1.ids, t2.ids, tp, swapped);
	Tadt or
	Tadtpick =>
		if(assumeteq(t1, t2))
			return (1, tp);
		(ok, tp) = idunify(t1.polys, t2.polys, tp, swapped);
		if(!ok)
			return (0, tp);
		(ok, tp) = idunify(t1.tags, t2.tags, tp, swapped);
		if(!ok)
			return (0, tp);
		return idunify(t1.ids, t2.ids, tp, swapped);
	Tmodule =>
		if(assumeteq(t1, t2))
			return (1, tp);
		return idunify(t1.tof.ids, t2.tof.ids, tp, swapped);
	Tpoly =>
		return (t1 == t2, tp);
	}
	return (1, tp);
}

idunify(id1: ref Decl, id2: ref Decl, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
	ok: int;

	if(id1 == id2)
		return (1, tp);
	for(; id1 != nil; id1 = id1.next){
		if(id2 == nil)
			return (0, tp);
		(ok, tp) = rtunify(id1.ty, id2.ty, tp, swapped);
		if(!ok)
			return (0, tp);
		id2 = id2.next;
	}
	return (id1 == nil && id2 == nil, tp);
}

polyequal(id1: ref Decl, id2: ref Decl): int
{
	# allow id2 list to have an optional for clause
	ck2 := 0;
	for(d := id2; d != nil; d = d.next)
		if(d.ty.ids != nil)
			ck2 = 1;
	for(; id1 != nil; id1 = id1.next){
		if(id2 == nil
		|| id1.sym != id2.sym
		|| id1.ty.decl != nil && id2.ty.decl != nil && id1.ty.decl.sym != id2.ty.decl.sym)
			return 0;
		if(ck2 && !idequal(id1.ty.ids, id2.ty.ids, 1, nil))
			return 0;
		id2 = id2.next;
	}
	return id1 == nil && id2 == nil;
}

calltype(f: ref Type, a: ref Node, rt: ref Type): ref Type
{
	t: ref Type;
	id, first, last: ref Decl;

	first = last = nil;
	t = mktype(f.src.start, f.src.stop, Tfn, rt, nil);
	if(f.kind == Tref)
		t.polys = f.tof.polys;
	else
		t.polys = f.polys;
	for( ; a != nil; a = a.right){
		id = mkdecl(f.src, Darg, a.left.ty);
		if(last == nil)
			first = id;
		else
			last.next = id;
		last = id;
	}
	t.ids = first;
	if(f.kind == Tref)
		t = mktype(f.src.start, f.src.stop, Tref, t, nil);
	return t;
}

duptype(t: ref Type): ref Type
{
	nt: ref Type;

	nt = ref Type;
	*nt = *t;
	nt.ok &= ~(OKverify|OKref|OKclass|OKsized|OKcycsize|OKcyc);
	nt.flags |= INST;
	nt.eq = nil;
	nt.sbl = -1;
	if(t.decl != nil && (nt.kind == Tadt || nt.kind == Tadtpick || nt.kind == Ttuple)){
		nt.decl = dupdecl(t.decl);
		nt.decl.ty = nt;
		nt.decl.link = t.decl;
		if(t.decl.dot != nil){
			nt.decl.dot = dupdecl(t.decl.dot);
			nt.decl.dot.link = t.decl.dot;
		}
	}
	else
		nt.decl = nil;
	return nt;
}

dpolys(ids: ref Decl): int
{
	p: ref Decl;

	for(p = ids; p != nil; p = p.next)
		if(tpolys(p.ty))
			return 1;
	return 0;
}

tpolys(t: ref Type): int
{
	v: int;
	tyl: ref Typelist;

	if(t == nil)
		return 0;
	if(int(t.flags&(POLY|NOPOLY)))
		return int(t.flags&POLY);
	case(t.kind){
		* =>
			v = 0;
			break;
		Tarrow or
		Tdot or
		Tpoly =>
			v = 1;
			break;
		Tref or
		Tlist or
		Tarray or
		Tchan =>
			v = tpolys(t.tof);
			break;
		Tid =>
			v = tpolys(t.decl.ty);
			break;
		Tinst =>
			for(tyl = t.tlist; tyl != nil; tyl = tyl.nxt)
				if(tpolys(tyl.t)){
					v = 1;
					break;
				}
			v = tpolys(t.tof);
			break;
		Tfn or
		Tadt or
		Tadtpick or
		Ttuple or
		Texception =>
			if(t.polys != nil){
				v = 1;
				break;
			}
			if(int(t.rec&TRvis))
				return 0;
			t.rec |= TRvis;
			v = tpolys(t.tof) || dpolys(t.polys) || dpolys(t.ids) || dpolys(t.tags);
			t.rec &= ~TRvis;
			if(t.kind == Tadtpick && v == 0)
				v = tpolys(t.decl.dot.ty);
			break;
	}
	if(v)
		t.flags |= POLY;
	else
		t.flags |= NOPOLY;
	return v;
}

doccurs(ids: ref Decl, tp: ref Tpair): int
{
	p: ref Decl;

	for(p = ids; p != nil; p = p.next){
		if(toccurs(p.ty, tp))
			return 1;
	}
	return 0;
}

toccurs(t: ref Type, tp: ref Tpair): int
{
	o: int;

	if(t == nil)
		return 0;
	if(!int(t.flags&(POLY|NOPOLY)))
		tpolys(t);
	if(int(t.flags&NOPOLY))
		return 0;
	case(t.kind){
		* =>
			fatal("unknown type " + string t.kind + " in toccurs");
		Tnone or
		Tbig or
		Tbyte or
		Treal or
		Tint or
		Tstring or
		Tfix or
		Tmodule or
		Terror =>
			return 0;
		Tarrow or
		Tdot =>
			return 1;
		Tpoly =>
			return valtmap(t, tp) != t;
		Tref or
		Tlist or
		Tarray or
		Tchan =>
			return toccurs(t.tof, tp);
		Tid =>
			return toccurs(t.decl.ty, tp);
		Tinst =>
			for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
				if(toccurs(tyl.t, tp))
					return 1;
			return toccurs(t.tof, tp);
		Tfn or
		Tadt or
		Tadtpick or
		Ttuple or
		Texception =>
			if(int(t.rec&TRvis))
				return 0;
			t.rec |= TRvis;
			o = toccurs(t.tof, tp) || doccurs(t.polys, tp) || doccurs(t.ids, tp) || doccurs(t.tags, tp);
			t.rec &= ~TRvis;
			if(t.kind == Tadtpick && o == 0)
				o = toccurs(t.decl.dot.ty, tp);
			return o;
	}
	return 0;
}

expandids(ids: ref Decl, adtt: ref Decl, tp: ref Tpair, sym: int): (ref Decl, ref Tpair)
{
	p, q, nids, last: ref Decl;

	nids = last = nil;
	for(p = ids; p != nil; p = p.next){
		q = dupdecl(p);
		(q.ty, tp) = expandtype(p.ty, nil, adtt, tp);
		if(sym && q.ty.decl != nil)
			q.sym = q.ty.decl.sym;
		if(q.store == Dfn)
			q.link = p;
		if(nids == nil)
			nids = q;
		else
			last.next = q;
		last = q;
	}
	return (nids, tp);
}

expandtype(t: ref Type, instt: ref Type, adtt: ref Decl, tp: ref Tpair): (ref Type, ref Tpair)
{
	nt: ref Type;

	if(t == nil)
		return (nil, tp);
	if(!toccurs(t, tp))
		return (t, tp);
	case(t.kind){
		* =>
			fatal("unknown type " + string t.kind + " in expandtype");
		Tpoly =>
			return (valtmap(t, tp), tp);
		Tref or
		Tlist or
		Tarray or
		Tchan =>
			nt = duptype(t);
			(nt.tof, tp) = expandtype(t.tof, nil, adtt, tp);
			return (nt, tp);
		Tid =>
			return expandtype(idtype(t), nil, adtt, tp);
		Tdot =>
			return expandtype(dottype(t, adtt), nil, adtt, tp);
		Tarrow =>
			return expandtype(arrowtype(t, adtt), nil, adtt, tp);
		Tinst =>
			if((nt = valtmap(t, tp)) != t)
				return (nt, tp);
			(t, tp) = insttype(t, adtt, tp);
			return expandtype(t, nil, adtt, tp);
		Tfn or
		Tadt or
		Tadtpick or
		Ttuple or
		Texception =>
			if((nt = valtmap(t, tp)) != t)
				return (nt, tp);
			if(t.kind == Tadt)
				adtt = t.decl;
			nt = duptype(t);
			tp = addtmap(t, nt, tp);
			if(instt != nil)
				tp = addtmap(instt, nt, tp);
			(nt.tof, tp) = expandtype(t.tof, nil, adtt, tp);
			(nt.polys, tp) = expandids(t.polys, adtt, tp, 1);
			(nt.ids, tp) = expandids(t.ids, adtt, tp, 0);
			(nt.tags, tp) = expandids(t.tags, adtt, tp, 0);
			if(t.kind == Tadt){
				for(ids := nt.tags; ids != nil; ids = ids.next)
					ids.ty.decl.dot = nt.decl;
			}
			if(t.kind == Tadtpick){
				(nt.decl.dot.ty, tp) = expandtype(t.decl.dot.ty, nil, adtt, tp);
			}
			if(t.tmap != nil){
				nt.tmap = nil;
				for(p := t.tmap; p != nil; p = p.nxt)
					nt.tmap = addtmap(valtmap(p.t1, tp), valtmap(p.t2, tp), nt.tmap);
			}
			return (nt, tp);
	}
	return (nil, tp);
}

#
# create type signatures
# sign the same information used
# for testing type equality
#
sign(d: ref Decl): int
{
	t := d.ty;
	if(t.sig != 0)
		return t.sig;

	if(ispoly(d))
		rmfnptrs(d);

	sigend := -1;
	sigalloc := 1024;
	sig: array of byte;
	while(sigend < 0 || sigend >= sigalloc){
		sigalloc *= 2;
		sig = array[sigalloc] of byte;
		eqrec = 0;
		sigend = rtsign(t, sig, 0);
		v := clearrec(t);
		if(v != eqrec)
			fatal("recid not balanced in sign: "+string v+" "+string eqrec);
		eqrec = 0;
	}

	if(signdump != "" && dotconv(d) == signdump){
		print("sign %s len %d\n", dotconv(d), sigend);
		print("%s\n", string sig[:sigend]);
	}

	md5sig := array[Crypt->MD5dlen] of {* => byte 0};
	md5(sig, sigend, md5sig, nil);

	for(i := 0; i < Crypt->MD5dlen; i += 4)
		t.sig ^= int md5sig[i+0] | (int md5sig[i+1]<<8) | (int md5sig[i+2]<<16) | (int md5sig[i+3]<<24);

	if(debug['S'])
		print("signed %s type %s len %d sig %#ux\n", dotconv(d), typeconv(t), sigend, t.sig);
	return t.sig;
}

SIGSELF:	con byte 'S';
SIGVARARGS:	con byte '*';
SIGCYC:		con byte 'y';
SIGREC:		con byte '@';

sigkind := array[Tend] of
{
	Tnone =>	byte 'n',
	Tadt =>		byte 'a',
	Tadtpick =>	byte 'p',
	Tarray =>	byte 'A',
	Tbig =>		byte 'B',
	Tbyte =>	byte 'b',
	Tchan =>	byte 'C',
	Treal =>	byte 'r',
	Tfn =>		byte 'f',
	Tint =>		byte 'i',
	Tlist =>	byte 'L',
	Tmodule =>	byte 'm',
	Tref =>		byte 'R',
	Tstring =>	byte 's',
	Ttuple =>	byte 't',
	Texception => byte 'e',
	Tfix => byte 'x',
	Tpoly => byte 'P',

	* => 		byte 0,
};

rtsign(t: ref Type, sig: array of byte, spos: int): int
{
	id: ref Decl;

	if(t == nil)
		return spos;

	if(spos < 0 || spos + 8 >= len sig)
		return -1;

	if(t.eq != nil && t.eq.id){
		if(t.eq.id < 0 || t.eq.id > eqrec)
			fatal("sign rec "+typeconv(t)+" "+string t.eq.id+" "+string eqrec);

		sig[spos++] = SIGREC;
		name := array of byte string t.eq.id;
		if(spos + len name > len sig)
			return -1;
		sig[spos:] = name;
		spos += len name;
		return spos;
	}
	if(t.eq != nil){
		eqrec++;
		t.eq.id = eqrec;
	}

	kind := sigkind[t.kind];
	sig[spos++] = kind;
	if(kind == byte 0)
		fatal("no sigkind for "+typeconv(t));

	t.rec = byte 1;
	case t.kind{
	* =>
		fatal("bogus type "+stypeconv(t)+" in rtsign");
		return -1;
	Tnone or
	Tbig or
	Tbyte or
	Treal or
	Tint or
	Tstring or
	Tpoly =>
		return spos;
	Tfix =>
		name := array of byte string t.val.c.rval;
		if(spos + len name - 1 >= len sig)
			return -1;
		sig[spos: ] = name;
		spos += len name;
		return spos;
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		return rtsign(t.tof, sig, spos);
	Tfn =>
		if(t.varargs != byte 0)
			sig[spos++] = SIGVARARGS;
		if(t.polys != nil)
			spos = idsign(t.polys, 0, sig, spos);
		spos = idsign(t.ids, 0, sig, spos);
		if(t.eraises != nil)
			spos = raisessign(t.eraises, sig, spos);
		return rtsign(t.tof, sig, spos);
	Ttuple =>
		return idsign(t.ids, 0, sig, spos);
	Tadt =>
		#
		# this is a little different than in rtequal,
		# since we flatten the adt we used to represent the globals
		#
		if(t.eq == nil){
			if(t.decl.sym.name != ".mp")
				fatal("no t.eq field for "+typeconv(t));
			spos--;
			for(id = t.ids; id != nil; id = id.next){
				spos = idsign1(id, 1, sig, spos);
				if(spos < 0 || spos >= len sig)
					return -1;
				sig[spos++] = byte ';';
			}
			return spos;
		}
		if(t.polys != nil)
			spos = idsign(t.polys, 0, sig, spos);
		spos = idsign(t.ids, 1, sig, spos);
		if(spos < 0 || t.tags == nil)
			return spos;

		#
		# convert closing ')' to a ',', then sign any tags
		#
		sig[spos-1] = byte ',';
		for(tg := t.tags; tg != nil; tg = tg.next){
			name := array of byte (tg.sym.name + "=>");
			if(spos + len name > len sig)
				return -1;
			sig[spos:] = name;
			spos += len name;

			spos = rtsign(tg.ty, sig, spos);
			if(spos < 0 || spos >= len sig)
				return -1;

			if(tg.next != nil)
				sig[spos++] = byte ',';
		}
		if(spos >= len sig)
			return -1;
		sig[spos++] = byte ')';
		return spos;
	Tadtpick =>
		spos = idsign(t.ids, 1, sig, spos);
		if(spos < 0)
			return spos;
		return rtsign(t.decl.dot.ty, sig, spos);
	Tmodule =>
		if(t.tof.linkall == byte 0)
			fatal("signing a narrowed module");

		if(spos >= len sig)
			return -1;
		sig[spos++] = byte '{';
		for(id = t.tof.ids; id != nil; id = id.next){
			if(id.tag)
				continue;
			if(id.sym.name == ".mp"){
				spos = rtsign(id.ty, sig, spos);
				if(spos < 0)
					return -1;
				continue;
			}
			spos = idsign1(id, 1, sig, spos);
			if(spos < 0 || spos >= len sig)
				return -1;
			sig[spos++] = byte ';';
		}
		if(spos >= len sig)
			return -1;
		sig[spos++] = byte '}';
		return spos;
	}
}

idsign(id: ref Decl, usenames: int, sig: array of byte, spos: int): int
{
	if(spos >= len sig)
		return -1;
	sig[spos++] = byte '(';
	first := 1;
	for(; id != nil; id = id.next){
		if(id.store == Dlocal)
			fatal("local "+id.sym.name+" in idsign");

		if(!storespace[id.store])
			continue;

		if(!first){
			if(spos >= len sig)
				return -1;
			sig[spos++] = byte ',';
		}

		spos = idsign1(id, usenames, sig, spos);
		if(spos < 0)
			return -1;
		first = 0;
	}
	if(spos >= len sig)
		return -1;
	sig[spos++] = byte ')';
	return spos;
}

idsign1(id: ref Decl, usenames: int, sig: array of byte, spos: int): int
{
	if(usenames){
		name := array of byte (id.sym.name+":");
		if(spos + len name >= len sig)
			return -1;
		sig[spos:] = name;
		spos += len name;
	}

	if(spos + 2 >= len sig)
		return -1;

	if(id.implicit != byte 0)
		sig[spos++] = SIGSELF;

	if(id.cyc != byte 0)
		sig[spos++] = SIGCYC;

	return rtsign(id.ty, sig, spos);
}

raisessign(n: ref Node, sig: array of byte, spos: int): int
{
	if(spos >= len sig)
		return -1;
	sig[spos++] = byte '(';
	for(nn := n.left; nn != nil; nn = nn.right){
		s := array of byte nn.left.decl.sym.name;
		if(spos+len s - 1 >= len sig)
			return -1;
		sig[spos: ] = s;
		spos += len s;
		if(nn.right != nil){
			if(spos >= len sig)
				return -1;
			sig[spos++] = byte ',';
		}
	}
	if(spos >= len sig)
		return -1;
	sig[spos++] = byte ')';
	return spos;
}

clearrec(t: ref Type): int
{
	id: ref Decl;

	n := 0;
	for(; t != nil && t.rec != byte 0; t = t.tof){
		t.rec = byte 0;
		if(t.eq != nil && t.eq.id != 0){
			t.eq.id = 0;
			n++;
		}
		if(t.kind == Tmodule){
			for(id = t.tof.ids; id != nil; id = id.next)
				n += clearrec(id.ty);
			return n;
		}
		if(t.kind == Tadtpick)
			n += clearrec(t.decl.dot.ty);
		for(id = t.ids; id != nil; id = id.next)
			n += clearrec(id.ty);
		for(id = t.tags; id != nil; id = id.next)
			n += clearrec(id.ty);
		for(id = t.polys; id != nil; id = id.next)
			n += clearrec(id.ty);
	}
	return n;
}

# must a variable of the given type be zeroed ? (for uninitialized declarations inside loops)
tmustzero(t : ref Type) : int
{
	if(t==nil)
		return 0;
	if(tattr[t.kind].isptr)
		return 1;
	if(t.kind == Tadtpick)
		t = t.tof;
	if(t.kind == Ttuple || t.kind == Tadt)
		return mustzero(t.ids);
	return 0;
}

mustzero(decls : ref Decl) : int
{
	d : ref Decl;

	for (d = decls; d != nil; d = d.next)
		if (tmustzero(d.ty))
			return 1;
	return 0;
}

typeconv(t: ref Type): string
{
	if(t == nil)
		return "nothing";
	return tprint(t);
}

stypeconv(t: ref Type): string
{
	if(t == nil)
		return "nothing";
	return stprint(t);
}

tprint(t: ref Type): string
{
	id: ref Decl;

	if(t == nil)
		return "";
	s := "";
	if(t.kind < 0 || t.kind >= Tend){
		s += "kind ";
		s += string t.kind;
		return s;
	}
	if(t.pr != byte 0 && t.decl != nil){
		if(t.decl.dot != nil && !isimpmod(t.decl.dot.sym)){
			s += t.decl.dot.sym.name;
			s += "->";
		}
		s += t.decl.sym.name;
		return s;
	}
	t.pr = byte 1;
	case t.kind{
	Tarrow =>
		s += tprint(t.tof);
		s += "->";
		s += t.decl.sym.name;
	Tdot =>
		s += tprint(t.tof);
		s += ".";
		s += t.decl.sym.name;
	Tid or
	Tpoly =>
		s += t.decl.sym.name;
	Tinst =>
		s += tprint(t.tof);
		s += "[";
		for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt){
			s += tprint(tyl.t);
			if(tyl.nxt != nil)
				s += ", ";
		}
		s += "]";
	Tint or
	Tbig or
	Tstring or
	Treal or
	Tbyte or
	Tany or
	Tnone or
	Terror or
	Tainit or
	Talt or
	Tcase or
	Tcasel or
	Tcasec or
	Tgoto or
	Tiface or
	Texception or
	Texcept =>
		s += kindname[t.kind];
	Tfix =>
		s += kindname[t.kind] + "(" + expconv(t.val) + ")";
	Tref =>
		s += "ref ";
		s += tprint(t.tof);
	Tchan or
	Tarray or
	Tlist =>
		s += kindname[t.kind];
		s += " of ";
		s += tprint(t.tof);
	Tadtpick =>
		s += t.decl.dot.sym.name + "." + t.decl.sym.name;
	Tadt =>
		if(t.decl.dot != nil && !isimpmod(t.decl.dot.sym))
			s += t.decl.dot.sym.name + "->";
		s += t.decl.sym.name;
		if(t.polys != nil){
			s += "[";
			for(id = t.polys; id != nil; id = id.next){
				if(t.tmap != nil)
					s += tprint(valtmap(id.ty, t.tmap));
				else
					s += id.sym.name;
				if(id.next != nil)
					s += ", ";
			}
			s += "]";
		}
	Tmodule =>
		s += t.decl.sym.name;
	Ttuple =>
		s += "(";
		for(id = t.ids; id != nil; id = id.next){
			s += tprint(id.ty);
			if(id.next != nil)
				s += ", ";
		}
		s += ")";
	Tfn =>
		s += "fn";
		if(t.polys != nil){
			s += "[";
			for(id = t.polys; id != nil; id = id.next){
				s += id.sym.name;
				if(id.next != nil)
					s += ", ";
			}
			s += "]";
		}
		s += "(";
		for(id = t.ids; id != nil; id = id.next){
			if(id.sym == nil)
				s += "nil: ";
			else{
				s += id.sym.name;
				s += ": ";
			}
			if(id.implicit != byte 0)
				s += "self ";
			s += tprint(id.ty);
			if(id.next != nil)
				s += ", ";
		}
		if(t.varargs != byte 0 && t.ids != nil)
			s += ", *";
		else if(t.varargs != byte 0)
			s += "*";
		if(t.tof != nil && t.tof.kind != Tnone){
			s += "): ";
			s += tprint(t.tof);
		}else
			s += ")";
	* =>
		yyerror("tprint: unknown type kind "+string t.kind);
	}
	t.pr = byte 0;
	return s;
}

stprint(t: ref Type): string
{
	if(t == nil)
		return "";
	s := "";
	case t.kind{
	Tid =>
		s += "id ";
		s += t.decl.sym.name;
	Tadt or
	Tadtpick or
	Tmodule =>
		return kindname[t.kind] + " " + tprint(t);
	}
	return tprint(t);
}

# generalize ref P.A, ref P.B to ref P

# tparent(t1: ref Type, t2: ref Type): ref Type
# {
# 	if(t1 == nil || t2 == nil || t1.kind != Tref || t2.kind != Tref)
# 		return t1;
# 	t1 = t1.tof;
# 	t2 = t2.tof;
# 	if(t1 == nil || t2 == nil || t1.kind != Tadtpick || t2.kind != Tadtpick)
# 		return t1;
# 	t1 = t1.decl.dot.ty;
# 	t2 = t2.decl.dot.ty;
# 	if(tequal(t1, t2))
# 		return mktype(t1.src.start, t1.src.stop, Tref, t1, nil);
# 	return t1;
# }

tparent0(t1: ref Type, t2: ref Type): int
{
	id1, id2: ref Decl;

	if(t1 == t2)
		return 1;
	if(t1 == nil || t2 == nil)
		return 0;
	if(t1.kind == Tadt && t2.kind == Tadtpick)
		t2 = t2.decl.dot.ty;
	if(t1.kind == Tadtpick && t2.kind == Tadt)
		t1 = t1.decl.dot.ty;
	if(t1.kind != t2.kind)
		return 0;
	case(t1.kind){
	* =>
		fatal("unknown type " + string t1.kind + " v " + string t2.kind + " in tparent");
		break;
	Terror or
	Tstring or
	Tnone or
	Tint or
	Tbig or
	Tbyte or
	Treal or
	Tany =>
		return 1;
	Texception or
	Tfix or
	Tfn or
	Tadt or
	Tmodule or
	Tpoly =>
		return tcompat(t1, t2, 0);
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		return tparent0(t1.tof, t2.tof);
	Ttuple =>
		for((id1, id2) = (t1.ids, t2.ids); id1 != nil && id2 != nil; (id1, id2) = (id1.next, id2.next))
			if(!tparent0(id1.ty, id2.ty))
				return 0;
		return id1 == nil && id2 == nil;
	Tadtpick =>
		return tequal(t1.decl.dot.ty, t2.decl.dot.ty);
	}
	return 0;
}

tparent1(t1: ref Type, t2: ref Type): ref Type
{
	t, nt: ref Type;
	id, id1, id2, idt: ref Decl;

	if(t1.kind == Tadt && t2.kind == Tadtpick)
		t2 = t2.decl.dot.ty;
	if(t1.kind == Tadtpick && t2.kind == Tadt)
		t1 = t1.decl.dot.ty;
	case(t1.kind){
	* =>
		return t1;
	Tref or
	Tlist or
	Tarray or
	Tchan =>
		t = tparent1(t1.tof, t2.tof);
		if(t == t1.tof)
			return t1;
		return mktype(t1.src.start, t1.src.stop, t1.kind, t, nil);
	Ttuple =>
		nt = nil;
		id = nil;
		for((id1, id2) = (t1.ids, t2.ids); id1 != nil && id2 != nil; (id1, id2) = (id1.next, id2.next)){
			t = tparent1(id1.ty, id2.ty);
			if(t != id1.ty){
				if(nt == nil){
					nt = mktype(t1.src.start, t1.src.stop, Ttuple, nil, dupdecls(t1.ids));
					for((id, idt) = (nt.ids, t1.ids); idt != id1; (id, idt) = (id.next, idt.next))
						;
				}
				id.ty = t;
			}
			if(id != nil)
				id = id.next;
		}
		if(nt == nil)
			return t1;
		return nt;
	Tadtpick =>
		if(tequal(t1, t2))
			return t1;
		return t1.decl.dot.ty;
	}
	return t1;
}

tparent(t1: ref Type, t2: ref Type): ref Type
{
	if(tparent0(t1, t2))
		return tparent1(t1, t2);
	return t1;
}

#
# make the tuple type used to initialize an exception type
#
mkexbasetype(t: ref Type): ref Type
{
	if(t.cons == byte 0)
		fatal("mkexbasetype on non-constant");
	last := mkids(t.decl.src, nil, tstring, nil);
	last.store = Dfield;
	nt := mktype(t.src.start, t.src.stop, Texception, nil, last);
	nt.cons = byte 0;
	new := mkids(t.decl.src, nil, tint, nil);
	new.store = Dfield;
	last.next = new;
	last = new;
	for(id := t.ids; id != nil; id = id.next){
		new = ref *id;
		new.cyc = byte 0;
		last.next = new;
		last = new;
	}
	last.next = nil;
	return usetype(nt);
}

#
# make an instantiated exception type
#
mkextype(t: ref Type): ref Type
{
	nt: ref Type;

	if(t.cons == byte 0)
		fatal("mkextype on non-constant");
	if(t.tof != nil)
		return t.tof;
	nt = copytypeids(t);
	nt.cons = byte 0;
	t.tof = usetype(nt);
	return t.tof;
}

#
# convert an instantiated exception type to its underlying type
#
mkextuptype(t: ref Type): ref Type
{
	id: ref Decl;
	nt: ref Type;

	if(int t.cons)
		return t;
	if(t.tof != nil)
		return t.tof;
	id = t.ids;
	if(id == nil)
		nt = t;
	else if(id.next == nil)
		nt = id.ty;
	else{
		nt = copytypeids(t);
		nt.cons = byte 0;
		nt.kind = Ttuple;
	}
	t.tof = usetype(nt);
	return t.tof;
}

ckfix(t: ref Type, max: real)
{
	s := t.val.c.rval;
	if(max == 0.0)
		k := (big 1<<32) - big 1;
	else
		k = big 2 * big (max/s) + big 1;
	x := big 1;
	for(p := 0; k > x; p++)
		x *= big 2;
	if(p == 0 || p > 32){
		error(t.src.start, "cannot fit fixed type into an int");	
		return;
	}
	if(p < 32)
		t.val.c.rval /= real (1<<(32-p));
}

scale(t: ref Type): real
{
	n: ref Node;

	if(t.kind == Tint || t.kind == Treal)
		return 1.0;
	if(t.kind != Tfix)
		fatal("scale() on non fixed point type");
	n = t.val;
	if(n.op != Oconst)
		fatal("non constant scale");
	if(n.ty != treal)
		fatal("non real scale");
	return n.c.rval;
}

scale2(f: ref Type, t: ref Type): real
{
	return scale(f)/scale(t);
}

# put x in normal form
nf(x: real): (int, int)
{
	p: int;
	m: real;

	p = 0;
	m = x;
	while(m >= 1.0){
		p++;
		m /= 2.0;
	}
	while(m < 0.5){
		p--;
		m *= 2.0;
	}
	m *= real (1<<16)*real (1<<15);
	if(m >= real 16r7fffffff - 0.5)
		return (p, 16r7fffffff);
	return (p, int m);
}

ispow2(x: real): int
{
	m: int;

	(nil, m) = nf(x);
	if(m != 1<<30)
		return 0;
	return 1;
}

round(x: real, n: int): (int, int)
{
	if(n != 31)
		fatal("not 31 in round");
	return nf(x);
}

fixmul2(sx: real, sy: real, sr: real): (int, int, int)
{
	k, n, a: int;
	alpha: real;

	alpha = (sx*sy)/sr;
	n = 31;
	(k, a) = round(1.0/alpha, n);
	return (IMULX, 1-k, 0);
}

fixdiv2(sx: real, sy: real, sr: real): (int, int, int)
{
	k, n, b: int;
	beta: real;

	beta = sx/(sy*sr);
	n = 31;
	(k, b) = round(beta, n);
	return (IDIVX, k-1, 0);
}

fixmul(sx: real, sy: real, sr: real): (int, int, int)
{
	k, m, n, a, v: int;
	W: big;
	alpha, eps: real;

	alpha = (sx*sy)/sr;
	if(ispow2(alpha))
		return fixmul2(sx, sy, sr);
	n = 31;
	(k, a) = round(1.0/alpha, n);
	m = n-k;
	if(m < -n-1)
		return (IMOVW, 0, 0);	# result is zero whatever the values
	v = 0;
	W = big 0;
	eps = real(1<<m)/(alpha*real(a)) - 1.0;
	if(eps < 0.0){
		v = a-1;
		eps = -eps;
	}
	if(m < 0 && real(1<<n)*eps*real(a) >= real(a)-1.0+real(1<<m))
		W = (big(1)<<(-m)) - big 1;
	if(v != 0 || W != big 0)
		m = m<<2|(v != 0)<<1|(W != big 0);
	if(v == 0 && W == big 0)
		return (IMULX0, m, a);
	else
		return (IMULX1, m, a);
}

fixdiv(sx: real, sy: real, sr: real): (int, int, int)
{
	k, m, n, b, v: int;
	W: big;
	beta, eps: real;

	beta = sx/(sy*sr);
	if(ispow2(beta))
		return fixdiv2(sx, sy, sr);
	n = 31;
	(k, b) = round(beta, n);
	m = k-n;
	if(m <= -2*n)
		return (IMOVW, 0, 0);	#result is zero whatever the values
	v = 0;
	W = big 0;
	eps = (real(1<<m)*real(b))/beta - 1.0;
	if(eps < 0.0)
		v = 1;
	if(m < 0)
		W = (big(1)<<(-m)) - big 1;
	if(v != 0 || W != big 0)
		m = m<<2|(v != 0)<<1|(W != big 0);
	if(v == 0 && W == big 0)
		return (IDIVX0, m, b);
	else
		return (IDIVX1, m, b);
}

fixcast(sx: real, sr: real): (int, int, int)
{
	(op, p, a) := fixmul(sx, 1.0, sr);
	return (op-IMULX+ICVTXX, p, a);
}

fixop(op: int, tx: ref Type, ty: ref Type, tr: ref Type): (int, int, int)
{
	sx, sy, sr: real;

	sx = scale(tx);
	sy = scale(ty);
	sr = scale(tr);
	if(op == IMULX)
		return fixmul(sx, sy, sr);
	else if(op == IDIVX)
		return fixdiv(sx, sy, sr);
	else
		return fixcast(sx, sr);
}

ispoly(d: ref Decl): int
{
	if(d == nil)
		return 0;
	t := d.ty;
	if(t.kind == Tfn){
		if(t.polys != nil)
			return 1;
		if((d = d.dot) == nil)
			return 0;
		t = d.ty;
		return t.kind == Tadt && t.polys != nil;
	}
	return 0;
}

ispolyadt(t: ref Type): int
{
	return (t.kind == Tadt || t.kind == Tadtpick) && t.polys != nil && (t.flags & INST) == byte 0;
}

polydecl(ids: ref Decl): ref Decl
{
	id: ref Decl;
	t: ref Type;

	for(id = ids; id != nil; id = id.next){
		t = mktype(id.src.start, id.src.stop, Tpoly, nil, nil);
		id.ty = t;
		t.decl = id;
	}
	return ids;
}

# try to convert an expression tree to a type
exptotype(n: ref Node): ref Type
{
	t, tt: ref Type;
	d: ref Decl;
	tll: ref Typelist;
	src: Src;

	if(n == nil)
		return nil;
	t = nil;
	case(n.op){
		Oname =>
			if((d = n.decl) != nil && d.store == Dtype)
				t = d.ty;
		Otype or Ochan =>
			t = n.ty;
		Oref =>
			t = exptotype(n.left);
			if(t != nil)
				t = mktype(n.src.start, n.src.stop, Tref, t, nil);
		Odot =>
			t = exptotype(n.left);
			if(t != nil){
				d = namedot(t.tags, n.right.decl.sym);
				if(d == nil)
					t = nil;
				else
					t = d.ty;
			}
			if(t == nil)
				t = exptotype(n.right);
		Omdot =>
			t = exptotype(n.right);
		Oindex =>
			t = exptotype(n.left);
			if(t != nil){
				src = n.src;
				tll = nil;
				for(n = n.right; n != nil; n = n.right){
					if(n.op == Oseq)
						tt = exptotype(n.left);
					else
						tt = exptotype(n);
					if(tt == nil)
						return nil;
					tll = addtype(tt, tll);
					if(n.op != Oseq)
						break;
				}
				t = mkinsttype(src, t, tll);
			}
	}
	return t;
}

uname(im: ref Decl): string
{
	s := "";
	for(p := im; p != nil; p = p.next){
		s += p.sym.name;
		if(p.next != nil)
			s += "+";
	}
	return s;
}

# check all implementation modules have consistent declarations
# and create their union if needed
#
modimp(dl: ref Dlist, im: ref Decl): ref Decl
{
	u, d, dd, ids, dot, last: ref Decl;
	s: ref Sym;

	if(dl.next == nil)
		return dl.d;
	dl0 := dl;
	sg0 := 0;
	un := uname(im);
	installids(Dglobal, mkids(dl.d.src, enter(".m."+un, 0), tnone, nil));
	u = dupdecl(dl.d);
	u.sym = enter(un, 0);
	u.sym.decl = u;
	u.ty = mktype(u.src.start, u.src.stop, Tmodule, nil, nil);
	u.ty.decl = u;
	for( ; dl != nil; dl = dl.next){
		d = dl.d;
		ids = d.ty.tof.ids;	# iface
		if(ids != nil && ids.store == Dglobal)	# .mp
			sg := sign(ids);
		else
			sg = 0;
		if(dl == dl0)
			sg0 = sg;
		else if(sg != sg0)
			error(d.src.start, d.sym.name + "'s module data not consistent with that of " + dl0.d.sym.name + "\n");
		for(ids = d.ty.ids; ids != nil; ids = ids.next){
			s = ids.sym;
			if(s.decl != nil && s.decl.scope >= scope){
				if(ids == s.decl){
					dd = dupdecl(ids);
					if(u.ty.ids == nil)
						u.ty.ids = dd;
					else
						last.next = dd;
					last = dd;
					continue;
				}
				dot = s.decl.dot;
				if(s.decl.store != Dwundef && dot != nil && dot != d && isimpmod(dot.sym) && dequal(ids, s.decl, 1))
					ids.refs = s.decl.refs;
				else
					redecl(ids);
				ids.init = s.decl.init;
			}
		}
	}
	u.ty = usetype(u.ty);
	return u;
}

modres(d: ref Decl)
{
	ids, id, n, i: ref Decl;
	t: ref Type;

	for(ids = d.ty.ids; ids != nil; ids = ids.next){
		id = ids.sym.decl;
		if(ids != id){
			n = ids.next;
			i = ids.iface;
			t = ids.ty;
			*ids = *id;
			ids.next = n;
			ids.iface = i;
			ids.ty = t;
		}
	}
}

# update the fields of duplicate declarations in other implementation modules
# and their union
#	
modresolve()
{
	dl: ref Dlist;

	dl = impdecls;
	if(dl.next == nil)
		return;
	for( ; dl != nil; dl = dl.next)
		modres(dl.d);
	modres(impdecl);
}