4422 lines · 89.2 KB · Brainfuck
RawDownload
 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#

Lines 1–500 of 4422.