#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. Load more
#include "limbo.h" static vlong ipow(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; } double rpow(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; } Long real2fix(double v, Type *t) { v /= scale(t); v = v < 0 ? v-0.5: v+0.5; return v; } Long fix2fix(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; } double fix2real(Long v, Type *f) { return (double)v * scale(f); } int istuple(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; } int varcom(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); } int initable(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); } int sametree(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); } int occurs(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);