Charles.Forsyth20060303a828770d19 years agoHistory
1538 lines · 26.1 KB · C
RawDownload
#include "limbo.h" static vlongipow(vlong x, int n){	int inv;	vlong r; 	inv = 0;	if(n < 0){		n = -n;		inv = 1;	}	r = 1;	for(;;){		if(n&1)			r *= x;		if((n >>= 1) == 0)			break;		x *= x;	}	if(inv)		r = 1/r;	return r;} doublerpow(double x, int n){	int inv;	double r; 	inv = 0;	if(n < 0){		n = -n;		inv = 1;	}	r = 1;	for(;;){		if(n&1)			r *= x;		if((n >>= 1) == 0)			break;		x *= x;	}	if(inv)		r = 1/r;	return r;} Longreal2fix(double v, Type *t){	v /= scale(t);	v = v < 0 ? v-0.5: v+0.5;	return v;} Longfix2fix(Long v, Type *f, Type *t){	double r; 	r = (double)v * (scale(f)/scale(t));	r = r < 0 ? r-0.5: r+0.5;	return r;} doublefix2real(Long v, Type *f){	return (double)v * scale(f);} intistuple(Node *n){	Decl *d; 	switch(n->op){	case Otuple:		return 1;	case Oname:		d = n->decl;		if(d->importid != nil)			d = d->importid;		return d->store == Dconst && (n->ty->kind == Ttuple || n->ty->kind == Tadt);	case Odot:		return 0;	/* istuple(n->left); */	}	return 0;} static Node*tuplemem(Node *n, Decl *d){	Type *ty;	Decl *ids; 	ty = n->ty;	n = n->left;	for(ids = ty->ids; ids != nil; ids = ids->next){		if(ids->sym == d->sym)			break;		else			n = n->right;	}	if(n == nil)		fatal("tuplemem cannot cope !\n");	return n->left;} intvarcom(Decl *v){	Node *n, tn; 	n = v->init;	n = fold(n);	v->init = n;	if(debug['v'])		print("variable '%D' val %V\n", v, n);	if(n == nil)		return 1; 	tn = znode;	tn.op = Oname;	tn.decl = v;	tn.src = v->src;	tn.ty = v->ty;	return initable(&tn, n, 0);} intinitable(Node *v, Node *n, int allocdep){	Node *e; 	switch(n->ty->kind){	case Tiface:	case Tgoto:	case Tcase:	case Tcasel:	case Tcasec:	case Talt:	case Texcept:		return 1;	case Tint:	case Tbig:	case Tbyte:	case Treal:	case Tstring:	case Tfix:		if(n->op != Oconst)			break;		return 1;	case Tadt:	case Tadtpick:	case Ttuple:		if(n->op == Otuple)			n = n->left;		else if(n->op == Ocall)			n = n->right;		else			break;		for(; n != nil; n = n->right)			if(!initable(v, n->left, allocdep))				return 0;		return 1;	case Tarray:		if(n->op != Oarray)			break;		if(allocdep >= DADEPTH){			nerror(v, "%Vs initializer has arrays nested more than %d deep", v, allocdep);			return 0;		}		allocdep++;		usedesc(mktdesc(n->ty->tof));		if(n->left->op != Oconst){			nerror(v, "%Vs size is not a constant", v);			return 0;		}		for(e = n->right; e != nil; e = e->right)			if(!initable(v, e->left->right, allocdep))				return 0;		return 1;	case Tany:		return 1;	case Tref:	case Tlist:	case Tpoly:	default:		nerror(v, "can't initialize %Q", v);		return 0;	}	nerror(v, "%Vs initializer, %V, is not a constant expression", v, n);	return 0;} /* * merge together two sorted lists, yielding a sorted list */static Node*elemmerge(Node *e, Node *f){	Node rock, *r; 	r = &rock;	while(e != nil && f != nil){		if(e->left->left->val <= f->left->left->val){			r->right = e;			e = e->right;		}else{			r->right = f;			f = f->right;		}		r = r->right;	}	if(e != nil)		r->right = e;	else		r->right = f;	return rock.right;} /* * recursively split lists and remerge them after they are sorted */static Node*recelemsort(Node *e, int n){	Node *r, *ee;	int i, m; 	if(n <= 1)		return e;	m = n / 2 - 1;	ee = e;	for(i = 0; i < m; i++)		ee = ee->right;	r = ee->right;	ee->right = nil;	return elemmerge(recelemsort(e, n / 2),			recelemsort(r, (n + 1) / 2));} /* * sort the elems by index; wild card is first */Node*elemsort(Node *e){	Node *ee;	int n; 	n = 0;	for(ee = e; ee != nil; ee = ee->right){		if(ee->left->left->op == Owild)			ee->left->left->val = -1;		n++;	}	return recelemsort(e, n);} intsametree(Node *n1, Node *n2){	if(n1 == n2)		return 1;	if(n1 == nil || n2 == nil)		return 0;	if(n1->op != n2->op || n1->ty != n2->ty)		return 0;	if(n1->op == Oconst){		switch(n1->ty->kind){		case Tbig:		case Tbyte:		case Tint:			return n1->val == n2->val;		case Treal:			return n1->rval == n2->rval;		case Tfix:			return n1->val == n2->val && tequal(n1->ty, n2->ty);		case Tstring:			return n1->decl->sym == n2->decl->sym;		}		return 0;	}	return n1->decl == n2->decl && sametree(n1->left, n2->left) && sametree(n1->right, n2->right);} intoccurs(Decl *d, Node *n){	if(n == nil)		return 0;	if(n->op == Oname){		if(d == n->decl)			return 1;		return 0;	}	return occurs(d, n->left) + occurs(d, n->right);} /* * left and right subtrees the same */Node*folds(Node *n){	if(hasside(n, 1))		return n;	switch(n->op){	case Oeq:	case Oleq:	case Ogeq:		n->val = 1;		break;	case Osub:		n->val = 0;		n->rval = 0.0;		break;	case Oxor:	case Oneq:	case Olt:	case Ogt:		n->val = 0;		break;	case Oand:	case Oor:	case Oandand:	case Ooror:		return n->left;	default:		return n;	}	n->op = Oconst;	n->left = n->right = nil;	n->decl = nil;	return n;} /* * constant folding for typechecked expressions, */Node*fold(Node *n){	if(n == nil)		return nil;	if(debug['F'])		print("fold %n\n", n);	n = efold(n);	if(debug['F'])		print("folded %n\n", n);	return n;} Node*efold(Node *n){	Decl *d;	Node *left, *right; 	if(n == nil)		return nil; 	left = n->left;	right = n->right;	switch(n->op){	case Oname:		d = n->decl;		if(d->importid != nil)			d = d->importid;		if(d->store != Dconst){			if(d->store == Dtag){				n->op = Oconst;				n->ty = tint;				n->val = d->tag;			}			break;		}		switch(n->ty->kind){		case Tbig:			n->op = Oconst;			n->val = d->init->val;			break;		case Tbyte:			n->op = Oconst;			n->val = d->init->val & 0xff;			break;		case Tint:		case Tfix:			n->op = Oconst;			n->val = d->init->val;			break;		case Treal:			n->op = Oconst;			n->rval = d->init->rval;			break;		case Tstring:			n->op = Oconst;			n->decl = d->init->decl;			break;		case Ttuple:			*n = *d->init;			break;		case Tadt:			*n = *d->init;			n = rewrite(n);	/* was call */			break;		case Texception:			if(!n->ty->cons)				fatal("non-const exception type in efold");			n->op = Oconst;			break;		default:			fatal("unknown const type %T in efold", n->ty);			break;		}		break;	case Oadd:		left = efold(left);		right = efold(right);		n->left = left;		n->right = right;		if(n->ty == tstring && right->op == Oconst){			if(left->op == Oconst)				n = mksconst(&n->src, stringcat(left->decl->sym, right->decl->sym));			else if(left->op == Oadd && left->ty == tstring && left->right->op == Oconst){				left->right = mksconst(&n->src, stringcat(left->right->decl->sym, right->decl->sym));				n = left;			}		}		break;	case Olen:		left = efold(left);		n->left = left;		if(left->ty == tstring && left->op == Oconst)			n = mkconst(&n->src, utflen(left->decl->sym->name));		break;	case Oslice:		if(right->left->op == Onothing)			right->left = mkconst(&right->left->src, 0);		n->left = efold(left);		n->right = efold(right);		break;	case Oinds:		n->left = left = efold(left);		n->right = right = efold(right);		if(right->op == Oconst && left->op == Oconst){			;		}		break;	case Ocast:		n->op = Ocast;		left = efold(left);		n->left = left;		if(n->ty == left->ty || n->ty->kind == Tfix && tequal(n->ty, left->ty))			return left;		if(left->op == Oconst)			return foldcast(n, left);		break;	case Odot:	case Omdot:		/*		 * what about side effects from left?		 */		d = right->decl;		switch(d->store){		case Dconst:		case Dtag:		case Dtype:			/*			 * set it up as a name and let that case do the hard work			 */			n->op = Oname;			n->decl = d;			n->left = nil;			n->right = nil;			return efold(n);		}		n->left = efold(left);		if(n->left->op == Otuple)			n = tuplemem(n->left, d);		else			n->right = efold(right);		break;	case Otagof:		if(n->decl != nil){			n->op = Oconst;			n->left = nil;			n->right = nil;			n->val = n->decl->tag;						return efold(n);		}		n->left = efold(left);		break;	case Oif:		n->left = left = efold(left);

Lines 1–500 of 1538.