ref: b548687a8ed1d0a159c9d3f3f921d93bbb56908e
dir: /appl/cmd/limbo/types.b/
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
#
adtdefd(t: ref Type)
{
next, aux, store, auxhd, tagnext: ref Decl;
if(debug['x'])
print("adt %s defd\n", typeconv(t));
d := t.decl;
tagnext = nil;
store = nil;
for(id := t.polys; id != nil; id = id.next){
id.store = Dtype;
id.ty = verifytypes(id.ty, d, nil);
}
for(id = t.ids; id != nil; id = next){
if(id.store == Dtag){
if(t.tags != nil)
error(id.src.start, "only one set of pick fields allowed");
tagnext = pickdefd(t, id);
next = tagnext;
if(store != nil)
store.next = next;
else
t.ids = next;
continue;
}else{
id.dot = d;
next = id.next;
store = id;
}
}
aux = nil;
store = nil;
auxhd = nil;
seentags := 0;
for(id = t.ids; id != nil; id = next){
if(id == tagnext)
seentags = 1;
next = id.next;
id.dot = d;
id.ty = topvartype(verifytypes(id.ty, d, nil), id, 1, 1);
if(id.store == Dfield && id.ty.kind == Tfn)
id.store = Dfn;
if(id.store == Dfn || id.store == Dconst){
if(store != nil)
store.next = next;
else
t.ids = next;
if(aux != nil)
aux.next = id;
else
auxhd = id;
aux = id;
}else{
if(seentags)
error(id.src.start, "pick fields must be the last data fields in an adt");
store = id;
}
}
if(aux != nil)
aux.next = nil;
if(store != nil)
store.next = auxhd;
else
t.ids = auxhd;
for(id = t.tags; id != nil; id = id.next){
id.ty = verifytypes(id.ty, d, nil);
if(id.ty.tof == nil)
id.ty.tof = mkadtpickcon(t, id.ty);
}
}
#
# assemble the data structure for an adt with a pick clause.
# since the scoping rules for adt pick fields are strange,
# we have a customized check for overlapping definitions.
#
pickdefd(t: ref Type, tg: ref Decl): ref Decl
{
lasttg : ref Decl = nil;
d := t.decl;
t.tags = tg;
tag := 0;
while(tg != nil){
tt := tg.ty;
if(tt.kind != Tadtpick || tg.tag != tag)
break;
tt.decl = tg;
lasttg = tg;
for(; tg != nil; tg = tg.next){
if(tg.ty != tt)
break;
tag++;
lasttg = tg;
tg.dot = d;
}
for(id := tt.ids; id != nil; id = id.next){
xid := namedot(t.ids, id.sym);
if(xid != nil)
error(id.src.start, "redeclaration of "+declconv(id)+
" previously declared as "+storeconv(xid)+" on line "+lineconv(xid.src.start));
id.dot = d;
}
}
if(lasttg == nil){
error(t.src.start, "empty pick field declaration in "+typeconv(t));
t.tags = nil;
}else
lasttg.next = nil;
d.tag = tag;
return tg;
}
moddecl(ids: ref Decl, fields: ref Node): ref Node
{
n := mkn(Omoddecl, mkn(Oseq, nil, nil), nil);
t := mktype(ids.src.start, ids.src.stop, Tmodule, nil, nil);
n.decl = ids;
n.left = fields;
n.ty = t;
return n;
}
moddecled(n: ref Node)
{
d := n.decl;
installids(Dtype, d);
isimp := 0;
for(ids := d; ids != nil; ids = ids.next){
for(im := impmods; im != nil; im = im.next){
if(ids.sym == im.sym){
isimp = 1;
d = ids;
dm := ref Dlist;
dm.d = ids;
dm.next = nil;
if(impdecls == nil)
impdecls = dm;
else{
for(dl := impdecls; dl.next != nil; dl = dl.next)
;
dl.next = dm;
}
}
}
ids.ty = n.ty;
}
pushscope(nil, Sother);
fielddecled(n.left);
d.ty.ids = popscope();
#
# make the current module the . parent of all contained decls.
#
for(ids = d.ty.ids; ids != nil; ids = ids.next)
ids.dot = d;
t := d.ty;
t.decl = d;
if(debug['m'])
print("declare module %s\n", d.sym.name);
#
# add the iface declaration in case it's needed later
#
installids(Dglobal, mkids(d.src, enter(".m."+d.sym.name, 0), tnone, nil));
if(isimp){
for(ids = d.ty.ids; ids != nil; ids = ids.next){
s := ids.sym;
if(s.decl != nil && s.decl.scope >= scope){
dot := s.decl.dot;
if(s.decl.store != Dwundef && dot != nil && dot != d && isimpmod(dot.sym) && dequal(ids, s.decl, 0))
continue;
redecl(ids);
ids.old = s.decl.old;
}else
ids.old = s.decl;
s.decl = ids;
ids.scope = scope;
}
}
}
#
# for each module in id,
# link by field ext all of the decls for
# functions needed in external linkage table
# collect globals and make a tuple for all of them
#
mkiface(m: ref Decl): ref Type
{
iface := last := ref Decl;
globals := glast := mkdecl(m.src, Dglobal, mktype(m.src.start, m.src.stop, Tadt, nil, nil));
for(id := m.ty.ids; id != nil; id = id.next){
case id.store{
Dglobal =>
glast = glast.next = dupdecl(id);
id.iface = globals;
glast.iface = id;
Dfn =>
id.iface = last = last.next = dupdecl(id);
last.iface = id;
Dtype =>
if(id.ty.kind != Tadt)
break;
for(d := id.ty.ids; d != nil; d = d.next){
if(d.store == Dfn){
d.iface = last = last.next = dupdecl(d);
last.iface = d;
}
}
}
}
last.next = nil;
iface = namesort(iface.next);
if(globals.next != nil){
glast.next = nil;
globals.ty.ids = namesort(globals.next);
globals.ty.decl = globals;
globals.sym = enter(".mp", 0);
globals.dot = m;
globals.next = iface;
iface = globals;
}
#
# make the interface type and install an identifier for it
# the iface has a ref count if it is loaded
#
t := mktype(m.src.start, m.src.stop, Tiface, nil, iface);
id = enter(".m."+m.sym.name, 0).decl;
t.decl = id;
id.ty = t;
#
# dummy node so the interface is initialized
#
id.init = mkn(Onothing, nil, nil);
id.init.ty = t;
id.init.decl = id;
return t;
}
joiniface(mt, t: ref Type)
{
iface := t.ids;
globals := iface;
if(iface != nil && iface.store == Dglobal)
iface = iface.next;
for(id := mt.tof.ids; id != nil; id = id.next){
case id.store{
Dglobal =>
for(d := id.ty.ids; d != nil; d = d.next)
d.iface.iface = globals;
Dfn =>
id.iface.iface = iface;
iface = iface.next;
* =>
fatal("unknown store "+storeconv(id)+" in joiniface");
}
}
if(iface != nil)
fatal("join iface not matched");
mt.tof = t;
}
addiface(m: ref Decl, d: ref Decl)
{
t: ref Type;
id, last, dd, lastorig: ref Decl;
if(d == nil || !local(d))
return;
modrefable(d.ty);
if(m == nil){
if(impdecls.next != nil)
for(dl := impdecls; dl != nil; dl = dl.next)
if(dl.d.ty.tof != impdecl.ty.tof) # impdecl last
addiface(dl.d, d);
addiface(impdecl, d);
return;
}
t = m.ty.tof;
last = nil;
lastorig = nil;
for(id = t.ids; id != nil; id = id.next){
if(d == id || d == id.iface)
return;
last = id;
if(id.tag == 0)
lastorig = id;
}
dd = dupdecl(d);
if(d.dot == nil)
d.dot = dd.dot = m;
d.iface = dd;
dd.iface = d;
if(last == nil)
t.ids = dd;
else
last.next = dd;
dd.tag = 1; # mark so not signed
if(lastorig == nil)
t.ids = namesort(t.ids);
else
lastorig.next = namesort(lastorig.next);
}
#
# eliminate unused declarations from interfaces
# label offset within interface
#
narrowmods()
{
id: ref Decl;
for(eq := modclass(); eq != nil; eq = eq.eq){
t := eq.ty.tof;
if(t.linkall == byte 0){
last : ref Decl = nil;
for(id = t.ids; id != nil; id = id.next){
if(id.refs == 0){
if(last == nil)
t.ids = id.next;
else
last.next = id.next;
}else
last = id;
}
#
# need to resize smaller interfaces
#
resizetype(t);
}
offset := 0;
for(id = t.ids; id != nil; id = id.next)
id.offset = offset++;
#
# rathole to stuff number of entries in interface
#
t.decl.init.c = ref Const;
t.decl.init.c.val = big offset;
}
}
#
# check to see if any data field of module m if referenced.
# if so, mark all data in m
#
moddataref()
{
for(eq := modclass(); eq != nil; eq = eq.eq){
id := eq.ty.tof.ids;
if(id != nil && id.store == Dglobal && id.refs)
for(id = eq.ty.ids; id != nil; id = id.next)
if(id.store == Dglobal)
modrefable(id.ty);
}
}
#
# move the global declarations in interface to the front
#
modglobals(mod, globals: ref Decl): ref Decl
{
#
# make a copy of all the global declarations
# used for making a type descriptor for globals ONLY
# note we now have two declarations for the same variables,
# which is apt to cause problems if code changes
#
# here we fix up the offsets for the real declarations
#
idoffsets(mod.ty.ids, 0, 1);
last := head := ref Decl;
for(id := mod.ty.ids; id != nil; id = id.next)
if(id.store == Dglobal)
last = last.next = dupdecl(id);
last.next = globals;
return head.next;
}
#
# snap all id type names to the actual type
# check that all types are completely defined
# verify that the types look ok
#
validtype(t: ref Type, inadt: ref Decl): ref Type
{
if(t == nil)
return t;
bindtypes(t);
t = verifytypes(t, inadt, nil);
cycsizetype(t);
teqclass(t);
return t;
}
usetype(t: ref Type): ref Type
{
if(t == nil)
return t;
t = validtype(t, nil);
reftype(t);
return t;
}
internaltype(t: ref Type): ref Type
{
bindtypes(t);
t.ok = OKverify;
sizetype(t);
t.ok = OKmask;
return t;
}
#
# checks that t is a valid top-level type
#
topvartype(t: ref Type, id: ref Decl, tyok: int, polyok: int): ref Type
{
if(t.kind == Tadt && t.tags != nil || t.kind == Tadtpick)
error(id.src.start, "cannot declare "+id.sym.name+" with type "+typeconv(t));
if(!tyok && t.kind == Tfn)
error(id.src.start, "cannot declare "+id.sym.name+" to be a function");
if(!polyok && (t.kind == Tadt || t.kind == Tadtpick) && ispolyadt(t))
error(id.src.start, "cannot declare " + id.sym.name + " of a polymorphic type");
return t;
}
toptype(src: Src, t: ref Type): ref Type
{
if(t.kind == Tadt && t.tags != nil || t.kind == Tadtpick)
error(src.start, typeconv(t)+", an adt with pick fields, must be used with ref");
if(t.kind == Tfn)
error(src.start, "data cannot have a fn type like "+typeconv(t));
return t;
}
comtype(src: Src, t: ref Type, adtd: ref Decl): ref Type
{
if(adtd == nil && (t.kind == Tadt || t.kind == Tadtpick) && ispolyadt(t))
error(src.start, "polymorphic type " + typeconv(t) + " illegal here");
return t;
}
usedty(t: ref Type)
{
if(t != nil && (t.ok | OKmodref) != OKmask)
fatal("used ty " + stypeconv(t) + " " + hex(int t.ok, 2));
}
bindtypes(t: ref Type)
{
id: ref Decl;
if(t == nil)
return;
if((t.ok & OKbind) == OKbind)
return;
t.ok |= OKbind;
case t.kind{
Tadt =>
if(t.polys != nil){
pushscope(nil, Sother);
installids(Dtype, t.polys);
}
if(t.val != nil)
mergepolydecs(t);
if(t.polys != nil){
popscope();
for(id = t.polys; id != nil; id = id.next)
bindtypes(id.ty);
}
Tadtpick or
Tmodule or
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tiface or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Texcept or
Tfix or
Tpoly =>
break;
Tarray or
Tarrow or
Tchan or
Tdot or
Tlist or
Tref =>
bindtypes(t.tof);
Tid =>
id = t.decl.sym.decl;
if(id == nil)
id = undefed(t.src, t.decl.sym);
# save a little space
id.sym.unbound = nil;
t.decl = id;
Ttuple or
Texception =>
for(id = t.ids; id != nil; id = id.next)
bindtypes(id.ty);
Tfn =>
if(t.polys != nil){
pushscope(nil, Sother);
installids(Dtype, t.polys);
}
for(id = t.ids; id != nil; id = id.next)
bindtypes(id.ty);
bindtypes(t.tof);
if(t.val != nil)
mergepolydecs(t);
if(t.polys != nil){
popscope();
for(id = t.polys; id != nil; id = id.next)
bindtypes(id.ty);
}
Tinst =>
bindtypes(t.tof);
for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
bindtypes(tyl.t);
* =>
fatal("bindtypes: unknown type kind "+string t.kind);
}
}
#
# walk the type checking for validity
#
verifytypes(t: ref Type, adtt: ref Decl, poly: ref Decl): ref Type
{
id: ref Decl;
if(t == nil)
return nil;
if((t.ok & OKverify) == OKverify)
return t;
t.ok |= OKverify;
if((t.ok & (OKverify|OKbind)) != (OKverify|OKbind))
fatal("verifytypes bogus ok for " + stypeconv(t));
cyc := t.flags&CYCLIC;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tiface or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Texcept =>
break;
Tfix =>
n := t.val;
ok: int;
max := 0.0;
if(n.op == Oseq){
(ok, nil) = echeck(n.left, 0, 0, n);
(ok1, nil) := echeck(n.right, 0, 0, n);
if(!ok || !ok1)
return terror;
if(n.left.ty != treal || n.right.ty != treal){
error(t.src.start, "fixed point scale/maximum not real");
return terror;
}
n.right = fold(n.right);
if(n.right.op != Oconst){
error(t.src.start, "fixed point maximum not constant");
return terror;
}
if((max = n.right.c.rval) <= 0.0){
error(t.src.start, "non-positive fixed point maximum");
return terror;
}
n = n.left;
}
else{
(ok, nil) = echeck(n, 0, 0, nil);
if(!ok)
return terror;
if(n.ty != treal){
error(t.src.start, "fixed point scale not real");
return terror;
}
}
n = t.val = fold(n);
if(n.op != Oconst){
error(t.src.start, "fixed point scale not constant");
return terror;
}
if(n.c.rval <= 0.0){
error(t.src.start, "non-positive fixed point scale");
return terror;
}
ckfix(t, max);
Tref =>
t.tof = comtype(t.src, verifytypes(t.tof, adtt, nil), adtt);
if(t.tof != nil && !tattr[t.tof.kind].refable){
error(t.src.start, "cannot have a ref " + typeconv(t.tof));
return terror;
}
if(0 && t.tof.kind == Tfn && t.tof.ids != nil && int t.tof.ids.implicit)
error(t.src.start, "function references cannot have a self argument");
if(0 && t.tof.kind == Tfn && t.polys != nil)
error(t.src.start, "function references cannot be polymorphic");
Tchan or
Tarray or
Tlist =>
t.tof = comtype(t.src, toptype(t.src, verifytypes(t.tof, adtt, nil)), adtt);
Tid =>
t.ok &= ~OKverify;
t = verifytypes(idtype(t), adtt, nil);
Tarrow =>
t.ok &= ~OKverify;
t = verifytypes(arrowtype(t, adtt), adtt, nil);
Tdot =>
#
# verify the parent adt & lookup the tag fields
#
t.ok &= ~OKverify;
t = verifytypes(dottype(t, adtt), adtt, nil);
Tadt =>
#
# this is where Tadt may get tag fields added
#
adtdefd(t);
Tadtpick =>
for(id = t.ids; id != nil; id = id.next){
id.ty = topvartype(verifytypes(id.ty, id.dot, nil), id, 0, 1);
if(id.store == Dconst)
error(t.src.start, "cannot declare a con like "+id.sym.name+" within a pick");
}
verifytypes(t.decl.dot.ty, nil, nil);
Tmodule =>
for(id = t.ids; id != nil; id = id.next){
id.ty = verifytypes(id.ty, nil, nil);
if(id.store == Dglobal && id.ty.kind == Tfn)
id.store = Dfn;
if(id.store != Dtype && id.store != Dfn)
topvartype(id.ty, id, 0, 0);
}
Ttuple or
Texception =>
if(t.decl == nil){
t.decl = mkdecl(t.src, Dtype, t);
t.decl.sym = anontupsym;
}
i := 0;
for(id = t.ids; id != nil; id = id.next){
id.store = Dfield;
if(id.sym == nil)
id.sym = enter("t"+string i, 0);
i++;
id.ty = toptype(id.src, verifytypes(id.ty, adtt, nil));
}
Tfn =>
last : ref Decl = nil;
for(id = t.ids; id != nil; id = id.next){
id.store = Darg;
id.ty = topvartype(verifytypes(id.ty, adtt, nil), id, 0, 1);
if(id.implicit != byte 0){
if(poly != nil)
selfd := poly;
else
selfd = adtt;
if(selfd == nil)
error(t.src.start, "function is not a member of an adt, so can't use self");
else if(id != t.ids)
error(id.src.start, "only the first argument can use self");
else if(id.ty != selfd.ty && (id.ty.kind != Tref || id.ty.tof != selfd.ty))
error(id.src.start, "self argument's type must be "+selfd.sym.name+" or ref "+selfd.sym.name);
}
last = id;
}
for(id = t.polys; id != nil; id = id.next){
if(adtt != nil){
for(id1 := adtt.ty.polys; id1 != nil; id1 = id1.next){
if(id1.sym == id.sym)
id.ty = id1.ty;
}
}
id.store = Dtype;
id.ty = verifytypes(id.ty, adtt, nil);
}
t.tof = comtype(t.src, toptype(t.src, verifytypes(t.tof, adtt, nil)), adtt);
if(t.varargs != byte 0 && (last == nil || last.ty != tstring))
error(t.src.start, "variable arguments must be preceded by a string");
if(t.varargs != byte 0 && t.polys != nil)
error(t.src.start, "polymorphic functions must not have variable arguments");
Tpoly =>
for(id = t.ids; id != nil; id = id.next){
id.store = Dfn;
id.ty = verifytypes(id.ty, adtt, t.decl);
}
Tinst =>
t.ok &= ~OKverify;
t.tof = verifytypes(t.tof, adtt, nil);
for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
tyl.t = verifytypes(tyl.t, adtt, nil);
(t, nil) = insttype(t, adtt, nil);
t = verifytypes(t, adtt, nil);
* =>
fatal("verifytypes: unknown type kind "+string t.kind);
}
if(int cyc)
t.flags |= CYCLIC;
return t;
}
#
# resolve an id type
#
idtype(t: ref Type): ref Type
{
id := t.decl;
if(id.store == Dunbound)
fatal("idtype: unbound decl");
tt := id.ty;
if(id.store != Dtype && id.store != Dtag){
if(id.store == Dundef){
id.store = Dwundef;
error(t.src.start, id.sym.name+" is not declared");
}else if(id.store == Dimport){
id.store = Dwundef;
error(t.src.start, id.sym.name+"'s type cannot be determined");
}else if(id.store != Dwundef)
error(t.src.start, id.sym.name+" is not a type");
return terror;
}
if(tt == nil){
error(t.src.start, stypeconv(t)+" not fully defined");
return terror;
}
return tt;
}
#
# resolve a -> qualified type
#
arrowtype(t: ref Type, adtt: ref Decl): ref Type
{
id := t.decl;
if(id.ty != nil){
if(id.store == Dunbound)
fatal("arrowtype: unbound decl has a type");
return id.ty;
}
#
# special hack to allow module variables to derive other types
#
tt := t.tof;
if(tt.kind == Tid){
id = tt.decl;
if(id.store == Dunbound)
fatal("arrowtype: Tid's decl unbound");
if(id.store == Dimport){
id.store = Dwundef;
error(t.src.start, id.sym.name+"'s type cannot be determined");
return terror;
}
#
# forward references to module variables can't be resolved
#
if(id.store != Dtype && (id.ty.ok & OKbind) != OKbind){
error(t.src.start, id.sym.name+"'s type cannot be determined");
return terror;
}
if(id.store == Dwundef)
return terror;
tt = id.ty = verifytypes(id.ty, adtt, nil);
if(tt == nil){
error(t.tof.src.start, typeconv(t.tof)+" is not a module");
return terror;
}
}else
tt = verifytypes(t.tof, adtt, nil);
t.tof = tt;
if(tt == terror)
return terror;
if(tt.kind != Tmodule){
error(t.src.start, typeconv(tt)+" is not a module");
return terror;
}
id = namedot(tt.ids, t.decl.sym);
if(id == nil){
error(t.src.start, t.decl.sym.name+" is not a member of "+typeconv(tt));
return terror;
}
if(id.store == Dtype && id.ty != nil){
t.decl = id;
return id.ty;
}
error(t.src.start, typeconv(t)+" is not a type");
return terror;
}
#
# resolve a . qualified type
#
dottype(t: ref Type, adtt: ref Decl): ref Type
{
if(t.decl.ty != nil){
if(t.decl.store == Dunbound)
fatal("dottype: unbound decl has a type");
return t.decl.ty;
}
t.tof = tt := verifytypes(t.tof, adtt, nil);
if(tt == terror)
return terror;
if(tt.kind != Tadt){
error(t.src.start, typeconv(tt)+" is not an adt");
return terror;
}
id := namedot(tt.tags, t.decl.sym);
if(id != nil && id.ty != nil){
t.decl = id;
return id.ty;
}
error(t.src.start, t.decl.sym.name+" is not a pick tag of "+typeconv(tt));
return terror;
}
insttype(t: ref Type, adtt: ref Decl, tp: ref Tpair): (ref Type, ref Tpair)
{
src := t.src;
if(t.tof.kind != Tadt && t.tof.kind != Tadtpick){
error(src.start, typeconv(t.tof) + " is not an adt");
return (terror, nil);
}
if(t.tof.kind == Tadt)
ids := t.tof.polys;
else
ids = t.tof.decl.dot.ty.polys;
if(ids == nil){
error(src.start, typeconv(t.tof) + " is not a polymorphic adt");
return (terror, nil);
}
for(tyl := t.tlist; tyl != nil && ids != nil; tyl = tyl.nxt){
tt := tyl.t;
if(!tattr[tt.kind].isptr){
error(src.start, typeconv(tt) + " is not a pointer type");
return (terror, nil);
}
unifysrc = src;
(ok, nil) := tunify(ids.ty, tt);
if(!ok){
error(src.start, "type " + typeconv(tt) + " does not match " + typeconv(ids.ty));
return (terror, nil);
}
# usetype(tt);
tt = verifytypes(tt, adtt, nil);
tp = addtmap(ids.ty, tt, tp);
ids = ids.next;
}
if(tyl != nil){
error(src.start, "too many actual types in instantiation");
return (terror, nil);
}
if(ids != nil){
error(src.start, "too few actual types in instantiation");
return (terror, nil);
}
tt := t.tof;
(t, nil) = expandtype(tt, t, adtt, tp);
if(t == tt && adtt == nil)
t = duptype(t);
if(t != tt)
t.tmap = tp;
t.src = src;
return (t, tp);
}
#
# walk a type, putting all adts, modules, and tuples into equivalence classes
#
teqclass(t: ref Type)
{
id: ref Decl;
if(t == nil || (t.ok & OKclass) == OKclass)
return;
t.ok |= OKclass;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tiface or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Texcept or
Tfix or
Tpoly =>
return;
Tref =>
teqclass(t.tof);
return;
Tchan or
Tarray or
Tlist =>
teqclass(t.tof);
#ZZZ elim return to fix recursive chans, etc
if(!debug['Z'])
return;
Tadt or
Tadtpick or
Ttuple or
Texception =>
for(id = t.ids; id != nil; id = id.next)
teqclass(id.ty);
for(tg := t.tags; tg != nil; tg = tg.next)
teqclass(tg.ty);
for(id = t.polys; id != nil; id = id.next)
teqclass(id.ty);
Tmodule =>
t.tof = mkiface(t.decl);
for(id = t.ids; id != nil; id = id.next)
teqclass(id.ty);
Tfn =>
for(id = t.ids; id != nil; id = id.next)
teqclass(id.ty);
for(id = t.polys; id != nil; id = id.next)
teqclass(id.ty);
teqclass(t.tof);
return;
* =>
fatal("teqclass: unknown type kind "+string t.kind);
}
#
# find an equivalent type
# stupid linear lookup could be made faster
#
if((t.ok & OKsized) != OKsized)
fatal("eqclass type not sized: " + stypeconv(t));
for(teq := eqclass[t.kind]; teq != nil; teq = teq.eq){
if(t.size == teq.ty.size && tequal(t, teq.ty)){
t.eq = teq;
if(t.kind == Tmodule)
joiniface(t, t.eq.ty.tof);
return;
}
}
#
# if no equiv type, make one
#
eqclass[t.kind] = t.eq = ref Teq(0, t, eqclass[t.kind]);
}
#
# record that we've used the type
# using a type uses all types reachable from that type
#
reftype(t: ref Type)
{
id: ref Decl;
if(t == nil || (t.ok & OKref) == OKref)
return;
t.ok |= OKref;
if(t.decl != nil && t.decl.refs == 0)
t.decl.refs++;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tiface or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Texcept or
Tfix or
Tpoly =>
break;
Tref or
Tchan or
Tarray or
Tlist =>
if(t.decl != nil){
if(nadts >= len adts){
a := array[nadts + 32] of ref Decl;
a[0:] = adts;
adts = a;
}
adts[nadts++] = t.decl;
}
reftype(t.tof);
Tadt or
Tadtpick or
Ttuple or
Texception =>
if(t.kind == Tadt || t.kind == Ttuple && t.decl.sym != anontupsym){
if(nadts >= len adts){
a := array[nadts + 32] of ref Decl;
a[0:] = adts;
adts = a;
}
adts[nadts++] = t.decl;
}
for(id = t.ids; id != nil; id = id.next)
if(id.store != Dfn)
reftype(id.ty);
for(tg := t.tags; tg != nil; tg = tg.next)
reftype(tg.ty);
for(id = t.polys; id != nil; id = id.next)
reftype(id.ty);
if(t.kind == Tadtpick)
reftype(t.decl.dot.ty);
Tmodule =>
#
# a module's elements should get used individually
# but do the globals for any sbl file
#
if(bsym != nil)
for(id = t.ids; id != nil; id = id.next)
if(id.store == Dglobal)
reftype(id.ty);
break;
Tfn =>
for(id = t.ids; id != nil; id = id.next)
reftype(id.ty);
for(id = t.polys; id != nil; id = id.next)
reftype(id.ty);
reftype(t.tof);
* =>
fatal("reftype: unknown type kind "+string t.kind);
}
}
#
# check all reachable types for cycles and illegal forward references
# find the size of all the types
#
cycsizetype(t: ref Type)
{
id: ref Decl;
if(t == nil || (t.ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
return;
t.ok |= OKcycsize;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tiface or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Texcept or
Tfix or
Tpoly =>
t.ok |= OKcyc;
sizetype(t);
Tref or
Tchan or
Tarray or
Tlist =>
cyctype(t);
sizetype(t);
cycsizetype(t.tof);
Tadt or
Ttuple or
Texception =>
cyctype(t);
sizetype(t);
for(id = t.ids; id != nil; id = id.next)
cycsizetype(id.ty);
for(tg := t.tags; tg != nil; tg = tg.next){
if((tg.ty.ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
continue;
tg.ty.ok |= (OKcycsize|OKcyc|OKsized);
for(id = tg.ty.ids; id != nil; id = id.next)
cycsizetype(id.ty);
}
for(id = t.polys; id != nil; id = id.next)
cycsizetype(id.ty);
Tadtpick =>
t.ok &= ~OKcycsize;
cycsizetype(t.decl.dot.ty);
Tmodule =>
cyctype(t);
sizetype(t);
for(id = t.ids; id != nil; id = id.next)
cycsizetype(id.ty);
sizeids(t.ids, 0);
Tfn =>
cyctype(t);
sizetype(t);
for(id = t.ids; id != nil; id = id.next)
cycsizetype(id.ty);
for(id = t.polys; id != nil; id = id.next)
cycsizetype(id.ty);
cycsizetype(t.tof);
sizeids(t.ids, MaxTemp);
#ZZZ need to align?
* =>
fatal("cycsizetype: unknown type kind "+string t.kind);
}
}
# check for circularity in type declarations
# - has to be called before verifytypes
#
tcycle(t: ref Type)
{
id: ref Decl;
tt: ref Type;
tll: ref Typelist;
if(t == nil)
return;
case(t.kind){
* =>
;
Tchan or
Tarray or
Tref or
Tlist or
Tdot =>
tcycle(t.tof);
Tfn or
Ttuple =>
tcycle(t.tof);
for(id = t.ids; id != nil; id = id.next)
tcycle(id.ty);
Tarrow =>
if(int(t.rec&TRvis)){
error(t.src.start, "circularity in definition of " + typeconv(t));
*t = *terror; # break the cycle
return;
}
tt = t.tof;
t.rec |= TRvis;
tcycle(tt);
if(tt.kind == Tid)
tt = tt.decl.ty;
id = namedot(tt.ids, t.decl.sym);
if(id != nil)
tcycle(id.ty);
t.rec &= ~TRvis;
Tid =>
if(int(t.rec&TRvis)){
error(t.src.start, "circularity in definition of " + typeconv(t));
*t = *terror; # break the cycle
return;
}
t.rec |= TRvis;
tcycle(t.decl.ty);
t.rec &= ~TRvis;
Tinst =>
tcycle(t.tof);
for(tll = t.tlist; tll != nil; tll = tll.nxt)
tcycle(tll.t);
}
}
#
# marks for checking for arcs
#
ArcValue,
ArcList,
ArcArray,
ArcRef,
ArcCyc, # cycle found
ArcPolycyc:
con 1 << iota;
cyctype(t: ref Type)
{
if((t.ok & OKcyc) == OKcyc)
return;
t.ok |= OKcyc;
t.rec |= TRcyc;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tfn or
Tchan or
Tarray or
Tref or
Tlist or
Tfix or
Tpoly =>
break;
Tadt or
Tmodule or
Ttuple or
Texception =>
for(id := t.ids; id != nil; id = id.next)
cycfield(t, id);
for(tg := t.tags; tg != nil; tg = tg.next){
if((tg.ty.ok & OKcyc) == OKcyc)
continue;
tg.ty.ok |= OKcyc;
for(id = tg.ty.ids; id != nil; id = id.next)
cycfield(t, id);
}
* =>
fatal("cyctype: unknown type kind "+string t.kind);
}
t.rec &= ~TRcyc;
}
cycfield(base: ref Type, id: ref Decl)
{
if(!storespace[id.store])
return;
arc := cycarc(base, id.ty);
if((arc & (ArcCyc|ArcValue)) == (ArcCyc|ArcValue)){
if(id.cycerr == byte 0)
error(base.src.start, "illegal type cycle without a reference in field "
+id.sym.name+" of "+stypeconv(base));
id.cycerr = byte 1;
}else if(arc & ArcCyc){
if((arc & ArcArray) && oldcycles && id.cyc == byte 0 && !(arc & ArcPolycyc)){
if(id.cycerr == byte 0)
error(base.src.start, "illegal circular reference to type "+typeconv(id.ty)
+" in field "+id.sym.name+" of "+stypeconv(base));
id.cycerr = byte 1;
}
id.cycle = byte 1;
}else if(id.cyc != byte 0){
if(id.cycerr == byte 0)
error(id.src.start, "spurious cyclic qualifier for field "+id.sym.name+" of "+stypeconv(base));
id.cycerr = byte 1;
}
}
cycarc(base, t: ref Type): int
{
if(t == nil)
return 0;
if((t.rec & TRcyc) == TRcyc){
if(tequal(t, base)){
if(t.kind == Tmodule)
return ArcCyc | ArcRef;
else
return ArcCyc | ArcValue;
}
return 0;
}
t.rec |= TRcyc;
me := 0;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tchan or
Tfn or
Tfix or
Tpoly =>
break;
Tarray =>
me = cycarc(base, t.tof) & ~ArcValue | ArcArray;
Tref =>
me = cycarc(base, t.tof) & ~ArcValue | ArcRef;
Tlist =>
me = cycarc(base, t.tof) & ~ArcValue | ArcList;
Tadt or
Tadtpick or
Tmodule or
Ttuple or
Texception =>
me = 0;
arc: int;
for(id := t.ids; id != nil; id = id.next){
if(!storespace[id.store])
continue;
arc = cycarc(base, id.ty);
if((arc & ArcCyc) && id.cycerr == byte 0)
me |= arc;
}
for(tg := t.tags; tg != nil; tg = tg.next){
arc = cycarc(base, tg.ty);
if((arc & ArcCyc) && tg.cycerr == byte 0)
me |= arc;
}
if(t.kind == Tmodule)
me = me & ArcCyc | ArcRef | ArcPolycyc;
else
me &= ArcCyc | ArcValue | ArcPolycyc;
* =>
fatal("cycarc: unknown type kind "+string t.kind);
}
t.rec &= ~TRcyc;
if(int (t.flags&CYCLIC))
me |= ArcPolycyc;
return me;
}
#
# set the sizes and field offsets for t
# look only as deeply as needed to size this type.
# cycsize type will clean up the rest.
#
sizetype(t: ref Type)
{
id: ref Decl;
sz, al, s, a: int;
if(t == nil)
return;
if((t.ok & OKsized) == OKsized)
return;
t.ok |= OKsized;
if((t.ok & (OKverify|OKsized)) != (OKverify|OKsized))
fatal("sizetype bogus ok for " + stypeconv(t));
case t.kind{
* =>
fatal("sizetype: unknown type kind "+string t.kind);
Terror or
Tnone or
Tbyte or
Tint or
Tbig or
Tstring or
Tany or
Treal =>
fatal(typeconv(t)+" should have a size");
Tref or
Tchan or
Tarray or
Tlist or
Tmodule or
Tfix or
Tpoly =>
t.size = t.align = IBY2WD;
Tadt or
Ttuple or
Texception =>
if(t.tags == nil){
#ZZZ
if(!debug['z']){
(sz, t.align) = sizeids(t.ids, 0);
t.size = align(sz, t.align);
}else{
(sz, nil) = sizeids(t.ids, 0);
t.align = IBY2LG;
t.size = align(sz, IBY2LG);
}
return;
}
#ZZZ
if(!debug['z']){
(sz, al) = sizeids(t.ids, IBY2WD);
if(al < IBY2WD)
al = IBY2WD;
}else{
(sz, nil) = sizeids(t.ids, IBY2WD);
al = IBY2LG;
}
for(tg := t.tags; tg != nil; tg = tg.next){
if((tg.ty.ok & OKsized) == OKsized)
continue;
tg.ty.ok |= OKsized;
#ZZZ
if(!debug['z']){
(s, a) = sizeids(tg.ty.ids, sz);
if(a < al)
a = al;
tg.ty.size = align(s, a);
tg.ty.align = a;
}else{
(s, nil) = sizeids(tg.ty.ids, sz);
tg.ty.size = align(s, IBY2LG);
tg.ty.align = IBY2LG;
}
}
Tfn =>
t.size = 0;
t.align = 1;
Tainit =>
t.size = 0;
t.align = 1;
Talt =>
t.size = t.cse.nlab * 2*IBY2WD + 2*IBY2WD;
t.align = IBY2WD;
Tcase or
Tcasec =>
t.size = t.cse.nlab * 3*IBY2WD + 2*IBY2WD;
t.align = IBY2WD;
Tcasel =>
t.size = t.cse.nlab * 6*IBY2WD + 3*IBY2WD;
t.align = IBY2LG;
Tgoto =>
t.size = t.cse.nlab * IBY2WD + IBY2WD;
if(t.cse.iwild != nil)
t.size += IBY2WD;
t.align = IBY2WD;
Tiface =>
sz = IBY2WD;
for(id = t.ids; id != nil; id = id.next){
sz = align(sz, IBY2WD) + IBY2WD;
sz += len array of byte id.sym.name + 1;
if(id.dot.ty.kind == Tadt)
sz += len array of byte id.dot.sym.name + 1;
}
t.size = sz;
t.align = IBY2WD;
Texcept =>
t.size = 0;
t.align = IBY2WD;
}
}
sizeids(id: ref Decl, off: int): (int, int)
{
al := 1;
for(; id != nil; id = id.next){
if(storespace[id.store]){
sizetype(id.ty);
#
# alignment can be 0 if we have
# illegal forward declarations.
# just patch a; other code will flag an error
#
a := id.ty.align;
if(a == 0)
a = 1;
if(a > al)
al = a;
off = align(off, a);
id.offset = off;
off += id.ty.size;
}
}
return (off, al);
}
align(off, align: int): int
{
if(align == 0)
fatal("align 0");
while(off % align)
off++;
return off;
}
#
# recalculate a type's size
#
resizetype(t: ref Type)
{
if((t.ok & OKsized) == OKsized){
t.ok &= ~OKsized;
cycsizetype(t);
}
}
#
# check if a module is accessable from t
# if so, mark that module interface
#
modrefable(t: ref Type)
{
id: ref Decl;
if(t == nil || (t.ok & OKmodref) == OKmodref)
return;
if((t.ok & OKverify) != OKverify)
fatal("modrefable unused type "+stypeconv(t));
t.ok |= OKmodref;
case t.kind{
Terror or
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tnone or
Tany or
Tfix or
Tpoly =>
break;
Tchan or
Tref or
Tarray or
Tlist =>
modrefable(t.tof);
Tmodule =>
t.tof.linkall = byte 1;
t.decl.refs++;
for(id = t.ids; id != nil; id = id.next){
case id.store{
Dglobal or
Dfn =>
modrefable(id.ty);
Dtype =>
if(id.ty.kind != Tadt)
break;
for(m := id.ty.ids; m != nil; m = m.next)
if(m.store == Dfn)
modrefable(m.ty);
}
}
Tfn or
Tadt or
Ttuple or
Texception =>
for(id = t.ids; id != nil; id = id.next)
if(id.store != Dfn)
modrefable(id.ty);
for(tg := t.tags; tg != nil; tg = tg.next){
# if((tg.ty.ok & OKmodref) == OKmodref)
# continue;
tg.ty.ok |= OKmodref;
for(id = tg.ty.ids; id != nil; id = id.next)
modrefable(id.ty);
}
for(id = t.polys; id != nil; id = id.next)
modrefable(id.ty);
modrefable(t.tof);
Tadtpick =>
modrefable(t.decl.dot.ty);
* =>
fatal("modrefable: unknown type kind "+string t.kind);
}
}
gendesc(d: ref Decl, size: int, decls: ref Decl): ref Desc
{
if(debug['D'])
print("generate desc for %s\n", dotconv(d));
if(ispoly(d))
addfnptrs(d, 0);
desc := usedesc(mkdesc(size, decls));
return desc;
}
mkdesc(size: int, d: ref Decl): ref Desc
{
pmap := array[(size+8*IBY2WD-1) / (8*IBY2WD)] of { * => byte 0 };
n := descmap(d, pmap, 0);
if(n >= 0)
n = n / (8*IBY2WD) + 1;
else
n = 0;
return enterdesc(pmap, size, n);
}
mktdesc(t: ref Type): ref Desc
{
usedty(t);
if(debug['D'])
print("generate desc for %s\n", typeconv(t));
if(t.decl == nil){
t.decl = mkdecl(t.src, Dtype, t);
t.decl.sym = enter("_mktdesc_", 0);
}
if(t.decl.desc != nil)
return t.decl.desc;
pmap := array[(t.size+8*IBY2WD-1) / (8*IBY2WD)] of {* => byte 0};
n := tdescmap(t, pmap, 0);
if(n >= 0)
n = n / (8*IBY2WD) + 1;
else
n = 0;
d := enterdesc(pmap, t.size, n);
t.decl.desc = d;
return d;
}
enterdesc(map: array of byte, size, nmap: int): ref Desc
{
last : ref Desc = nil;
for(d := descriptors; d != nil; d = d.next){
if(d.size > size || d.size == size && d.nmap > nmap)
break;
if(d.size == size && d.nmap == nmap){
c := mapcmp(d.map, map, nmap);
if(c == 0)
return d;
if(c > 0)
break;
}
last = d;
}
d = ref Desc(-1, 0, map, size, nmap, nil);
if(last == nil){
d.next = descriptors;
descriptors = d;
}else{
d.next = last.next;
last.next = d;
}
return d;
}
mapcmp(a, b: array of byte, n: int): int
{
for(i := 0; i < n; i++)
if(a[i] != b[i])
return int a[i] - int b[i];
return 0;
}
usedesc(d: ref Desc): ref Desc
{
d.used = 1;
return d;
}
#
# create the pointer description byte map for every type in decls
# each bit corresponds to a word, and is 1 if occupied by a pointer
# the high bit in the byte maps the first word
#
descmap(decls: ref Decl, map: array of byte, start: int): int
{
if(debug['D'])
print("descmap offset %d\n", start);
last := -1;
for(d := decls; d != nil; d = d.next){
if(d.store == Dtype && d.ty.kind == Tmodule
|| d.store == Dfn
|| d.store == Dconst)
continue;
if(d.store == Dlocal && d.link != nil)
continue;
m := tdescmap(d.ty, map, d.offset + start);
if(debug['D']){
if(d.sym != nil)
print("descmap %s type %s offset %d returns %d\n", d.sym.name, typeconv(d.ty), d.offset+start, m);
else
print("descmap type %s offset %d returns %d\n", typeconv(d.ty), d.offset+start, m);
}
if(m >= 0)
last = m;
}
return last;
}
tdescmap(t: ref Type, map: array of byte, offset: int): int
{
i, e, bit: int;
if(t == nil)
return -1;
m := -1;
if(t.kind == Talt){
lab := t.cse.labs;
e = t.cse.nlab;
offset += IBY2WD * 2;
for(i = 0; i < e; i++){
if(lab[i].isptr){
bit = offset / IBY2WD % 8;
map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
m = offset;
}
offset += 2*IBY2WD;
}
return m;
}
if(t.kind == Tcasec){
e = t.cse.nlab;
offset += IBY2WD;
for(i = 0; i < e; i++){
bit = offset / IBY2WD % 8;
map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
offset += IBY2WD;
bit = offset / IBY2WD % 8;
map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
m = offset;
offset += 2*IBY2WD;
}
return m;
}
if(tattr[t.kind].isptr){
bit = offset / IBY2WD % 8;
map[offset / (8*IBY2WD)] |= byte 1 << (7 - bit);
return offset;
}
if(t.kind == Tadtpick)
t = t.tof;
if(t.kind == Ttuple || t.kind == Tadt || t.kind == Texception){
if(debug['D'])
print("descmap adt offset %d\n", offset);
if(t.rec != byte 0)
fatal("illegal cyclic type "+stypeconv(t)+" in tdescmap");
t.rec = byte 1;
offset = descmap(t.ids, map, offset);
t.rec = byte 0;
return offset;
}
return -1;
}
tcomset: int;
#
# can a t2 be assigned to a t1?
# any means Tany matches all types,
# not just references
#
tcompat(t1, t2: ref Type, any: int): int
{
if(t1 == t2)
return 1;
if(t1 == nil || t2 == nil)
return 0;
if(t2.kind == Texception && t1.kind != Texception)
t2 = mkextuptype(t2);
tcomset = 0;
ok := rtcompat(t1, t2, any, 0);
v := cleartcomrec(t1) + cleartcomrec(t2);
if(v != tcomset)
fatal("recid t1 "+stypeconv(t1)+" and t2 "+stypeconv(t2)+" not balanced in tcompat: "+string v+" "+string tcomset);
return ok;
}
rtcompat(t1, t2: ref Type, any: int, inaorc: int): int
{
if(t1 == t2)
return 1;
if(t1 == nil || t2 == nil)
return 0;
if(t1.kind == Terror || t2.kind == Terror)
return 1;
if(t2.kind == Texception && t1.kind != Texception)
t2 = mkextuptype(t2);
t1.rec |= TRcom;
t2.rec |= TRcom;
case t1.kind{
* =>
fatal("unknown type "+stypeconv(t1)+" v "+stypeconv(t2)+" in rtcompat");
return 0;
Tstring =>
return t2.kind == Tstring || t2.kind == Tany;
Texception =>
if(t2.kind == Texception && t1.cons == t2.cons){
if(assumetcom(t1, t2))
return 1;
return idcompat(t1.ids, t2.ids, 0, inaorc);
}
return 0;
Tnone or
Tint or
Tbig or
Tbyte or
Treal =>
return t1.kind == t2.kind;
Tfix =>
return t1.kind == t2.kind && sametree(t1.val, t2.val);
Tany =>
if(tattr[t2.kind].isptr)
return 1;
return any;
Tref or
Tlist or
Tarray or
Tchan =>
if(t1.kind != t2.kind){
if(t2.kind == Tany)
return 1;
return 0;
}
if(t1.kind != Tref && assumetcom(t1, t2))
return 1;
return rtcompat(t1.tof, t2.tof, 0, t1.kind == Tarray || t1.kind == Tchan || inaorc);
Tfn =>
break;
Ttuple =>
if(t2.kind == Tadt && t2.tags == nil
|| t2.kind == Ttuple){
if(assumetcom(t1, t2))
return 1;
return idcompat(t1.ids, t2.ids, any, inaorc);
}
if(t2.kind == Tadtpick){
t2.tof.rec |= TRcom;
if(assumetcom(t1, t2.tof))
return 1;
return idcompat(t1.ids, t2.tof.ids.next, any, inaorc);
}
return 0;
Tadt =>
if(t2.kind == Ttuple && t1.tags == nil){
if(assumetcom(t1, t2))
return 1;
return idcompat(t1.ids, t2.ids, any, inaorc);
}
if(t1.tags != nil && t2.kind == Tadtpick && !inaorc)
t2 = t2.decl.dot.ty;
Tadtpick =>
#if(t2.kind == Ttuple)
# return idcompat(t1.tof.ids.next, t2.ids, any, inaorc);
break;
Tmodule =>
if(t2.kind == Tany)
return 1;
Tpoly =>
if(t2.kind == Tany)
return 1;
}
return tequal(t1, t2);
}
#
# add the assumption that t1 and t2 are compatable
#
assumetcom(t1, t2: ref Type): int
{
r1, r2: ref Type;
if(t1.tcom == nil && t2.tcom == nil){
tcomset += 2;
t1.tcom = t2.tcom = t1;
}else{
if(t1.tcom == nil){
r1 = t1;
t1 = t2;
t2 = r1;
}
for(r1 = t1.tcom; r1 != r1.tcom; r1 = r1.tcom)
;
for(r2 = t2.tcom; r2 != nil && r2 != r2.tcom; r2 = r2.tcom)
;
if(r1 == r2)
return 1;
if(r2 == nil)
tcomset++;
t2.tcom = t1;
for(; t2 != r1; t2 = r2){
r2 = t2.tcom;
t2.tcom = r1;
}
}
return 0;
}
cleartcomrec(t: ref Type): int
{
n := 0;
for(; t != nil && (t.rec & TRcom) == TRcom; t = t.tof){
t.rec &= ~TRcom;
if(t.tcom != nil){
t.tcom = nil;
n++;
}
if(t.kind == Tadtpick)
n += cleartcomrec(t.tof);
if(t.kind == Tmodule)
t = t.tof;
for(id := t.ids; id != nil; id = id.next)
n += cleartcomrec(id.ty);
for(id = t.tags; id != nil; id = id.next)
n += cleartcomrec(id.ty);
for(id = t.polys; id != nil; id = id.next)
n += cleartcomrec(id.ty);
}
return n;
}
#
# id1 and id2 are the fields in an adt or tuple
# simple structural check; ignore names
#
idcompat(id1, id2: ref Decl, any: int, inaorc: int): int
{
for(; id1 != nil; id1 = id1.next){
if(id1.store != Dfield)
continue;
while(id2 != nil && id2.store != Dfield)
id2 = id2.next;
if(id2 == nil
|| id1.store != id2.store
|| !rtcompat(id1.ty, id2.ty, any, inaorc))
return 0;
id2 = id2.next;
}
while(id2 != nil && id2.store != Dfield)
id2 = id2.next;
return id2 == nil;
}
#
# structural equality on types
# t->recid is used to detect cycles
# t->rec is used to clear t->recid
#
tequal(t1, t2: ref Type): int
{
eqrec = 0;
eqset = 0;
ok := rtequal(t1, t2);
v := cleareqrec(t1) + cleareqrec(t2);
if(0 && v != eqset)
fatal("recid t1 "+stypeconv(t1)+" and t2 "+stypeconv(t2)+" not balanced in tequal: "+string v+" "+string eqset);
eqset = 0;
return ok;
}
rtequal(t1, t2: ref Type): int
{
#
# this is just a shortcut
#
if(t1 == t2)
return 1;
if(t1 == nil || t2 == nil)
return 0;
if(t1.kind == Terror || t2.kind == Terror)
return 1;
if(t1.kind != t2.kind)
return 0;
if(t1.eq != nil && t2.eq != nil)
return t1.eq == t2.eq;
t1.rec |= TReq;
t2.rec |= TReq;
case t1.kind{
* =>
fatal("bogus type "+stypeconv(t1)+" vs "+stypeconv(t2)+" in rtequal");
return 0;
Tnone or
Tbig or
Tbyte or
Treal or
Tint or
Tstring =>
#
# this should always be caught by t1 == t2 check
#
fatal("bogus value type "+stypeconv(t1)+" vs "+stypeconv(t2)+" in rtequal");
return 1;
Tfix =>
return sametree(t1.val, t2.val);
Tref or
Tlist or
Tarray or
Tchan =>
if(t1.kind != Tref && assumeteq(t1, t2))
return 1;
return rtequal(t1.tof, t2.tof);
Tfn =>
if(t1.varargs != t2.varargs)
return 0;
if(!idequal(t1.ids, t2.ids, 0, storespace))
return 0;
# if(!idequal(t1.polys, t2.polys, 1, nil))
if(!pyequal(t1, t2))
return 0;
return rtequal(t1.tof, t2.tof);
Ttuple or
Texception =>
if(t1.kind != t2.kind || t1.cons != t2.cons)
return 0;
if(assumeteq(t1, t2))
return 1;
return idequal(t1.ids, t2.ids, 0, storespace);
Tadt or
Tadtpick or
Tmodule =>
if(assumeteq(t1, t2))
return 1;
#
# compare interfaces when comparing modules
#
if(t1.kind == Tmodule)
return idequal(t1.tof.ids, t2.tof.ids, 1, nil);
#
# picked adts; check parent,
# assuming equiv picked fields,
# then check picked fields are equiv
#
if(t1.kind == Tadtpick && !rtequal(t1.decl.dot.ty, t2.decl.dot.ty))
return 0;
#
# adts with pick tags: check picked fields for equality
#
if(!idequal(t1.tags, t2.tags, 1, nil))
return 0;
# if(!idequal(t1.polys, t2.polys, 1, nil))
if(!pyequal(t1, t2))
return 0;
return idequal(t1.ids, t2.ids, 1, storespace);
Tpoly =>
if(assumeteq(t1, t2))
return 1;
if(t1.decl.sym != t2.decl.sym)
return 0;
return idequal(t1.ids, t2.ids, 1, nil);
}
}
assumeteq(t1, t2: ref Type): int
{
r1, r2: ref Type;
if(t1.teq == nil && t2.teq == nil){
eqrec++;
eqset += 2;
t1.teq = t2.teq = t1;
}else{
if(t1.teq == nil){
r1 = t1;
t1 = t2;
t2 = r1;
}
for(r1 = t1.teq; r1 != r1.teq; r1 = r1.teq)
;
for(r2 = t2.teq; r2 != nil && r2 != r2.teq; r2 = r2.teq)
;
if(r1 == r2)
return 1;
if(r2 == nil)
eqset++;
t2.teq = t1;
for(; t2 != r1; t2 = r2){
r2 = t2.teq;
t2.teq = r1;
}
}
return 0;
}
#
# checking structural equality for modules, adts, tuples, and fns
#
idequal(id1, id2: ref Decl, usenames: int, storeok: array of int): int
{
#
# this is just a shortcut
#
if(id1 == id2)
return 1;
for(; id1 != nil; id1 = id1.next){
if(storeok != nil && !storeok[id1.store])
continue;
while(id2 != nil && storeok != nil && !storeok[id2.store])
id2 = id2.next;
if(id2 == nil
|| usenames && id1.sym != id2.sym
|| id1.store != id2.store
|| id1.implicit != id2.implicit
|| id1.cyc != id2.cyc
|| (id1.dot == nil) != (id2.dot == nil)
|| id1.dot != nil && id2.dot != nil && id1.dot.ty.kind != id2.dot.ty.kind
|| !rtequal(id1.ty, id2.ty))
return 0;
id2 = id2.next;
}
while(id2 != nil && storeok != nil && !storeok[id2.store])
id2 = id2.next;
return id1 == nil && id2 == nil;
}
pyequal(t1: ref Type, t2: ref Type): int
{
pt1, pt2: ref Type;
id1, id2: ref Decl;
if(t1 == t2)
return 1;
id1 = t1.polys;
id2 = t2.polys;
for(; id1 != nil; id1 = id1.next){
if(id2 == nil)
return 0;
pt1 = id1.ty;
pt2 = id2.ty;
if(!rtequal(pt1, pt2)){
if(t1.tmap != nil)
pt1 = valtmap(pt1, t1.tmap);
if(t2.tmap != nil)
pt2 = valtmap(pt2, t2.tmap);
if(!rtequal(pt1, pt2))
return 0;
}
id2 = id2.next;
}
return id1 == nil && id2 == nil;
}
cleareqrec(t: ref Type): int
{
n := 0;
for(; t != nil && (t.rec & TReq) == TReq; t = t.tof){
t.rec &= ~TReq;
if(t.teq != nil){
t.teq = nil;
n++;
}
if(t.kind == Tadtpick)
n += cleareqrec(t.decl.dot.ty);
if(t.kind == Tmodule)
t = t.tof;
for(id := t.ids; id != nil; id = id.next)
n += cleareqrec(id.ty);
for(id = t.tags; id != nil; id = id.next)
n += cleareqrec(id.ty);
for(id = t.polys; id != nil; id = id.next)
n += cleareqrec(id.ty);
}
return n;
}
raisescompat(n1: ref Node, n2: ref Node): int
{
if(n1 == n2)
return 1;
if(n2 == nil)
return 1; # no need to repeat in definition if given in declaration
if(n1 == nil)
return 0;
for((n1, n2) = (n1.left, n2.left); n1 != nil && n2 != nil; (n1, n2) = (n1.right, n2.right)){
if(n1.left.decl != n2.left.decl)
return 0;
}
return n1 == n2;
}
# t1 a polymorphic type
fnunify(t1: ref Type, t2: ref Type, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
id, ids: ref Decl;
sym: ref Sym;
ok: int;
for(ids = t1.ids; ids != nil; ids = ids.next){
sym = ids.sym;
(id, nil) = fnlookup(sym, t2);
if(id != nil)
usetype(id.ty);
if(id == nil){
if(dowarn)
error(unifysrc.start, "type " + typeconv(t2) + " does not have a '" + sym.name + "' function");
return (0, tp);
}
else if(id.ty.kind != Tfn){
if(dowarn)
error(unifysrc.start, typeconv(id.ty) + " is not a function");
return (0, tp);
}
else{
(ok, tp) = rtunify(ids.ty, id.ty, tp, !swapped);
if(!ok){
if(dowarn)
error(unifysrc.start, typeconv(ids.ty) + " and " + typeconv(id.ty) + " are not compatible wrt " + sym.name);
return (0, tp);
}
}
}
return (1, tp);
}
fncleareqrec(t1: ref Type, t2: ref Type): int
{
id, ids: ref Decl;
n: int;
n = 0;
n += cleareqrec(t1);
n += cleareqrec(t2);
for(ids = t1.ids; ids != nil; ids = ids.next){
(id, nil) = fnlookup(ids.sym, t2);
if(id == nil)
continue;
else{
n += cleareqrec(ids.ty);
n += cleareqrec(id.ty);
}
}
return n;
}
tunify(t1: ref Type, t2: ref Type): (int, ref Tpair)
{
v: int;
p: ref Tpair;
eqrec = 0;
eqset = 0;
(ok, tp) := rtunify(t1, t2, nil, 0);
v = cleareqrec(t1) + cleareqrec(t2);
for(p = tp; p != nil; p = p.nxt)
v += fncleareqrec(p.t1, p.t2);
if(0 && v != eqset)
fatal("recid t1 " + stypeconv(t1) + " and t2 " + stypeconv(t2) + " not balanced in tunify: " + string v + " " + string eqset);
return (ok, tp);
}
rtunify(t1: ref Type, t2: ref Type, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
ok: int;
t1 = valtmap(t1, tp);
t2 = valtmap(t2, tp);
if(t1 == t2)
return (1, tp);
if(t1 == nil || t2 == nil)
return (0, tp);
if(t1.kind == Terror || t2.kind == Terror)
return (1, tp);
if(t1.kind != Tpoly && t2.kind == Tpoly){
(t1, t2) = (t2, t1);
swapped = !swapped;
}
if(t1.kind == Tpoly){
# if(typein(t1, t2))
# return (0, tp);
if(!tattr[t2.kind].isptr)
return (0, tp);
if(t2.kind != Tany)
tp = addtmap(t1, t2, tp);
return fnunify(t1, t2, tp, swapped);
}
if(t1.kind != Tany && t2.kind == Tany){
(t1, t2) = (t2, t1);
swapped = !swapped;
}
if(t1.kind == Tadt && t1.tags != nil && t2.kind == Tadtpick && !swapped)
t2 = t2.decl.dot.ty;
if(t2.kind == Tadt && t2.tags != nil && t1.kind == Tadtpick && swapped)
t1 = t1.decl.dot.ty;
if(t1.kind != Tany && t1.kind != t2.kind)
return (0, tp);
t1.rec |= TReq;
t2.rec |= TReq;
case(t1.kind){
* =>
return (tequal(t1, t2), tp);
Tany =>
return (tattr[t2.kind].isptr, tp);
Tref or
Tlist or
Tarray or
Tchan =>
if(t1.kind != Tref && assumeteq(t1, t2))
return (1, tp);
return rtunify(t1.tof, t2.tof, tp, swapped);
Tfn =>
(ok, tp) = idunify(t1.ids, t2.ids, tp, swapped);
if(!ok)
return (0, tp);
(ok, tp) = idunify(t1.polys, t2.polys, tp, swapped);
if(!ok)
return (0, tp);
return rtunify(t1.tof, t2.tof, tp, swapped);
Ttuple =>
if(assumeteq(t1, t2))
return (1, tp);
return idunify(t1.ids, t2.ids, tp, swapped);
Tadt or
Tadtpick =>
if(assumeteq(t1, t2))
return (1, tp);
(ok, tp) = idunify(t1.polys, t2.polys, tp, swapped);
if(!ok)
return (0, tp);
(ok, tp) = idunify(t1.tags, t2.tags, tp, swapped);
if(!ok)
return (0, tp);
return idunify(t1.ids, t2.ids, tp, swapped);
Tmodule =>
if(assumeteq(t1, t2))
return (1, tp);
return idunify(t1.tof.ids, t2.tof.ids, tp, swapped);
Tpoly =>
return (t1 == t2, tp);
}
return (1, tp);
}
idunify(id1: ref Decl, id2: ref Decl, tp: ref Tpair, swapped: int): (int, ref Tpair)
{
ok: int;
if(id1 == id2)
return (1, tp);
for(; id1 != nil; id1 = id1.next){
if(id2 == nil)
return (0, tp);
(ok, tp) = rtunify(id1.ty, id2.ty, tp, swapped);
if(!ok)
return (0, tp);
id2 = id2.next;
}
return (id1 == nil && id2 == nil, tp);
}
polyequal(id1: ref Decl, id2: ref Decl): int
{
# allow id2 list to have an optional for clause
ck2 := 0;
for(d := id2; d != nil; d = d.next)
if(d.ty.ids != nil)
ck2 = 1;
for(; id1 != nil; id1 = id1.next){
if(id2 == nil
|| id1.sym != id2.sym
|| id1.ty.decl != nil && id2.ty.decl != nil && id1.ty.decl.sym != id2.ty.decl.sym)
return 0;
if(ck2 && !idequal(id1.ty.ids, id2.ty.ids, 1, nil))
return 0;
id2 = id2.next;
}
return id1 == nil && id2 == nil;
}
calltype(f: ref Type, a: ref Node, rt: ref Type): ref Type
{
t: ref Type;
id, first, last: ref Decl;
first = last = nil;
t = mktype(f.src.start, f.src.stop, Tfn, rt, nil);
if(f.kind == Tref)
t.polys = f.tof.polys;
else
t.polys = f.polys;
for( ; a != nil; a = a.right){
id = mkdecl(f.src, Darg, a.left.ty);
if(last == nil)
first = id;
else
last.next = id;
last = id;
}
t.ids = first;
if(f.kind == Tref)
t = mktype(f.src.start, f.src.stop, Tref, t, nil);
return t;
}
duptype(t: ref Type): ref Type
{
nt: ref Type;
nt = ref Type;
*nt = *t;
nt.ok &= ~(OKverify|OKref|OKclass|OKsized|OKcycsize|OKcyc);
nt.flags |= INST;
nt.eq = nil;
nt.sbl = -1;
if(t.decl != nil && (nt.kind == Tadt || nt.kind == Tadtpick || nt.kind == Ttuple)){
nt.decl = dupdecl(t.decl);
nt.decl.ty = nt;
nt.decl.link = t.decl;
if(t.decl.dot != nil){
nt.decl.dot = dupdecl(t.decl.dot);
nt.decl.dot.link = t.decl.dot;
}
}
else
nt.decl = nil;
return nt;
}
dpolys(ids: ref Decl): int
{
p: ref Decl;
for(p = ids; p != nil; p = p.next)
if(tpolys(p.ty))
return 1;
return 0;
}
tpolys(t: ref Type): int
{
v: int;
tyl: ref Typelist;
if(t == nil)
return 0;
if(int(t.flags&(POLY|NOPOLY)))
return int(t.flags&POLY);
case(t.kind){
* =>
v = 0;
break;
Tarrow or
Tdot or
Tpoly =>
v = 1;
break;
Tref or
Tlist or
Tarray or
Tchan =>
v = tpolys(t.tof);
break;
Tid =>
v = tpolys(t.decl.ty);
break;
Tinst =>
for(tyl = t.tlist; tyl != nil; tyl = tyl.nxt)
if(tpolys(tyl.t)){
v = 1;
break;
}
v = tpolys(t.tof);
break;
Tfn or
Tadt or
Tadtpick or
Ttuple or
Texception =>
if(t.polys != nil){
v = 1;
break;
}
if(int(t.rec&TRvis))
return 0;
t.rec |= TRvis;
v = tpolys(t.tof) || dpolys(t.polys) || dpolys(t.ids) || dpolys(t.tags);
t.rec &= ~TRvis;
if(t.kind == Tadtpick && v == 0)
v = tpolys(t.decl.dot.ty);
break;
}
if(v)
t.flags |= POLY;
else
t.flags |= NOPOLY;
return v;
}
doccurs(ids: ref Decl, tp: ref Tpair): int
{
p: ref Decl;
for(p = ids; p != nil; p = p.next){
if(toccurs(p.ty, tp))
return 1;
}
return 0;
}
toccurs(t: ref Type, tp: ref Tpair): int
{
o: int;
if(t == nil)
return 0;
if(!int(t.flags&(POLY|NOPOLY)))
tpolys(t);
if(int(t.flags&NOPOLY))
return 0;
case(t.kind){
* =>
fatal("unknown type " + string t.kind + " in toccurs");
Tnone or
Tbig or
Tbyte or
Treal or
Tint or
Tstring or
Tfix or
Tmodule or
Terror =>
return 0;
Tarrow or
Tdot =>
return 1;
Tpoly =>
return valtmap(t, tp) != t;
Tref or
Tlist or
Tarray or
Tchan =>
return toccurs(t.tof, tp);
Tid =>
return toccurs(t.decl.ty, tp);
Tinst =>
for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt)
if(toccurs(tyl.t, tp))
return 1;
return toccurs(t.tof, tp);
Tfn or
Tadt or
Tadtpick or
Ttuple or
Texception =>
if(int(t.rec&TRvis))
return 0;
t.rec |= TRvis;
o = toccurs(t.tof, tp) || doccurs(t.polys, tp) || doccurs(t.ids, tp) || doccurs(t.tags, tp);
t.rec &= ~TRvis;
if(t.kind == Tadtpick && o == 0)
o = toccurs(t.decl.dot.ty, tp);
return o;
}
return 0;
}
expandids(ids: ref Decl, adtt: ref Decl, tp: ref Tpair, sym: int): (ref Decl, ref Tpair)
{
p, q, nids, last: ref Decl;
nids = last = nil;
for(p = ids; p != nil; p = p.next){
q = dupdecl(p);
(q.ty, tp) = expandtype(p.ty, nil, adtt, tp);
if(sym && q.ty.decl != nil)
q.sym = q.ty.decl.sym;
if(q.store == Dfn)
q.link = p;
if(nids == nil)
nids = q;
else
last.next = q;
last = q;
}
return (nids, tp);
}
expandtype(t: ref Type, instt: ref Type, adtt: ref Decl, tp: ref Tpair): (ref Type, ref Tpair)
{
nt: ref Type;
if(t == nil)
return (nil, tp);
if(!toccurs(t, tp))
return (t, tp);
case(t.kind){
* =>
fatal("unknown type " + string t.kind + " in expandtype");
Tpoly =>
return (valtmap(t, tp), tp);
Tref or
Tlist or
Tarray or
Tchan =>
nt = duptype(t);
(nt.tof, tp) = expandtype(t.tof, nil, adtt, tp);
return (nt, tp);
Tid =>
return expandtype(idtype(t), nil, adtt, tp);
Tdot =>
return expandtype(dottype(t, adtt), nil, adtt, tp);
Tarrow =>
return expandtype(arrowtype(t, adtt), nil, adtt, tp);
Tinst =>
if((nt = valtmap(t, tp)) != t)
return (nt, tp);
(t, tp) = insttype(t, adtt, tp);
return expandtype(t, nil, adtt, tp);
Tfn or
Tadt or
Tadtpick or
Ttuple or
Texception =>
if((nt = valtmap(t, tp)) != t)
return (nt, tp);
if(t.kind == Tadt)
adtt = t.decl;
nt = duptype(t);
tp = addtmap(t, nt, tp);
if(instt != nil)
tp = addtmap(instt, nt, tp);
(nt.tof, tp) = expandtype(t.tof, nil, adtt, tp);
(nt.polys, tp) = expandids(t.polys, adtt, tp, 1);
(nt.ids, tp) = expandids(t.ids, adtt, tp, 0);
(nt.tags, tp) = expandids(t.tags, adtt, tp, 0);
if(t.kind == Tadt){
for(ids := nt.tags; ids != nil; ids = ids.next)
ids.ty.decl.dot = nt.decl;
}
if(t.kind == Tadtpick){
(nt.decl.dot.ty, tp) = expandtype(t.decl.dot.ty, nil, adtt, tp);
}
if(t.tmap != nil){
nt.tmap = nil;
for(p := t.tmap; p != nil; p = p.nxt)
nt.tmap = addtmap(valtmap(p.t1, tp), valtmap(p.t2, tp), nt.tmap);
}
return (nt, tp);
}
return (nil, tp);
}
#
# create type signatures
# sign the same information used
# for testing type equality
#
sign(d: ref Decl): int
{
t := d.ty;
if(t.sig != 0)
return t.sig;
if(ispoly(d))
rmfnptrs(d);
sigend := -1;
sigalloc := 1024;
sig: array of byte;
while(sigend < 0 || sigend >= sigalloc){
sigalloc *= 2;
sig = array[sigalloc] of byte;
eqrec = 0;
sigend = rtsign(t, sig, 0);
v := clearrec(t);
if(v != eqrec)
fatal("recid not balanced in sign: "+string v+" "+string eqrec);
eqrec = 0;
}
if(signdump != "" && dotconv(d) == signdump){
print("sign %s len %d\n", dotconv(d), sigend);
print("%s\n", string sig[:sigend]);
}
md5sig := array[Crypt->MD5dlen] of {* => byte 0};
md5(sig, sigend, md5sig, nil);
for(i := 0; i < Crypt->MD5dlen; i += 4)
t.sig ^= int md5sig[i+0] | (int md5sig[i+1]<<8) | (int md5sig[i+2]<<16) | (int md5sig[i+3]<<24);
if(debug['S'])
print("signed %s type %s len %d sig %#ux\n", dotconv(d), typeconv(t), sigend, t.sig);
return t.sig;
}
SIGSELF: con byte 'S';
SIGVARARGS: con byte '*';
SIGCYC: con byte 'y';
SIGREC: con byte '@';
sigkind := array[Tend] of
{
Tnone => byte 'n',
Tadt => byte 'a',
Tadtpick => byte 'p',
Tarray => byte 'A',
Tbig => byte 'B',
Tbyte => byte 'b',
Tchan => byte 'C',
Treal => byte 'r',
Tfn => byte 'f',
Tint => byte 'i',
Tlist => byte 'L',
Tmodule => byte 'm',
Tref => byte 'R',
Tstring => byte 's',
Ttuple => byte 't',
Texception => byte 'e',
Tfix => byte 'x',
Tpoly => byte 'P',
* => byte 0,
};
rtsign(t: ref Type, sig: array of byte, spos: int): int
{
id: ref Decl;
if(t == nil)
return spos;
if(spos < 0 || spos + 8 >= len sig)
return -1;
if(t.eq != nil && t.eq.id){
if(t.eq.id < 0 || t.eq.id > eqrec)
fatal("sign rec "+typeconv(t)+" "+string t.eq.id+" "+string eqrec);
sig[spos++] = SIGREC;
name := array of byte string t.eq.id;
if(spos + len name > len sig)
return -1;
sig[spos:] = name;
spos += len name;
return spos;
}
if(t.eq != nil){
eqrec++;
t.eq.id = eqrec;
}
kind := sigkind[t.kind];
sig[spos++] = kind;
if(kind == byte 0)
fatal("no sigkind for "+typeconv(t));
t.rec = byte 1;
case t.kind{
* =>
fatal("bogus type "+stypeconv(t)+" in rtsign");
return -1;
Tnone or
Tbig or
Tbyte or
Treal or
Tint or
Tstring or
Tpoly =>
return spos;
Tfix =>
name := array of byte string t.val.c.rval;
if(spos + len name - 1 >= len sig)
return -1;
sig[spos: ] = name;
spos += len name;
return spos;
Tref or
Tlist or
Tarray or
Tchan =>
return rtsign(t.tof, sig, spos);
Tfn =>
if(t.varargs != byte 0)
sig[spos++] = SIGVARARGS;
if(t.polys != nil)
spos = idsign(t.polys, 0, sig, spos);
spos = idsign(t.ids, 0, sig, spos);
if(t.eraises != nil)
spos = raisessign(t.eraises, sig, spos);
return rtsign(t.tof, sig, spos);
Ttuple =>
return idsign(t.ids, 0, sig, spos);
Tadt =>
#
# this is a little different than in rtequal,
# since we flatten the adt we used to represent the globals
#
if(t.eq == nil){
if(t.decl.sym.name != ".mp")
fatal("no t.eq field for "+typeconv(t));
spos--;
for(id = t.ids; id != nil; id = id.next){
spos = idsign1(id, 1, sig, spos);
if(spos < 0 || spos >= len sig)
return -1;
sig[spos++] = byte ';';
}
return spos;
}
if(t.polys != nil)
spos = idsign(t.polys, 0, sig, spos);
spos = idsign(t.ids, 1, sig, spos);
if(spos < 0 || t.tags == nil)
return spos;
#
# convert closing ')' to a ',', then sign any tags
#
sig[spos-1] = byte ',';
for(tg := t.tags; tg != nil; tg = tg.next){
name := array of byte (tg.sym.name + "=>");
if(spos + len name > len sig)
return -1;
sig[spos:] = name;
spos += len name;
spos = rtsign(tg.ty, sig, spos);
if(spos < 0 || spos >= len sig)
return -1;
if(tg.next != nil)
sig[spos++] = byte ',';
}
if(spos >= len sig)
return -1;
sig[spos++] = byte ')';
return spos;
Tadtpick =>
spos = idsign(t.ids, 1, sig, spos);
if(spos < 0)
return spos;
return rtsign(t.decl.dot.ty, sig, spos);
Tmodule =>
if(t.tof.linkall == byte 0)
fatal("signing a narrowed module");
if(spos >= len sig)
return -1;
sig[spos++] = byte '{';
for(id = t.tof.ids; id != nil; id = id.next){
if(id.tag)
continue;
if(id.sym.name == ".mp"){
spos = rtsign(id.ty, sig, spos);
if(spos < 0)
return -1;
continue;
}
spos = idsign1(id, 1, sig, spos);
if(spos < 0 || spos >= len sig)
return -1;
sig[spos++] = byte ';';
}
if(spos >= len sig)
return -1;
sig[spos++] = byte '}';
return spos;
}
}
idsign(id: ref Decl, usenames: int, sig: array of byte, spos: int): int
{
if(spos >= len sig)
return -1;
sig[spos++] = byte '(';
first := 1;
for(; id != nil; id = id.next){
if(id.store == Dlocal)
fatal("local "+id.sym.name+" in idsign");
if(!storespace[id.store])
continue;
if(!first){
if(spos >= len sig)
return -1;
sig[spos++] = byte ',';
}
spos = idsign1(id, usenames, sig, spos);
if(spos < 0)
return -1;
first = 0;
}
if(spos >= len sig)
return -1;
sig[spos++] = byte ')';
return spos;
}
idsign1(id: ref Decl, usenames: int, sig: array of byte, spos: int): int
{
if(usenames){
name := array of byte (id.sym.name+":");
if(spos + len name >= len sig)
return -1;
sig[spos:] = name;
spos += len name;
}
if(spos + 2 >= len sig)
return -1;
if(id.implicit != byte 0)
sig[spos++] = SIGSELF;
if(id.cyc != byte 0)
sig[spos++] = SIGCYC;
return rtsign(id.ty, sig, spos);
}
raisessign(n: ref Node, sig: array of byte, spos: int): int
{
if(spos >= len sig)
return -1;
sig[spos++] = byte '(';
for(nn := n.left; nn != nil; nn = nn.right){
s := array of byte nn.left.decl.sym.name;
if(spos+len s - 1 >= len sig)
return -1;
sig[spos: ] = s;
spos += len s;
if(nn.right != nil){
if(spos >= len sig)
return -1;
sig[spos++] = byte ',';
}
}
if(spos >= len sig)
return -1;
sig[spos++] = byte ')';
return spos;
}
clearrec(t: ref Type): int
{
id: ref Decl;
n := 0;
for(; t != nil && t.rec != byte 0; t = t.tof){
t.rec = byte 0;
if(t.eq != nil && t.eq.id != 0){
t.eq.id = 0;
n++;
}
if(t.kind == Tmodule){
for(id = t.tof.ids; id != nil; id = id.next)
n += clearrec(id.ty);
return n;
}
if(t.kind == Tadtpick)
n += clearrec(t.decl.dot.ty);
for(id = t.ids; id != nil; id = id.next)
n += clearrec(id.ty);
for(id = t.tags; id != nil; id = id.next)
n += clearrec(id.ty);
for(id = t.polys; id != nil; id = id.next)
n += clearrec(id.ty);
}
return n;
}
# must a variable of the given type be zeroed ? (for uninitialized declarations inside loops)
tmustzero(t : ref Type) : int
{
if(t==nil)
return 0;
if(tattr[t.kind].isptr)
return 1;
if(t.kind == Tadtpick)
t = t.tof;
if(t.kind == Ttuple || t.kind == Tadt)
return mustzero(t.ids);
return 0;
}
mustzero(decls : ref Decl) : int
{
d : ref Decl;
for (d = decls; d != nil; d = d.next)
if (tmustzero(d.ty))
return 1;
return 0;
}
typeconv(t: ref Type): string
{
if(t == nil)
return "nothing";
return tprint(t);
}
stypeconv(t: ref Type): string
{
if(t == nil)
return "nothing";
return stprint(t);
}
tprint(t: ref Type): string
{
id: ref Decl;
if(t == nil)
return "";
s := "";
if(t.kind < 0 || t.kind >= Tend){
s += "kind ";
s += string t.kind;
return s;
}
if(t.pr != byte 0 && t.decl != nil){
if(t.decl.dot != nil && !isimpmod(t.decl.dot.sym)){
s += t.decl.dot.sym.name;
s += "->";
}
s += t.decl.sym.name;
return s;
}
t.pr = byte 1;
case t.kind{
Tarrow =>
s += tprint(t.tof);
s += "->";
s += t.decl.sym.name;
Tdot =>
s += tprint(t.tof);
s += ".";
s += t.decl.sym.name;
Tid or
Tpoly =>
s += t.decl.sym.name;
Tinst =>
s += tprint(t.tof);
s += "[";
for(tyl := t.tlist; tyl != nil; tyl = tyl.nxt){
s += tprint(tyl.t);
if(tyl.nxt != nil)
s += ", ";
}
s += "]";
Tint or
Tbig or
Tstring or
Treal or
Tbyte or
Tany or
Tnone or
Terror or
Tainit or
Talt or
Tcase or
Tcasel or
Tcasec or
Tgoto or
Tiface or
Texception or
Texcept =>
s += kindname[t.kind];
Tfix =>
s += kindname[t.kind] + "(" + expconv(t.val) + ")";
Tref =>
s += "ref ";
s += tprint(t.tof);
Tchan or
Tarray or
Tlist =>
s += kindname[t.kind];
s += " of ";
s += tprint(t.tof);
Tadtpick =>
s += t.decl.dot.sym.name + "." + t.decl.sym.name;
Tadt =>
if(t.decl.dot != nil && !isimpmod(t.decl.dot.sym))
s += t.decl.dot.sym.name + "->";
s += t.decl.sym.name;
if(t.polys != nil){
s += "[";
for(id = t.polys; id != nil; id = id.next){
if(t.tmap != nil)
s += tprint(valtmap(id.ty, t.tmap));
else
s += id.sym.name;
if(id.next != nil)
s += ", ";
}
s += "]";
}
Tmodule =>
s += t.decl.sym.name;
Ttuple =>
s += "(";
for(id = t.ids; id != nil; id = id.next){
s += tprint(id.ty);
if(id.next != nil)
s += ", ";
}
s += ")";
Tfn =>
s += "fn";
if(t.polys != nil){
s += "[";
for(id = t.polys; id != nil; id = id.next){
s += id.sym.name;
if(id.next != nil)
s += ", ";
}
s += "]";
}
s += "(";
for(id = t.ids; id != nil; id = id.next){
if(id.sym == nil)
s += "nil: ";
else{
s += id.sym.name;
s += ": ";
}
if(id.implicit != byte 0)
s += "self ";
s += tprint(id.ty);
if(id.next != nil)
s += ", ";
}
if(t.varargs != byte 0 && t.ids != nil)
s += ", *";
else if(t.varargs != byte 0)
s += "*";
if(t.tof != nil && t.tof.kind != Tnone){
s += "): ";
s += tprint(t.tof);
}else
s += ")";
* =>
yyerror("tprint: unknown type kind "+string t.kind);
}
t.pr = byte 0;
return s;
}
stprint(t: ref Type): string
{
if(t == nil)
return "";
s := "";
case t.kind{
Tid =>
s += "id ";
s += t.decl.sym.name;
Tadt or
Tadtpick or
Tmodule =>
return kindname[t.kind] + " " + tprint(t);
}
return tprint(t);
}
# generalize ref P.A, ref P.B to ref P
# tparent(t1: ref Type, t2: ref Type): ref Type
# {
# if(t1 == nil || t2 == nil || t1.kind != Tref || t2.kind != Tref)
# return t1;
# t1 = t1.tof;
# t2 = t2.tof;
# if(t1 == nil || t2 == nil || t1.kind != Tadtpick || t2.kind != Tadtpick)
# return t1;
# t1 = t1.decl.dot.ty;
# t2 = t2.decl.dot.ty;
# if(tequal(t1, t2))
# return mktype(t1.src.start, t1.src.stop, Tref, t1, nil);
# return t1;
# }
tparent0(t1: ref Type, t2: ref Type): int
{
id1, id2: ref Decl;
if(t1 == t2)
return 1;
if(t1 == nil || t2 == nil)
return 0;
if(t1.kind == Tadt && t2.kind == Tadtpick)
t2 = t2.decl.dot.ty;
if(t1.kind == Tadtpick && t2.kind == Tadt)
t1 = t1.decl.dot.ty;
if(t1.kind != t2.kind)
return 0;
case(t1.kind){
* =>
fatal("unknown type " + string t1.kind + " v " + string t2.kind + " in tparent");
break;
Terror or
Tstring or
Tnone or
Tint or
Tbig or
Tbyte or
Treal or
Tany =>
return 1;
Texception or
Tfix or
Tfn or
Tadt or
Tmodule or
Tpoly =>
return tcompat(t1, t2, 0);
Tref or
Tlist or
Tarray or
Tchan =>
return tparent0(t1.tof, t2.tof);
Ttuple =>
for((id1, id2) = (t1.ids, t2.ids); id1 != nil && id2 != nil; (id1, id2) = (id1.next, id2.next))
if(!tparent0(id1.ty, id2.ty))
return 0;
return id1 == nil && id2 == nil;
Tadtpick =>
return tequal(t1.decl.dot.ty, t2.decl.dot.ty);
}
return 0;
}
tparent1(t1: ref Type, t2: ref Type): ref Type
{
t, nt: ref Type;
id, id1, id2, idt: ref Decl;
if(t1.kind == Tadt && t2.kind == Tadtpick)
t2 = t2.decl.dot.ty;
if(t1.kind == Tadtpick && t2.kind == Tadt)
t1 = t1.decl.dot.ty;
case(t1.kind){
* =>
return t1;
Tref or
Tlist or
Tarray or
Tchan =>
t = tparent1(t1.tof, t2.tof);
if(t == t1.tof)
return t1;
return mktype(t1.src.start, t1.src.stop, t1.kind, t, nil);
Ttuple =>
nt = nil;
id = nil;
for((id1, id2) = (t1.ids, t2.ids); id1 != nil && id2 != nil; (id1, id2) = (id1.next, id2.next)){
t = tparent1(id1.ty, id2.ty);
if(t != id1.ty){
if(nt == nil){
nt = mktype(t1.src.start, t1.src.stop, Ttuple, nil, dupdecls(t1.ids));
for((id, idt) = (nt.ids, t1.ids); idt != id1; (id, idt) = (id.next, idt.next))
;
}
id.ty = t;
}
if(id != nil)
id = id.next;
}
if(nt == nil)
return t1;
return nt;
Tadtpick =>
if(tequal(t1, t2))
return t1;
return t1.decl.dot.ty;
}
return t1;
}
tparent(t1: ref Type, t2: ref Type): ref Type
{
if(tparent0(t1, t2))
return tparent1(t1, t2);
return t1;
}
#
# make the tuple type used to initialize an exception type
#
mkexbasetype(t: ref Type): ref Type
{
if(t.cons == byte 0)
fatal("mkexbasetype on non-constant");
last := mkids(t.decl.src, nil, tstring, nil);
last.store = Dfield;
nt := mktype(t.src.start, t.src.stop, Texception, nil, last);
nt.cons = byte 0;
new := mkids(t.decl.src, nil, tint, nil);
new.store = Dfield;
last.next = new;
last = new;
for(id := t.ids; id != nil; id = id.next){
new = ref *id;
new.cyc = byte 0;
last.next = new;
last = new;
}
last.next = nil;
return usetype(nt);
}
#
# make an instantiated exception type
#
mkextype(t: ref Type): ref Type
{
nt: ref Type;
if(t.cons == byte 0)
fatal("mkextype on non-constant");
if(t.tof != nil)
return t.tof;
nt = copytypeids(t);
nt.cons = byte 0;
t.tof = usetype(nt);
return t.tof;
}
#
# convert an instantiated exception type to its underlying type
#
mkextuptype(t: ref Type): ref Type
{
id: ref Decl;
nt: ref Type;
if(int t.cons)
return t;
if(t.tof != nil)
return t.tof;
id = t.ids;
if(id == nil)
nt = t;
else if(id.next == nil)
nt = id.ty;
else{
nt = copytypeids(t);
nt.cons = byte 0;
nt.kind = Ttuple;
}
t.tof = usetype(nt);
return t.tof;
}
ckfix(t: ref Type, max: real)
{
s := t.val.c.rval;
if(max == 0.0)
k := (big 1<<32) - big 1;
else
k = big 2 * big (max/s) + big 1;
x := big 1;
for(p := 0; k > x; p++)
x *= big 2;
if(p == 0 || p > 32){
error(t.src.start, "cannot fit fixed type into an int");
return;
}
if(p < 32)
t.val.c.rval /= real (1<<(32-p));
}
scale(t: ref Type): real
{
n: ref Node;
if(t.kind == Tint || t.kind == Treal)
return 1.0;
if(t.kind != Tfix)
fatal("scale() on non fixed point type");
n = t.val;
if(n.op != Oconst)
fatal("non constant scale");
if(n.ty != treal)
fatal("non real scale");
return n.c.rval;
}
scale2(f: ref Type, t: ref Type): real
{
return scale(f)/scale(t);
}
# put x in normal form
nf(x: real): (int, int)
{
p: int;
m: real;
p = 0;
m = x;
while(m >= 1.0){
p++;
m /= 2.0;
}
while(m < 0.5){
p--;
m *= 2.0;
}
m *= real (1<<16)*real (1<<15);
if(m >= real 16r7fffffff - 0.5)
return (p, 16r7fffffff);
return (p, int m);
}
ispow2(x: real): int
{
m: int;
(nil, m) = nf(x);
if(m != 1<<30)
return 0;
return 1;
}
round(x: real, n: int): (int, int)
{
if(n != 31)
fatal("not 31 in round");
return nf(x);
}
fixmul2(sx: real, sy: real, sr: real): (int, int, int)
{
k, n, a: int;
alpha: real;
alpha = (sx*sy)/sr;
n = 31;
(k, a) = round(1.0/alpha, n);
return (IMULX, 1-k, 0);
}
fixdiv2(sx: real, sy: real, sr: real): (int, int, int)
{
k, n, b: int;
beta: real;
beta = sx/(sy*sr);
n = 31;
(k, b) = round(beta, n);
return (IDIVX, k-1, 0);
}
fixmul(sx: real, sy: real, sr: real): (int, int, int)
{
k, m, n, a, v: int;
W: big;
alpha, eps: real;
alpha = (sx*sy)/sr;
if(ispow2(alpha))
return fixmul2(sx, sy, sr);
n = 31;
(k, a) = round(1.0/alpha, n);
m = n-k;
if(m < -n-1)
return (IMOVW, 0, 0); # result is zero whatever the values
v = 0;
W = big 0;
eps = real(1<<m)/(alpha*real(a)) - 1.0;
if(eps < 0.0){
v = a-1;
eps = -eps;
}
if(m < 0 && real(1<<n)*eps*real(a) >= real(a)-1.0+real(1<<m))
W = (big(1)<<(-m)) - big 1;
if(v != 0 || W != big 0)
m = m<<2|(v != 0)<<1|(W != big 0);
if(v == 0 && W == big 0)
return (IMULX0, m, a);
else
return (IMULX1, m, a);
}
fixdiv(sx: real, sy: real, sr: real): (int, int, int)
{
k, m, n, b, v: int;
W: big;
beta, eps: real;
beta = sx/(sy*sr);
if(ispow2(beta))
return fixdiv2(sx, sy, sr);
n = 31;
(k, b) = round(beta, n);
m = k-n;
if(m <= -2*n)
return (IMOVW, 0, 0); #result is zero whatever the values
v = 0;
W = big 0;
eps = (real(1<<m)*real(b))/beta - 1.0;
if(eps < 0.0)
v = 1;
if(m < 0)
W = (big(1)<<(-m)) - big 1;
if(v != 0 || W != big 0)
m = m<<2|(v != 0)<<1|(W != big 0);
if(v == 0 && W == big 0)
return (IDIVX0, m, b);
else
return (IDIVX1, m, b);
}
fixcast(sx: real, sr: real): (int, int, int)
{
(op, p, a) := fixmul(sx, 1.0, sr);
return (op-IMULX+ICVTXX, p, a);
}
fixop(op: int, tx: ref Type, ty: ref Type, tr: ref Type): (int, int, int)
{
sx, sy, sr: real;
sx = scale(tx);
sy = scale(ty);
sr = scale(tr);
if(op == IMULX)
return fixmul(sx, sy, sr);
else if(op == IDIVX)
return fixdiv(sx, sy, sr);
else
return fixcast(sx, sr);
}
ispoly(d: ref Decl): int
{
if(d == nil)
return 0;
t := d.ty;
if(t.kind == Tfn){
if(t.polys != nil)
return 1;
if((d = d.dot) == nil)
return 0;
t = d.ty;
return t.kind == Tadt && t.polys != nil;
}
return 0;
}
ispolyadt(t: ref Type): int
{
return (t.kind == Tadt || t.kind == Tadtpick) && t.polys != nil && (t.flags & INST) == byte 0;
}
polydecl(ids: ref Decl): ref Decl
{
id: ref Decl;
t: ref Type;
for(id = ids; id != nil; id = id.next){
t = mktype(id.src.start, id.src.stop, Tpoly, nil, nil);
id.ty = t;
t.decl = id;
}
return ids;
}
# try to convert an expression tree to a type
exptotype(n: ref Node): ref Type
{
t, tt: ref Type;
d: ref Decl;
tll: ref Typelist;
src: Src;
if(n == nil)
return nil;
t = nil;
case(n.op){
Oname =>
if((d = n.decl) != nil && d.store == Dtype)
t = d.ty;
Otype or Ochan =>
t = n.ty;
Oref =>
t = exptotype(n.left);
if(t != nil)
t = mktype(n.src.start, n.src.stop, Tref, t, nil);
Odot =>
t = exptotype(n.left);
if(t != nil){
d = namedot(t.tags, n.right.decl.sym);
if(d == nil)
t = nil;
else
t = d.ty;
}
if(t == nil)
t = exptotype(n.right);
Omdot =>
t = exptotype(n.right);
Oindex =>
t = exptotype(n.left);
if(t != nil){
src = n.src;
tll = nil;
for(n = n.right; n != nil; n = n.right){
if(n.op == Oseq)
tt = exptotype(n.left);
else
tt = exptotype(n);
if(tt == nil)
return nil;
tll = addtype(tt, tll);
if(n.op != Oseq)
break;
}
t = mkinsttype(src, t, tll);
}
}
return t;
}
uname(im: ref Decl): string
{
s := "";
for(p := im; p != nil; p = p.next){
s += p.sym.name;
if(p.next != nil)
s += "+";
}
return s;
}
# check all implementation modules have consistent declarations
# and create their union if needed
#
modimp(dl: ref Dlist, im: ref Decl): ref Decl
{
u, d, dd, ids, dot, last: ref Decl;
s: ref Sym;
if(dl.next == nil)
return dl.d;
dl0 := dl;
sg0 := 0;
un := uname(im);
installids(Dglobal, mkids(dl.d.src, enter(".m."+un, 0), tnone, nil));
u = dupdecl(dl.d);
u.sym = enter(un, 0);
u.sym.decl = u;
u.ty = mktype(u.src.start, u.src.stop, Tmodule, nil, nil);
u.ty.decl = u;
for( ; dl != nil; dl = dl.next){
d = dl.d;
ids = d.ty.tof.ids; # iface
if(ids != nil && ids.store == Dglobal) # .mp
sg := sign(ids);
else
sg = 0;
if(dl == dl0)
sg0 = sg;
else if(sg != sg0)
error(d.src.start, d.sym.name + "'s module data not consistent with that of " + dl0.d.sym.name + "\n");
for(ids = d.ty.ids; ids != nil; ids = ids.next){
s = ids.sym;
if(s.decl != nil && s.decl.scope >= scope){
if(ids == s.decl){
dd = dupdecl(ids);
if(u.ty.ids == nil)
u.ty.ids = dd;
else
last.next = dd;
last = dd;
continue;
}
dot = s.decl.dot;
if(s.decl.store != Dwundef && dot != nil && dot != d && isimpmod(dot.sym) && dequal(ids, s.decl, 1))
ids.refs = s.decl.refs;
else
redecl(ids);
ids.init = s.decl.init;
}
}
}
u.ty = usetype(u.ty);
return u;
}
modres(d: ref Decl)
{
ids, id, n, i: ref Decl;
t: ref Type;
for(ids = d.ty.ids; ids != nil; ids = ids.next){
id = ids.sym.decl;
if(ids != id){
n = ids.next;
i = ids.iface;
t = ids.ty;
*ids = *id;
ids.next = n;
ids.iface = i;
ids.ty = t;
}
}
}
# update the fields of duplicate declarations in other implementation modules
# and their union
#
modresolve()
{
dl: ref Dlist;
dl = impdecls;
if(dl.next == nil)
return;
for( ; dl != nil; dl = dl.next)
modres(dl.d);
modres(impdecl);
}