#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. Load more
#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 void addtmap(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; } void typeinit(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; } void typestart(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; } void typebuiltin(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; } void typedecled(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; } void adtdecled(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; } void fielddecled(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); } } } int pickdecled(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);