Charles.Forsyth20080201-190845629f718 years agoHistory
4745 lines · 91.7 KB · C
RawDownload
#include "limbo.h"#include "mp.h"#include "libsec.h" char *kindname[Tend] ={	/* 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 tattr[Tend] ={	/*		 isptr	refable	conable	big	vis */	/* Tnone */	{ 0,	0,	0,	0,	0, },	/* Tadt */	{ 0,	1,	1,	1,	1, },	/* Tadtpick */	{ 0,	1,	0,	1,	1, },	/* Tarray */	{ 1,	0,	0,	0,	1, },	/* Tbig */	{ 0,	0,	1,	1,	1, },	/* Tbyte */	{ 0,	0,	1,	0,	1, },	/* Tchan */	{ 1,	0,	0,	0,	1, },	/* Treal */	{ 0,	0,	1,	1,	1, },	/* Tfn */	{ 0,	1,	0,	0,	1, },	/* Tint */	{ 0,	0,	1,	0,	1, },	/* Tlist */	{ 1,	0,	0,	0,	1, },	/* Tmodule */	{ 1,	0,	0,	0,	1, },	/* Tref */	{ 1,	0,	0,	0,	1, },	/* Tstring */	{ 1,	0,	1,	0,	1, },	/* Ttuple */	{ 0,	1,	1,	1,	1, },	/* Texception */	{ 0,	0,	0,	1,	1, },	/* Tfix */	{ 0,	0,	1,	0,	1, },	/* Tpoly */	{ 1,	0,	0,	0,	1, }, 	/* Tainit */	{ 0,	0,	0,	1,	0, },	/* Talt */	{ 0,	0,	0,	1,	0, },	/* Tany */	{ 1,	0,	0,	0,	0, },	/* Tarrow */	{ 0,	0,	0,	0,	1, },	/* Tcase */	{ 0,	0,	0,	1,	0, },	/* Tcasel */	{ 0,	0,	0,	1,	0, },	/* Tcasec */	{ 0,	0,	0,	1,	0, },	/* Tdot */	{ 0,	0,	0,	0,	1, },	/* Terror */	{ 0,	1,	1,	0,	0, },	/* Tgoto */	{ 0,	0,	0,	1,	0, },	/* Tid */	{ 0,	0,	0,	0,	1, },	/* Tiface */	{ 0,	0,	0,	1,	0, },	/* Texcept */	{ 0,	0,	0,	1,	0, },	/* Tinst */	{ 0,	1,	1,	1,	1, },}; static	Teq	*eqclass[Tend]; static	Type	ztype;static	int	eqrec;static	int	eqset;static	int	tcomset; static	int	idcompat(Decl*, Decl*, int, int);static	int	rtcompat(Type *t1, Type *t2, int any, int);static	int	assumeteq(Type *t1, Type *t2);static	int	assumetcom(Type *t1, Type *t2);static	int	cleartcomrec(Type *t);static	int	rtequal(Type*, Type*);static	int	cleareqrec(Type*);static	int	idequal(Decl*, Decl*, int, int*);static	int	pyequal(Type*, Type*);static	int	rtsign(Type*, uchar*, int, int);static	int	clearrec(Type*);static	int	idsign(Decl*, int, uchar*, int, int);static	int	idsign1(Decl*, int, uchar*, int, int);static	int	raisessign(Node *n, uchar *sig, int lensig, int spos);static	void	ckfix(Type*, double);static	int	fnunify(Type*, Type*, Tpair**, int);static	int	rtunify(Type*, Type*, Tpair**, int);static	int	idunify(Decl*, Decl*, Tpair**, int);static	int	toccurs(Type*, Tpair**);static	int	fncleareqrec(Type*, Type*);static	Type*	comtype(Src*, Type*, Decl*);static	Type*	duptype(Type*);static	int	tpolys(Type*); static voidaddtmap(Type *t1, Type *t2, Tpair **tpp){	Tpair *tp; 	tp = allocmem(sizeof *tp);	tp->t1 = t1;	tp->t2 = t2;	tp->nxt = *tpp;	*tpp = tp;} Type*valtmap(Type *t, Tpair *tp){	for( ; tp != nil; tp = tp->nxt)		if(tp->t1 == t)			return tp->t2;	return t;} Typelist*addtype(Type *t, Typelist *hd){	Typelist *tl, *p; 	tl = allocmem(sizeof(*tl));	tl->t = t;	tl->nxt = nil;	if(hd == nil)		return tl;	for(p = hd; p->nxt != nil; p = p->nxt)		;	p->nxt = tl;	return hd;} voidtypeinit(void){	Decl *id; 	anontupsym = enter(".tuple", 0); 	ztype.sbl = -1;	ztype.ok = 0;	ztype.rec = 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 = nosrc;	id = tfnptr->ids->next = mkids(&nosrc, nil, tint, nil);	id->store = Dfield;	id->offset = IBY2WD;	id->sym = enter("t1", 0);	id->src = nosrc; 	rtexception = mktype(&noline, &noline, Tref, texception, nil);	rtexception->size = IBY2WD;	rtexception->align = IBY2WD;	rtexception->ok = OKmask;} voidtypestart(void){	descriptors = nil;	nfns = 0;	nadts = 0;	selfdecl = nil;	if(tfnptr->decl != nil)		tfnptr->decl->desc = nil; 	memset(eqclass, 0, sizeof eqclass); 	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);} Teq*modclass(void){	return eqclass[Tmodule];} Type*mktype(Line *start, Line *stop, int kind, Type *tof, Decl *args){	Type *t; 	t = allocmem(sizeof *t);	*t = ztype;	t->src.start = *start;	t->src.stop = *stop;	t->kind = kind;	t->tof = tof;	t->ids = args;	return t;} Type*mktalt(Case *c){	Type *t;	char buf[32];	static int nalt; 	t = mktype(&noline, &noline, Talt, nil, nil);	t->decl = mkdecl(&nosrc, Dtype, t);	seprint(buf, buf+sizeof(buf), ".a%d", nalt++);	t->decl->sym = enter(buf, 0);	t->cse = c;	return usetype(t);} /* * copy t and the top level of ids */Type*copytypeids(Type *t){	Type *nt;	Decl *id, *new, *last; 	nt = allocmem(sizeof *nt);	*nt = *t;	last = nil;	for(id = t->ids; id != nil; id = id->next){		new = allocmem(sizeof *id);		*new = *id;		if(last == nil)			nt->ids = new;		else			last->next = new;		last = new;	}	return nt;} /* * make each of the ids have type t */Decl*typeids(Decl *ids, Type *t){	Decl *id; 	if(ids == nil)		return nil; 	ids->ty = t;	for(id = ids->next; id != nil; id = id->next){		id->ty = t;	}	return ids;} voidtypebuiltin(Decl *d, Type *t){	d->ty = t;	t->decl = d;	installids(Dtype, d);} Node *fielddecl(int store, Decl *ids){	Node *n; 	n = mkn(Ofielddecl, nil, nil);	n->decl = ids;	for(; ids != nil; ids = ids->next)		ids->store = store;	return n;} Node *typedecl(Decl *ids, Type *t){	Node *n; 	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;} voidtypedecled(Node *n){	installids(Dtype, n->decl);} Node *adtdecl(Decl *ids, Node *fields){	Node *n;	Type *t; 	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;} voidadtdecled(Node *n){	Decl *d, *ids; 	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;} voidfielddecled(Node *n){	for(; n != nil; n = n->right){		switch(n->op){		case Oseq:			fielddecled(n->left);			break;		case Oadtdecl:			adtdecled(n);			return;		case Otypedecl:			typedecled(n);			return;		case Ofielddecl:			installids(Dfield, n->decl);			return;		case Ocondecl:			condecled(n);			gdasdecl(n->right);			return;		case Oexdecl:			exdecled(n);			return;		case Opickdecl:			pickdecled(n);			return;		default:			fatal("can't deal with %O in fielddecled", n->op);		}	}} intpickdecled(Node *n){	Decl *d;	int tag; 	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 */Type*mkadtcon(Type *t){	Decl *id, *new, *last;	Type *nt; 	nt = allocmem(sizeof *nt);	*nt = *t;	last = nil;	nt->ids = nil;	nt->kind = Ttuple;	for(id = t->ids; id != nil; id = id->next){		if(id->store != Dfield)			continue;		new = allocmem(sizeof *id);		*new = *id;		new->cyc = 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 */Type*mkadtpickcon(Type *t, Type *tgt){	Decl *id, *new, *last;	Type *nt; 	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 = allocmem(sizeof *id);

Lines 1–500 of 4745.