1 #include "limbo.h"
2 #include "mp.h"
3 #include "libsec.h"
4
5 char *kindname[Tend] =
6 {
7 /* Tnone */ "no type",
8 /* Tadt */ "adt",
9 /* Tadtpick */ "adt",
10 /* Tarray */ "array",
11 /* Tbig */ "big",
12 /* Tbyte */ "byte",
13 /* Tchan */ "chan",
14 /* Treal */ "real",
15 /* Tfn */ "fn",
16 /* Tint */ "int",
17 /* Tlist */ "list",
18 /* Tmodule */ "module",
19 /* Tref */ "ref",
20 /* Tstring */ "string",
21 /* Ttuple */ "tuple",
22 /* Texception */ "exception",
23 /* Tfix */ "fixed point",
24 /* Tpoly */ "polymorphic",
25
26 /* Tainit */ "array initializers",
27 /* Talt */ "alt channels",
28 /* Tany */ "polymorphic type",
29 /* Tarrow */ "->",
30 /* Tcase */ "case int labels",
31 /* Tcasel */ "case big labels",
32 /* Tcasec */ "case string labels",
33 /* Tdot */ ".",
34 /* Terror */ "type error",
35 /* Tgoto */ "goto labels",
36 /* Tid */ "id",
37 /* Tiface */ "module interface",
38 /* Texcept */ "exception handler table",
39 /* Tinst */ "instantiated type",
40 };
41
42 Tattr tattr[Tend] =
43 {
44 /* isptr refable conable big vis */
45 /* Tnone */ { 0, 0, 0, 0, 0, },
46 /* Tadt */ { 0, 1, 1, 1, 1, },
47 /* Tadtpick */ { 0, 1, 0, 1, 1, },
48 /* Tarray */ { 1, 0, 0, 0, 1, },
49 /* Tbig */ { 0, 0, 1, 1, 1, },
50 /* Tbyte */ { 0, 0, 1, 0, 1, },
51 /* Tchan */ { 1, 0, 0, 0, 1, },
52 /* Treal */ { 0, 0, 1, 1, 1, },
53 /* Tfn */ { 0, 1, 0, 0, 1, },
54 /* Tint */ { 0, 0, 1, 0, 1, },
55 /* Tlist */ { 1, 0, 0, 0, 1, },
56 /* Tmodule */ { 1, 0, 0, 0, 1, },
57 /* Tref */ { 1, 0, 0, 0, 1, },
58 /* Tstring */ { 1, 0, 1, 0, 1, },
59 /* Ttuple */ { 0, 1, 1, 1, 1, },
60 /* Texception */ { 0, 0, 0, 1, 1, },
61 /* Tfix */ { 0, 0, 1, 0, 1, },
62 /* Tpoly */ { 1, 0, 0, 0, 1, },
63
64 /* Tainit */ { 0, 0, 0, 1, 0, },
65 /* Talt */ { 0, 0, 0, 1, 0, },
66 /* Tany */ { 1, 0, 0, 0, 0, },
67 /* Tarrow */ { 0, 0, 0, 0, 1, },
68 /* Tcase */ { 0, 0, 0, 1, 0, },
69 /* Tcasel */ { 0, 0, 0, 1, 0, },
70 /* Tcasec */ { 0, 0, 0, 1, 0, },
71 /* Tdot */ { 0, 0, 0, 0, 1, },
72 /* Terror */ { 0, 1, 1, 0, 0, },
73 /* Tgoto */ { 0, 0, 0, 1, 0, },
74 /* Tid */ { 0, 0, 0, 0, 1, },
75 /* Tiface */ { 0, 0, 0, 1, 0, },
76 /* Texcept */ { 0, 0, 0, 1, 0, },
77 /* Tinst */ { 0, 1, 1, 1, 1, },
78 };
79
80 static Teq *eqclass[Tend];
81
82 static Type ztype;
83 static int eqrec;
84 static int eqset;
85 static int tcomset;
86
87 static int idcompat(Decl*, Decl*, int, int);
88 static int rtcompat(Type *t1, Type *t2, int any, int);
89 static int assumeteq(Type *t1, Type *t2);
90 static int assumetcom(Type *t1, Type *t2);
91 static int cleartcomrec(Type *t);
92 static int rtequal(Type*, Type*);
93 static int cleareqrec(Type*);
94 static int idequal(Decl*, Decl*, int, int*);
95 static int pyequal(Type*, Type*);
96 static int rtsign(Type*, uchar*, int, int);
97 static int clearrec(Type*);
98 static int idsign(Decl*, int, uchar*, int, int);
99 static int idsign1(Decl*, int, uchar*, int, int);
100 static int raisessign(Node *n, uchar *sig, int lensig, int spos);
101 static void ckfix(Type*, double);
102 static int fnunify(Type*, Type*, Tpair**, int);
103 static int rtunify(Type*, Type*, Tpair**, int);
104 static int idunify(Decl*, Decl*, Tpair**, int);
105 static int toccurs(Type*, Tpair**);
106 static int fncleareqrec(Type*, Type*);
107 static Type* comtype(Src*, Type*, Decl*);
108 static Type* duptype(Type*);
109 static int tpolys(Type*);
110
111 static void
addtmap(Type * t1,Type * t2,Tpair ** tpp)112 addtmap(Type *t1, Type *t2, Tpair **tpp)
113 {
114 Tpair *tp;
115
116 tp = allocmem(sizeof *tp);
117 tp->t1 = t1;
118 tp->t2 = t2;
119 tp->nxt = *tpp;
120 *tpp = tp;
121 }
122
123 Type*
valtmap(Type * t,Tpair * tp)124 valtmap(Type *t, Tpair *tp)
125 {
126 for( ; tp != nil; tp = tp->nxt)
127 if(tp->t1 == t)
128 return tp->t2;
129 return t;
130 }
131
132 Typelist*
addtype(Type * t,Typelist * hd)133 addtype(Type *t, Typelist *hd)
134 {
135 Typelist *tl, *p;
136
137 tl = allocmem(sizeof(*tl));
138 tl->t = t;
139 tl->nxt = nil;
140 if(hd == nil)
141 return tl;
142 for(p = hd; p->nxt != nil; p = p->nxt)
143 ;
144 p->nxt = tl;
145 return hd;
146 }
147
148 void
typeinit(void)149 typeinit(void)
150 {
151 Decl *id;
152
153 anontupsym = enter(".tuple", 0);
154
155 ztype.sbl = -1;
156 ztype.ok = 0;
157 ztype.rec = 0;
158
159 tbig = mktype(&noline, &noline, Tbig, nil, nil);
160 tbig->size = IBY2LG;
161 tbig->align = IBY2LG;
162 tbig->ok = OKmask;
163
164 tbyte = mktype(&noline, &noline, Tbyte, nil, nil);
165 tbyte->size = 1;
166 tbyte->align = 1;
167 tbyte->ok = OKmask;
168
169 tint = mktype(&noline, &noline, Tint, nil, nil);
170 tint->size = IBY2WD;
171 tint->align = IBY2WD;
172 tint->ok = OKmask;
173
174 treal = mktype(&noline, &noline, Treal, nil, nil);
175 treal->size = IBY2FT;
176 treal->align = IBY2FT;
177 treal->ok = OKmask;
178
179 tstring = mktype(&noline, &noline, Tstring, nil, nil);
180 tstring->size = IBY2WD;
181 tstring->align = IBY2WD;
182 tstring->ok = OKmask;
183
184 texception = mktype(&noline, &noline, Texception, nil, nil);
185 texception->size = IBY2WD;
186 texception->align = IBY2WD;
187 texception->ok = OKmask;
188
189 tany = mktype(&noline, &noline, Tany, nil, nil);
190 tany->size = IBY2WD;
191 tany->align = IBY2WD;
192 tany->ok = OKmask;
193
194 tnone = mktype(&noline, &noline, Tnone, nil, nil);
195 tnone->size = 0;
196 tnone->align = 1;
197 tnone->ok = OKmask;
198
199 terror = mktype(&noline, &noline, Terror, nil, nil);
200 terror->size = 0;
201 terror->align = 1;
202 terror->ok = OKmask;
203
204 tunknown = mktype(&noline, &noline, Terror, nil, nil);
205 tunknown->size = 0;
206 tunknown->align = 1;
207 tunknown->ok = OKmask;
208
209 tfnptr = mktype(&noline, &noline, Ttuple, nil, nil);
210 id = tfnptr->ids = mkids(&nosrc, nil, tany, nil);
211 id->store = Dfield;
212 id->offset = 0;
213 id->sym = enter("t0", 0);
214 id->src = nosrc;
215 id = tfnptr->ids->next = mkids(&nosrc, nil, tint, nil);
216 id->store = Dfield;
217 id->offset = IBY2WD;
218 id->sym = enter("t1", 0);
219 id->src = nosrc;
220
221 rtexception = mktype(&noline, &noline, Tref, texception, nil);
222 rtexception->size = IBY2WD;
223 rtexception->align = IBY2WD;
224 rtexception->ok = OKmask;
225 }
226
227 void
typestart(void)228 typestart(void)
229 {
230 descriptors = nil;
231 nfns = 0;
232 nadts = 0;
233 selfdecl = nil;
234 if(tfnptr->decl != nil)
235 tfnptr->decl->desc = nil;
236
237 memset(eqclass, 0, sizeof eqclass);
238
239 typebuiltin(mkids(&nosrc, enter("int", 0), nil, nil), tint);
240 typebuiltin(mkids(&nosrc, enter("big", 0), nil, nil), tbig);
241 typebuiltin(mkids(&nosrc, enter("byte", 0), nil, nil), tbyte);
242 typebuiltin(mkids(&nosrc, enter("string", 0), nil, nil), tstring);
243 typebuiltin(mkids(&nosrc, enter("real", 0), nil, nil), treal);
244 }
245
246 Teq*
modclass(void)247 modclass(void)
248 {
249 return eqclass[Tmodule];
250 }
251
252 Type*
mktype(Line * start,Line * stop,int kind,Type * tof,Decl * args)253 mktype(Line *start, Line *stop, int kind, Type *tof, Decl *args)
254 {
255 Type *t;
256
257 t = allocmem(sizeof *t);
258 *t = ztype;
259 t->src.start = *start;
260 t->src.stop = *stop;
261 t->kind = kind;
262 t->tof = tof;
263 t->ids = args;
264 return t;
265 }
266
267 Type*
mktalt(Case * c)268 mktalt(Case *c)
269 {
270 Type *t;
271 char buf[32];
272 static int nalt;
273
274 t = mktype(&noline, &noline, Talt, nil, nil);
275 t->decl = mkdecl(&nosrc, Dtype, t);
276 seprint(buf, buf+sizeof(buf), ".a%d", nalt++);
277 t->decl->sym = enter(buf, 0);
278 t->cse = c;
279 return usetype(t);
280 }
281
282 /*
283 * copy t and the top level of ids
284 */
285 Type*
copytypeids(Type * t)286 copytypeids(Type *t)
287 {
288 Type *nt;
289 Decl *id, *new, *last;
290
291 nt = allocmem(sizeof *nt);
292 *nt = *t;
293 last = nil;
294 for(id = t->ids; id != nil; id = id->next){
295 new = allocmem(sizeof *id);
296 *new = *id;
297 if(last == nil)
298 nt->ids = new;
299 else
300 last->next = new;
301 last = new;
302 }
303 return nt;
304 }
305
306 /*
307 * make each of the ids have type t
308 */
309 Decl*
typeids(Decl * ids,Type * t)310 typeids(Decl *ids, Type *t)
311 {
312 Decl *id;
313
314 if(ids == nil)
315 return nil;
316
317 ids->ty = t;
318 for(id = ids->next; id != nil; id = id->next){
319 id->ty = t;
320 }
321 return ids;
322 }
323
324 void
typebuiltin(Decl * d,Type * t)325 typebuiltin(Decl *d, Type *t)
326 {
327 d->ty = t;
328 t->decl = d;
329 installids(Dtype, d);
330 }
331
332 Node *
fielddecl(int store,Decl * ids)333 fielddecl(int store, Decl *ids)
334 {
335 Node *n;
336
337 n = mkn(Ofielddecl, nil, nil);
338 n->decl = ids;
339 for(; ids != nil; ids = ids->next)
340 ids->store = store;
341 return n;
342 }
343
344 Node *
typedecl(Decl * ids,Type * t)345 typedecl(Decl *ids, Type *t)
346 {
347 Node *n;
348
349 if(t->decl == nil)
350 t->decl = ids;
351 n = mkn(Otypedecl, nil, nil);
352 n->decl = ids;
353 n->ty = t;
354 for(; ids != nil; ids = ids->next)
355 ids->ty = t;
356 return n;
357 }
358
359 void
typedecled(Node * n)360 typedecled(Node *n)
361 {
362 installids(Dtype, n->decl);
363 }
364
365 Node *
adtdecl(Decl * ids,Node * fields)366 adtdecl(Decl *ids, Node *fields)
367 {
368 Node *n;
369 Type *t;
370
371 n = mkn(Oadtdecl, nil, nil);
372 t = mktype(&ids->src.start, &ids->src.stop, Tadt, nil, nil);
373 n->decl = ids;
374 n->left = fields;
375 n->ty = t;
376 t->decl = ids;
377 for(; ids != nil; ids = ids->next)
378 ids->ty = t;
379 return n;
380 }
381
382 void
adtdecled(Node * n)383 adtdecled(Node *n)
384 {
385 Decl *d, *ids;
386
387 d = n->ty->decl;
388 installids(Dtype, d);
389 if(n->ty->polys != nil){
390 pushscope(nil, Sother);
391 installids(Dtype, n->ty->polys);
392 }
393 pushscope(nil, Sother);
394 fielddecled(n->left);
395 n->ty->ids = popscope();
396 if(n->ty->polys != nil)
397 n->ty->polys = popscope();
398 for(ids = n->ty->ids; ids != nil; ids = ids->next)
399 ids->dot = d;
400 }
401
402 void
fielddecled(Node * n)403 fielddecled(Node *n)
404 {
405 for(; n != nil; n = n->right){
406 switch(n->op){
407 case Oseq:
408 fielddecled(n->left);
409 break;
410 case Oadtdecl:
411 adtdecled(n);
412 return;
413 case Otypedecl:
414 typedecled(n);
415 return;
416 case Ofielddecl:
417 installids(Dfield, n->decl);
418 return;
419 case Ocondecl:
420 condecled(n);
421 gdasdecl(n->right);
422 return;
423 case Oexdecl:
424 exdecled(n);
425 return;
426 case Opickdecl:
427 pickdecled(n);
428 return;
429 default:
430 fatal("can't deal with %O in fielddecled", n->op);
431 }
432 }
433 }
434
435 int
pickdecled(Node * n)436 pickdecled(Node *n)
437 {
438 Decl *d;
439 int tag;
440
441 if(n == nil)
442 return 0;
443 tag = pickdecled(n->left);
444 pushscope(nil, Sother);
445 fielddecled(n->right->right);
446 d = n->right->left->decl;
447 d->ty->ids = popscope();
448 installids(Dtag, d);
449 for(; d != nil; d = d->next)
450 d->tag = tag++;
451 return tag;
452 }
453
454 /*
455 * make the tuple type used to initialize adt t
456 */
457 Type*
mkadtcon(Type * t)458 mkadtcon(Type *t)
459 {
460 Decl *id, *new, *last;
461 Type *nt;
462
463 nt = allocmem(sizeof *nt);
464 *nt = *t;
465 last = nil;
466 nt->ids = nil;
467 nt->kind = Ttuple;
468 for(id = t->ids; id != nil; id = id->next){
469 if(id->store != Dfield)
470 continue;
471 new = allocmem(sizeof *id);
472 *new = *id;
473 new->cyc = 0;
474 if(last == nil)
475 nt->ids = new;
476 else
477 last->next = new;
478 last = new;
479 }
480 last->next = nil;
481 return nt;
482 }
483
484 /*
485 * make the tuple type used to initialize t,
486 * an adt with pick fields tagged by tg
487 */
488 Type*
mkadtpickcon(Type * t,Type * tgt)489 mkadtpickcon(Type *t, Type *tgt)
490 {
491 Decl *id, *new, *last;
492 Type *nt;
493
494 last = mkids(&tgt->decl->src, nil, tint, nil);
495 last->store = Dfield;
496 nt = mktype(&t->src.start, &t->src.stop, Ttuple, nil, last);
497 for(id = t->ids; id != nil; id = id->next){
498 if(id->store != Dfield)
499 continue;
500 new = allocmem(sizeof *id);
501 *new = *id;
502 new->cyc = 0;
503 last->next = new;
504 last = new;
505 }
506 for(id = tgt->ids; id != nil; id = id->next){
507 if(id->store != Dfield)
508 continue;
509 new = allocmem(sizeof *id);
510 *new = *id;
511 new->cyc = 0;
512 last->next = new;
513 last = new;
514 }
515 last->next = nil;
516 return nt;
517 }
518
519 /*
520 * make an identifier type
521 */
522 Type*
mkidtype(Src * src,Sym * s)523 mkidtype(Src *src, Sym *s)
524 {
525 Type *t;
526
527 t = mktype(&src->start, &src->stop, Tid, nil, nil);
528 if(s->unbound == nil){
529 s->unbound = mkdecl(src, Dunbound, nil);
530 s->unbound->sym = s;
531 }
532 t->decl = s->unbound;
533 return t;
534 }
535
536 /*
537 * make a qualified type for t->s
538 */
539 Type*
mkarrowtype(Line * start,Line * stop,Type * t,Sym * s)540 mkarrowtype(Line *start, Line *stop, Type *t, Sym *s)
541 {
542 Src src;
543
544 src.start = *start;
545 src.stop = *stop;
546 t = mktype(start, stop, Tarrow, t, nil);
547 if(s->unbound == nil){
548 s->unbound = mkdecl(&src, Dunbound, nil);
549 s->unbound->sym = s;
550 }
551 t->decl = s->unbound;
552 return t;
553 }
554
555 /*
556 * make a qualified type for t.s
557 */
558 Type*
mkdottype(Line * start,Line * stop,Type * t,Sym * s)559 mkdottype(Line *start, Line *stop, Type *t, Sym *s)
560 {
561 Src src;
562
563 src.start = *start;
564 src.stop = *stop;
565 t = mktype(start, stop, Tdot, t, nil);
566 if(s->unbound == nil){
567 s->unbound = mkdecl(&src, Dunbound, nil);
568 s->unbound->sym = s;
569 }
570 t->decl = s->unbound;
571 return t;
572 }
573
574 Type*
mkinsttype(Src * src,Type * tt,Typelist * tl)575 mkinsttype(Src* src, Type *tt, Typelist *tl)
576 {
577 Type *t;
578
579 t = mktype(&src->start, &src->stop, Tinst, tt, nil);
580 t->u.tlist = tl;
581 return t;
582 }
583
584 /*
585 * look up the name f in the fields of a module, adt, or tuple
586 */
587 Decl*
namedot(Decl * ids,Sym * s)588 namedot(Decl *ids, Sym *s)
589 {
590 for(; ids != nil; ids = ids->next)
591 if(ids->sym == s)
592 return ids;
593 return nil;
594 }
595
596 /*
597 * complete the declaration of an adt
598 * methods frames get sized in module definition or during function definition
599 * place the methods at the end of the field list
600 */
601 void
adtdefd(Type * t)602 adtdefd(Type *t)
603 {
604 Decl *d, *id, *next, *aux, *store, *auxhd, *tagnext;
605 int seentags;
606
607 if(debug['x'])
608 print("adt %T defd\n", t);
609 d = t->decl;
610 tagnext = nil;
611 store = nil;
612 for(id = t->polys; id != nil; id = id->next){
613 id->store = Dtype;
614 id->ty = verifytypes(id->ty, d, nil);
615 }
616 for(id = t->ids; id != nil; id = next){
617 if(id->store == Dtag){
618 if(t->tags != nil)
619 error(id->src.start, "only one set of pick fields allowed");
620 tagnext = pickdefd(t, id);
621 next = tagnext;
622 if(store != nil)
623 store->next = next;
624 else
625 t->ids = next;
626 continue;
627 }else{
628 id->dot = d;
629 next = id->next;
630 store = id;
631 }
632 }
633 aux = nil;
634 store = nil;
635 auxhd = nil;
636 seentags = 0;
637 for(id = t->ids; id != nil; id = next){
638 if(id == tagnext)
639 seentags = 1;
640
641 next = id->next;
642 id->dot = d;
643 id->ty = topvartype(verifytypes(id->ty, d, nil), id, 1, 1);
644 if(id->store == Dfield && id->ty->kind == Tfn)
645 id->store = Dfn;
646 if(id->store == Dfn || id->store == Dconst){
647 if(store != nil)
648 store->next = next;
649 else
650 t->ids = next;
651 if(aux != nil)
652 aux->next = id;
653 else
654 auxhd = id;
655 aux = id;
656 }else{
657 if(seentags)
658 error(id->src.start, "pick fields must be the last data fields in an adt");
659 store = id;
660 }
661 }
662 if(aux != nil)
663 aux->next = nil;
664 if(store != nil)
665 store->next = auxhd;
666 else
667 t->ids = auxhd;
668
669 for(id = t->tags; id != nil; id = id->next){
670 id->ty = verifytypes(id->ty, d, nil);
671 if(id->ty->tof == nil)
672 id->ty->tof = mkadtpickcon(t, id->ty);
673 }
674 }
675
676 /*
677 * assemble the data structure for an adt with a pick clause.
678 * since the scoping rules for adt pick fields are strange,
679 * we have a customized check for overlapping definitions.
680 */
681 Decl*
pickdefd(Type * t,Decl * tg)682 pickdefd(Type *t, Decl *tg)
683 {
684 Decl *id, *xid, *lasttg, *d;
685 Type *tt;
686 int tag;
687
688 lasttg = nil;
689 d = t->decl;
690 t->tags = tg;
691 tag = 0;
692 while(tg != nil){
693 tt = tg->ty;
694 if(tt->kind != Tadtpick || tg->tag != tag)
695 break;
696 tt->decl = tg;
697 lasttg = tg;
698 for(; tg != nil; tg = tg->next){
699 if(tg->ty != tt)
700 break;
701 tag++;
702 lasttg = tg;
703 tg->dot = d;
704 }
705 for(id = tt->ids; id != nil; id = id->next){
706 xid = namedot(t->ids, id->sym);
707 if(xid != nil)
708 error(id->src.start, "redeclaration of %K, previously declared as %k on line %L",
709 id, xid, xid->src.start);
710 id->dot = d;
711 }
712 }
713 if(lasttg == nil){
714 error(t->src.start, "empty pick field declaration in %T", t);
715 t->tags = nil;
716 }else
717 lasttg->next = nil;
718 d->tag = tag;
719 return tg;
720 }
721
722 Node*
moddecl(Decl * ids,Node * fields)723 moddecl(Decl *ids, Node *fields)
724 {
725 Node *n;
726 Type *t;
727
728 n = mkn(Omoddecl, mkn(Oseq, nil, nil), nil);
729 t = mktype(&ids->src.start, &ids->src.stop, Tmodule, nil, nil);
730 n->decl = ids;
731 n->left = fields;
732 n->ty = t;
733 return n;
734 }
735
736 void
moddecled(Node * n)737 moddecled(Node *n)
738 {
739 Decl *d, *ids, *im, *dot;
740 Type *t;
741 Sym *s;
742 char buf[StrSize];
743 int isimp;
744 Dlist *dm, *dl;
745
746 d = n->decl;
747 installids(Dtype, d);
748 isimp = 0;
749 for(ids = d; ids != nil; ids = ids->next){
750 for(im = impmods; im != nil; im = im->next){
751 if(ids->sym == im->sym){
752 isimp = 1;
753 d = ids;
754 dm = malloc(sizeof(Dlist));
755 dm->d = ids;
756 dm->next = nil;
757 if(impdecls == nil)
758 impdecls = dm;
759 else{
760 for(dl = impdecls; dl->next != nil; dl = dl->next)
761 ;
762 dl->next = dm;
763 }
764 }
765 }
766 ids->ty = n->ty;
767 }
768 pushscope(nil, Sother);
769 fielddecled(n->left);
770
771 d->ty->ids = popscope();
772
773 /*
774 * make the current module the -> parent of all contained decls->
775 */
776 for(ids = d->ty->ids; ids != nil; ids = ids->next)
777 ids->dot = d;
778
779 t = d->ty;
780 t->decl = d;
781 if(debug['m'])
782 print("declare module %s\n", d->sym->name);
783
784 /*
785 * add the iface declaration in case it's needed later
786 */
787 seprint(buf, buf+sizeof(buf), ".m.%s", d->sym->name);
788 installids(Dglobal, mkids(&d->src, enter(buf, 0), tnone, nil));
789
790 if(isimp){
791 for(ids = d->ty->ids; ids != nil; ids = ids->next){
792 s = ids->sym;
793 if(s->decl != nil && s->decl->scope >= scope){
794 dot = s->decl->dot;
795 if(s->decl->store != Dwundef && dot != nil && dot != d && isimpmod(dot->sym) && dequal(ids, s->decl, 0))
796 continue;
797 redecl(ids);
798 ids->old = s->decl->old;
799 }else
800 ids->old = s->decl;
801 s->decl = ids;
802 ids->scope = scope;
803 }
804 }
805 }
806
807 /*
808 * for each module in id,
809 * link by field ext all of the decls for
810 * functions needed in external linkage table
811 * collect globals and make a tuple for all of them
812 */
813 Type*
mkiface(Decl * m)814 mkiface(Decl *m)
815 {
816 Decl *iface, *last, *globals, *glast, *id, *d;
817 Type *t;
818 char buf[StrSize];
819
820 iface = last = allocmem(sizeof(Decl));
821 globals = glast = mkdecl(&m->src, Dglobal, mktype(&m->src.start, &m->src.stop, Tadt, nil, nil));
822 for(id = m->ty->ids; id != nil; id = id->next){
823 switch(id->store){
824 case Dglobal:
825 glast = glast->next = dupdecl(id);
826 id->iface = globals;
827 glast->iface = id;
828 break;
829 case Dfn:
830 id->iface = last = last->next = dupdecl(id);
831 last->iface = id;
832 break;
833 case Dtype:
834 if(id->ty->kind != Tadt)
835 break;
836 for(d = id->ty->ids; d != nil; d = d->next){
837 if(d->store == Dfn){
838 d->iface = last = last->next = dupdecl(d);
839 last->iface = d;
840 }
841 }
842 break;
843 }
844 }
845 last->next = nil;
846 iface = namesort(iface->next);
847
848 if(globals->next != nil){
849 glast->next = nil;
850 globals->ty->ids = namesort(globals->next);
851 globals->ty->decl = globals;
852 globals->sym = enter(".mp", 0);
853 globals->dot = m;
854 globals->next = iface;
855 iface = globals;
856 }
857
858 /*
859 * make the interface type and install an identifier for it
860 * the iface has a ref count if it is loaded
861 */
862 t = mktype(&m->src.start, &m->src.stop, Tiface, nil, iface);
863 seprint(buf, buf+sizeof(buf), ".m.%s", m->sym->name);
864 id = enter(buf, 0)->decl;
865 t->decl = id;
866 id->ty = t;
867
868 /*
869 * dummy node so the interface is initialized
870 */
871 id->init = mkn(Onothing, nil, nil);
872 id->init->ty = t;
873 id->init->decl = id;
874 return t;
875 }
876
877 void
joiniface(Type * mt,Type * t)878 joiniface(Type *mt, Type *t)
879 {
880 Decl *id, *d, *iface, *globals;
881
882 iface = t->ids;
883 globals = iface;
884 if(iface != nil && iface->store == Dglobal)
885 iface = iface->next;
886 for(id = mt->tof->ids; id != nil; id = id->next){
887 switch(id->store){
888 case Dglobal:
889 for(d = id->ty->ids; d != nil; d = d->next)
890 d->iface->iface = globals;
891 break;
892 case Dfn:
893 id->iface->iface = iface;
894 iface = iface->next;
895 break;
896 default:
897 fatal("unknown store %k in joiniface", id);
898 break;
899 }
900 }
901 if(iface != nil)
902 fatal("join iface not matched");
903 mt->tof = t;
904 }
905
906 void
addiface(Decl * m,Decl * d)907 addiface(Decl *m, Decl *d)
908 {
909 Type *t;
910 Decl *id, *last, *dd, *lastorig;
911 Dlist *dl;
912
913 if(d == nil || !local(d))
914 return;
915 modrefable(d->ty);
916 if(m == nil){
917 if(impdecls->next != nil)
918 for(dl = impdecls; dl != nil; dl = dl->next)
919 if(dl->d->ty->tof != impdecl->ty->tof) /* impdecl last */
920 addiface(dl->d, d);
921 addiface(impdecl, d);
922 return;
923 }
924 t = m->ty->tof;
925 last = nil;
926 lastorig = nil;
927 for(id = t->ids; id != nil; id = id->next){
928 if(d == id || d == id->iface)
929 return;
930 last = id;
931 if(id->tag == 0)
932 lastorig = id;
933 }
934 dd = dupdecl(d);
935 if(d->dot == nil)
936 d->dot = dd->dot = m;
937 d->iface = dd;
938 dd->iface = d;
939 if(debug['v']) print("addiface %p %p\n", d, dd);
940 if(last == nil)
941 t->ids = dd;
942 else
943 last->next = dd;
944 dd->tag = 1; /* mark so not signed */
945 if(lastorig == nil)
946 t->ids = namesort(t->ids);
947 else
948 lastorig->next = namesort(lastorig->next);
949 }
950
951 /*
952 * eliminate unused declarations from interfaces
953 * label offset within interface
954 */
955 void
narrowmods(void)956 narrowmods(void)
957 {
958 Teq *eq;
959 Decl *id, *last;
960 Type *t;
961 long offset;
962
963 for(eq = modclass(); eq != nil; eq = eq->eq){
964 t = eq->ty->tof;
965
966 if(t->linkall == 0){
967 last = nil;
968 for(id = t->ids; id != nil; id = id->next){
969 if(id->refs == 0){
970 if(last == nil)
971 t->ids = id->next;
972 else
973 last->next = id->next;
974 }else
975 last = id;
976 }
977
978 /*
979 * need to resize smaller interfaces
980 */
981 resizetype(t);
982 }
983
984 offset = 0;
985 for(id = t->ids; id != nil; id = id->next)
986 id->offset = offset++;
987
988 /*
989 * rathole to stuff number of entries in interface
990 */
991 t->decl->init->val = offset;
992 }
993 }
994
995 /*
996 * check to see if any data field of module m if referenced.
997 * if so, mark all data in m
998 */
999 void
moddataref(void)1000 moddataref(void)
1001 {
1002 Teq *eq;
1003 Decl *id;
1004
1005 for(eq = modclass(); eq != nil; eq = eq->eq){
1006 id = eq->ty->tof->ids;
1007 if(id != nil && id->store == Dglobal && id->refs)
1008 for(id = eq->ty->ids; id != nil; id = id->next)
1009 if(id->store == Dglobal)
1010 modrefable(id->ty);
1011 }
1012 }
1013
1014 /*
1015 * move the global declarations in interface to the front
1016 */
1017 Decl*
modglobals(Decl * mod,Decl * globals)1018 modglobals(Decl *mod, Decl *globals)
1019 {
1020 Decl *id, *head, *last;
1021
1022 /*
1023 * make a copy of all the global declarations
1024 * used for making a type descriptor for globals ONLY
1025 * note we now have two declarations for the same variables,
1026 * which is apt to cause problems if code changes
1027 *
1028 * here we fix up the offsets for the real declarations
1029 */
1030 idoffsets(mod->ty->ids, 0, 1);
1031
1032 last = head = allocmem(sizeof(Decl));
1033 for(id = mod->ty->ids; id != nil; id = id->next)
1034 if(id->store == Dglobal)
1035 last = last->next = dupdecl(id);
1036
1037 last->next = globals;
1038 return head->next;
1039 }
1040
1041 /*
1042 * snap all id type names to the actual type
1043 * check that all types are completely defined
1044 * verify that the types look ok
1045 */
1046 Type*
validtype(Type * t,Decl * inadt)1047 validtype(Type *t, Decl *inadt)
1048 {
1049 if(t == nil)
1050 return t;
1051 bindtypes(t);
1052 t = verifytypes(t, inadt, nil);
1053 cycsizetype(t);
1054 teqclass(t);
1055 return t;
1056 }
1057
1058 Type*
usetype(Type * t)1059 usetype(Type *t)
1060 {
1061 if(t == nil)
1062 return t;
1063 t = validtype(t, nil);
1064 reftype(t);
1065 return t;
1066 }
1067
1068 Type*
internaltype(Type * t)1069 internaltype(Type *t)
1070 {
1071 bindtypes(t);
1072 t->ok = OKverify;
1073 sizetype(t);
1074 t->ok = OKmask;
1075 return t;
1076 }
1077
1078 /*
1079 * checks that t is a valid top-level type
1080 */
1081 Type*
topvartype(Type * t,Decl * id,int tyok,int polyok)1082 topvartype(Type *t, Decl *id, int tyok, int polyok)
1083 {
1084 if(t->kind == Tadt && t->tags != nil || t->kind == Tadtpick)
1085 error(id->src.start, "cannot declare %s with type %T", id->sym->name, t);
1086 if(!tyok && t->kind == Tfn)
1087 error(id->src.start, "cannot declare %s to be a function", id->sym->name);
1088 if(!polyok && (t->kind == Tadt || t->kind == Tadtpick) && ispolyadt(t))
1089 error(id->src.start, "cannot declare %s of a polymorphic type", id->sym->name);
1090 return t;
1091 }
1092
1093 Type*
toptype(Src * src,Type * t)1094 toptype(Src *src, Type *t)
1095 {
1096 if(t->kind == Tadt && t->tags != nil || t->kind == Tadtpick)
1097 error(src->start, "%T, an adt with pick fields, must be used with ref", t);
1098 if(t->kind == Tfn)
1099 error(src->start, "data cannot have a fn type like %T", t);
1100 return t;
1101 }
1102
1103 static Type*
comtype(Src * src,Type * t,Decl * adtd)1104 comtype(Src *src, Type *t, Decl* adtd)
1105 {
1106 if(adtd == nil && (t->kind == Tadt || t->kind == Tadtpick) && ispolyadt(t))
1107 error(src->start, "polymorphic type %T illegal here", t);
1108 return t;
1109 }
1110
1111 void
usedty(Type * t)1112 usedty(Type *t)
1113 {
1114 if(t != nil && (t->ok | OKmodref) != OKmask)
1115 fatal("used ty %t %2.2ux", t, t->ok);
1116 }
1117
1118 void
bindtypes(Type * t)1119 bindtypes(Type *t)
1120 {
1121 Decl *id;
1122 Typelist *tl;
1123
1124 if(t == nil)
1125 return;
1126 if((t->ok & OKbind) == OKbind)
1127 return;
1128 t->ok |= OKbind;
1129 switch(t->kind){
1130 case Tadt:
1131 if(t->polys != nil){
1132 pushscope(nil, Sother);
1133 installids(Dtype, t->polys);
1134 }
1135 if(t->val != nil)
1136 mergepolydecs(t);
1137 if(t->polys != nil){
1138 popscope();
1139 for(id = t->polys; id != nil; id = id->next)
1140 bindtypes(id->ty);
1141 }
1142 break;
1143 case Tadtpick:
1144 case Tmodule:
1145 case Terror:
1146 case Tint:
1147 case Tbig:
1148 case Tstring:
1149 case Treal:
1150 case Tbyte:
1151 case Tnone:
1152 case Tany:
1153 case Tiface:
1154 case Tainit:
1155 case Talt:
1156 case Tcase:
1157 case Tcasel:
1158 case Tcasec:
1159 case Tgoto:
1160 case Texcept:
1161 case Tfix:
1162 case Tpoly:
1163 break;
1164 case Tarray:
1165 case Tarrow:
1166 case Tchan:
1167 case Tdot:
1168 case Tlist:
1169 case Tref:
1170 bindtypes(t->tof);
1171 break;
1172 case Tid:
1173 id = t->decl->sym->decl;
1174 if(id == nil)
1175 id = undefed(&t->src, t->decl->sym);
1176 /* save a little space */
1177 id->sym->unbound = nil;
1178 t->decl = id;
1179 break;
1180 case Ttuple:
1181 case Texception:
1182 for(id = t->ids; id != nil; id = id->next)
1183 bindtypes(id->ty);
1184 break;
1185 case Tfn:
1186 if(t->polys != nil){
1187 pushscope(nil, Sother);
1188 installids(Dtype, t->polys);
1189 }
1190 for(id = t->ids; id != nil; id = id->next)
1191 bindtypes(id->ty);
1192 bindtypes(t->tof);
1193 if(t->val != nil)
1194 mergepolydecs(t);
1195 if(t->polys != nil){
1196 popscope();
1197 for(id = t->polys; id != nil; id = id->next)
1198 bindtypes(id->ty);
1199 }
1200 break;
1201 case Tinst:
1202 bindtypes(t->tof);
1203 for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
1204 bindtypes(tl->t);
1205 break;
1206 default:
1207 fatal("bindtypes: unknown type kind %d", t->kind);
1208 }
1209 }
1210
1211 /*
1212 * walk the type checking for validity
1213 */
1214 Type*
verifytypes(Type * t,Decl * adtt,Decl * poly)1215 verifytypes(Type *t, Decl *adtt, Decl *poly)
1216 {
1217 Node *n;
1218 Decl *id, *id1, *last;
1219 char buf[32];
1220 int i, cyc;
1221 Ok ok, ok1;
1222 double max;
1223 Typelist *tl;
1224
1225 if(t == nil)
1226 return nil;
1227 if((t->ok & OKverify) == OKverify)
1228 return t;
1229 t->ok |= OKverify;
1230 if((t->ok & (OKverify|OKbind)) != (OKverify|OKbind))
1231 fatal("verifytypes bogus ok for %t", t);
1232 cyc = t->flags&CYCLIC;
1233 switch(t->kind){
1234 case Terror:
1235 case Tint:
1236 case Tbig:
1237 case Tstring:
1238 case Treal:
1239 case Tbyte:
1240 case Tnone:
1241 case Tany:
1242 case Tiface:
1243 case Tainit:
1244 case Talt:
1245 case Tcase:
1246 case Tcasel:
1247 case Tcasec:
1248 case Tgoto:
1249 case Texcept:
1250 break;
1251 case Tfix:
1252 n = t->val;
1253 max = 0.0;
1254 if(n->op == Oseq){
1255 ok = echeck(n->left, 0, 0, n);
1256 ok1 = echeck(n->right, 0, 0, n);
1257 if(!ok.ok || !ok1.ok)
1258 return terror;
1259 if(n->left->ty != treal || n->right->ty != treal){
1260 error(t->src.start, "fixed point scale/maximum not real");
1261 return terror;
1262 }
1263 n->right = fold(n->right);
1264 if(n->right->op != Oconst){
1265 error(t->src.start, "fixed point maximum not constant");
1266 return terror;
1267 }
1268 if((max = n->right->rval) <= 0){
1269 error(t->src.start, "non-positive fixed point maximum");
1270 return terror;
1271 }
1272 n = n->left;
1273 }
1274 else{
1275 ok = echeck(n, 0, 0, nil);
1276 if(!ok.ok)
1277 return terror;
1278 if(n->ty != treal){
1279 error(t->src.start, "fixed point scale not real");
1280 return terror;
1281 }
1282 }
1283 n = t->val = fold(n);
1284 if(n->op != Oconst){
1285 error(t->src.start, "fixed point scale not constant");
1286 return terror;
1287 }
1288 if(n->rval <= 0){
1289 error(t->src.start, "non-positive fixed point scale");
1290 return terror;
1291 }
1292 ckfix(t, max);
1293 break;
1294 case Tref:
1295 t->tof = comtype(&t->src, verifytypes(t->tof, adtt, nil), adtt);
1296 if(t->tof != nil && !tattr[t->tof->kind].refable){
1297 error(t->src.start, "cannot have a ref %T", t->tof);
1298 return terror;
1299 }
1300 if(0 && t->tof->kind == Tfn && t->tof->ids != nil && t->tof->ids->implicit)
1301 error(t->src.start, "function references cannot have a self argument");
1302 if(0 && t->tof->kind == Tfn && t->polys != nil)
1303 error(t->src.start, "function references cannot be polymorphic");
1304 break;
1305 case Tchan:
1306 case Tarray:
1307 case Tlist:
1308 t->tof = comtype(&t->src, toptype(&t->src, verifytypes(t->tof, adtt, nil)), adtt);
1309 break;
1310 case Tid:
1311 t->ok &= ~OKverify;
1312 t = verifytypes(idtype(t), adtt, nil);
1313 break;
1314 case Tarrow:
1315 t->ok &= ~OKverify;
1316 t = verifytypes(arrowtype(t, adtt), adtt, nil);
1317 break;
1318 case Tdot:
1319 /*
1320 * verify the parent adt & lookup the tag fields
1321 */
1322 t->ok &= ~OKverify;
1323 t = verifytypes(dottype(t, adtt), adtt, nil);
1324 break;
1325 case Tadt:
1326 /*
1327 * this is where Tadt may get tag fields added
1328 */
1329 adtdefd(t);
1330 break;
1331 case Tadtpick:
1332 for(id = t->ids; id != nil; id = id->next){
1333 id->ty = topvartype(verifytypes(id->ty, id->dot, nil), id, 0, 1);
1334 if(id->store == Dconst)
1335 error(t->src.start, "pick fields cannot be a con like %s", id->sym->name);
1336 }
1337 verifytypes(t->decl->dot->ty, nil, nil);
1338 break;
1339 case Tmodule:
1340 for(id = t->ids; id != nil; id = id->next){
1341 id->ty = verifytypes(id->ty, nil, nil);
1342 if(id->store == Dglobal && id->ty->kind == Tfn)
1343 id->store = Dfn;
1344 if(id->store != Dtype && id->store != Dfn)
1345 topvartype(id->ty, id, 0, 0);
1346 }
1347 break;
1348 case Ttuple:
1349 case Texception:
1350 if(t->decl == nil){
1351 t->decl = mkdecl(&t->src, Dtype, t);
1352 t->decl->sym = enter(".tuple", 0);
1353 }
1354 i = 0;
1355 for(id = t->ids; id != nil; id = id->next){
1356 id->store = Dfield;
1357 if(id->sym == nil){
1358 seprint(buf, buf+sizeof(buf), "t%d", i);
1359 id->sym = enter(buf, 0);
1360 }
1361 i++;
1362 id->ty = toptype(&id->src, verifytypes(id->ty, adtt, nil));
1363 /* id->ty = comtype(&id->src, toptype(&id->src, verifytypes(id->ty, adtt, nil)), adtt); */
1364 }
1365 break;
1366 case Tfn:
1367 last = nil;
1368 for(id = t->ids; id != nil; id = id->next){
1369 id->store = Darg;
1370 id->ty = topvartype(verifytypes(id->ty, adtt, nil), id, 0, 1);
1371 if(id->implicit){
1372 Decl *selfd;
1373
1374 selfd = poly ? poly : adtt;
1375 if(selfd == nil)
1376 error(t->src.start, "function is not a member of an adt, so can't use self");
1377 else if(id != t->ids)
1378 error(id->src.start, "only the first argument can use self");
1379 else if(id->ty != selfd->ty && (id->ty->kind != Tref || id->ty->tof != selfd->ty))
1380 error(id->src.start, "self argument's type must be %s or ref %s",
1381 selfd->sym->name, selfd->sym->name);
1382 }
1383 last = id;
1384 }
1385 for(id = t->polys; id != nil; id = id->next){
1386 if(adtt != nil){
1387 for(id1 = adtt->ty->polys; id1 != nil; id1 = id1->next){
1388 if(id1->sym == id->sym)
1389 id->ty = id1->ty;
1390 }
1391 }
1392 id->store = Dtype;
1393 id->ty = verifytypes(id->ty, adtt, nil);
1394 }
1395 t->tof = comtype(&t->src, toptype(&t->src, verifytypes(t->tof, adtt, nil)), adtt);
1396 if(t->varargs && (last == nil || last->ty != tstring))
1397 error(t->src.start, "variable arguments must be preceded by a string");
1398 if(t->varargs && t->polys != nil)
1399 error(t->src.start, "polymorphic functions must not have variable arguments");
1400 break;
1401 case Tpoly:
1402 for(id = t->ids; id != nil; id = id->next){
1403 id->store = Dfn;
1404 id->ty = verifytypes(id->ty, adtt, t->decl);
1405 }
1406 break;
1407 case Tinst:
1408 t->ok &= ~OKverify;
1409 t->tof = verifytypes(t->tof, adtt, nil);
1410 for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
1411 tl->t = verifytypes(tl->t, adtt, nil);
1412 t = verifytypes(insttype(t, adtt, nil), adtt, nil);
1413 break;
1414 default:
1415 fatal("verifytypes: unknown type kind %d", t->kind);
1416 }
1417 if(cyc)
1418 t->flags |= CYCLIC;
1419 return t;
1420 }
1421
1422 /*
1423 * resolve an id type
1424 */
1425 Type*
idtype(Type * t)1426 idtype(Type *t)
1427 {
1428 Decl *id;
1429 Type *tt;
1430
1431 id = t->decl;
1432 if(id->store == Dunbound)
1433 fatal("idtype: unbound decl");
1434 tt = id->ty;
1435 if(id->store != Dtype && id->store != Dtag){
1436 if(id->store == Dundef){
1437 id->store = Dwundef;
1438 error(t->src.start, "%s is not declared", id->sym->name);
1439 }else if(id->store == Dimport){
1440 id->store = Dwundef;
1441 error(t->src.start, "%s's type cannot be determined", id->sym->name);
1442 }else if(id->store != Dwundef)
1443 error(t->src.start, "%s is not a type", id->sym->name);
1444 return terror;
1445 }
1446 if(tt == nil){
1447 error(t->src.start, "%t not fully defined", t);
1448 return terror;
1449 }
1450 return tt;
1451 }
1452
1453 /*
1454 * resolve a -> qualified type
1455 */
1456 Type*
arrowtype(Type * t,Decl * adtt)1457 arrowtype(Type *t, Decl *adtt)
1458 {
1459 Type *tt;
1460 Decl *id;
1461
1462 id = t->decl;
1463 if(id->ty != nil){
1464 if(id->store == Dunbound)
1465 fatal("arrowtype: unbound decl has a type");
1466 return id->ty;
1467 }
1468
1469 /*
1470 * special hack to allow module variables to derive other types
1471 */
1472 tt = t->tof;
1473 if(tt->kind == Tid){
1474 id = tt->decl;
1475 if(id->store == Dunbound)
1476 fatal("arrowtype: Tid's decl unbound");
1477 if(id->store == Dimport){
1478 id->store = Dwundef;
1479 error(t->src.start, "%s's type cannot be determined", id->sym->name);
1480 return terror;
1481 }
1482
1483 /*
1484 * forward references to module variables can't be resolved
1485 */
1486 if(id->store != Dtype && !(id->ty->ok & OKbind)){
1487 error(t->src.start, "%s's type cannot be determined", id->sym->name);
1488 return terror;
1489 }
1490
1491 if(id->store == Dwundef)
1492 return terror;
1493 tt = id->ty = verifytypes(id->ty, adtt, nil);
1494 if(tt == nil){
1495 error(t->tof->src.start, "%T is not a module", t->tof);
1496 return terror;
1497 }
1498 }else
1499 tt = verifytypes(t->tof, adtt, nil);
1500 t->tof = tt;
1501 if(tt == terror)
1502 return terror;
1503 if(tt->kind != Tmodule){
1504 error(t->src.start, "%T is not a module", tt);
1505 return terror;
1506 }
1507 id = namedot(tt->ids, t->decl->sym);
1508 if(id == nil){
1509 error(t->src.start, "%s is not a member of %T", t->decl->sym->name, tt);
1510 return terror;
1511 }
1512 if(id->store == Dtype && id->ty != nil){
1513 t->decl = id;
1514 return id->ty;
1515 }
1516 error(t->src.start, "%T is not a type", t);
1517 return terror;
1518 }
1519
1520 /*
1521 * resolve a . qualified type
1522 */
1523 Type*
dottype(Type * t,Decl * adtt)1524 dottype(Type *t, Decl *adtt)
1525 {
1526 Type *tt;
1527 Decl *id;
1528
1529 if(t->decl->ty != nil){
1530 if(t->decl->store == Dunbound)
1531 fatal("dottype: unbound decl has a type");
1532 return t->decl->ty;
1533 }
1534 t->tof = tt = verifytypes(t->tof, adtt, nil);
1535 if(tt == terror)
1536 return terror;
1537 if(tt->kind != Tadt){
1538 error(t->src.start, "%T is not an adt", tt);
1539 return terror;
1540 }
1541 id = namedot(tt->tags, t->decl->sym);
1542 if(id != nil && id->ty != nil){
1543 t->decl = id;
1544 return id->ty;
1545 }
1546 error(t->src.start, "%s is not a pick tag of %T", t->decl->sym->name, tt);
1547 return terror;
1548 }
1549
1550 Type*
insttype(Type * t,Decl * adtt,Tpair ** tp)1551 insttype(Type *t, Decl *adtt, Tpair **tp)
1552 {
1553 Type *tt;
1554 Typelist *tl;
1555 Decl *ids;
1556 Tpair *tp1, *tp2;
1557 Src src;
1558
1559 src = t->src;
1560 if(tp == nil){
1561 tp2 = nil;
1562 tp = &tp2;
1563 }
1564 if(t->tof->kind != Tadt && t->tof->kind != Tadtpick){
1565 error(src.start, "%T is not an adt", t->tof);
1566 return terror;
1567 }
1568 if(t->tof->kind == Tadt)
1569 ids = t->tof->polys;
1570 else
1571 ids = t->tof->decl->dot->ty->polys;
1572 if(ids == nil){
1573 error(src.start, "%T is not a polymorphic adt", t->tof);
1574 return terror;
1575 }
1576 for(tl = t->u.tlist; tl != nil && ids != nil; tl = tl->nxt, ids = ids->next){
1577 tt = tl->t;
1578 if(!tattr[tt->kind].isptr){
1579 error(src.start, "%T is not a pointer type", tt);
1580 return terror;
1581 }
1582 unifysrc = src;
1583 if(!tunify(ids->ty, tt, &tp1)){
1584 error(src.start, "type %T does not match %T", tt, ids->ty);
1585 return terror;
1586 }
1587 /* usetype(tt); */
1588 tt = verifytypes(tt, adtt, nil);
1589 addtmap(ids->ty, tt, tp);
1590 }
1591 if(tl != nil){
1592 error(src.start, "too many actual types in instantiation");
1593 return terror;
1594 }
1595 if(ids != nil){
1596 error(src.start, "too few actual types in instantiation");
1597 return terror;
1598 }
1599 tp1 = *tp;
1600 tt = t->tof;
1601 t = expandtype(tt, t, adtt, tp);
1602 if(t == tt && adtt == nil)
1603 t = duptype(t);
1604 if(t != tt){
1605 t->u.tmap = tp1;
1606 if(debug['w']){
1607 print("tmap for %T: ", t);
1608 for( ; tp1!=nil; tp1=tp1->nxt)
1609 print("%T -> %T ", tp1->t1, tp1->t2);
1610 print("\n");
1611 }
1612 }
1613 t->src = src;
1614 return t;
1615 }
1616
1617 /*
1618 * walk a type, putting all adts, modules, and tuples into equivalence classes
1619 */
1620 void
teqclass(Type * t)1621 teqclass(Type *t)
1622 {
1623 Decl *id, *tg;
1624 Teq *teq;
1625
1626 if(t == nil || (t->ok & OKclass) == OKclass)
1627 return;
1628 t->ok |= OKclass;
1629 switch(t->kind){
1630 case Terror:
1631 case Tint:
1632 case Tbig:
1633 case Tstring:
1634 case Treal:
1635 case Tbyte:
1636 case Tnone:
1637 case Tany:
1638 case Tiface:
1639 case Tainit:
1640 case Talt:
1641 case Tcase:
1642 case Tcasel:
1643 case Tcasec:
1644 case Tgoto:
1645 case Texcept:
1646 case Tfix:
1647 case Tpoly:
1648 return;
1649 case Tref:
1650 teqclass(t->tof);
1651 return;
1652 case Tchan:
1653 case Tarray:
1654 case Tlist:
1655 teqclass(t->tof);
1656 if(!debug['Z'])
1657 return;
1658 break;
1659 case Tadt:
1660 case Tadtpick:
1661 case Ttuple:
1662 case Texception:
1663 for(id = t->ids; id != nil; id = id->next)
1664 teqclass(id->ty);
1665 for(tg = t->tags; tg != nil; tg = tg->next)
1666 teqclass(tg->ty);
1667 for(id = t->polys; id != nil; id = id->next)
1668 teqclass(id->ty);
1669 break;
1670 case Tmodule:
1671 t->tof = mkiface(t->decl);
1672 for(id = t->ids; id != nil; id = id->next)
1673 teqclass(id->ty);
1674 break;
1675 case Tfn:
1676 for(id = t->ids; id != nil; id = id->next)
1677 teqclass(id->ty);
1678 for(id = t->polys; id != nil; id = id->next)
1679 teqclass(id->ty);
1680 teqclass(t->tof);
1681 return;
1682 default:
1683 fatal("teqclass: unknown type kind %d", t->kind);
1684 return;
1685 }
1686
1687 /*
1688 * find an equivalent type
1689 * stupid linear lookup could be made faster
1690 */
1691 if((t->ok & OKsized) != OKsized)
1692 fatal("eqclass type not sized: %t", t);
1693
1694 for(teq = eqclass[t->kind]; teq != nil; teq = teq->eq){
1695 if(t->size == teq->ty->size && tequal(t, teq->ty)){
1696 t->eq = teq;
1697 if(t->kind == Tmodule)
1698 joiniface(t, t->eq->ty->tof);
1699 return;
1700 }
1701 }
1702
1703 /*
1704 * if no equiv type, make one
1705 */
1706 t->eq = allocmem(sizeof(Teq));
1707 t->eq->id = 0;
1708 t->eq->ty = t;
1709 t->eq->eq = eqclass[t->kind];
1710 eqclass[t->kind] = t->eq;
1711 }
1712
1713 /*
1714 * record that we've used the type
1715 * using a type uses all types reachable from that type
1716 */
1717 void
reftype(Type * t)1718 reftype(Type *t)
1719 {
1720 Decl *id, *tg;
1721
1722 if(t == nil || (t->ok & OKref) == OKref)
1723 return;
1724 t->ok |= OKref;
1725 if(t->decl != nil && t->decl->refs == 0)
1726 t->decl->refs++;
1727 switch(t->kind){
1728 case Terror:
1729 case Tint:
1730 case Tbig:
1731 case Tstring:
1732 case Treal:
1733 case Tbyte:
1734 case Tnone:
1735 case Tany:
1736 case Tiface:
1737 case Tainit:
1738 case Talt:
1739 case Tcase:
1740 case Tcasel:
1741 case Tcasec:
1742 case Tgoto:
1743 case Texcept:
1744 case Tfix:
1745 case Tpoly:
1746 break;
1747 case Tref:
1748 case Tchan:
1749 case Tarray:
1750 case Tlist:
1751 if(t->decl != nil){
1752 if(nadts >= lenadts){
1753 lenadts = nadts + 32;
1754 adts = reallocmem(adts, lenadts * sizeof *adts);
1755 }
1756 adts[nadts++] = t->decl;
1757 }
1758 reftype(t->tof);
1759 break;
1760 case Tadt:
1761 case Tadtpick:
1762 case Ttuple:
1763 case Texception:
1764 if(t->kind == Tadt || t->kind == Ttuple && t->decl->sym != anontupsym){
1765 if(nadts >= lenadts){
1766 lenadts = nadts + 32;
1767 adts = reallocmem(adts, lenadts * sizeof *adts);
1768 }
1769 adts[nadts++] = t->decl;
1770 }
1771 for(id = t->ids; id != nil; id = id->next)
1772 if(id->store != Dfn)
1773 reftype(id->ty);
1774 for(tg = t->tags; tg != nil; tg = tg->next)
1775 reftype(tg->ty);
1776 for(id = t->polys; id != nil; id = id->next)
1777 reftype(id->ty);
1778 if(t->kind == Tadtpick)
1779 reftype(t->decl->dot->ty);
1780 break;
1781 case Tmodule:
1782 /*
1783 * a module's elements should get used individually
1784 * but do the globals for any sbl file
1785 */
1786 if(bsym != nil)
1787 for(id = t->ids; id != nil; id = id->next)
1788 if(id->store == Dglobal)
1789 reftype(id->ty);
1790 break;
1791 case Tfn:
1792 for(id = t->ids; id != nil; id = id->next)
1793 reftype(id->ty);
1794 for(id = t->polys; id != nil; id = id->next)
1795 reftype(id->ty);
1796 reftype(t->tof);
1797 break;
1798 default:
1799 fatal("reftype: unknown type kind %d", t->kind);
1800 break;
1801 }
1802 }
1803
1804 /*
1805 * check all reachable types for cycles and illegal forward references
1806 * find the size of all the types
1807 */
1808 void
cycsizetype(Type * t)1809 cycsizetype(Type *t)
1810 {
1811 Decl *id, *tg;
1812
1813 if(t == nil || (t->ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
1814 return;
1815 t->ok |= OKcycsize;
1816 switch(t->kind){
1817 case Terror:
1818 case Tint:
1819 case Tbig:
1820 case Tstring:
1821 case Treal:
1822 case Tbyte:
1823 case Tnone:
1824 case Tany:
1825 case Tiface:
1826 case Tainit:
1827 case Talt:
1828 case Tcase:
1829 case Tcasel:
1830 case Tcasec:
1831 case Tgoto:
1832 case Texcept:
1833 case Tfix:
1834 case Tpoly:
1835 t->ok |= OKcyc;
1836 sizetype(t);
1837 break;
1838 case Tref:
1839 case Tchan:
1840 case Tarray:
1841 case Tlist:
1842 cyctype(t);
1843 sizetype(t);
1844 cycsizetype(t->tof);
1845 break;
1846 case Tadt:
1847 case Ttuple:
1848 case Texception:
1849 cyctype(t);
1850 sizetype(t);
1851 for(id = t->ids; id != nil; id = id->next)
1852 cycsizetype(id->ty);
1853 for(tg = t->tags; tg != nil; tg = tg->next){
1854 if((tg->ty->ok & (OKcycsize|OKcyc|OKsized)) == (OKcycsize|OKcyc|OKsized))
1855 continue;
1856 tg->ty->ok |= (OKcycsize|OKcyc|OKsized);
1857 for(id = tg->ty->ids; id != nil; id = id->next)
1858 cycsizetype(id->ty);
1859 }
1860 for(id = t->polys; id != nil; id = id->next)
1861 cycsizetype(id->ty);
1862 break;
1863 case Tadtpick:
1864 t->ok &= ~OKcycsize;
1865 cycsizetype(t->decl->dot->ty);
1866 break;
1867 case Tmodule:
1868 cyctype(t);
1869 sizetype(t);
1870 for(id = t->ids; id != nil; id = id->next)
1871 cycsizetype(id->ty);
1872 sizeids(t->ids, 0);
1873 break;
1874 case Tfn:
1875 cyctype(t);
1876 sizetype(t);
1877 for(id = t->ids; id != nil; id = id->next)
1878 cycsizetype(id->ty);
1879 for(id = t->polys; id != nil; id = id->next)
1880 cycsizetype(id->ty);
1881 cycsizetype(t->tof);
1882 sizeids(t->ids, MaxTemp);
1883 break;
1884 default:
1885 fatal("cycsizetype: unknown type kind %d", t->kind);
1886 break;
1887 }
1888 }
1889
1890 /* check for circularity in type declarations
1891 * - has to be called before verifytypes
1892 */
1893 void
tcycle(Type * t)1894 tcycle(Type *t)
1895 {
1896 Decl *id;
1897 Type *tt;
1898 Typelist *tl;
1899
1900 if(t == nil)
1901 return;
1902 switch(t->kind){
1903 default:
1904 break;
1905 case Tchan:
1906 case Tarray:
1907 case Tref:
1908 case Tlist:
1909 case Tdot:
1910 tcycle(t->tof);
1911 break;
1912 case Tfn:
1913 case Ttuple:
1914 tcycle(t->tof);
1915 for(id = t->ids; id != nil; id = id->next)
1916 tcycle(id->ty);
1917 break;
1918 case Tarrow:
1919 if(t->rec&TRvis){
1920 error(t->src.start, "circularity in definition of %T", t);
1921 *t = *terror; /* break the cycle */
1922 return;
1923 }
1924 tt = t->tof;
1925 t->rec |= TRvis;
1926 tcycle(tt);
1927 if(tt->kind == Tid)
1928 tt = tt->decl->ty;
1929 id = namedot(tt->ids, t->decl->sym);
1930 if(id != nil)
1931 tcycle(id->ty);
1932 t->rec &= ~TRvis;
1933 break;
1934 case Tid:
1935 if(t->rec&TRvis){
1936 error(t->src.start, "circularity in definition of %T", t);
1937 *t = *terror; /* break the cycle */
1938 return;
1939 }
1940 t->rec |= TRvis;
1941 tcycle(t->decl->ty);
1942 t->rec &= ~TRvis;
1943 break;
1944 case Tinst:
1945 tcycle(t->tof);
1946 for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
1947 tcycle(tl->t);
1948 break;
1949 }
1950 }
1951
1952 /*
1953 * marks for checking for arcs
1954 */
1955 enum
1956 {
1957 ArcValue = 1 << 0,
1958 ArcList = 1 << 1,
1959 ArcArray = 1 << 2,
1960 ArcRef = 1 << 3,
1961 ArcCyc = 1 << 4, /* cycle found */
1962 ArcPolycyc = 1 << 5,
1963 };
1964
1965 void
cyctype(Type * t)1966 cyctype(Type *t)
1967 {
1968 Decl *id, *tg;
1969
1970 if((t->ok & OKcyc) == OKcyc)
1971 return;
1972 t->ok |= OKcyc;
1973 t->rec |= TRcyc;
1974 switch(t->kind){
1975 case Terror:
1976 case Tint:
1977 case Tbig:
1978 case Tstring:
1979 case Treal:
1980 case Tbyte:
1981 case Tnone:
1982 case Tany:
1983 case Tfn:
1984 case Tchan:
1985 case Tarray:
1986 case Tref:
1987 case Tlist:
1988 case Tfix:
1989 case Tpoly:
1990 break;
1991 case Tadt:
1992 case Tmodule:
1993 case Ttuple:
1994 case Texception:
1995 for(id = t->ids; id != nil; id = id->next)
1996 cycfield(t, id);
1997 for(tg = t->tags; tg != nil; tg = tg->next){
1998 if((tg->ty->ok & OKcyc) == OKcyc)
1999 continue;
2000 tg->ty->ok |= OKcyc;
2001 for(id = tg->ty->ids; id != nil; id = id->next)
2002 cycfield(t, id);
2003 }
2004 break;
2005 default:
2006 fatal("checktype: unknown type kind %d", t->kind);
2007 break;
2008 }
2009 t->rec &= ~TRcyc;
2010 }
2011
2012 void
cycfield(Type * base,Decl * id)2013 cycfield(Type *base, Decl *id)
2014 {
2015 int arc;
2016
2017 if(!storespace[id->store])
2018 return;
2019 arc = cycarc(base, id->ty);
2020
2021 if((arc & (ArcCyc|ArcValue)) == (ArcCyc|ArcValue)){
2022 if(id->cycerr == 0)
2023 error(base->src.start, "illegal type cycle without a reference in field %s of %t",
2024 id->sym->name, base);
2025 id->cycerr = 1;
2026 }else if(arc & ArcCyc){
2027 if((arc & ArcArray) && oldcycles && id->cyc == 0 && !(arc & ArcPolycyc)){
2028 if(id->cycerr == 0)
2029 error(base->src.start, "illegal circular reference to type %T in field %s of %t",
2030 id->ty, id->sym->name, base);
2031 id->cycerr = 1;
2032 }
2033 id->cycle = 1;
2034 }else if(id->cyc != 0){
2035 if(id->cycerr == 0)
2036 error(id->src.start, "spurious cyclic qualifier for field %s of %t", id->sym->name, base);
2037 id->cycerr = 1;
2038 }
2039 }
2040
2041 int
cycarc(Type * base,Type * t)2042 cycarc(Type *base, Type *t)
2043 {
2044 Decl *id, *tg;
2045 int me, arc;
2046
2047 if(t == nil)
2048 return 0;
2049 if(t->rec & TRcyc){
2050 if(tequal(t, base)){
2051 if(t->kind == Tmodule)
2052 return ArcCyc | ArcRef;
2053 else
2054 return ArcCyc | ArcValue;
2055 }
2056 return 0;
2057 }
2058 t->rec |= TRcyc;
2059 me = 0;
2060 switch(t->kind){
2061 case Terror:
2062 case Tint:
2063 case Tbig:
2064 case Tstring:
2065 case Treal:
2066 case Tbyte:
2067 case Tnone:
2068 case Tany:
2069 case Tchan:
2070 case Tfn:
2071 case Tfix:
2072 case Tpoly:
2073 break;
2074 case Tarray:
2075 me = cycarc(base, t->tof) & ~ArcValue | ArcArray;
2076 break;
2077 case Tref:
2078 me = cycarc(base, t->tof) & ~ArcValue | ArcRef;
2079 break;
2080 case Tlist:
2081 me = cycarc(base, t->tof) & ~ArcValue | ArcList;
2082 break;
2083 case Tadt:
2084 case Tadtpick:
2085 case Tmodule:
2086 case Ttuple:
2087 case Texception:
2088 me = 0;
2089 for(id = t->ids; id != nil; id = id->next){
2090 if(!storespace[id->store])
2091 continue;
2092 arc = cycarc(base, id->ty);
2093 if((arc & ArcCyc) && id->cycerr == 0)
2094 me |= arc;
2095 }
2096 for(tg = t->tags; tg != nil; tg = tg->next){
2097 arc = cycarc(base, tg->ty);
2098 if((arc & ArcCyc) && tg->cycerr == 0)
2099 me |= arc;
2100 }
2101
2102 if(t->kind == Tmodule)
2103 me = me & ArcCyc | ArcRef | ArcPolycyc;
2104 else
2105 me &= ArcCyc | ArcValue | ArcPolycyc;
2106 break;
2107 default:
2108 fatal("cycarc: unknown type kind %d", t->kind);
2109 break;
2110 }
2111 t->rec &= ~TRcyc;
2112 if(t->flags&CYCLIC)
2113 me |= ArcPolycyc;
2114 return me;
2115 }
2116
2117 /*
2118 * set the sizes and field offsets for t
2119 * look only as deeply as needed to size this type.
2120 * cycsize type will clean up the rest.
2121 */
2122 void
sizetype(Type * t)2123 sizetype(Type *t)
2124 {
2125 Decl *id, *tg;
2126 Szal szal;
2127 long sz, al, a;
2128
2129 if(t == nil)
2130 return;
2131 if((t->ok & OKsized) == OKsized)
2132 return;
2133 t->ok |= OKsized;
2134 if((t->ok & (OKverify|OKsized)) != (OKverify|OKsized))
2135 fatal("sizetype bogus ok for %t", t);
2136 switch(t->kind){
2137 default:
2138 fatal("sizetype: unknown type kind %d", t->kind);
2139 break;
2140 case Terror:
2141 case Tnone:
2142 case Tbyte:
2143 case Tint:
2144 case Tbig:
2145 case Tstring:
2146 case Tany:
2147 case Treal:
2148 fatal("%T should have a size", t);
2149 break;
2150 case Tref:
2151 case Tchan:
2152 case Tarray:
2153 case Tlist:
2154 case Tmodule:
2155 case Tfix:
2156 case Tpoly:
2157 t->size = t->align = IBY2WD;
2158 break;
2159 case Ttuple:
2160 case Tadt:
2161 case Texception:
2162 if(t->tags == nil){
2163 if(!debug['z']){
2164 szal = sizeids(t->ids, 0);
2165 t->size = align(szal.size, szal.align);
2166 t->align = szal.align;
2167 }else{
2168 szal = sizeids(t->ids, 0);
2169 t->align = IBY2LG;
2170 t->size = align(szal.size, IBY2LG);
2171 }
2172 return;
2173 }
2174 if(!debug['z']){
2175 szal = sizeids(t->ids, IBY2WD);
2176 sz = szal.size;
2177 al = szal.align;
2178 if(al < IBY2WD)
2179 al = IBY2WD;
2180 }else{
2181 szal = sizeids(t->ids, IBY2WD);
2182 sz = szal.size;
2183 al = IBY2LG;
2184 }
2185 for(tg = t->tags; tg != nil; tg = tg->next){
2186 if((tg->ty->ok & OKsized) == OKsized)
2187 continue;
2188 tg->ty->ok |= OKsized;
2189 if(!debug['z']){
2190 szal = sizeids(tg->ty->ids, sz);
2191 a = szal.align;
2192 if(a < al)
2193 a = al;
2194 tg->ty->size = align(szal.size, a);
2195 tg->ty->align = a;
2196 }else{
2197 szal = sizeids(tg->ty->ids, sz);
2198 tg->ty->size = align(szal.size, IBY2LG);
2199 tg->ty->align = IBY2LG;
2200 }
2201 }
2202 break;
2203 case Tfn:
2204 t->size = 0;
2205 t->align = 1;
2206 break;
2207 case Tainit:
2208 t->size = 0;
2209 t->align = 1;
2210 break;
2211 case Talt:
2212 t->size = t->cse->nlab * 2*IBY2WD + 2*IBY2WD;
2213 t->align = IBY2WD;
2214 break;
2215 case Tcase:
2216 case Tcasec:
2217 t->size = t->cse->nlab * 3*IBY2WD + 2*IBY2WD;
2218 t->align = IBY2WD;
2219 break;
2220 case Tcasel:
2221 t->size = t->cse->nlab * 6*IBY2WD + 3*IBY2WD;
2222 t->align = IBY2LG;
2223 break;
2224 case Tgoto:
2225 t->size = t->cse->nlab * IBY2WD + IBY2WD;
2226 if(t->cse->iwild != nil)
2227 t->size += IBY2WD;
2228 t->align = IBY2WD;
2229 break;
2230 case Tiface:
2231 sz = IBY2WD;
2232 for(id = t->ids; id != nil; id = id->next){
2233 sz = align(sz, IBY2WD) + IBY2WD;
2234 sz += id->sym->len + 1;
2235 if(id->dot->ty->kind == Tadt)
2236 sz += id->dot->sym->len + 1;
2237 }
2238 t->size = sz;
2239 t->align = IBY2WD;
2240 break;
2241 case Texcept:
2242 t->size = 0;
2243 t->align = IBY2WD;
2244 break;
2245 }
2246 }
2247
2248 Szal
sizeids(Decl * id,long off)2249 sizeids(Decl *id, long off)
2250 {
2251 Szal szal;
2252 int a, al;
2253
2254 al = 1;
2255 for(; id != nil; id = id->next){
2256 if(storespace[id->store]){
2257 sizetype(id->ty);
2258 /*
2259 * alignment can be 0 if we have
2260 * illegal forward declarations.
2261 * just patch a; other code will flag an error
2262 */
2263 a = id->ty->align;
2264 if(a == 0)
2265 a = 1;
2266
2267 if(a > al)
2268 al = a;
2269
2270 off = align(off, a);
2271 id->offset = off;
2272 off += id->ty->size;
2273 }
2274 }
2275 szal.size = off;
2276 szal.align = al;
2277 return szal;
2278 }
2279
2280 long
align(long off,int align)2281 align(long off, int align)
2282 {
2283 if(align == 0)
2284 fatal("align 0");
2285 while(off % align)
2286 off++;
2287 return off;
2288 }
2289
2290 /*
2291 * recalculate a type's size
2292 */
2293 void
resizetype(Type * t)2294 resizetype(Type *t)
2295 {
2296 if((t->ok & OKsized) == OKsized){
2297 t->ok &= ~OKsized;
2298 cycsizetype(t);
2299 }
2300 }
2301
2302 /*
2303 * check if a module is accessable from t
2304 * if so, mark that module interface
2305 */
2306 void
modrefable(Type * t)2307 modrefable(Type *t)
2308 {
2309 Decl *id, *m, *tg;
2310
2311 if(t == nil || (t->ok & OKmodref) == OKmodref)
2312 return;
2313 if((t->ok & OKverify) != OKverify)
2314 fatal("modrefable unused type %t", t);
2315 t->ok |= OKmodref;
2316 switch(t->kind){
2317 case Terror:
2318 case Tint:
2319 case Tbig:
2320 case Tstring:
2321 case Treal:
2322 case Tbyte:
2323 case Tnone:
2324 case Tany:
2325 case Tfix:
2326 case Tpoly:
2327 break;
2328 case Tchan:
2329 case Tref:
2330 case Tarray:
2331 case Tlist:
2332 modrefable(t->tof);
2333 break;
2334 case Tmodule:
2335 t->tof->linkall = 1;
2336 t->decl->refs++;
2337 for(id = t->ids; id != nil; id = id->next){
2338 switch(id->store){
2339 case Dglobal:
2340 case Dfn:
2341 modrefable(id->ty);
2342 break;
2343 case Dtype:
2344 if(id->ty->kind != Tadt)
2345 break;
2346 for(m = id->ty->ids; m != nil; m = m->next)
2347 if(m->store == Dfn)
2348 modrefable(m->ty);
2349 break;
2350 }
2351 }
2352 break;
2353 case Tfn:
2354 case Tadt:
2355 case Ttuple:
2356 case Texception:
2357 for(id = t->ids; id != nil; id = id->next)
2358 if(id->store != Dfn)
2359 modrefable(id->ty);
2360 for(tg = t->tags; tg != nil; tg = tg->next){
2361 /*
2362 if((tg->ty->ok & OKmodref) == OKmodref)
2363 continue;
2364 */
2365 tg->ty->ok |= OKmodref;
2366 for(id = tg->ty->ids; id != nil; id = id->next)
2367 modrefable(id->ty);
2368 }
2369 for(id = t->polys; id != nil; id = id->next)
2370 modrefable(id->ty);
2371 modrefable(t->tof);
2372 break;
2373 case Tadtpick:
2374 modrefable(t->decl->dot->ty);
2375 break;
2376 default:
2377 fatal("unknown type kind %d", t->kind);
2378 break;
2379 }
2380 }
2381
2382 Desc*
gendesc(Decl * d,long size,Decl * decls)2383 gendesc(Decl *d, long size, Decl *decls)
2384 {
2385 Desc *desc;
2386
2387 if(debug['D'])
2388 print("generate desc for %D\n", d);
2389 if(ispoly(d))
2390 addfnptrs(d, 0);
2391 desc = usedesc(mkdesc(size, decls));
2392 return desc;
2393 }
2394
2395 Desc*
mkdesc(long size,Decl * d)2396 mkdesc(long size, Decl *d)
2397 {
2398 uchar *pmap;
2399 long len, n;
2400
2401 len = (size+8*IBY2WD-1) / (8*IBY2WD);
2402 pmap = allocmem(len);
2403 memset(pmap, 0, len);
2404 n = descmap(d, pmap, 0);
2405 if(n >= 0)
2406 n = n / (8*IBY2WD) + 1;
2407 else
2408 n = 0;
2409 if(n > len)
2410 fatal("wrote off end of decl map: %ld %ld", n, len);
2411 return enterdesc(pmap, size, n);
2412 }
2413
2414 Desc*
mktdesc(Type * t)2415 mktdesc(Type *t)
2416 {
2417 Desc *d;
2418 uchar *pmap;
2419 long len, n;
2420
2421 usedty(t);
2422 if(debug['D'])
2423 print("generate desc for %T\n", t);
2424 if(t->decl == nil){
2425 t->decl = mkdecl(&t->src, Dtype, t);
2426 t->decl->sym = enter("_mktdesc_", 0);
2427 }
2428 if(t->decl->desc != nil)
2429 return t->decl->desc;
2430 len = (t->size+8*IBY2WD-1) / (8*IBY2WD);
2431 pmap = allocmem(len);
2432 memset(pmap, 0, len);
2433 n = tdescmap(t, pmap, 0);
2434 if(n >= 0)
2435 n = n / (8*IBY2WD) + 1;
2436 else
2437 n = 0;
2438 if(n > len)
2439 fatal("wrote off end of type map for %T: %ld %ld 0x%2.2ux", t, n, len, t->ok);
2440 d = enterdesc(pmap, t->size, n);
2441 t->decl->desc = d;
2442 if(debug['j']){
2443 uchar *m, *e;
2444
2445 print("generate desc for %T\n", t);
2446 print("\tdesc\t$%d,%lud,\"", d->id, d->size);
2447 e = d->map + d->nmap;
2448 for(m = d->map; m < e; m++)
2449 print("%.2x", *m);
2450 print("\"\n");
2451 }
2452 return d;
2453 }
2454
2455 Desc*
enterdesc(uchar * map,long size,long nmap)2456 enterdesc(uchar *map, long size, long nmap)
2457 {
2458 Desc *d, *last;
2459 int c;
2460
2461 last = nil;
2462 for(d = descriptors; d != nil; d = d->next){
2463 if(d->size > size || d->size == size && d->nmap > nmap)
2464 break;
2465 if(d->size == size && d->nmap == nmap){
2466 c = memcmp(d->map, map, nmap);
2467 if(c == 0){
2468 free(map);
2469 return d;
2470 }
2471 if(c > 0)
2472 break;
2473 }
2474 last = d;
2475 }
2476 d = allocmem(sizeof *d);
2477 d->id = -1;
2478 d->used = 0;
2479 d->map = map;
2480 d->size = size;
2481 d->nmap = nmap;
2482 if(last == nil){
2483 d->next = descriptors;
2484 descriptors = d;
2485 }else{
2486 d->next = last->next;
2487 last->next = d;
2488 }
2489 return d;
2490 }
2491
2492 Desc*
usedesc(Desc * d)2493 usedesc(Desc *d)
2494 {
2495 d->used = 1;
2496 return d;
2497 }
2498
2499 /*
2500 * create the pointer description byte map for every type in decls
2501 * each bit corresponds to a word, and is 1 if occupied by a pointer
2502 * the high bit in the byte maps the first word
2503 */
2504 long
descmap(Decl * decls,uchar * map,long start)2505 descmap(Decl *decls, uchar *map, long start)
2506 {
2507 Decl *d;
2508 long last, m;
2509
2510 if(debug['D'])
2511 print("descmap offset %ld\n", start);
2512 last = -1;
2513 for(d = decls; d != nil; d = d->next){
2514 if(d->store == Dtype && d->ty->kind == Tmodule
2515 || d->store == Dfn
2516 || d->store == Dconst)
2517 continue;
2518 if(d->store == Dlocal && d->link != nil)
2519 continue;
2520 m = tdescmap(d->ty, map, d->offset + start);
2521 if(debug['D']){
2522 if(d->sym != nil)
2523 print("descmap %s type %T offset %ld returns %ld\n",
2524 d->sym->name, d->ty, d->offset+start, m);
2525 else
2526 print("descmap type %T offset %ld returns %ld\n", d->ty, d->offset+start, m);
2527 }
2528 if(m >= 0)
2529 last = m;
2530 }
2531 return last;
2532 }
2533
2534 long
tdescmap(Type * t,uchar * map,long offset)2535 tdescmap(Type *t, uchar *map, long offset)
2536 {
2537 Label *lab;
2538 long i, e, m;
2539 int bit;
2540
2541 if(t == nil)
2542 return -1;
2543
2544 m = -1;
2545 if(t->kind == Talt){
2546 lab = t->cse->labs;
2547 e = t->cse->nlab;
2548 offset += IBY2WD * 2;
2549 for(i = 0; i < e; i++){
2550 if(lab[i].isptr){
2551 bit = offset / IBY2WD % 8;
2552 map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
2553 m = offset;
2554 }
2555 offset += 2*IBY2WD;
2556 }
2557 return m;
2558 }
2559 if(t->kind == Tcasec){
2560 e = t->cse->nlab;
2561 offset += IBY2WD;
2562 for(i = 0; i < e; i++){
2563 bit = offset / IBY2WD % 8;
2564 map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
2565 offset += IBY2WD;
2566 bit = offset / IBY2WD % 8;
2567 map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
2568 m = offset;
2569 offset += 2*IBY2WD;
2570 }
2571 return m;
2572 }
2573
2574 if(tattr[t->kind].isptr){
2575 bit = offset / IBY2WD % 8;
2576 map[offset / (8*IBY2WD)] |= 1 << (7 - bit);
2577 return offset;
2578 }
2579 if(t->kind == Tadtpick)
2580 t = t->tof;
2581 if(t->kind == Ttuple || t->kind == Tadt || t->kind == Texception){
2582 if(debug['D'])
2583 print("descmap adt offset %ld\n", offset);
2584 if(t->rec != 0)
2585 fatal("illegal cyclic type %t in tdescmap", t);
2586 t->rec = 1;
2587 offset = descmap(t->ids, map, offset);
2588 t->rec = 0;
2589 return offset;
2590 }
2591
2592 return -1;
2593 }
2594
2595 /*
2596 * can a t2 be assigned to a t1?
2597 * any means Tany matches all types,
2598 * not just references
2599 */
2600 int
tcompat(Type * t1,Type * t2,int any)2601 tcompat(Type *t1, Type *t2, int any)
2602 {
2603 int ok, v;
2604
2605 if(t1 == t2)
2606 return 1;
2607 if(t1 == nil || t2 == nil)
2608 return 0;
2609 if(t2->kind == Texception && t1->kind != Texception)
2610 t2 = mkextuptype(t2);
2611 tcomset = 0;
2612 ok = rtcompat(t1, t2, any, 0);
2613 v = cleartcomrec(t1) + cleartcomrec(t2);
2614 if(v != tcomset)
2615 fatal("recid t1 %t and t2 %t not balanced in tcompat: %d v %d", t1, t2, v, tcomset);
2616 return ok;
2617 }
2618
2619 static int
rtcompat(Type * t1,Type * t2,int any,int inaorc)2620 rtcompat(Type *t1, Type *t2, int any, int inaorc)
2621 {
2622 if(t1 == t2)
2623 return 1;
2624 if(t1 == nil || t2 == nil)
2625 return 0;
2626 if(t1->kind == Terror || t2->kind == Terror)
2627 return 1;
2628 if(t2->kind == Texception && t1->kind != Texception)
2629 t2 = mkextuptype(t2);
2630
2631 if(debug['x'])
2632 print("rtcompat: %t and %t\n", t1, t2);
2633
2634 t1->rec |= TRcom;
2635 t2->rec |= TRcom;
2636 switch(t1->kind){
2637 default:
2638 fatal("unknown type %t v %t in rtcompat", t1, t2);
2639 case Tstring:
2640 return t2->kind == Tstring || t2->kind == Tany;
2641 case Texception:
2642 if(t2->kind == Texception && t1->cons == t2->cons){
2643 if(assumetcom(t1, t2))
2644 return 1;
2645 return idcompat(t1->ids, t2->ids, 0, inaorc);
2646 }
2647 return 0;
2648 case Tnone:
2649 case Tint:
2650 case Tbig:
2651 case Tbyte:
2652 case Treal:
2653 return t1->kind == t2->kind;
2654 case Tfix:
2655 return t1->kind == t2->kind && sametree(t1->val, t2->val);
2656 case Tany:
2657 if(tattr[t2->kind].isptr)
2658 return 1;
2659 return any;
2660 case Tref:
2661 case Tlist:
2662 case Tarray:
2663 case Tchan:
2664 if(t1->kind != t2->kind){
2665 if(t2->kind == Tany)
2666 return 1;
2667 return 0;
2668 }
2669 if(t1->kind != Tref && assumetcom(t1, t2))
2670 return 1;
2671 return rtcompat(t1->tof, t2->tof, 0, t1->kind == Tarray || t1->kind == Tchan || inaorc);
2672 case Tfn:
2673 break;
2674 case Ttuple:
2675 if(t2->kind == Tadt && t2->tags == nil
2676 || t2->kind == Ttuple){
2677 if(assumetcom(t1, t2))
2678 return 1;
2679 return idcompat(t1->ids, t2->ids, any, inaorc);
2680 }
2681 if(t2->kind == Tadtpick){
2682 t2->tof->rec |= TRcom;
2683 if(assumetcom(t1, t2->tof))
2684 return 1;
2685 return idcompat(t1->ids, t2->tof->ids->next, any, inaorc);
2686 }
2687 return 0;
2688 case Tadt:
2689 if(t2->kind == Ttuple && t1->tags == nil){
2690 if(assumetcom(t1, t2))
2691 return 1;
2692 return idcompat(t1->ids, t2->ids, any, inaorc);
2693 }
2694 if(t1->tags != nil && t2->kind == Tadtpick && !inaorc)
2695 t2 = t2->decl->dot->ty;
2696 break;
2697 case Tadtpick:
2698 /*
2699 if(t2->kind == Ttuple)
2700 return idcompat(t1->tof->ids->next, t2->ids, any, inaorc);
2701 */
2702 break;
2703 case Tmodule:
2704 if(t2->kind == Tany)
2705 return 1;
2706 break;
2707 case Tpoly:
2708 if(t2->kind == Tany)
2709 return 1;
2710 break;
2711 }
2712 return tequal(t1, t2);
2713 }
2714
2715 /*
2716 * add the assumption that t1 and t2 are compatable
2717 */
2718 static int
assumetcom(Type * t1,Type * t2)2719 assumetcom(Type *t1, Type *t2)
2720 {
2721 Type *r1, *r2;
2722
2723 if(t1->tcom == nil && t2->tcom == nil){
2724 tcomset += 2;
2725 t1->tcom = t2->tcom = t1;
2726 }else{
2727 if(t1->tcom == nil){
2728 r1 = t1;
2729 t1 = t2;
2730 t2 = r1;
2731 }
2732 for(r1 = t1->tcom; r1 != r1->tcom; r1 = r1->tcom)
2733 ;
2734 for(r2 = t2->tcom; r2 != nil && r2 != r2->tcom; r2 = r2->tcom)
2735 ;
2736 if(r1 == r2)
2737 return 1;
2738 if(r2 == nil)
2739 tcomset++;
2740 t2->tcom = t1;
2741 for(; t2 != r1; t2 = r2){
2742 r2 = t2->tcom;
2743 t2->tcom = r1;
2744 }
2745 }
2746 return 0;
2747 }
2748
2749 static int
cleartcomrec(Type * t)2750 cleartcomrec(Type *t)
2751 {
2752 Decl *id;
2753 int n;
2754
2755 n = 0;
2756 for(; t != nil && (t->rec & TRcom) == TRcom; t = t->tof){
2757 t->rec &= ~TRcom;
2758 if(t->tcom != nil){
2759 t->tcom = nil;
2760 n++;
2761 }
2762 if(t->kind == Tadtpick)
2763 n += cleartcomrec(t->tof);
2764 if(t->kind == Tmodule)
2765 t = t->tof;
2766 for(id = t->ids; id != nil; id = id->next)
2767 n += cleartcomrec(id->ty);
2768 for(id = t->tags; id != nil; id = id->next)
2769 n += cleartcomrec(id->ty);
2770 for(id = t->polys; id != nil; id = id->next)
2771 n += cleartcomrec(id->ty);
2772 }
2773 return n;
2774 }
2775
2776 /*
2777 * id1 and id2 are the fields in an adt or tuple
2778 * simple structural check; ignore names
2779 */
2780 static int
idcompat(Decl * id1,Decl * id2,int any,int inaorc)2781 idcompat(Decl *id1, Decl *id2, int any, int inaorc)
2782 {
2783 for(; id1 != nil; id1 = id1->next){
2784 if(id1->store != Dfield)
2785 continue;
2786 while(id2 != nil && id2->store != Dfield)
2787 id2 = id2->next;
2788 if(id2 == nil
2789 || id1->store != id2->store
2790 || !rtcompat(id1->ty, id2->ty, any, inaorc))
2791 return 0;
2792 id2 = id2->next;
2793 }
2794 while(id2 != nil && id2->store != Dfield)
2795 id2 = id2->next;
2796 return id2 == nil;
2797 }
2798
2799 int
tequal(Type * t1,Type * t2)2800 tequal(Type *t1, Type *t2)
2801 {
2802 int ok, v;
2803
2804 eqrec = 0;
2805 eqset = 0;
2806 ok = rtequal(t1, t2);
2807 v = cleareqrec(t1) + cleareqrec(t2);
2808 if(v != eqset && 0)
2809 fatal("recid t1 %t and t2 %t not balanced in tequal: %d %d", t1, t2, v, eqset);
2810 eqset = 0;
2811 return ok;
2812 }
2813
2814 /*
2815 * structural equality on types
2816 */
2817 static int
rtequal(Type * t1,Type * t2)2818 rtequal(Type *t1, Type *t2)
2819 {
2820 /*
2821 * this is just a shortcut
2822 */
2823 if(t1 == t2)
2824 return 1;
2825
2826 if(t1 == nil || t2 == nil)
2827 return 0;
2828 if(t1->kind == Terror || t2->kind == Terror)
2829 return 1;
2830
2831 if(t1->kind != t2->kind)
2832 return 0;
2833
2834 if(t1->eq != nil && t2->eq != nil)
2835 return t1->eq == t2->eq;
2836
2837 if(debug['x'])
2838 print("rtequal: %t and %t\n", t1, t2);
2839
2840 t1->rec |= TReq;
2841 t2->rec |= TReq;
2842 switch(t1->kind){
2843 default:
2844 fatal("unknown type %t v %t in rtequal", t1, t2);
2845 case Tnone:
2846 case Tbig:
2847 case Tbyte:
2848 case Treal:
2849 case Tint:
2850 case Tstring:
2851 /*
2852 * this should always be caught by t1 == t2 check
2853 */
2854 fatal("bogus value type %t vs %t in rtequal", t1, t2);
2855 return 1;
2856 case Tfix:
2857 return sametree(t1->val, t2->val);
2858 case Tref:
2859 case Tlist:
2860 case Tarray:
2861 case Tchan:
2862 if(t1->kind != Tref && assumeteq(t1, t2))
2863 return 1;
2864 return rtequal(t1->tof, t2->tof);
2865 case Tfn:
2866 if(t1->varargs != t2->varargs)
2867 return 0;
2868 if(!idequal(t1->ids, t2->ids, 0, storespace))
2869 return 0;
2870 /* if(!idequal(t1->polys, t2->polys, 1, nil)) */
2871 if(!pyequal(t1, t2))
2872 return 0;
2873 return rtequal(t1->tof, t2->tof);
2874 case Ttuple:
2875 case Texception:
2876 if(t1->kind != t2->kind || t1->cons != t2->cons)
2877 return 0;
2878 if(assumeteq(t1, t2))
2879 return 1;
2880 return idequal(t1->ids, t2->ids, 0, storespace);
2881 case Tadt:
2882 case Tadtpick:
2883 case Tmodule:
2884 if(assumeteq(t1, t2))
2885 return 1;
2886 /*
2887 * compare interfaces when comparing modules
2888 */
2889 if(t1->kind == Tmodule)
2890 return idequal(t1->tof->ids, t2->tof->ids, 1, nil);
2891
2892 /*
2893 * picked adts; check parent,
2894 * assuming equiv picked fields,
2895 * then check picked fields are equiv
2896 */
2897 if(t1->kind == Tadtpick && !rtequal(t1->decl->dot->ty, t2->decl->dot->ty))
2898 return 0;
2899
2900 /*
2901 * adts with pick tags: check picked fields for equality
2902 */
2903 if(!idequal(t1->tags, t2->tags, 1, nil))
2904 return 0;
2905
2906 /* if(!idequal(t1->polys, t2->polys, 1, nil)) */
2907 if(!pyequal(t1, t2))
2908 return 0;
2909 return idequal(t1->ids, t2->ids, 1, storespace);
2910 case Tpoly:
2911 if(assumeteq(t1, t2))
2912 return 1;
2913 if(t1->decl->sym != t2->decl->sym)
2914 return 0;
2915 return idequal(t1->ids, t2->ids, 1, nil);
2916 }
2917 }
2918
2919 static int
assumeteq(Type * t1,Type * t2)2920 assumeteq(Type *t1, Type *t2)
2921 {
2922 Type *r1, *r2;
2923
2924 if(t1->teq == nil && t2->teq == nil){
2925 eqrec++;
2926 eqset += 2;
2927 t1->teq = t2->teq = t1;
2928 }else{
2929 if(t1->teq == nil){
2930 r1 = t1;
2931 t1 = t2;
2932 t2 = r1;
2933 }
2934 for(r1 = t1->teq; r1 != r1->teq; r1 = r1->teq)
2935 ;
2936 for(r2 = t2->teq; r2 != nil && r2 != r2->teq; r2 = r2->teq)
2937 ;
2938 if(r1 == r2)
2939 return 1;
2940 if(r2 == nil)
2941 eqset++;
2942 t2->teq = t1;
2943 for(; t2 != r1; t2 = r2){
2944 r2 = t2->teq;
2945 t2->teq = r1;
2946 }
2947 }
2948 return 0;
2949 }
2950
2951 /*
2952 * checking structural equality for adts, tuples, and fns
2953 */
2954 static int
idequal(Decl * id1,Decl * id2,int usenames,int * storeok)2955 idequal(Decl *id1, Decl *id2, int usenames, int *storeok)
2956 {
2957 /*
2958 * this is just a shortcut
2959 */
2960 if(id1 == id2)
2961 return 1;
2962
2963 for(; id1 != nil; id1 = id1->next){
2964 if(storeok != nil && !storeok[id1->store])
2965 continue;
2966 while(id2 != nil && storeok != nil && !storeok[id2->store])
2967 id2 = id2->next;
2968 if(id2 == nil
2969 || usenames && id1->sym != id2->sym
2970 || id1->store != id2->store
2971 || id1->implicit != id2->implicit
2972 || id1->cyc != id2->cyc
2973 || (id1->dot == nil) != (id2->dot == nil)
2974 || id1->dot != nil && id2->dot != nil && id1->dot->ty->kind != id2->dot->ty->kind
2975 || !rtequal(id1->ty, id2->ty))
2976 return 0;
2977 id2 = id2->next;
2978 }
2979 while(id2 != nil && storeok != nil && !storeok[id2->store])
2980 id2 = id2->next;
2981 return id1 == nil && id2 == nil;
2982 }
2983
2984 static int
pyequal(Type * t1,Type * t2)2985 pyequal(Type *t1, Type *t2)
2986 {
2987 Type *pt1, *pt2;
2988 Decl *id1, *id2;
2989
2990 if(t1 == t2)
2991 return 1;
2992 id1 = t1->polys;
2993 id2 = t2->polys;
2994 for(; id1 != nil; id1 = id1->next){
2995 if(id2 == nil)
2996 return 0;
2997 pt1 = id1->ty;
2998 pt2 = id2->ty;
2999 if(!rtequal(pt1, pt2)){
3000 if(t1->u.tmap != nil)
3001 pt1 = valtmap(pt1, t1->u.tmap);
3002 if(t2->u.tmap != nil)
3003 pt2 = valtmap(pt2, t2->u.tmap);
3004 if(!rtequal(pt1, pt2))
3005 return 0;
3006 }
3007 id2 = id2->next;
3008 }
3009 return id1 == nil && id2 == nil;
3010 }
3011
3012 static int
cleareqrec(Type * t)3013 cleareqrec(Type *t)
3014 {
3015 Decl *id;
3016 int n;
3017
3018 n = 0;
3019 for(; t != nil && (t->rec & TReq) == TReq; t = t->tof){
3020 t->rec &= ~TReq;
3021 if(t->teq != nil){
3022 t->teq = nil;
3023 n++;
3024 }
3025 if(t->kind == Tadtpick)
3026 n += cleareqrec(t->decl->dot->ty);
3027 if(t->kind == Tmodule)
3028 t = t->tof;
3029 for(id = t->ids; id != nil; id = id->next)
3030 n += cleareqrec(id->ty);
3031 for(id = t->tags; id != nil; id = id->next)
3032 n += cleareqrec(id->ty);
3033 for(id = t->polys; id != nil; id = id->next)
3034 n += cleareqrec(id->ty);
3035 }
3036 return n;
3037 }
3038
3039 int
raisescompat(Node * n1,Node * n2)3040 raisescompat(Node *n1, Node *n2)
3041 {
3042 if(n1 == n2)
3043 return 1;
3044 if(n2 == nil)
3045 return 1; /* no need to repeat in definition if given in declaration */
3046 if(n1 == nil)
3047 return 0;
3048 for(n1 = n1->left, n2 = n2->left; n1 != nil && n2 != nil; n1 = n1->right, n2 = n2->right){
3049 if(n1->left->decl != n2->left->decl)
3050 return 0;
3051 }
3052 return n1 == n2;
3053 }
3054
3055 /* t1 a polymorphic type */
3056 static int
fnunify(Type * t1,Type * t2,Tpair ** tp,int swapped)3057 fnunify(Type *t1, Type *t2, Tpair **tp, int swapped)
3058 {
3059 Decl *id, *ids;
3060 Sym *sym;
3061
3062 for(ids = t1->ids; ids != nil; ids = ids->next){
3063 sym = ids->sym;
3064 id = fnlookup(sym, t2, nil);
3065 if(id != nil)
3066 usetype(id->ty);
3067 if(id == nil){
3068 if(dowarn)
3069 error(unifysrc.start, "type %T does not have a '%s' function", t2, sym->name);
3070 return 0;
3071 }
3072 else if(id->ty->kind != Tfn){
3073 if(dowarn)
3074 error(unifysrc.start, "%T is not a function", id->ty);
3075 return 0;
3076 }
3077 else if(!rtunify(ids->ty, id->ty, tp, !swapped)){
3078 if(dowarn)
3079 error(unifysrc.start, "%T and %T are not compatible wrt %s", ids->ty, id->ty, sym->name);
3080 return 0;
3081 }
3082 }
3083 return 1;
3084 }
3085
3086 static int
fncleareqrec(Type * t1,Type * t2)3087 fncleareqrec(Type *t1, Type *t2)
3088 {
3089 Decl *id, *ids;
3090 int n;
3091
3092 n = 0;
3093 n += cleareqrec(t1);
3094 n += cleareqrec(t2);
3095 for(ids = t1->ids; ids != nil; ids = ids->next){
3096 id = fnlookup(ids->sym, t2, nil);
3097 if(id == nil)
3098 continue;
3099 else{
3100 n += cleareqrec(ids->ty);
3101 n += cleareqrec(id->ty);
3102 }
3103 }
3104 return n;
3105 }
3106 int
tunify(Type * t1,Type * t2,Tpair ** tp)3107 tunify(Type *t1, Type *t2, Tpair **tp)
3108 {
3109 int ok, v;
3110 Tpair *p;
3111
3112 *tp = nil;
3113 eqrec = 0;
3114 eqset = 0;
3115 ok = rtunify(t1, t2, tp, 0);
3116 v = cleareqrec(t1) + cleareqrec(t2);
3117 for(p = *tp; p != nil; p = p->nxt)
3118 v += fncleareqrec(p->t1, p->t2);
3119 if(0 && v != eqset)
3120 fatal("recid t1 %t and t2 %t not balanced in tunify: %d %d", t1, t2, v, eqset);
3121 return ok;
3122 }
3123
3124 static int
rtunify(Type * t1,Type * t2,Tpair ** tp,int swapped)3125 rtunify(Type *t1, Type *t2, Tpair **tp, int swapped)
3126 {
3127 Type *tmp;
3128
3129 if(debug['w']) print("rtunifya - %T %T\n", t1, t2);
3130 t1 = valtmap(t1, *tp);
3131 t2 = valtmap(t2, *tp);
3132 if(debug['w']) print("rtunifyb - %T %T\n", t1, t2);
3133 if(t1 == t2)
3134 return 1;
3135 if(t1 == nil || t2 == nil)
3136 return 0;
3137 if(t1->kind == Terror || t2->kind == Terror)
3138 return 1;
3139 if(t1->kind != Tpoly && t2->kind == Tpoly){
3140 tmp = t1;
3141 t1 = t2;
3142 t2 = tmp;
3143 swapped = !swapped;
3144 }
3145 if(t1->kind == Tpoly){
3146 /*
3147 if(typein(t1, t2))
3148 return 0;
3149 */
3150 if(!tattr[t2->kind].isptr)
3151 return 0;
3152 if(t2->kind != Tany)
3153 addtmap(t1, t2, tp);
3154 return fnunify(t1, t2, tp, swapped);
3155 }
3156 if(t1->kind != Tany && t2->kind == Tany){
3157 tmp = t1;
3158 t1 = t2;
3159 t2 = tmp;
3160 swapped = !swapped;
3161 }
3162 if(t1->kind == Tadt && t1->tags != nil && t2->kind == Tadtpick && !swapped)
3163 t2 = t2->decl->dot->ty;
3164 if(t2->kind == Tadt && t2->tags != nil && t1->kind == Tadtpick && swapped)
3165 t1 = t1->decl->dot->ty;
3166 if(t1->kind != Tany && t1->kind != t2->kind)
3167 return 0;
3168 t1->rec |= TReq;
3169 t2->rec |= TReq;
3170 switch(t1->kind){
3171 default:
3172 return tequal(t1, t2);
3173 case Tany:
3174 return tattr[t2->kind].isptr;
3175 case Tref:
3176 case Tlist:
3177 case Tarray:
3178 case Tchan:
3179 if(t1->kind != Tref && assumeteq(t1, t2))
3180 return 1;
3181 return rtunify(t1->tof, t2->tof, tp, swapped);
3182 case Tfn:
3183 if(!idunify(t1->ids, t2->ids, tp, swapped))
3184 return 0;
3185 if(!idunify(t1->polys, t2->polys, tp, swapped))
3186 return 0;
3187 return rtunify(t1->tof, t2->tof, tp, swapped);
3188 case Ttuple:
3189 if(assumeteq(t1, t2))
3190 return 1;
3191 return idunify(t1->ids, t2->ids, tp, swapped);
3192 case Tadt:
3193 case Tadtpick:
3194 if(assumeteq(t1, t2))
3195 return 1;
3196 if(!idunify(t1->polys, t2->polys, tp, swapped))
3197 return 0;
3198 if(!idunify(t1->tags, t2->tags, tp, swapped))
3199 return 0;
3200 return idunify(t1->ids, t2->ids, tp, swapped);
3201 case Tmodule:
3202 if(assumeteq(t1, t2))
3203 return 1;
3204 return idunify(t1->tof->ids, t2->tof->ids, tp, swapped);
3205 case Tpoly:
3206 return t1 == t2;
3207 }
3208 }
3209
3210 static int
idunify(Decl * id1,Decl * id2,Tpair ** tp,int swapped)3211 idunify(Decl *id1, Decl *id2, Tpair **tp, int swapped)
3212 {
3213 if(id1 == id2)
3214 return 1;
3215 for(; id1 != nil; id1 = id1->next){
3216 if(id2 == nil || !rtunify(id1->ty, id2->ty, tp, swapped))
3217 return 0;
3218 id2 = id2->next;
3219 }
3220 return id1 == nil && id2 == nil;
3221 }
3222
3223 int
polyequal(Decl * id1,Decl * id2)3224 polyequal(Decl *id1, Decl *id2)
3225 {
3226 int ck2;
3227 Decl *d;
3228
3229 /* allow id2 list to have an optional for clause */
3230 ck2 = 0;
3231 for(d = id2; d != nil; d = d->next)
3232 if(d->ty->ids != nil)
3233 ck2 = 1;
3234 for( ; id1 != nil; id1 = id1->next){
3235 if(id2 == nil
3236 || id1->sym != id2->sym
3237 || id1->ty->decl != nil && id2->ty->decl != nil && id1->ty->decl->sym != id2->ty->decl->sym)
3238 return 0;
3239 if(ck2 && !idequal(id1->ty->ids, id2->ty->ids, 1, nil))
3240 return 0;
3241 id2 = id2->next;
3242 }
3243 return id1 == nil && id2 == nil;
3244 }
3245
3246 Type*
calltype(Type * f,Node * a,Type * rt)3247 calltype(Type *f, Node *a, Type *rt)
3248 {
3249 Type *t;
3250 Decl *id, *first, *last;
3251
3252 first = last = nil;
3253 t = mktype(&f->src.start, &f->src.stop, Tfn, rt, nil);
3254 t->polys = f->kind == Tref ? f->tof->polys : f->polys;
3255 for( ; a != nil; a = a->right){
3256 id = mkdecl(&f->src, Darg, a->left->ty);
3257 if(last == nil)
3258 first = id;
3259 else
3260 last->next = id;
3261 last = id;
3262 }
3263 t->ids = first;
3264 if(f->kind == Tref)
3265 t = mktype(&f->src.start, &f->src.stop, Tref, t, nil);
3266 return t;
3267 }
3268
3269 static Type*
duptype(Type * t)3270 duptype(Type *t)
3271 {
3272 Type *nt;
3273
3274 nt = allocmem(sizeof(*nt));
3275 *nt = *t;
3276 nt->ok &= ~(OKverify|OKref|OKclass|OKsized|OKcycsize|OKcyc);
3277 nt->flags |= INST;
3278 nt->eq = nil;
3279 nt->sbl = -1;
3280 if(t->decl != nil && (nt->kind == Tadt || nt->kind == Tadtpick || nt->kind == Ttuple)){
3281 nt->decl = dupdecl(t->decl);
3282 nt->decl->ty = nt;
3283 nt->decl->link = t->decl;
3284 if(t->decl->dot != nil){
3285 nt->decl->dot = dupdecl(t->decl->dot);
3286 nt->decl->dot->link = t->decl->dot;
3287 }
3288 }
3289 else
3290 nt->decl = nil;
3291 return nt;
3292 }
3293
3294 static int
dpolys(Decl * ids)3295 dpolys(Decl *ids)
3296 {
3297 Decl *p;
3298
3299 for(p = ids; p != nil; p = p->next)
3300 if(tpolys(p->ty))
3301 return 1;
3302 return 0;
3303 }
3304
3305 static int
tpolys(Type * t)3306 tpolys(Type *t)
3307 {
3308 int v;
3309 Typelist *tl;
3310
3311 if(t == nil)
3312 return 0;
3313 if(t->flags&(POLY|NOPOLY))
3314 return t->flags&POLY;
3315 switch(t->kind){
3316 default:
3317 v = 0;
3318 break;
3319 case Tarrow:
3320 case Tdot:
3321 case Tpoly:
3322 v = 1;
3323 break;
3324 case Tref:
3325 case Tlist:
3326 case Tarray:
3327 case Tchan:
3328 v = tpolys(t->tof);
3329 break;
3330 case Tid:
3331 v = tpolys(t->decl->ty);
3332 break;
3333 case Tinst:
3334 v = 0;
3335 for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
3336 if(tpolys(tl->t)){
3337 v = 1;
3338 break;
3339 }
3340 if(v == 0)
3341 v = tpolys(t->tof);
3342 break;
3343 case Tfn:
3344 case Tadt:
3345 case Tadtpick:
3346 case Ttuple:
3347 case Texception:
3348 if(t->polys != nil){
3349 v = 1;
3350 break;
3351 }
3352 if(t->rec&TRvis)
3353 return 0;
3354 t->rec |= TRvis;
3355 v = tpolys(t->tof) || dpolys(t->polys) || dpolys(t->ids) || dpolys(t->tags);
3356 t->rec &= ~TRvis;
3357 if(t->kind == Tadtpick && v == 0)
3358 v = tpolys(t->decl->dot->ty);
3359 break;
3360 }
3361 if(v)
3362 t->flags |= POLY;
3363 else
3364 t->flags |= NOPOLY;
3365 return v;
3366 }
3367
3368 static int
doccurs(Decl * ids,Tpair ** tp)3369 doccurs(Decl *ids, Tpair **tp)
3370 {
3371 Decl *p;
3372
3373 for(p = ids; p != nil; p = p->next)
3374 if(toccurs(p->ty, tp))
3375 return 1;
3376 return 0;
3377 }
3378
3379 static int
toccurs(Type * t,Tpair ** tp)3380 toccurs(Type *t, Tpair **tp)
3381 {
3382 int o;
3383 Typelist *tl;
3384
3385 if(t == nil)
3386 return 0;
3387 if(!(t->flags&(POLY|NOPOLY)))
3388 tpolys(t);
3389 if(t->flags&NOPOLY)
3390 return 0;
3391 switch(t->kind){
3392 default:
3393 fatal("unknown type %t in toccurs", t);
3394 case Tnone:
3395 case Tbig:
3396 case Tbyte:
3397 case Treal:
3398 case Tint:
3399 case Tstring:
3400 case Tfix:
3401 case Tmodule:
3402 case Terror:
3403 return 0;
3404 case Tarrow:
3405 case Tdot:
3406 return 1;
3407 case Tpoly:
3408 return valtmap(t, *tp) != t;
3409 case Tref:
3410 case Tlist:
3411 case Tarray:
3412 case Tchan:
3413 return toccurs(t->tof, tp);
3414 case Tid:
3415 return toccurs(t->decl->ty, tp);
3416 case Tinst:
3417 for(tl = t->u.tlist; tl != nil; tl = tl->nxt)
3418 if(toccurs(tl->t, tp))
3419 return 1;
3420 return toccurs(t->tof, tp);
3421 case Tfn:
3422 case Tadt:
3423 case Tadtpick:
3424 case Ttuple:
3425 case Texception:
3426 if(t->rec&TRvis)
3427 return 0;
3428 t->rec |= TRvis;
3429 o = toccurs(t->tof, tp) || doccurs(t->polys, tp) || doccurs(t->ids, tp) || doccurs(t->tags, tp);
3430 t->rec &= ~TRvis;
3431 if(t->kind == Tadtpick && o == 0)
3432 o = toccurs(t->decl->dot->ty, tp);
3433 return o;
3434 }
3435 }
3436
3437 static Decl*
expandids(Decl * ids,Decl * adtt,Tpair ** tp,int sym)3438 expandids(Decl *ids, Decl *adtt, Tpair **tp, int sym)
3439 {
3440 Decl *p, *q, *nids, *last;
3441
3442 nids = last = nil;
3443 for(p = ids; p != nil; p = p->next){
3444 q = dupdecl(p);
3445 q->ty = expandtype(p->ty, nil, adtt, tp);
3446 if(sym && q->ty->decl != nil)
3447 q->sym = q->ty->decl->sym;
3448 if(q->store == Dfn){
3449 if(debug['v']) print("%p->link = %p\n", q, p);
3450 q->link = p;
3451 }
3452 if(nids == nil)
3453 nids = q;
3454 else
3455 last->next = q;
3456 last = q;
3457 }
3458 return nids;
3459 }
3460
3461 Type*
expandtype(Type * t,Type * instt,Decl * adtt,Tpair ** tp)3462 expandtype(Type *t, Type *instt, Decl *adtt, Tpair **tp)
3463 {
3464 Type *nt;
3465 Decl *ids;
3466
3467 if(t == nil)
3468 return nil;
3469 if(debug['w']) print("expandtype %d %#p %T\n", t->kind, t, t);
3470 if(!toccurs(t, tp))
3471 return t;
3472 if(debug['w']) print("\texpanding\n");
3473 switch(t->kind){
3474 default:
3475 fatal("unknown type %t in expandtype", t);
3476 case Tpoly:
3477 return valtmap(t, *tp);
3478 case Tref:
3479 case Tlist:
3480 case Tarray:
3481 case Tchan:
3482 nt = duptype(t);
3483 nt->tof = expandtype(t->tof, nil, adtt, tp);
3484 return nt;
3485 case Tid:
3486 return expandtype(idtype(t), nil, adtt, tp);
3487 case Tdot:
3488 return expandtype(dottype(t, adtt), nil, adtt, tp);
3489 case Tarrow:
3490 return expandtype(arrowtype(t, adtt), nil, adtt, tp);
3491 case Tinst:
3492 if((nt = valtmap(t, *tp)) != t)
3493 return nt;
3494 return expandtype(insttype(t, adtt, tp), nil, adtt, tp);
3495 case Tfn:
3496 case Tadt:
3497 case Tadtpick:
3498 case Ttuple:
3499 case Texception:
3500 if((nt = valtmap(t, *tp)) != t)
3501 return nt;
3502 if(t->kind == Tadt)
3503 adtt = t->decl;
3504 nt = duptype(t);
3505 addtmap(t, nt, tp);
3506 if(instt != nil)
3507 addtmap(instt, nt, tp);
3508 nt->tof = expandtype(t->tof, nil, adtt, tp);
3509 nt->polys = expandids(t->polys, adtt, tp, 1);
3510 nt->ids = expandids(t->ids, adtt, tp, 0);
3511 nt->tags = expandids(t->tags, adtt, tp, 0);
3512 if(t->kind == Tadt){
3513 for(ids = nt->tags; ids != nil; ids = ids->next)
3514 ids->ty->decl->dot = nt->decl;
3515 }
3516 if(t->kind == Tadtpick){
3517 nt->decl->dot->ty = expandtype(t->decl->dot->ty, nil, adtt, tp);
3518 }
3519 if((t->kind == Tadt || t->kind == Tadtpick) && t->u.tmap != nil){
3520 Tpair *p;
3521
3522 nt->u.tmap = nil;
3523 for(p = t->u.tmap; p != nil; p = p->nxt)
3524 addtmap(valtmap(p->t1, *tp), valtmap(p->t2, *tp), &nt->u.tmap);
3525 if(debug['w']){
3526 print("new tmap for %T->%T: ", t, nt);
3527 for(p=nt->u.tmap;p!=nil;p=p->nxt)print("%T -> %T ", p->t1, p->t2);
3528 print("\n");
3529 }
3530 }
3531 return nt;
3532 }
3533 }
3534
3535 /*
3536 * create type signatures
3537 * sign the same information used
3538 * for testing type equality
3539 */
3540 ulong
sign(Decl * d)3541 sign(Decl *d)
3542 {
3543 Type *t;
3544 uchar *sig, md5sig[MD5dlen];
3545 char buf[StrSize];
3546 int i, sigend, sigalloc, v;
3547
3548 t = d->ty;
3549 if(t->sig != 0)
3550 return t->sig;
3551
3552 if(ispoly(d))
3553 rmfnptrs(d);
3554
3555 sig = 0;
3556 sigend = -1;
3557 sigalloc = 1024;
3558 while(sigend < 0 || sigend >= sigalloc){
3559 sigalloc *= 2;
3560 sig = reallocmem(sig, sigalloc);
3561 eqrec = 0;
3562 sigend = rtsign(t, sig, sigalloc, 0);
3563 v = clearrec(t);
3564 if(v != eqrec)
3565 fatal("recid not balanced in sign: %d %d", v, eqrec);
3566 eqrec = 0;
3567 }
3568 sig[sigend] = '\0';
3569
3570 if(signdump != nil){
3571 seprint(buf, buf+sizeof(buf), "%D", d);
3572 if(strcmp(buf, signdump) == 0){
3573 print("sign %D len %d\n", d, sigend);
3574 print("%s\n", (char*)sig);
3575 }
3576 }
3577
3578 md5(sig, sigend, md5sig, nil);
3579 for(i = 0; i < MD5dlen; i += 4)
3580 t->sig ^= md5sig[i+0] | (md5sig[i+1]<<8) | (md5sig[i+2]<<16) | (md5sig[i+3]<<24);
3581 if(debug['S'])
3582 print("signed %D type %T len %d sig %#lux\n", d, t, sigend, t->sig);
3583 free(sig);
3584 return t->sig;
3585 }
3586
3587 enum
3588 {
3589 SIGSELF = 'S',
3590 SIGVARARGS = '*',
3591 SIGCYC = 'y',
3592 SIGREC = '@'
3593 };
3594
3595 static int sigkind[Tend] =
3596 {
3597 /* Tnone */ 'n',
3598 /* Tadt */ 'a',
3599 /* Tadtpick */ 'p',
3600 /* Tarray */ 'A',
3601 /* Tbig */ 'B',
3602 /* Tbyte */ 'b',
3603 /* Tchan */ 'C',
3604 /* Treal */ 'r',
3605 /* Tfn */ 'f',
3606 /* Tint */ 'i',
3607 /* Tlist */ 'L',
3608 /* Tmodule */ 'm',
3609 /* Tref */ 'R',
3610 /* Tstring */ 's',
3611 /* Ttuple */ 't',
3612 /* Texception */ 'e',
3613 /* Tfix */ 'x',
3614 /* Tpoly */ 'P',
3615 };
3616
3617 static int
rtsign(Type * t,uchar * sig,int lensig,int spos)3618 rtsign(Type *t, uchar *sig, int lensig, int spos)
3619 {
3620 Decl *id, *tg;
3621 char name[32];
3622 int kind, lenname;
3623
3624 if(t == nil)
3625 return spos;
3626
3627 if(spos < 0 || spos + 8 >= lensig)
3628 return -1;
3629
3630 if(t->eq != nil && t->eq->id){
3631 if(t->eq->id < 0 || t->eq->id > eqrec)
3632 fatal("sign rec %T %d %d", t, t->eq->id, eqrec);
3633
3634 sig[spos++] = SIGREC;
3635 seprint(name, name+sizeof(name), "%d", t->eq->id);
3636 lenname = strlen(name);
3637 if(spos + lenname > lensig)
3638 return -1;
3639 strcpy((char*)&sig[spos], name);
3640 spos += lenname;
3641 return spos;
3642 }
3643 if(t->eq != nil){
3644 eqrec++;
3645 t->eq->id = eqrec;
3646 }
3647
3648 kind = sigkind[t->kind];
3649 sig[spos++] = kind;
3650 if(kind == 0)
3651 fatal("no sigkind for %t", t);
3652
3653 t->rec = 1;
3654 switch(t->kind){
3655 default:
3656 fatal("bogus type %t in rtsign", t);
3657 return -1;
3658 case Tnone:
3659 case Tbig:
3660 case Tbyte:
3661 case Treal:
3662 case Tint:
3663 case Tstring:
3664 case Tpoly:
3665 return spos;
3666 case Tfix:
3667 seprint(name, name+sizeof(name), "%g", t->val->rval);
3668 lenname = strlen(name);
3669 if(spos+lenname-1 >= lensig)
3670 return -1;
3671 strcpy((char*)&sig[spos], name);
3672 spos += lenname;
3673 return spos;
3674 case Tref:
3675 case Tlist:
3676 case Tarray:
3677 case Tchan:
3678 return rtsign(t->tof, sig, lensig, spos);
3679 case Tfn:
3680 if(t->varargs != 0)
3681 sig[spos++] = SIGVARARGS;
3682 if(t->polys != nil)
3683 spos = idsign(t->polys, 0, sig, lensig, spos);
3684 spos = idsign(t->ids, 0, sig, lensig, spos);
3685 if(t->u.eraises)
3686 spos = raisessign(t->u.eraises, sig, lensig, spos);
3687 return rtsign(t->tof, sig, lensig, spos);
3688 case Ttuple:
3689 return idsign(t->ids, 0, sig, lensig, spos);
3690 case Tadt:
3691 /*
3692 * this is a little different than in rtequal,
3693 * since we flatten the adt we used to represent the globals
3694 */
3695 if(t->eq == nil){
3696 if(strcmp(t->decl->sym->name, ".mp") != 0)
3697 fatal("no t->eq field for %t", t);
3698 spos--;
3699 for(id = t->ids; id != nil; id = id->next){
3700 spos = idsign1(id, 1, sig, lensig, spos);
3701 if(spos < 0 || spos >= lensig)
3702 return -1;
3703 sig[spos++] = ';';
3704 }
3705 return spos;
3706 }
3707 if(t->polys != nil)
3708 spos = idsign(t->polys, 0, sig, lensig, spos);
3709 spos = idsign(t->ids, 1, sig, lensig, spos);
3710 if(spos < 0 || t->tags == nil)
3711 return spos;
3712
3713 /*
3714 * convert closing ')' to a ',', then sign any tags
3715 */
3716 sig[spos-1] = ',';
3717 for(tg = t->tags; tg != nil; tg = tg->next){
3718 lenname = tg->sym->len;
3719 if(spos + lenname + 2 >= lensig)
3720 return -1;
3721 strcpy((char*)&sig[spos], tg->sym->name);
3722 spos += lenname;
3723 sig[spos++] = '=';
3724 sig[spos++] = '>';
3725
3726 spos = rtsign(tg->ty, sig, lensig, spos);
3727 if(spos < 0 || spos >= lensig)
3728 return -1;
3729
3730 if(tg->next != nil)
3731 sig[spos++] = ',';
3732 }
3733 if(spos >= lensig)
3734 return -1;
3735 sig[spos++] = ')';
3736 return spos;
3737 case Tadtpick:
3738 spos = idsign(t->ids, 1, sig, lensig, spos);
3739 if(spos < 0)
3740 return spos;
3741 return rtsign(t->decl->dot->ty, sig, lensig, spos);
3742 case Tmodule:
3743 if(t->tof->linkall == 0)
3744 fatal("signing a narrowed module");
3745
3746 if(spos >= lensig)
3747 return -1;
3748 sig[spos++] = '{';
3749 for(id = t->tof->ids; id != nil; id = id->next){
3750 if(id->tag)
3751 continue;
3752 if(strcmp(id->sym->name, ".mp") == 0){
3753 spos = rtsign(id->ty, sig, lensig, spos);
3754 if(spos < 0)
3755 return -1;
3756 continue;
3757 }
3758 spos = idsign1(id, 1, sig, lensig, spos);
3759 if(spos < 0 || spos >= lensig)
3760 return -1;
3761 sig[spos++] = ';';
3762 }
3763 if(spos >= lensig)
3764 return -1;
3765 sig[spos++] = '}';
3766 return spos;
3767 }
3768 }
3769
3770 static int
idsign(Decl * id,int usenames,uchar * sig,int lensig,int spos)3771 idsign(Decl *id, int usenames, uchar *sig, int lensig, int spos)
3772 {
3773 int first;
3774
3775 if(spos >= lensig)
3776 return -1;
3777 sig[spos++] = '(';
3778 first = 1;
3779 for(; id != nil; id = id->next){
3780 if(id->store == Dlocal)
3781 fatal("local %s in idsign", id->sym->name);
3782
3783 if(!storespace[id->store])
3784 continue;
3785
3786 if(!first){
3787 if(spos >= lensig)
3788 return -1;
3789 sig[spos++] = ',';
3790 }
3791
3792 spos = idsign1(id, usenames, sig, lensig, spos);
3793 if(spos < 0)
3794 return -1;
3795 first = 0;
3796 }
3797 if(spos >= lensig)
3798 return -1;
3799 sig[spos++] = ')';
3800 return spos;
3801 }
3802
3803 static int
idsign1(Decl * id,int usenames,uchar * sig,int lensig,int spos)3804 idsign1(Decl *id, int usenames, uchar *sig, int lensig, int spos)
3805 {
3806 char *name;
3807 int lenname;
3808
3809 if(usenames){
3810 name = id->sym->name;
3811 lenname = id->sym->len;
3812 if(spos + lenname + 1 >= lensig)
3813 return -1;
3814 strcpy((char*)&sig[spos], name);
3815 spos += lenname;
3816 sig[spos++] = ':';
3817 }
3818
3819 if(spos + 2 >= lensig)
3820 return -1;
3821
3822 if(id->implicit != 0)
3823 sig[spos++] = SIGSELF;
3824
3825 if(id->cyc != 0)
3826 sig[spos++] = SIGCYC;
3827
3828 return rtsign(id->ty, sig, lensig, spos);
3829 }
3830
3831 static int
raisessign(Node * n,uchar * sig,int lensig,int spos)3832 raisessign(Node *n, uchar *sig, int lensig, int spos)
3833 {
3834 int m;
3835 char *s;
3836 Node *nn;
3837
3838 if(spos >= lensig)
3839 return -1;
3840 sig[spos++] = '(';
3841 for(nn = n->left; nn != nil; nn = nn->right){
3842 s = nn->left->decl->sym->name;
3843 m = nn->left->decl->sym->len;
3844 if(spos+m-1 >= lensig)
3845 return -1;
3846 strcpy((char*)&sig[spos], s);
3847 spos += m;
3848 if(nn->right != nil){
3849 if(spos >= lensig)
3850 return -1;
3851 sig[spos++] = ',';
3852 }
3853 }
3854 if(spos >= lensig)
3855 return -1;
3856 sig[spos++] = ')';
3857 return spos;
3858 }
3859
3860 static int
clearrec(Type * t)3861 clearrec(Type *t)
3862 {
3863 Decl *id;
3864 int n;
3865
3866 n = 0;
3867 for(; t != nil && t->rec; t = t->tof){
3868 t->rec = 0;
3869 if(t->eq != nil && t->eq->id != 0){
3870 t->eq->id = 0;
3871 n++;
3872 }
3873 if(t->kind == Tmodule){
3874 for(id = t->tof->ids; id != nil; id = id->next)
3875 n += clearrec(id->ty);
3876 return n;
3877 }
3878 if(t->kind == Tadtpick)
3879 n += clearrec(t->decl->dot->ty);
3880 for(id = t->ids; id != nil; id = id->next)
3881 n += clearrec(id->ty);
3882 for(id = t->tags; id != nil; id = id->next)
3883 n += clearrec(id->ty);
3884 for(id = t->polys; id != nil; id = id->next)
3885 n += clearrec(id->ty);
3886 }
3887 return n;
3888 }
3889
3890 /* must a variable of the given type be zeroed ? (for uninitialized declarations inside loops) */
3891 int
tmustzero(Type * t)3892 tmustzero(Type *t)
3893 {
3894 if(t==nil)
3895 return 0;
3896 if(tattr[t->kind].isptr)
3897 return 1;
3898 if(t->kind == Tadtpick)
3899 t = t->tof;
3900 if(t->kind == Ttuple || t->kind == Tadt)
3901 return mustzero(t->ids);
3902 return 0;
3903 }
3904
3905 int
mustzero(Decl * decls)3906 mustzero(Decl *decls)
3907 {
3908 Decl *d;
3909
3910 for (d = decls; d != nil; d = d->next)
3911 if (tmustzero(d->ty))
3912 return 1;
3913 return 0;
3914 }
3915
3916 int
typeconv(Fmt * f)3917 typeconv(Fmt *f)
3918 {
3919 Type *t;
3920 char *p, buf[1024];
3921
3922 t = va_arg(f->args, Type*);
3923 if(t == nil){
3924 p = "nothing";
3925 }else{
3926 p = buf;
3927 buf[0] = 0;
3928 tprint(buf, buf+sizeof(buf), t);
3929 }
3930 return fmtstrcpy(f, p);
3931 }
3932
3933 int
stypeconv(Fmt * f)3934 stypeconv(Fmt *f)
3935 {
3936 Type *t;
3937 char *p, buf[1024];
3938
3939 t = va_arg(f->args, Type*);
3940 if(t == nil){
3941 p = "nothing";
3942 }else{
3943 p = buf;
3944 buf[0] = 0;
3945 stprint(buf, buf+sizeof(buf), t);
3946 }
3947 return fmtstrcpy(f, p);
3948 }
3949
3950 int
ctypeconv(Fmt * f)3951 ctypeconv(Fmt *f)
3952 {
3953 Type *t;
3954 char buf[1024];
3955
3956 t = va_arg(f->args, Type*);
3957 buf[0] = 0;
3958 ctprint(buf, buf+sizeof(buf), t);
3959 return fmtstrcpy(f, buf);
3960 }
3961
3962 char*
tprint(char * buf,char * end,Type * t)3963 tprint(char *buf, char *end, Type *t)
3964 {
3965 Decl *id;
3966 Typelist *tl;
3967
3968 if(t == nil)
3969 return buf;
3970 if(t->kind >= Tend)
3971 return seprint(buf, end, "kind %d", t->kind);
3972 switch(t->kind){
3973 case Tarrow:
3974 buf = seprint(buf, end, "%T->%s", t->tof, t->decl->sym->name);
3975 break;
3976 case Tdot:
3977 buf = seprint(buf, end, "%T.%s", t->tof, t->decl->sym->name);
3978 break;
3979 case Tid:
3980 case Tpoly:
3981 buf = seprint(buf, end, "%s", t->decl->sym->name);
3982 break;
3983 case Tinst:
3984 buf = tprint(buf, end, t->tof);
3985 buf = secpy(buf ,end, "[");
3986 for(tl = t->u.tlist; tl != nil; tl = tl->nxt){
3987 buf = tprint(buf, end, tl->t);
3988 if(tl->nxt != nil)
3989 buf = secpy(buf, end, ", ");
3990 }
3991 buf = secpy(buf, end, "]");
3992 break;
3993 case Tint:
3994 case Tbig:
3995 case Tstring:
3996 case Treal:
3997 case Tbyte:
3998 case Tany:
3999 case Tnone:
4000 case Terror:
4001 case Tainit:
4002 case Talt:
4003 case Tcase:
4004 case Tcasel:
4005 case Tcasec:
4006 case Tgoto:
4007 case Tiface:
4008 case Texception:
4009 case Texcept:
4010 buf = secpy(buf, end, kindname[t->kind]);
4011 break;
4012 case Tfix:
4013 buf = seprint(buf, end, "%s(%v)", kindname[t->kind], t->val);
4014 break;
4015 case Tref:
4016 buf = secpy(buf, end, "ref ");
4017 buf = tprint(buf, end, t->tof);
4018 break;
4019 case Tchan:
4020 case Tarray:
4021 case Tlist:
4022 buf = seprint(buf, end, "%s of ", kindname[t->kind]);
4023 buf = tprint(buf, end, t->tof);
4024 break;
4025 case Tadtpick:
4026 buf = seprint(buf, end, "%s.%s", t->decl->dot->sym->name, t->decl->sym->name);
4027 break;
4028 case Tadt:
4029 if(t->decl->dot != nil && !isimpmod(t->decl->dot->sym))
4030 buf = seprint(buf, end, "%s->%s", t->decl->dot->sym->name, t->decl->sym->name);
4031 else
4032 buf = seprint(buf, end, "%s", t->decl->sym->name);
4033 if(t->polys != nil){
4034 buf = secpy(buf ,end, "[");
4035 for(id = t->polys; id != nil; id = id->next){
4036 if(t->u.tmap != nil)
4037 buf = tprint(buf, end, valtmap(id->ty, t->u.tmap));
4038 else
4039 buf = seprint(buf, end, "%s", id->sym->name);
4040 if(id->next != nil)
4041 buf = secpy(buf, end, ", ");
4042 }
4043 buf = secpy(buf, end, "]");
4044 }
4045 break;
4046 case Tmodule:
4047 buf = seprint(buf, end, "%s", t->decl->sym->name);
4048 break;
4049 case Ttuple:
4050 buf = secpy(buf, end, "(");
4051 for(id = t->ids; id != nil; id = id->next){
4052 buf = tprint(buf, end, id->ty);
4053 if(id->next != nil)
4054 buf = secpy(buf, end, ", ");
4055 }
4056 buf = secpy(buf, end, ")");
4057 break;
4058 case Tfn:
4059 buf = secpy(buf, end, "fn");
4060 if(t->polys != nil){
4061 buf = secpy(buf, end, "[");
4062 for(id = t->polys; id != nil; id = id->next){
4063 buf = seprint(buf, end, "%s", id->sym->name);
4064 if(id->next != nil)
4065 buf = secpy(buf, end, ", ");
4066 }
4067 buf = secpy(buf, end, "]");
4068 }
4069 buf = secpy(buf, end, "(");
4070 for(id = t->ids; id != nil; id = id->next){
4071 if(id->sym == nil)
4072 buf = secpy(buf, end, "nil: ");
4073 else
4074 buf = seprint(buf, end, "%s: ", id->sym->name);
4075 if(id->implicit)
4076 buf = secpy(buf, end, "self ");
4077 buf = tprint(buf, end, id->ty);
4078 if(id->next != nil)
4079 buf = secpy(buf, end, ", ");
4080 }
4081 if(t->varargs && t->ids != nil)
4082 buf = secpy(buf, end, ", *");
4083 else if(t->varargs)
4084 buf = secpy(buf, end, "*");
4085 if(t->tof != nil && t->tof->kind != Tnone){
4086 buf = secpy(buf, end, "): ");
4087 buf = tprint(buf, end, t->tof);
4088 break;
4089 }
4090 buf = secpy(buf, end, ")");
4091 break;
4092 default:
4093 yyerror("tprint: unknown type kind %d", t->kind);
4094 break;
4095 }
4096 return buf;
4097 }
4098
4099 char*
stprint(char * buf,char * end,Type * t)4100 stprint(char *buf, char *end, Type *t)
4101 {
4102 if(t == nil)
4103 return buf;
4104 switch(t->kind){
4105 case Tid:
4106 return seprint(buf, end, "id %s", t->decl->sym->name);
4107 case Tadt:
4108 case Tadtpick:
4109 case Tmodule:
4110 buf = secpy(buf, end, kindname[t->kind]);
4111 buf = secpy(buf, end, " ");
4112 return tprint(buf, end, t);
4113 }
4114 return tprint(buf, end, t);
4115 }
4116
4117 /* generalize ref P.A, ref P.B to ref P */
4118
4119 /*
4120 Type*
4121 tparentx(Type *t1, Type* t2)
4122 {
4123 if(t1 == nil || t2 == nil || t1->kind != Tref || t2->kind != Tref)
4124 return t1;
4125 t1 = t1->tof;
4126 t2 = t2->tof;
4127 if(t1 == nil || t2 == nil || t1->kind != Tadtpick || t2->kind != Tadtpick)
4128 return t1;
4129 t1 = t1->decl->dot->ty;
4130 t2 = t2->decl->dot->ty;
4131 if(tequal(t1, t2))
4132 return mktype(&t1->src.start, &t1->src.stop, Tref, t1, nil);
4133 return t1;
4134 }
4135 */
4136
4137 static int
tparent0(Type * t1,Type * t2)4138 tparent0(Type *t1, Type *t2)
4139 {
4140 Decl *id1, *id2;
4141
4142 if(t1 == t2)
4143 return 1;
4144 if(t1 == nil || t2 == nil)
4145 return 0;
4146 if(t1->kind == Tadt && t2->kind == Tadtpick)
4147 t2 = t2->decl->dot->ty;
4148 if(t1->kind == Tadtpick && t2->kind == Tadt)
4149 t1 = t1->decl->dot->ty;
4150 if(t1->kind != t2->kind)
4151 return 0;
4152 switch(t1->kind){
4153 default:
4154 fatal("unknown type %t v %t in tparent", t1, t2);
4155 break;
4156 case Terror:
4157 case Tstring:
4158 case Tnone:
4159 case Tint:
4160 case Tbig:
4161 case Tbyte:
4162 case Treal:
4163 case Tany:
4164 return 1;
4165 case Texception:
4166 case Tfix:
4167 case Tfn:
4168 case Tadt:
4169 case Tmodule:
4170 case Tpoly:
4171 return tcompat(t1, t2, 0);
4172 case Tref:
4173 case Tlist:
4174 case Tarray:
4175 case Tchan:
4176 return tparent0(t1->tof, t2->tof);
4177 case Ttuple:
4178 for(id1 = t1->ids, id2 = t2->ids; id1 != nil && id2 != nil; id1 = id1->next, id2 = id2->next)
4179 if(!tparent0(id1->ty, id2->ty))
4180 return 0;
4181 return id1 == nil && id2 == nil;
4182 case Tadtpick:
4183 return tequal(t1->decl->dot->ty, t2->decl->dot->ty);
4184 }
4185 return 0;
4186 }
4187
4188 static Type*
tparent1(Type * t1,Type * t2)4189 tparent1(Type *t1, Type *t2)
4190 {
4191 Type *t, *nt;
4192 Decl *id, *id1, *id2, *idt;
4193
4194 if(t1->kind == Tadt && t2->kind == Tadtpick)
4195 t2 = t2->decl->dot->ty;
4196 if(t1->kind == Tadtpick && t2->kind == Tadt)
4197 t1 = t1->decl->dot->ty;
4198 switch(t1->kind){
4199 default:
4200 return t1;
4201 case Tref:
4202 case Tlist:
4203 case Tarray:
4204 case Tchan:
4205 t = tparent1(t1->tof, t2->tof);
4206 if(t == t1->tof)
4207 return t1;
4208 return mktype(&t1->src.start, &t1->src.stop, t1->kind, t, nil);
4209 case Ttuple:
4210 nt = nil;
4211 id = nil;
4212 for(id1 = t1->ids, id2 = t2->ids; id1 != nil && id2 != nil; id1 = id1->next, id2 = id2->next){
4213 t = tparent1(id1->ty, id2->ty);
4214 if(t != id1->ty){
4215 if(nt == nil){
4216 nt = mktype(&t1->src.start, &t1->src.stop, Ttuple, nil, dupdecls(t1->ids));
4217 for(id = nt->ids, idt = t1->ids; idt != id1; id = id->next, idt = idt->next)
4218 ;
4219 }
4220 id->ty = t;
4221 }
4222 if(id != nil)
4223 id = id->next;
4224 }
4225 if(nt == nil)
4226 return t1;
4227 return nt;
4228 case Tadtpick:
4229 if(tequal(t1, t2))
4230 return t1;
4231 return t1->decl->dot->ty;
4232 }
4233 }
4234
4235 Type*
tparent(Type * t1,Type * t2)4236 tparent(Type *t1, Type *t2)
4237 {
4238 if(tparent0(t1, t2))
4239 return tparent1(t1, t2);
4240 return t1;
4241 }
4242
4243 /*
4244 * make the tuple type used to initialize an exception type
4245 */
4246 Type*
mkexbasetype(Type * t)4247 mkexbasetype(Type *t)
4248 {
4249 Decl *id, *new, *last;
4250 Type *nt;
4251
4252 if(!t->cons)
4253 fatal("mkexbasetype on non-constant");
4254 last = mkids(&t->decl->src, nil, tstring, nil);
4255 last->store = Dfield;
4256 nt = mktype(&t->src.start, &t->src.stop, Texception, nil, last);
4257 nt->cons = 0;
4258 new = mkids(&t->decl->src, nil, tint, nil);
4259 new->store = Dfield;
4260 last->next = new;
4261 last = new;
4262 for(id = t->ids; id != nil; id = id->next){
4263 new = allocmem(sizeof *id);
4264 *new = *id;
4265 new->cyc = 0;
4266 last->next = new;
4267 last = new;
4268 }
4269 last->next = nil;
4270 return usetype(nt);
4271 }
4272
4273 /*
4274 * make an instantiated exception type
4275 */
4276 Type*
mkextype(Type * t)4277 mkextype(Type *t)
4278 {
4279 Type *nt;
4280
4281 if(!t->cons)
4282 fatal("mkextype on non-constant");
4283 if(t->tof != nil)
4284 return t->tof;
4285 nt = copytypeids(t);
4286 nt->cons = 0;
4287 t->tof = usetype(nt);
4288 return t->tof;
4289 }
4290
4291 /*
4292 * convert an instantiated exception type to its underlying type
4293 */
4294 Type*
mkextuptype(Type * t)4295 mkextuptype(Type *t)
4296 {
4297 Decl *id;
4298 Type *nt;
4299
4300 if(t->cons)
4301 return t;
4302 if(t->tof != nil)
4303 return t->tof;
4304 id = t->ids;
4305 if(id == nil)
4306 nt = t;
4307 else if(id->next == nil)
4308 nt = id->ty;
4309 else{
4310 nt = copytypeids(t);
4311 nt->cons = 0;
4312 nt->kind = Ttuple;
4313 }
4314 t->tof = usetype(nt);
4315 return t->tof;
4316 }
4317
4318 static void
ckfix(Type * t,double max)4319 ckfix(Type *t, double max)
4320 {
4321 int p;
4322 vlong k, x;
4323 double s;
4324
4325 s = t->val->rval;
4326 if(max == 0.0)
4327 k = ((vlong)1<<32)-1;
4328 else
4329 k = 2*(vlong)(max/s+0.5)+1;
4330 x = 1;
4331 for(p = 0; k > x; p++)
4332 x *= 2;
4333 if(p == 0 || p > 32){
4334 error(t->src.start, "cannot fit fixed type into an int");
4335 return;
4336 }
4337 if(p < 32)
4338 t->val->rval /= (double)(1<<(32-p));
4339 }
4340
4341 double
scale(Type * t)4342 scale(Type *t)
4343 {
4344 Node *n;
4345
4346 if(t->kind == Tint || t->kind == Treal)
4347 return 1.0;
4348 if(t->kind != Tfix)
4349 fatal("scale() on non fixed point type");
4350 n = t->val;
4351 if(n->op != Oconst)
4352 fatal("non constant scale");
4353 if(n->ty != treal)
4354 fatal("non real scale");
4355 return n->rval;
4356 }
4357
4358 double
scale2(Type * f,Type * t)4359 scale2(Type *f, Type *t)
4360 {
4361 return scale(f)/scale(t);
4362 }
4363
4364 #define I(x) ((int)(x))
4365 #define V(x) ((Long)(x))
4366 #define D(x) ((double)(x))
4367
4368 /* put x in normal form */
4369 static int
nf(double x,int * mant)4370 nf(double x, int *mant)
4371 {
4372 int p;
4373 double m;
4374
4375 p = 0;
4376 m = x;
4377 while(m >= 1){
4378 p++;
4379 m /= 2;
4380 }
4381 while(m < 0.5){
4382 p--;
4383 m *= 2;
4384 }
4385 m *= D(1<<16)*D(1<<15);
4386 if(m >= D(0x7fffffff) - 0.5){
4387 *mant = 0x7fffffff;
4388 return p;
4389 }
4390 *mant = I(m+0.5);
4391 return p;
4392 }
4393
4394 static int
ispow2(double x)4395 ispow2(double x)
4396 {
4397 int m;
4398
4399 nf(x, &m);
4400 if(m != 1<<30)
4401 return 0;
4402 return 1;
4403 }
4404
4405 static int
fround(double x,int n,int * m)4406 fround(double x, int n, int *m)
4407 {
4408 if(n != 31)
4409 fatal("not 31 in fround");
4410 return nf(x, m);
4411 }
4412
4413 static int
fixmul2(double sx,double sy,double sr,int * rp,int * ra)4414 fixmul2(double sx, double sy, double sr, int *rp, int *ra)
4415 {
4416 int k, n, a;
4417 double alpha;
4418
4419 alpha = (sx*sy)/sr;
4420 n = 31;
4421 k = fround(1/alpha, n, &a);
4422 *rp = 1-k;
4423 *ra = 0;
4424 return IMULX;
4425 }
4426
4427 static int
fixdiv2(double sx,double sy,double sr,int * rp,int * ra)4428 fixdiv2(double sx, double sy, double sr, int *rp, int *ra)
4429 {
4430 int k, n, b;
4431 double beta;
4432
4433 beta = sx/(sy*sr);
4434 n = 31;
4435 k = fround(beta, n, &b);
4436 *rp = k-1;
4437 *ra = 0;
4438 return IDIVX;
4439 }
4440
4441 static int
fixmul(double sx,double sy,double sr,int * rp,int * ra)4442 fixmul(double sx, double sy, double sr, int *rp, int *ra)
4443 {
4444 int k, m, n, a, v;
4445 vlong W;
4446 double alpha, eps;
4447
4448 alpha = (sx*sy)/sr;
4449 if(ispow2(alpha))
4450 return fixmul2(sx, sy, sr, rp, ra);
4451 n = 31;
4452 k = fround(1/alpha, n, &a);
4453 m = n-k;
4454 if(m < -n-1)
4455 return IMOVW; /* result is zero whatever the values */
4456 v = 0;
4457 W = 0;
4458 eps = D(1<<m)/(alpha*D(a)) - 1;
4459 if(eps < 0){
4460 v = a-1;
4461 eps = -eps;
4462 }
4463 if(m < 0 && D(1<<n)*eps*D(a) >= D(a)-1+D(1<<m))
4464 W = (V(1)<<(-m)) - 1;
4465 if(v != 0 || W != 0)
4466 m = m<<2|(v != 0)<<1|(W != 0);
4467 *rp = m;
4468 *ra = a;
4469 return v == 0 && W == 0 ? IMULX0: IMULX1;
4470 }
4471
4472 static int
fixdiv(double sx,double sy,double sr,int * rp,int * ra)4473 fixdiv(double sx, double sy, double sr, int *rp, int *ra)
4474 {
4475 int k, m, n, b, v;
4476 vlong W;
4477 double beta, eps;
4478
4479 beta = sx/(sy*sr);
4480 if(ispow2(beta))
4481 return fixdiv2(sx, sy, sr, rp, ra);
4482 n = 31;
4483 k = fround(beta, n, &b);
4484 m = k-n;
4485 if(m <= -2*n)
4486 return IMOVW; /* result is zero whatever the values */
4487 v = 0;
4488 W = 0;
4489 eps = (D(1<<m)*D(b))/beta - 1;
4490 if(eps < 0)
4491 v = 1;
4492 if(m < 0)
4493 W = (V(1)<<(-m)) - 1;
4494 if(v != 0 || W != 0)
4495 m = m<<2|(v != 0)<<1|(W != 0);
4496 *rp = m;
4497 *ra = b;
4498 return v == 0 && W == 0 ? IDIVX0: IDIVX1;
4499 }
4500
4501 static int
fixcast(double sx,double sr,int * rp,int * ra)4502 fixcast(double sx, double sr, int *rp, int *ra)
4503 {
4504 int op;
4505
4506 op = fixmul(sx, 1.0, sr, rp, ra);
4507 return op-IMULX+ICVTXX;
4508 }
4509
4510 int
fixop(int op,Type * tx,Type * ty,Type * tr,int * rp,int * ra)4511 fixop(int op, Type *tx, Type *ty, Type *tr, int *rp, int *ra)
4512 {
4513 double sx, sy, sr;
4514
4515 sx = scale(tx);
4516 sy = scale(ty);
4517 sr = scale(tr);
4518 if(op == IMULX)
4519 op = fixmul(sx, sy, sr, rp, ra);
4520 else if(op == IDIVX)
4521 op = fixdiv(sx, sy, sr, rp, ra);
4522 else
4523 op = fixcast(sx, sr, rp, ra);
4524 return op;
4525 }
4526
4527 int
ispoly(Decl * d)4528 ispoly(Decl *d)
4529 {
4530 Type *t;
4531
4532 if(d == nil)
4533 return 0;
4534 t = d->ty;
4535 if(t->kind == Tfn){
4536 if(t->polys != nil)
4537 return 1;
4538 if((d = d->dot) == nil)
4539 return 0;
4540 t = d->ty;
4541 return t->kind == Tadt && t->polys != nil;
4542 }
4543 return 0;
4544 }
4545
4546 int
ispolyadt(Type * t)4547 ispolyadt(Type *t)
4548 {
4549 return (t->kind == Tadt || t->kind == Tadtpick) && t->polys != nil && !(t->flags & INST);
4550 }
4551
4552 Decl*
polydecl(Decl * ids)4553 polydecl(Decl *ids)
4554 {
4555 Decl *id;
4556 Type *t;
4557
4558 for(id = ids; id != nil; id = id->next){
4559 t = mktype(&id->src.start, &id->src.stop, Tpoly, nil, nil);
4560 id->ty = t;
4561 t->decl = id;
4562 }
4563 return ids;
4564 }
4565
4566 /* try to convert an expression tree to a type */
4567 Type*
exptotype(Node * n)4568 exptotype(Node *n)
4569 {
4570 Type *t, *tt;
4571 Decl *d;
4572 Typelist *tl;
4573 Src *src;
4574
4575 if(n == nil)
4576 return nil;
4577 t = nil;
4578 switch(n->op){
4579 case Oname:
4580 if((d = n->decl) != nil && d->store == Dtype)
4581 t = d->ty;
4582 break;
4583 case Otype:
4584 case Ochan:
4585 t = n->ty;
4586 break;
4587 case Oref:
4588 t = exptotype(n->left);
4589 if(t != nil)
4590 t = mktype(&n->src.start, &n->src.stop, Tref, t, nil);
4591 break;
4592 case Odot:
4593 t = exptotype(n->left);
4594 if(t != nil){
4595 d = namedot(t->tags, n->right->decl->sym);
4596 if(d == nil)
4597 t = nil;
4598 else
4599 t = d->ty;
4600 }
4601 if(t == nil)
4602 t = exptotype(n->right);
4603 break;
4604 case Omdot:
4605 t = exptotype(n->right);
4606 break;
4607 case Oindex:
4608 t = exptotype(n->left);
4609 if(t != nil){
4610 src = &n->src;
4611 tl = nil;
4612 for(n = n->right; n != nil; n = n->right){
4613 if(n->op == Oseq)
4614 tt = exptotype(n->left);
4615 else
4616 tt = exptotype(n);
4617 if(tt == nil)
4618 return nil;
4619 tl = addtype(tt, tl);
4620 if(n->op != Oseq)
4621 break;
4622 }
4623 t = mkinsttype(src, t, tl);
4624 }
4625 break;
4626 }
4627 return t;
4628 }
4629
4630 static char*
uname(Decl * im)4631 uname(Decl *im)
4632 {
4633 Decl *p;
4634 int n;
4635 char *s;
4636
4637 n = 0;
4638 for(p = im; p != nil; p = p->next)
4639 n += strlen(p->sym->name)+1;
4640 s = allocmem(n);
4641 strcpy(s, "");
4642 for(p = im; p != nil; p = p->next){
4643 strcat(s, p->sym->name);
4644 if(p->next != nil)
4645 strcat(s, "+");
4646 }
4647 return s;
4648 }
4649
4650 /* check all implementation modules have consistent declarations
4651 * and create their union if needed
4652 */
4653 Decl*
modimp(Dlist * dl,Decl * im)4654 modimp(Dlist *dl, Decl *im)
4655 {
4656 Decl *u, *d, *dd, *ids, *dot, *last;
4657 Sym *s;
4658 Dlist *dl0;
4659 long sg, sg0;
4660 char buf[StrSize], *un;
4661
4662 if(dl->next == nil)
4663 return dl->d;
4664 dl0 = dl;
4665 sg0 = 0;
4666 un = uname(im);
4667 seprint(buf, buf+sizeof(buf), ".m.%s", un);
4668 installids(Dglobal, mkids(&dl->d->src, enter(buf, 0), tnone, nil));
4669 u = dupdecl(dl->d);
4670 u->sym = enter(un, 0);
4671 u->sym->decl = u;
4672 u->ty = mktype(&u->src.start, &u->src.stop, Tmodule, nil, nil);
4673 u->ty->decl = u;
4674 last = nil;
4675 for( ; dl != nil; dl = dl->next){
4676 d = dl->d;
4677 ids = d->ty->tof->ids; /* iface */
4678 if(ids != nil && ids->store == Dglobal) /* .mp */
4679 sg = sign(ids);
4680 else
4681 sg = 0;
4682 if(dl == dl0)
4683 sg0 = sg;
4684 else if(sg != sg0)
4685 error(d->src.start, "%s's module data not consistent with that of %s\n", d->sym->name, dl0->d->sym->name);
4686 for(ids = d->ty->ids; ids != nil; ids = ids->next){
4687 s = ids->sym;
4688 if(s->decl != nil && s->decl->scope >= scope){
4689 if(ids == s->decl){
4690 dd = dupdecl(ids);
4691 if(u->ty->ids == nil)
4692 u->ty->ids = dd;
4693 else
4694 last->next = dd;
4695 last = dd;
4696 continue;
4697 }
4698 dot = s->decl->dot;
4699 if(s->decl->store != Dwundef && dot != nil && dot != d && isimpmod(dot->sym) && dequal(ids, s->decl, 1))
4700 ids->refs = s->decl->refs;
4701 else
4702 redecl(ids);
4703 ids->init = s->decl->init;
4704 }
4705 }
4706 }
4707 u->ty = usetype(u->ty);
4708 return u;
4709 }
4710
4711 static void
modres(Decl * d)4712 modres(Decl *d)
4713 {
4714 Decl *ids, *id, *n, *i;
4715 Type *t;
4716
4717 for(ids = d->ty->ids; ids != nil; ids = ids->next){
4718 id = ids->sym->decl;
4719 if(ids != id){
4720 n = ids->next;
4721 i = ids->iface;
4722 t = ids->ty;
4723 *ids = *id;
4724 ids->next = n;
4725 ids->iface = i;
4726 ids->ty = t;
4727 }
4728 }
4729 }
4730
4731 /* update the fields of duplicate declarations in other implementation modules
4732 * and their union
4733 */
4734 void
modresolve(void)4735 modresolve(void)
4736 {
4737 Dlist *dl;
4738
4739 dl = impdecls;
4740 if(dl->next == nil)
4741 return;
4742 for( ; dl != nil; dl = dl->next)
4743 modres(dl->d);
4744 modres(impdecl);
4745 }
4746