]> andersk Git - splint.git/blame - src/sort.c
andersk / splint.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Committing after merging Evan's changes.
[splint.git] / src / sort.c
CommitLineData
616915dd 1/*
11db3170 2** Splint - annotation-assisted static program checker
c59f5181 3** Copyright (C) 1994-2003 University of Virginia,
616915dd 4** Massachusetts Institute of Technology
5**
6** This program is free software; you can redistribute it and/or modify it
7** under the terms of the GNU General Public License as published by the
8** Free Software Foundation; either version 2 of the License, or (at your
9** option) any later version.
10**
11** This program is distributed in the hope that it will be useful, but
12** WITHOUT ANY WARRANTY; without even the implied warranty of
13** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14** General Public License for more details.
15**
16** The GNU General Public License is available from http://www.gnu.org/ or
17** the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
18** MA 02111-1307, USA.
19**
155af98d 20** For information on splint: info@splint.org
21** To report a bug: splint-bug@splint.org
11db3170 22** For more information: http://www.splint.org
616915dd 23*/
24/*
25** sort.c
26**
27** sort abstraction
28**
29** NOTE: The structure of this module follows a similar one
30** used in the previous LCL checker. However, all other
31** details are quite different.
32**
33** AUTHOR:
34** Yang Meng Tan,
35** Massachusetts Institute of Technology
36*/
37
1b8ae690 38# include "splintMacros.nf"
616915dd 39# include "llbasic.h"
40# include "llgrammar.h"
41# include "lclscan.h"
42
43/*@+ignorequals@*/
44
45static lsymbol newStructTag (void) /*@*/ ;
46static lsymbol newEnumTag (void) /*@*/ ;
47static lsymbol newUnionTag (void) /*@*/ ;
48
49/*@constant static int MAXBUFFLEN; @*/
50# define MAXBUFFLEN 1024
51
52/*@constant static int DELTA; @*/
53# define DELTA 100
54
55/*@constant static int NOSORTHANDLE; @*/
56# define NOSORTHANDLE 0
57
58/*@constant static int HOFSORTHANDLE; @*/
59# define HOFSORTHANDLE 1
60
61/* local routines */
62
63static void sort_addTupleMembers (sort p_tupleSort, sort p_strSort)
64 /*@modifies internalState@*/ ;
65
66static bool sort_isNewEntry (sortNode p_s) /*@*/ ;
67
28bf4b0b 68static sort sort_enterNew (/*@only@*/ sortNode p_s)
616915dd 69 /*@modifies internalState@*/ ;
70
28bf4b0b 71static sort sort_enterGlobal (/*@only@*/ sortNode p_s) /*@modifies internalState@*/ ;
616915dd 72
28bf4b0b 73static sort sort_enterNewForce (/*@only@*/ sortNode p_s)
616915dd 74 /*@modifies internalState@*/ ;
75
76static void genPtrOps (sort p_baseSort, sort p_ptrSort, sort p_arraySort);
77static void genArrOps (sort p_baseSort, sort p_arraySort, int p_dim,
78 sort p_vecSort);
79static void genVecOps (sort p_baseSort, sort p_vecSort, int p_dim);
80static void genTupleOps (sort p_tupleSort);
81static void genUnionOps (sort p_tupleSort);
82static void genStrOps (sort p_strSort, sort p_tupleSort);
83static void genEnumOps (sort p_enumSort);
84
85static void overloadPtrFcns (sort p_ptrSort);
86static void overloadIsSub (sort p_s, int p_dim);
87static void overloadSizeof (sort p_domainSort);
88
89/*@observer@*/ static cstring sort_unparseKind (sortKind p_k) /*@*/ ;
90
91static /*@observer@*/ cstring
92 sort_unparseKindName (sortNode p_s) /*@*/ ;
93
94static lsymbol
95 sortTag_toSymbol (char *p_kind, ltoken p_tagid, /*@out@*/ bool *p_isNew);
96
97static void
98 overloadUnaryTok (/*@only@*/ nameNode p_nn,
99 sort p_domainSort, /*@only@*/ ltoken p_range);
100static void
101 overloadUnary (/*@only@*/ nameNode p_nn,
102 sort p_domainSort, sort p_rangeSort);
103static void
104 overloadBinary (/*@only@*/ nameNode p_nn,
105 sort p_s, /*@only@*/ ltoken p_dTok, sort p_rs);
106static /*@only@*/ nameNode makeFieldOp (lsymbol p_field);
107static /*@only@*/ nameNode makeArrowFieldOp (lsymbol p_field);
108
109# undef sp
110static lsymbol sp (lsymbol p_s1, lsymbol p_s2);
111static void sortError (ltoken p_t, sort p_oldsort, sortNode p_newnode);
112
2a6e9c30 113sort g_sortBool;
114sort g_sortCapBool;
115sort g_sortInt;
116sort g_sortChar;
117sort g_sortFloat;
118sort g_sortDouble;
119sort g_sortCstring;
616915dd 120
121static sort sort_void;
122static sort char_obj_ptrSort;
123static sort char_obj_ArrSort;
124
125/* This is used to uniqueize sort names, for anonymous C types */
126static int sortUID = 1;
127
28bf4b0b 128typedef /*@only@*/ sortNode o_sortNode;
129
130static /*@only@*/ /*@null@*/ o_sortNode *sortTable = (sortNode *) 0;
131
616915dd 132static int sortTableSize = 0;
133static int sortTableAlloc = 0;
134
135/* Important to keep sorts in some order because importing routines
136for sorts rely on this order to ensure that when we encounter a sort
137S1 that is based on sort S2, S2 is before S1 in the imported file. */
138
139static bool exporting = TRUE;
140
141static lsymbol underscoreSymbol;
142static /*@only@*/ ltoken intToken;
143
144static /*@owned@*/ nameNode arrayRefNameNode;
145static /*@owned@*/ nameNode ptr2arrayNameNode;
146static /*@owned@*/ nameNode deRefNameNode;
147static /*@owned@*/ nameNode nilNameNode;
148static /*@owned@*/ nameNode plusNameNode;
149static /*@owned@*/ nameNode minusNameNode;
150static /*@owned@*/ nameNode condNameNode;
151static /*@owned@*/ nameNode eqNameNode;
152static /*@owned@*/ nameNode neqNameNode;
153
616915dd 154static ob_mstring sortKindName[] =
155{
156 "FIRSTSORT", "NOSORT", "HOFSORT",
157 "PRIMITIVE", "SYNONYM", "POINTER", "OBJ", "ARRAY", "VECTOR",
158 "STRUCT", "TUPLE", "UNION", "UNIONVAL", "ENUM", "LASTSORT"
159} ;
160
161static void smemberInfo_free (/*@null@*/ /*@only@*/ smemberInfo *mem)
162{
163 sfree (mem);
164}
165
28bf4b0b 166static void sortNode_free (/*@only@*/ sortNode sn)
616915dd 167{
28bf4b0b 168 smemberInfo_free (sn->members);
169 sfree (sn);
616915dd 170}
171
172void
173sort_destroyMod (void)
174 /*@globals killed sortTable, killed arrayRefNameNode,
175 killed ptr2arrayNameNode,killed deRefNameNode,
176 killed nilNameNode, killed plusNameNode,
177 killed minusNameNode, killed condNameNode,
178 killed eqNameNode, killed neqNameNode @*/
179{
180 if (sortTable != NULL)
181 {
182 int i;
183
616915dd 184 nameNode_free (arrayRefNameNode);
185 nameNode_free (ptr2arrayNameNode);
186 nameNode_free (deRefNameNode);
187 nameNode_free (nilNameNode);
188 nameNode_free (plusNameNode);
189 nameNode_free (minusNameNode);
190 nameNode_free (condNameNode);
191 nameNode_free (eqNameNode);
192 nameNode_free (neqNameNode);
193
28bf4b0b 194 for (i = 0; i < sortTableSize; i++)
195 {
196 sortNode_free (sortTable[i]);
197 }
198
616915dd 199 sfree (sortTable);
200 /*@-branchstate@*/
201 }
202} /*@=branchstate@*/
203
204sort
205sort_makeNoSort (void)
206{
207 return NOSORTHANDLE;
208}
209
210sort
211sort_makeHOFSort (sort base)
212{
213 sortNode outSort;
214 sort handle;
215
28bf4b0b 216 outSort = (sortNode) dmalloc (sizeof (*outSort));
217 outSort->kind = SRT_HOF;
218 outSort->name = cstring_toSymbol (message ("_HOF_sort_%d", sortTableSize));
219 outSort->tag = lsymbol_undefined;
220 outSort->baseSort = base;
221 outSort->objSort = NOSORTHANDLE;
222 outSort->members = smemberInfo_undefined;
223 outSort->export = exporting;
224 outSort->imported = context_inImport ();
225 outSort->mutable = FALSE;
226 outSort->abstract = FALSE;
616915dd 227
228 llassert (sortTable != NULL);
229
28bf4b0b 230 outSort->handle = handle = sortTableSize;
616915dd 231 sortTable[handle] = outSort;
232
233 sortTableSize++;
234 return handle;
235}
236
237static sort
238sort_construct (lsymbol name, sortKind kind, sort baseSort,
239 lsymbol tagName,
28bf4b0b 240 bool mut, sort objSort, /*@null@*/ /*@only@*/ smemberInfo *members)
616915dd 241{
242 sortNode outSort;
243 sort handle;
244
245 handle = sort_lookupName (name);
246
28bf4b0b 247 outSort = (sortNode) dmalloc (sizeof (*outSort));
248 outSort->kind = kind;
249 outSort->name = name;
250 outSort->tag = tagName;
251 outSort->realtag = TRUE;
252 outSort->baseSort = baseSort;
253 outSort->objSort = objSort;
254 outSort->members = members;
255 outSort->mutable = mut;
256 outSort->export = exporting;
257 outSort->imported = context_inImport ();
258 outSort->abstract = FALSE;
259 outSort->handle = handle;
616915dd 260
261 if (handle == NOSORTHANDLE)
262 {
28bf4b0b 263 outSort->handle = handle = sort_enterNew (outSort);
616915dd 264 return handle;
265 }
266 else
267 {
268 llassert (sortTable != NULL);
269
28bf4b0b 270 if (sortTable[handle]->kind != kind)
616915dd 271 {
272 sortError (ltoken_undefined, handle, outSort);
28bf4b0b 273 sortNode_free (outSort);
616915dd 274 return handle;
275 }
276 else
277 {
278 /* evs --- added 11 Mar 1994
279 ** the new entry should supercede the old one, since
280 ** it could be a forward reference to a struct, etc.
281 */
282
283 sortTable[handle] = outSort;
284 return handle;
285 }
286 }
287}
288
289static sort
290 sort_constructAbstract (lsymbol name, bool mut, sort baseSort)
291{
292 sortNode outSort;
293 sortKind kind;
294 sort handle;
295
296 if (mut)
297 kind = SRT_OBJ;
298 else
299 kind = SRT_PRIM;
300
301 handle = sort_lookupName (name);
28bf4b0b 302 outSort = (sortNode) dmalloc (sizeof (*outSort));
303 outSort->kind = kind;
304 outSort->name = name;
305 outSort->tag = lsymbol_undefined;
306 outSort->baseSort = baseSort;
307 outSort->objSort = NOSORTHANDLE;
308 outSort->members = smemberInfo_undefined;
309 outSort->mutable = mut;
310 outSort->export = exporting;
311 outSort->imported = context_inImport ();
312 outSort->abstract = TRUE;
313 outSort->handle = handle;
616915dd 314
315 if (handle == NOSORTHANDLE)
316 {
28bf4b0b 317 outSort->handle = handle = sort_enterNew (outSort);
616915dd 318 /* do not make sort operators. */
319 }
320 else
321 {
322 llassert (sortTable != NULL);
323
28bf4b0b 324 if (sortTable[handle]->kind != kind)
616915dd 325 {
326 sortError (ltoken_undefined, handle, outSort);
327 }
328
28bf4b0b 329 sortNode_free (outSort);
616915dd 330 }
331
332 return handle;
333}
334
335sort
336sort_makeSort (/*@unused@*/ ltoken t, lsymbol n)
337{
338 /*
339 ** Expects n to be a new sort.
340 ** Generate a sort with the given name. Useful for LSL sorts.
341 */
342
343 sort handle = sort_lookupName (n);
344
345 if (handle == NOSORTHANDLE)
346 {
347 sortNode outSort;
348
28bf4b0b 349 outSort = (sortNode) dmalloc (sizeof (*outSort));
350 outSort->handle = handle;
351 outSort->kind = SRT_PRIM;
352 outSort->name = n;
353 outSort->tag = lsymbol_undefined;
354 outSort->baseSort = NOSORTHANDLE;
355 outSort->objSort = NOSORTHANDLE;
356 outSort->members = smemberInfo_undefined;
357 outSort->export = exporting;
358 outSort->mutable = FALSE;
359 outSort->imported = context_inImport ();
360 outSort->abstract = FALSE;
616915dd 361
362 /* Put into sort table, sort_enter checks for duplicates. */
28bf4b0b 363 handle = sort_enterNew (outSort);
616915dd 364 }
365 else
366 {
367 /* don't override old info */
368 ;
369 }
370
371 return handle;
372}
373
374static sort
375sort_makeSortNoOps (/*@unused@*/ ltoken t, lsymbol n) /*@modifies internalState@*/
376{
377 sort handle;
378
379 handle = sort_lookupName (n);
380
381 if (handle == NOSORTHANDLE)
382 {
383 sortNode outSort;
384
28bf4b0b 385 outSort = (sortNode) dmalloc (sizeof (*outSort));
386 outSort->handle = handle;
387 outSort->kind = SRT_PRIM;
388 outSort->name = n;
389 outSort->tag = lsymbol_undefined;
390 outSort->baseSort = NOSORTHANDLE;
391 outSort->objSort = NOSORTHANDLE;
392 outSort->members = smemberInfo_undefined;
393 outSort->export = exporting;
394 outSort->mutable = FALSE;
395 outSort->imported = context_inImport ();
396 outSort->abstract = FALSE;
616915dd 397 /* Put into sort table, sort_enter checks for duplicates. */
28bf4b0b 398 handle = sort_enterNew (outSort);
399 } /* Don't override old info */
616915dd 400
401 return handle;
402}
403
404static sort
405sort_makeLiteralSort (ltoken t, lsymbol n)
406 /*@modifies internalState@*/
407{
408 /*
409 ** Like sort_makeSort, in addition, generate sizeof operator
410 ** t not currently used, may be useful for generating error msgs later
411 ** Also useful for abstract types, need sizeof operator.
412 */
413
414 sort handle = sort_makeSort (t, n);
415
416 overloadSizeof (handle);
417 return handle;
418}
419
420sort
421sort_makeSyn (ltoken t, sort s, lsymbol n)
422{
423 /* make a synonym sort with name n that is == to sort s */
424 /* expect n to be a new sort name */
425 sortNode outSort;
426 sort handle;
427 /* must not clash with any LSL sorts */
428 lsymbol newname = sp (underscoreSymbol, n);
429
430 if (n == lsymbol_undefined)
431 {
432 llbuglit ("sort_makeSyn: synonym must have name");
433 }
434
435 handle = sort_lookupName (newname);
436
28bf4b0b 437 outSort = (sortNode) dmalloc (sizeof (*outSort));
438 outSort->kind = SRT_SYN;
439 outSort->name = newname;
440 outSort->baseSort = s;
441 outSort->objSort = NOSORTHANDLE;
616915dd 442 /* info is not duplicated */
28bf4b0b 443 outSort->tag = lsymbol_undefined;
444 outSort->members = smemberInfo_undefined;
445 outSort->export = exporting;
446 outSort->mutable = FALSE;
447 outSort->imported = context_inImport ();
448 outSort->abstract = FALSE;
449 outSort->handle = handle;
616915dd 450
451 if (handle == NOSORTHANDLE)
452 {
28bf4b0b 453 outSort->handle = handle = sort_enterNew (outSort);
616915dd 454 /* No operators to generate for synonyms */
455 }
456 else
457 {
458 llassert (sortTable != NULL);
459
28bf4b0b 460 if (sortTable[handle]->kind != SRT_SYN)
616915dd 461 {
462 sortError (t, handle, outSort);
463 }
464
28bf4b0b 465 sortNode_free (outSort);
616915dd 466 }
467
468 return handle;
469}
470
471sort
472sort_makeFormal (sort insort)
473{
474 sortNode s;
475 sort sor, handle;
476
477 sor = sort_getUnderlying (insort);
478 handle = sor;
479 s = sort_lookup (sor);
480
28bf4b0b 481 switch (s->kind)
616915dd 482 {
483 case SRT_STRUCT:
484 handle = sort_makeTuple (ltoken_undefined, sor);
485 break;
486 case SRT_UNION:
487 handle = sort_makeUnionVal (ltoken_undefined, sor);
488 break;
489 default:
490 break;
491 }
492
493 return handle;
494}
495
496sort
497sort_makeGlobal (sort insort)
498{
499 /* Make a Obj if not an array or a struct */
500 sortNode s;
501 sort sor, handle;
502 sor = sort_getUnderlying (insort);
503 handle = sor;
504 s = sort_lookup (sor);
505
28bf4b0b 506 switch (s->kind)
616915dd 507 {
508 case SRT_ARRAY:
509 case SRT_STRUCT:
510 case SRT_UNION:
511 case SRT_HOF:
512 case SRT_NONE:
513 break;
514 case SRT_VECTOR:
515 case SRT_TUPLE:
516 case SRT_UNIONVAL:
517 llcontbuglit ("sort_makeGlobal: can't make vectors, tuples, or unionvals global");
518 break;
519 default:
520 handle = sort_makeObj (sor);
521 break;
522 }
523 return handle;
524}
525
526sort
527sort_makeObj (sort sor)
528{
529 sortNode baseSortNode, outSort;
530 sort baseSort, handle;
531 lsymbol name;
532
533 /* skip the synonym sort */
534 baseSort = sort_getUnderlying (sor);
535 baseSortNode = sort_quietLookup (baseSort);
28bf4b0b 536 switch (baseSortNode->kind)
616915dd 537 {
538 case SRT_HOF:
539 case SRT_NONE:
540 return baseSort;
541 case SRT_VECTOR:
28bf4b0b 542 if (baseSortNode->objSort != 0)
543 return baseSortNode->objSort;
616915dd 544 else /* must have well-defined objSort field */
545 {
546 llcontbuglit ("sort_makeObj: Inconsistent vector reps:invalid objSort field");
547 return baseSort;
548 }
549 case SRT_TUPLE:
550 case SRT_UNIONVAL:
551 /* need to map *_Struct_Tuple to *_Struct and *_Union_UnionVal to
552 *_Union, according to sort naming conventions */
28bf4b0b 553 if (baseSortNode->baseSort != NOSORTHANDLE)
616915dd 554 /* for tuples and unionvals, baseSort field keeps the map from
28bf4b0b 555 value sort to obj sort-> */
556 return baseSortNode->baseSort;
616915dd 557 else /* valid tuples and unionvals must have baseSort fields */
558 {
559 llcontbuglit ("sort_makeObj: Inconsistent tuples or unionvals reps: invalid baseSort field");
560 return baseSort;
561 }
562 default:
563 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
564 lsymbol_fromChars ("_Obj"));
565 handle = sort_lookupName (name);
566
28bf4b0b 567 outSort = (sortNode) dmalloc (sizeof (*outSort));
568 outSort->kind = SRT_OBJ;
616915dd 569 /* must not clash with any LSL sorts */
28bf4b0b 570 outSort->name = name;
571 outSort->tag = lsymbol_undefined;
572 outSort->baseSort = baseSort;
573 outSort->objSort = NOSORTHANDLE;
574 outSort->members = smemberInfo_undefined;
575 outSort->mutable = TRUE;
576 outSort->export = exporting;
577 outSort->abstract = FALSE;
578 outSort->handle = handle;
579 outSort->imported = TRUE;
616915dd 580
581 if (handle == NOSORTHANDLE)
582 {
583 if (sort_isNewEntry (outSort))
584 {
28bf4b0b 585 outSort->handle = handle = sort_enterNew (outSort);
616915dd 586 }
587 else
588 {
28bf4b0b 589 outSort->handle = handle = sort_enterNew (outSort);
616915dd 590 }
591 }
592 else
593 {
594 llassert (sortTable != NULL);
595
28bf4b0b 596 if (sortTable[handle]->kind != SRT_OBJ)
616915dd 597 {
598 sortError (ltoken_undefined, handle, outSort);
599 }
600
28bf4b0b 601 sortNode_free (outSort);
616915dd 602 }
603
604 return handle;
605 }
606}
607
608sort
609sort_makePtr (ltoken t, sort baseSort)
610{
611 sortNode s, outSort;
612 sort handle, arrayHandle;
613 lsymbol name;
614
615 s = sort_lookup (baseSort);
616
28bf4b0b 617 if (s->kind == SRT_HOF)
616915dd 618 {
619 return baseSort;
620 }
28bf4b0b 621 if (s->kind == SRT_NONE)
616915dd 622 {
623 return baseSort;
624 }
625
28bf4b0b 626 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
627 s->kind != SRT_UNION)
628 /* && s->kind != SRT_OBJ) */
616915dd 629 /* base is not an SRT_ARRAY, struct or union. Need to insert a obj. */
630 baseSort = sort_makeObj (baseSort);
631
632 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
633 lsymbol_fromChars ("_Ptr"));
634 handle = sort_lookupName (name);
635
28bf4b0b 636 outSort = (sortNode) dmalloc (sizeof (*outSort));
637 outSort->kind = SRT_PTR;
638 outSort->name = name;
639 outSort->tag = lsymbol_undefined;
640 outSort->baseSort = baseSort;
641 outSort->objSort = NOSORTHANDLE;
642 outSort->members = smemberInfo_undefined;
643 outSort->mutable = FALSE;
644 outSort->export = exporting;
645 outSort->imported = context_inImport ();
646 outSort->abstract = FALSE;
647 outSort->handle = handle;
616915dd 648
649 if (handle == NOSORTHANDLE)
650 {
651 if (sort_isNewEntry (outSort))
652 {
28bf4b0b 653 outSort->handle = handle = sort_enterNew (outSort);
616915dd 654 arrayHandle = sort_makeArr (t, baseSort);
655 genPtrOps (baseSort, handle, arrayHandle);
656 }
657 else
658 {
28bf4b0b 659 outSort->handle = handle = sort_enterNew (outSort);
616915dd 660 }
661 }
662 else
663 {
664 llassert (sortTable != NULL);
665
28bf4b0b 666 if (sortTable[handle]->kind != SRT_PTR)
616915dd 667 {
668 sortError (t, handle, outSort);
669 }
28bf4b0b 670
671 sortNode_free (outSort);
616915dd 672 }
28bf4b0b 673
616915dd 674 return handle;
675}
676
677sort
f9264521 678sort_makePtrN (sort s, pointers p)
616915dd 679{
f9264521 680 if (pointers_isUndefined (p))
616915dd 681 {
682 return s;
683 }
684 else
685 {
686 return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
f9264521 687 pointers_getRest (p));
616915dd 688 }
689}
690
691sort
692sort_makeArr (ltoken t, sort baseSort)
693{
694 sortNode s, outSort, old;
695 sort handle, vecHandle;
696 int dim;
697 lsymbol name;
698
699 s = sort_lookup (baseSort);
700
28bf4b0b 701 if (s->kind == SRT_HOF)
616915dd 702 return baseSort;
28bf4b0b 703 if (s->kind == SRT_NONE)
616915dd 704 return baseSort;
705
28bf4b0b 706 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
707 s->kind != SRT_UNION && s->kind != SRT_OBJ)
616915dd 708 /* base is not an array, struct or obj. Need to insert a Obj. */
709 baseSort = sort_makeObj (baseSort);
710
711 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
712 lsymbol_fromChars ("_Arr"));
713 handle = sort_lookupName (name);
714
28bf4b0b 715 /* must not clash with any LSL sorts */
716 outSort = (sortNode) dmalloc (sizeof (*outSort));
717 outSort->name = name;
718 outSort->kind = SRT_ARRAY;
719 outSort->baseSort = baseSort;
720 outSort->objSort = NOSORTHANDLE;
721 outSort->members = smemberInfo_undefined;
722 outSort->mutable = TRUE;
723 outSort->export = exporting;
724 outSort->imported = context_inImport ();
725 outSort->abstract = FALSE;
726 outSort->handle = handle;
616915dd 727
728 if (handle == NOSORTHANDLE)
729 {
730 if (sort_isNewEntry (outSort))
731 {
28bf4b0b 732 handle = sort_enterNew (outSort);
733 outSort = sort_lookup (handle);
616915dd 734
735 for (old = outSort, dim = 0;
28bf4b0b 736 old->kind == SRT_ARRAY;
737 dim++, old = sort_lookup (old->baseSort))
616915dd 738 {
739 ;
740 }
741
742 vecHandle = sort_makeVec (t, handle);
743 genArrOps (baseSort, handle, dim, vecHandle);
744 }
745 else
746 {
28bf4b0b 747 outSort->handle = handle = sort_enterNew (outSort);
616915dd 748 }
749 }
750 else
751 {
752 llassert (sortTable != NULL);
753
28bf4b0b 754 if (sortTable[handle]->kind != SRT_ARRAY)
616915dd 755 {
756 sortError (t, handle, outSort);
757 }
758
28bf4b0b 759 sortNode_free (outSort);
616915dd 760 }
761
762 return handle;
763}
764
765sort
766sort_makeVec (ltoken t, sort arraySort)
767{
768 sortNode s, outSort, old;
769 sort baseSort, handle, elementSort;
770 int dim; /* array dimension count. */
771 lsymbol name;
772
773 s = sort_lookup (arraySort);
774
28bf4b0b 775 if (s->kind == SRT_HOF)
616915dd 776 return arraySort;
28bf4b0b 777 if (s->kind == SRT_NONE)
616915dd 778 return arraySort;
779
28bf4b0b 780 if (s->kind != SRT_ARRAY)
616915dd 781 {
782 llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
28bf4b0b 783 sort_unparseKind (s->kind)));
616915dd 784 }
785
28bf4b0b 786 if (s->baseSort == NOSORTHANDLE)
616915dd 787 llbuglit ("sort_makeVec: arrays must have base (element) sort");
788
789 /* Vectors return "values", so make array elements values. */
790
28bf4b0b 791 baseSort = s->baseSort;
616915dd 792 elementSort = sort_makeVal (baseSort);
793
794 name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
795 lsymbol_fromChars ("_Vec"));
796 handle = sort_lookupName (name);
797
28bf4b0b 798 outSort = (sortNode) dmalloc (sizeof (*outSort));
799 outSort->baseSort = elementSort;
800 outSort->name = name;
801 outSort->objSort = arraySort;
802 outSort->kind = SRT_VECTOR;
803 outSort->members = smemberInfo_undefined;
804 outSort->mutable = FALSE;
805 outSort->export = exporting;
806 outSort->imported = context_inImport ();
807 outSort->abstract = FALSE;
808 outSort->handle = handle;
616915dd 809
810 if (handle == NOSORTHANDLE)
811 {
812 if (sort_isNewEntry (outSort))
813 {
28bf4b0b 814 outSort = sort_lookup (handle = sort_enterNew (outSort));
616915dd 815
816 for (old = outSort, dim = 0;
28bf4b0b 817 old->kind == SRT_VECTOR;
818 dim++, old = sort_lookup (old->baseSort))
616915dd 819 {
820 ;
821 }
822
823 genVecOps (elementSort, handle, dim);
824 }
825 else
826 {
28bf4b0b 827 outSort->handle = handle = sort_enterNew (outSort);
616915dd 828 }
829 }
830 else
831 {
832 llassert (sortTable != NULL);
833
28bf4b0b 834 if (sortTable[handle]->kind != SRT_VECTOR)
616915dd 835 {
836 sortError (t, handle, outSort);
837 }
838
28bf4b0b 839 sortNode_free (outSort);
616915dd 840 }
841
842 return handle;
843}
844
845sort
846sort_makeVal (sort sor)
847{
848 sort retSort = sor;
849 sortNode rsn, s;
850
851 llassert (sortTable != NULL);
852 s = sort_quietLookup (sor);
853
28bf4b0b 854 switch (s->kind)
616915dd 855 {
856 case SRT_PRIM:
857 case SRT_ENUM:
858 case SRT_PTR:
859 case SRT_TUPLE:
860 case SRT_UNIONVAL:
861 case SRT_VECTOR:
862 case SRT_HOF:
863 case SRT_NONE:
864 /* Do nothing for basic types and pointers. */
865 retSort = sor;
866 break;
867 case SRT_SYN:
28bf4b0b 868 return sort_makeVal (sortTable[sor]->baseSort);
616915dd 869 case SRT_OBJ:
870 /* Strip out the last Obj's */
28bf4b0b 871 if (s->baseSort == NOSORTHANDLE)
616915dd 872 {
873 llbuglit ("sort_makeVal: expecting a base sort for Obj");
874 }
28bf4b0b 875 retSort = s->baseSort;
616915dd 876 break;
877 case SRT_ARRAY:
878 retSort = sort_makeVec (ltoken_undefined, sor);
879 break;
880 case SRT_STRUCT:
881 retSort = sort_makeTuple (ltoken_undefined, sor);
882 break;
883 case SRT_UNION:
884 retSort = sort_makeUnionVal (ltoken_undefined, sor);
885 break;
886 default:
887 llbuglit ("sort_makeVal: invalid sort kind");
888 }
889 rsn = sort_quietLookup (retSort);
28bf4b0b 890 if (rsn->kind == SRT_NONE)
616915dd 891 {
28bf4b0b 892 llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
616915dd 893 }
894 return retSort;
895}
896
897sort
898sort_makeImmutable (ltoken t, lsymbol name)
899{
900 sortNode outSort;
901 sort handle;
902
903 handle = sort_lookupName (name);
904
28bf4b0b 905 outSort = (sortNode) dmalloc (sizeof (*outSort));
906 outSort->kind = SRT_PRIM;
907 outSort->name = name;
908 outSort->baseSort = NOSORTHANDLE;
909 outSort->objSort = NOSORTHANDLE;
910 outSort->members = smemberInfo_undefined;
911 outSort->export = exporting;
912 outSort->mutable = FALSE;
913 outSort->imported = context_inImport ();
914 outSort->abstract = TRUE;
915 outSort->handle = handle;
616915dd 916
917 if (handle == NOSORTHANDLE)
918 {
28bf4b0b 919 handle = sort_enterNew (outSort);
920 outSort = sort_lookup (handle);
616915dd 921 overloadSizeof (handle);
922 }
923 else
924 { /* complain */
925 llassert (sortTable != NULL);
926
28bf4b0b 927 if ((sortTable[handle]->kind != SRT_PRIM) &&
928 (sortTable[handle]->abstract) &&
929 (!sortTable[handle]->mutable))
616915dd 930 {
931 sortError (t, handle, outSort);
932 }
933
28bf4b0b 934 sortNode_free (outSort);
616915dd 935 }
936
937 return handle;
938}
939
940sort
941sort_makeMutable (ltoken t, lsymbol name)
942{
943 sort immutable_old, handle, baseSort;
944 lsymbol objName;
945
946 immutable_old = sort_lookupName (name);
947
948 /* First generate the value sort */
949 baseSort = sort_makeImmutable (t, name);
950
951 llassert (sortTable != NULL);
952
953 /* to prevent duplicate error messages */
954 if (immutable_old != NOSORTHANDLE &&
28bf4b0b 955 (sortTable[baseSort]->kind != SRT_PRIM) &&
956 (sortTable[baseSort]->abstract) &&
957 (!sortTable[baseSort]->mutable))
616915dd 958 {
959 /* already complained */
960 handle = NOSORTHANDLE;
961 }
962 else
963 { /* sort_makeImmutable must have succeeded */
964 sortNode outSort;
965
966 /* must not clash with any LSL sorts */
967 objName = sp (sp (underscoreSymbol, name),
968 lsymbol_fromChars ("_Obj"));
969 handle = sort_lookupName (objName);
970
28bf4b0b 971 outSort = (sortNode) dmalloc (sizeof (*outSort));
972 outSort->kind = SRT_OBJ;
973 outSort->name = objName;
974 outSort->tag = lsymbol_undefined;
975 outSort->baseSort = baseSort;
976 outSort->objSort = NOSORTHANDLE;
977 outSort->members = smemberInfo_undefined;
978 outSort->mutable = TRUE;
979 outSort->export = exporting;
980 outSort->imported = context_inImport ();
981 outSort->abstract = TRUE;
982 outSort->handle = handle;
616915dd 983
984 if (handle == NOSORTHANDLE)
985 {
986 if (sort_isNewEntry (outSort))
987 {
28bf4b0b 988 outSort->handle = handle = sort_enterNew (outSort);
616915dd 989 }
990 else
991 {
992 handle = sort_enterNew (outSort);
993 }
994 }
995 else
996 {
997 llassert (sortTable != NULL);
998
28bf4b0b 999 if ((sortTable[handle]->kind != SRT_OBJ)
1000 && sortTable[handle]->abstract
1001 && sortTable[handle]->mutable)
616915dd 1002 {
1003 sortError (t, handle, outSort);
1004 }
1005
28bf4b0b 1006 sortNode_free (outSort);
616915dd 1007 }
1008 }
1009 return handle;
1010}
1011
1012sort
1013sort_makeStr (ltoken opttagid)
1014{
1015 sortNode outSort;
1016 sort handle;
1017 bool isNewTag;
1018 lsymbol name;
1019
28bf4b0b 1020 outSort = (sortNode) dmalloc (sizeof (*outSort));
1021
616915dd 1022 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1023 /* isNewTag true means that the name generated is new */
1024
1025 if (ltoken_isUndefined (opttagid))
1026 {
1027 opttagid = ltoken_create (simpleId, newStructTag ());
1028
28bf4b0b 1029 outSort->realtag = FALSE;
616915dd 1030 }
1031 else
1032 {
28bf4b0b 1033 outSort->realtag = TRUE;
616915dd 1034 }
1035
1036 name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1037
1038 llassert (sortTable != NULL);
1039 handle = sort_lookupName (name);
28bf4b0b 1040 outSort->name = name;
1041 outSort->kind = SRT_STRUCT;
1042 outSort->tag = ltoken_getText (opttagid);
1043 outSort->baseSort = NOSORTHANDLE;
1044 outSort->objSort = NOSORTHANDLE;
1045 outSort->members = smemberInfo_undefined;
1046 outSort->export = exporting;
1047 outSort->mutable = TRUE;
1048 outSort->imported = context_inImport ();
1049 outSort->abstract = FALSE;
1050 outSort->handle = handle;
616915dd 1051
1052 if (handle == NOSORTHANDLE)
1053 {
1054 if (sort_isNewEntry (outSort))
1055 {
28bf4b0b 1056 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1057 }
1058 else
1059 {
28bf4b0b 1060 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1061 }
1062 }
1063 else
1064 {
28bf4b0b 1065 if (sortTable[handle]->kind != SRT_STRUCT)
616915dd 1066 {
1067 sortError (opttagid, handle, outSort);
1068 }
1069
28bf4b0b 1070 sortNode_free (outSort);
616915dd 1071 }
1072
1073 return handle;
1074}
1075
1076bool
1077sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1078{
1079 /* expect strSort to be in sort table but not yet filled in */
1080 /* return TRUE if it is "new" */
1081 sort tupleSort;
1082 sortNode sn;
1083
1084 llassert (sortTable != NULL);
1085 sn = sort_lookup (strSort);
1086
28bf4b0b 1087 if (sn->members == (smemberInfo *) 0)
616915dd 1088 {
28bf4b0b 1089 sortTable[strSort]->members = info;
616915dd 1090 tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1091 genStrOps (strSort, tupleSort);
1092 return TRUE;
1093 }
1094 else
1095 {
1096 smemberInfo_free (info);
1097 return FALSE;
1098 }
1099}
1100
1101sort
1102sort_makeTuple (ltoken t, sort strSort)
1103{
1104 sort handle;
1105 sortNode outSort, s = sort_lookup (strSort);
1106 lsymbol name;
1107
28bf4b0b 1108 if (s->kind != SRT_STRUCT)
616915dd 1109 {
1110 llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
28bf4b0b 1111 sort_unparseKind (s->kind)));
616915dd 1112 }
1113
28bf4b0b 1114 name = sp (s->name, lsymbol_fromChars ("_Tuple"));
616915dd 1115 llassert (sortTable != NULL);
1116 handle = sort_lookupName (name);
1117
28bf4b0b 1118 outSort = (sortNode) dmalloc (sizeof (*outSort));
1119 outSort->kind = SRT_TUPLE;
1120 outSort->name = name;
1121 outSort->tag = s->tag;
1122 outSort->realtag = s->realtag;
1123 outSort->baseSort = strSort;
1124 outSort->objSort = NOSORTHANDLE;
1125 outSort->members = smemberInfo_undefined;
1126 outSort->export = exporting;
1127 outSort->abstract = FALSE;
1128 outSort->imported = context_inImport ();
1129 outSort->mutable = FALSE;
1130 outSort->handle = handle;
616915dd 1131
1132 if (handle == NOSORTHANDLE)
1133 {
1134 if (sort_isNewEntry (outSort))
1135 {
28bf4b0b 1136 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1137
1138 sort_addTupleMembers (handle, strSort);
1139 genTupleOps (handle);
1140 }
1141 else
1142 {
28bf4b0b 1143 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1144 }
1145 }
1146 else
1147 {
28bf4b0b 1148 if (sortTable[handle]->kind != SRT_TUPLE)
616915dd 1149 {
1150 sortError (t, handle, outSort);
1151 }
1152
28bf4b0b 1153 sortNode_free (outSort);
616915dd 1154 }
1155
1156 return handle;
1157}
1158
1159static void
1160sort_addTupleMembers (sort tupleSort, sort strSort)
1161{
1162 smemberInfo *mem, *tail = smemberInfo_undefined;
1163 smemberInfo *top = smemberInfo_undefined;
1164 smemberInfo *newinfo;
1165
1166 /* make sure it works for empty smemberInfo */
1167
1168 llassert (sortTable != NULL);
28bf4b0b 1169
1170 for (mem = sortTable[strSort]->members;
616915dd 1171 mem != smemberInfo_undefined; mem = mem->next)
1172 {
1173 newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1174 newinfo->name = mem->name;
1175 newinfo->sort = sort_makeVal (mem->sort);
1176 newinfo->next = smemberInfo_undefined;
1177
1178 if (top == smemberInfo_undefined)
1179 { /* start of iteration */
1180 top = newinfo;
1181 tail = newinfo;
1182 }
1183 else
1184 {
1185 llassert (tail != smemberInfo_undefined);
1186
1187 tail->next = newinfo;
1188 tail = newinfo;
1189 /*@-branchstate@*/ /* tail is dependent */
1190 }
1191 /*@=branchstate@*/
1192 }
1193
28bf4b0b 1194 sortTable[tupleSort]->members = top;
616915dd 1195}
1196
1197static
1198void genTupleOps (sort tupleSort)
1199{
1200 ltoken range, dom;
1201 sort fieldsort;
1202 smemberInfo *m;
1203 unsigned int memCount;
1204 ltokenList domain = ltokenList_new ();
1205 sigNode signature;
1206 opFormUnion u;
1207 opFormNode opform;
1208 nameNode nn;
1209
1210 memCount = 0;
1211 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1212
1213 llassert (sortTable != NULL);
28bf4b0b 1214 for (m = sortTable[tupleSort]->members;
616915dd 1215 m != smemberInfo_undefined; m = m->next)
1216 {
1217 fieldsort = sort_makeVal (m->sort);
1218 overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1219
1220 dom = ltoken_createType (simpleId, SID_SORT,
1221 sort_getLsymbol (fieldsort));
1222 ltokenList_addh (domain, dom);
1223 memCount++;
1224 }
1225
1226 /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1227 signature = makesigNode (ltoken_undefined, domain, range);
1228 u.middle = memCount;
1229
1230 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1231 OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1232
1233 nn = makeNameNodeForm (opform);
1234 symtable_enterOp (g_symtab, nn, signature);
1235
1236 /*
1237 ** should not be able to take sizeof (struct^) ...
1238 */
1239}
1240
1241static
1242void genUnionOps (sort tupleSort)
1243{
1244 /* like genTupleOps but no constructor [ ...]: -> unionSort */
1245 smemberInfo *m;
1246 sort sort;
1247
1248 llassert (sortTable != NULL);
28bf4b0b 1249 for (m = sortTable[tupleSort]->members;
616915dd 1250 m != smemberInfo_undefined; m = m->next)
1251 {
1252 /* Generate __.memName: strSort ->memSortObj */
1253 overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1254 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1255 sort_getName (tupleSort), sort_getName (m->sort)); */
1256 /* __->memName : Union_Ptr -> memSortObj */
1257 sort = sort_makePtr (ltoken_undefined, tupleSort);
1258 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1259 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1260 sort_getName (sort), sort_getName (m->sort)); */
1261 }
1262}
1263
1264static
1265void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1266{
1267 smemberInfo *m;
1268 sort sort;
1269
1270 llassert (sortTable != NULL);
28bf4b0b 1271 for (m = sortTable[strSort]->members;
616915dd 1272 m != smemberInfo_undefined; m = m->next)
1273 {
1274 /* Generate __.memName: strSort ->memSortObj */
1275 overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1276 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1277 sort_getName (strSort), sort_getName (m->sort)); */
1278 /* __->memName : Struct_Ptr -> memSortObj */
1279 sort = sort_makePtr (ltoken_undefined, strSort);
1280 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1281 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1282 sort_getName (sort), sort_getName (m->sort)); */
1283 }
1284 /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1285 /* Generate __any, __pre, __post: nStruct -> nTuple */
1286 /* Generate sizeof: strSort -> int */
1287 /* overloadStateFcns (strSort, tupleSort); */
1288}
1289
1290sort
1291sort_makeUnion (ltoken opttagid)
1292{
1293 sortNode outSort;
1294 sort handle;
1295 bool isNewTag;
1296 lsymbol name;
1297
1298 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1299 /* isNewTag true means that the name generated is new */
1300
28bf4b0b 1301 outSort = (sortNode) dmalloc (sizeof (*outSort));
1302
616915dd 1303 if (ltoken_isUndefined (opttagid))
1304 {
1305 opttagid = ltoken_create (simpleId, newUnionTag ());
28bf4b0b 1306 outSort->realtag = FALSE;
616915dd 1307 }
1308 else
28bf4b0b 1309 {
1310 outSort->realtag = TRUE;
1311 }
616915dd 1312
1313 llassert (sortTable != NULL);
1314 name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1315 handle = sort_lookupName (name);
28bf4b0b 1316 outSort->name = name;
1317 outSort->kind = SRT_UNION;
1318 outSort->tag = ltoken_getText (opttagid);
1319 outSort->baseSort = NOSORTHANDLE;
1320 outSort->objSort = NOSORTHANDLE;
1321 outSort->members = smemberInfo_undefined;
1322 outSort->export = exporting;
1323 outSort->mutable = TRUE;
1324 outSort->imported = context_inImport ();
1325 outSort->abstract = FALSE;
1326 outSort->handle = handle;
616915dd 1327
1328 if (handle == NOSORTHANDLE)
1329 {
1330 if (sort_isNewEntry (outSort))
1331 {
28bf4b0b 1332 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1333 }
1334 else
1335 {
28bf4b0b 1336 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1337 }
1338 }
1339 else
1340 {
28bf4b0b 1341 if (sortTable[handle]->kind != SRT_UNION)
616915dd 1342 {
1343 sortError (opttagid, handle, outSort);
1344 }
1345
28bf4b0b 1346 sortNode_free (outSort);
616915dd 1347 }
1348
1349 return handle;
1350}
1351
1352bool
1353sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1354{
1355 /* expect unionSort to be in sort table but not yet filled in */
1356 /* return TRUE if it is "new" */
1357 sort uValSort;
1358 sortNode sn;
1359
1360 llassert (sortTable != NULL);
1361
1362 sn = sort_lookup (unionSort);
1363
28bf4b0b 1364 if (sn->members == (smemberInfo *) 0)
616915dd 1365 {
28bf4b0b 1366 sortTable[unionSort]->members = info;
616915dd 1367 uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1368 /* same as struct operations */
1369 genStrOps (unionSort, uValSort);
1370 return TRUE;
1371 }
1372 else
1373 {
1374 smemberInfo_free (info);
1375 return FALSE;
1376 }
1377}
1378
1379sort
1380sort_makeUnionVal (ltoken t, sort unionSort)
1381{
1382 sort handle;
1383 sortNode outSort, s = sort_lookup (unionSort);
1384 lsymbol name;
1385
28bf4b0b 1386 if (s->kind != SRT_UNION)
616915dd 1387 {
1388 llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
28bf4b0b 1389 sort_unparseKind (s->kind)));
616915dd 1390 }
1391
1392 llassert (sortTable != NULL);
1393
28bf4b0b 1394 name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
616915dd 1395 handle = sort_lookupName (name);
1396
28bf4b0b 1397 outSort = (sortNode) dmalloc (sizeof (*outSort));
1398 outSort->kind = SRT_UNIONVAL;
1399 outSort->name = name;
1400 outSort->tag = s->tag;
1401 outSort->realtag = s->realtag;
1402 outSort->baseSort = unionSort;
1403 outSort->objSort = NOSORTHANDLE;
1404 outSort->members = smemberInfo_undefined;
1405 outSort->export = exporting;
1406 outSort->abstract = FALSE;
1407 outSort->imported = context_inImport ();
1408 outSort->mutable = FALSE;
1409 outSort->handle = handle;
616915dd 1410
1411 if (handle == NOSORTHANDLE)
1412 {
1413 if (sort_isNewEntry (outSort))
1414 {
28bf4b0b 1415 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1416
1417 /* Add members to the unionVal's. */
1418 /* same as structs and tuples */
1419
1420 sort_addTupleMembers (handle, unionSort);
1421 genUnionOps (handle);
1422 }
1423 else
1424 {
28bf4b0b 1425 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1426 }
1427 }
1428 else
1429 {
28bf4b0b 1430 if (sortTable[handle]->kind != SRT_UNIONVAL)
616915dd 1431 {
1432 sortError (t, handle, outSort);
1433 }
1434
28bf4b0b 1435 sortNode_free (outSort);
616915dd 1436 }
1437
1438 return handle;
1439}
1440
1441static lsymbol
1442newEnumTag ()
1443{
1444 static int ecount = 0;
1445
1446 return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1447}
1448
1449static lsymbol
1450newStructTag ()
1451{
1452 static int ecount = 0;
1453
1454 return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1455}
1456
1457static lsymbol
1458newUnionTag ()
1459{
1460 static int ecount = 0;
1461
1462 return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1463}
1464
1465sort
1466sort_makeEnum (ltoken opttagid)
1467{
1468 sortNode outSort;
1469 sort handle;
1470 bool isNew;
1471 lsymbol name;
1472
1473 llassert (sortTable != NULL);
1474
28bf4b0b 1475 outSort = (sortNode) dmalloc (sizeof (*outSort));
1476
616915dd 1477 if (ltoken_isUndefined (opttagid))
1478 {
1479 opttagid = ltoken_create (simpleId, newEnumTag ());
28bf4b0b 1480 outSort->realtag = FALSE;
616915dd 1481 }
1482 else
28bf4b0b 1483 {
1484 outSort->realtag = TRUE;
1485 }
616915dd 1486
1487 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1488
1489 name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1490 handle = sort_lookupName (name);
28bf4b0b 1491 outSort->name = name;
1492 outSort->kind = SRT_ENUM;
1493 outSort->tag = ltoken_getText (opttagid);
1494 outSort->baseSort = NOSORTHANDLE;
1495 outSort->objSort = NOSORTHANDLE;
1496 outSort->members = smemberInfo_undefined;
1497 outSort->export = exporting;
1498 outSort->mutable = FALSE;
1499 outSort->imported = context_inImport ();
1500 outSort->abstract = FALSE;
1501 outSort->handle = handle;
616915dd 1502
1503 if (handle == NOSORTHANDLE)
1504 {
1505 if (sort_isNewEntry (outSort))
1506 {
28bf4b0b 1507 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1508 }
1509 else
1510 {
28bf4b0b 1511 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1512 }
1513 }
1514 else
1515 {
28bf4b0b 1516 if (sortTable[handle]->kind != SRT_ENUM)
616915dd 1517 {
1518 sortError (opttagid, handle, outSort);
1519 }
1520
28bf4b0b 1521 sortNode_free (outSort);
616915dd 1522 }
1523
1524 return handle;
1525}
1526
1527bool
1528sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1529{
1530 /*
1531 ** Expect enumSort to be in sort table but not yet filled in.
1532 ** Return TRUE if it is "new"
1533 */
1534
1535 sortNode sn;
1536
1537 llassert (sortTable != NULL);
1538
1539 sn = sort_lookup (enumSort);
28bf4b0b 1540 if (sn->members == (smemberInfo *) 0)
616915dd 1541 {
28bf4b0b 1542 sortTable[enumSort]->members = info;
616915dd 1543 genEnumOps (enumSort);
1544 return TRUE;
1545 }
1546 else
1547 {
1548 smemberInfo_free (info);
1549 return FALSE;
1550 }
1551}
1552
1553static
1554void genEnumOps (sort enumSort)
1555{
1556 smemberInfo *ei;
1557 ltokenList domain = ltokenList_new ();
1558 ltoken range, mem;
1559 nameNode nn;
1560 sigNode signature;
1561
1562 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1563 signature = makesigNode (ltoken_undefined, domain, range);
1564
1565 llassert (sortTable != NULL);
1566
28bf4b0b 1567 for (ei = sortTable[enumSort]->members;
616915dd 1568 ei != (smemberInfo *) 0; ei = ei->next)
1569 {
1570 mem = ltoken_createType (simpleId, SID_OP, ei->name);
1571 nn = makeNameNodeId (mem);
1572 symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1573 }
1574
1575 sigNode_free (signature);
1576 overloadSizeof (enumSort);
1577}
1578
1579static void
1580genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1581{
1582 /* Generate *__: xPtr -> x */
1583
1584 /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1585
1586 /* Generate maxIndex, minIndex: xPtr -> int */
1587 /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1588 /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1589
1590 /* Generate __[]: pointer -> array */
1591 overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1592
1593 /* Generate __+__, __-__: pointer, int -> pointer */
1594 overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1595 ltoken_copy (intToken), ptrSort);
1596
1597 overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1598 ltoken_copy (intToken), ptrSort);
1599
1600 /* Generate NIL: -> xPtr */
1601 /* Generate __+__: int, pointer -> pointer */
1602 /* Generate __-__: pointer, pointer -> int */
1603 overloadPtrFcns (ptrSort);
1604}
1605
1606static void
1607genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1608{
1609 /* Generate __[__]: nArr, int -> n */
1610 overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1611 ltoken_copy (intToken), baseSort);
1612
1613 /* Generate maxIndex, minIndex: sort -> int */
1614 /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1615 /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1616
1617 /* Generate isSub: arraySort, int, ... -> bool */
1618 overloadIsSub (arraySort, dim);
1619
1620 /* Generate fresh, trashed, modifies, unchanged: array -> bool */
1621 /* Generate any, pre, post: array -> vector */
1622
1623 /* overloadStateFcns (arraySort, vecSort); */
1624 /* overloadObjFcns (arraySort); */
1625}
1626
1627/*
1628** overloadPtrFcns:
1629** generate NIL: -> ptrSort
1630** __+__: int, ptrSort -> ptrSort
1631** __-__: ptrSort, ptrSort -> int
1632*/
1633static void
1634overloadPtrFcns (sort ptrSort)
1635{
1636 ltokenList domain = ltokenList_new ();
1637 ltoken range;
1638 sigNode signature;
1639
1640 /* NIL: -> ptrSort */
1641
1642 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1643 signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1644 symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1645
1646 /* __+__: int, ptrSort -> ptrSort */
1647
1648 ltokenList_addh (domain, ltoken_copy (intToken));
1649 ltokenList_addh (domain, ltoken_copy (range));
1650
1651 signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1652 symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1653
1654 /* __-__: ptrSort, ptrSort -> int */
1655
1656 domain = ltokenList_new ();
1657 ltokenList_addh (domain, ltoken_copy (range));
1658 ltokenList_addh (domain, range);
1659 range = ltoken_copy (intToken);
1660 signature = makesigNode (ltoken_undefined, domain, range);
1661 symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1662}
1663
1664static void
1665genVecOps (sort baseSort, sort vecSort, int dim)
1666{
1667 /* Generate __[__]: vecSort, int -> baseSort */
1668
1669 overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1670 ltoken_copy (intToken), baseSort);
1671
1672 /* sizeof: vecSort -> int */
1673 /* Generate isSub: vecSort, int, ... -> bool */
1674
1675 overloadIsSub (vecSort, dim);
1676}
1677
1678static void
1679overloadIsSub (sort s, int dim)
1680{
1681 /* Generate isSub: s, int, ... -> bool */
1682 int j, i;
1683 ltoken dom, nulltok = ltoken_undefined;
1684 ltokenList domain;
1685 sigNode signature;
1686
1687 for (j = 1; j <= dim; j++)
1688 {
1689 nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1690
1691 isSubNameNode->isOpId = TRUE;
1692 isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1693 lsymbol_fromChars ("isSub"));
1694 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1695
1696 domain = ltokenList_singleton (dom);
1697
1698 for (i = 1; i <= j; i++)
1699 {
1700 ltokenList_addh (domain, ltoken_copy (intToken));
1701 }
1702
1703 signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1704 symtable_enterOp (g_symtab, isSubNameNode, signature);
1705 }
1706}
1707
1708static void
1709overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1710{
1711 /* Generate <nn>: domainSort -> rangeTok */
1712 sigNode signature;
1713 ltoken dom;
1714 ltokenList domain;
1715
1716 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1717 domain = ltokenList_singleton (dom);
1718 signature = makesigNode (ltoken_undefined, domain, range);
1719 symtable_enterOp (g_symtab, nn, signature);
1720}
1721
1722static void
1723overloadSizeof (sort domainSort)
1724{
1725 nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1726
1727 sizeofNameNode->isOpId = TRUE;
1728 sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1729 lsymbol_fromChars ("sizeof"));
1730
1731 overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1732}
1733
1734static void
1735overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1736{
1737 ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1738
1739 overloadUnaryTok (nn, domainSort, range);
1740}
1741
1742static void
1743overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1744{
1745 /* Generate <nn>: s, dTok -> rs */
1746 sigNode signature;
1747 ltoken range, dom;
1748 ltokenList domain = ltokenList_new ();
1749
1750 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1751 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1752
1753 ltokenList_addh (domain, dom);
1754 ltokenList_addh (domain, dTok);
1755
1756 signature = makesigNode (ltoken_undefined, domain, range);
1757 symtable_enterOp (g_symtab, nn, signature);
1758}
1759
1760static /*@only@*/ nameNode
1761makeFieldOp (lsymbol field)
1762{
1763 /* operator: __.<field> */
1764 nameNode nn;
1765 opFormUnion u;
1766 opFormNode opform;
1767
1768 u.id = ltoken_createType (simpleId, SID_OP, field);
1769 opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1770 nn = makeNameNodeForm (opform);
1771 return nn;
1772}
1773
1774static /*@only@*/ nameNode
1775makeArrowFieldOp (lsymbol field)
1776{
1777 /* operator: __-><field> */
1778 nameNode nn;
1779 opFormUnion u;
1780 opFormNode opform;
1781
1782 u.id = ltoken_createType (simpleId, SID_OP, field);
1783 opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1784 nn = makeNameNodeForm (opform);
1785 return nn;
1786}
1787
1788void
1789sort_init (void)
28bf4b0b 1790 /*@globals undef arrayRefNameNode,
616915dd 1791 undef ptr2arrayNameNode,
1792 undef deRefNameNode,
1793 undef nilNameNode,
1794 undef plusNameNode,
1795 undef minusNameNode,
1796 undef condNameNode,
1797 undef eqNameNode,
1798 undef neqNameNode,
1799 undef intToken; @*/
1800{
1801 /* on alpha, declaration does not allocate storage */
28bf4b0b 1802 sortNode noSort, HOFSort;
616915dd 1803 opFormNode opform;
1804 opFormUnion u;
1805 underscoreSymbol = lsymbol_fromChars ("_");
1806
1807 /*
1808 ** commonly used data for generating operators
1809 */
1810
1811 lsymbol_setbool (lsymbol_fromChars ("bool"));
1812 intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1813
1814 /*
1815 ** __ \eq __: sort, sort -> bool
1816 */
1817
1818 u.anyop = ltoken_copy (ltoken_eq);
1819 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1820 eqNameNode = makeNameNodeForm (opform);
1821
1822 /*
1823 ** __ \neq __: sort, sort -> bool
1824 */
1825
1826 u.anyop = ltoken_copy (ltoken_neq);
1827 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1828 neqNameNode = makeNameNodeForm (opform);
1829
1830 /*
1831 **if __ then __ else __: bool, sort, sort -> sort
1832 */
1833
1834 opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1835 opFormUnion_createMiddle (0), ltoken_undefined);
1836 condNameNode = makeNameNodeForm (opform);
1837
1838 /* operator: __[__]: arraySort, int -> elementSort_Obj */
1839 u.middle = 1;
1840 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1841 ltoken_copy (ltoken_rbracket));
1842 arrayRefNameNode = makeNameNodeForm (opform);
1843
1844 /* operator: __[]: ptrSort -> arraySort */
1845 u.middle = 0;
1846 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1847 OPF_BMMIDDLE, u,
1848 ltoken_copy (ltoken_rbracket));
1849 ptr2arrayNameNode = makeNameNodeForm (opform);
1850
1851 /* operator: *__ */
1852 u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1853 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1854 deRefNameNode = makeNameNodeForm (opform);
1855
1856 /* operator: __ + __ */
1857 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1858 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1859 plusNameNode = makeNameNodeForm (opform);
1860
1861 /* operator: __ - __ */
1862 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1863 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1864 minusNameNode = makeNameNodeForm (opform);
1865
1866 /* operator: NIL */
1867 nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1868 nilNameNode->isOpId = TRUE;
1869 nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1870 lsymbol_fromChars ("NIL"));
1871
28bf4b0b 1872 noSort = (sortNode) dmalloc (sizeof (*noSort));
1873 noSort->kind = SRT_NONE;
1874 noSort->name = lsymbol_fromChars ("_unknown");;
1875 noSort->tag = lsymbol_undefined;
1876 noSort->baseSort = NOSORTHANDLE;
1877 noSort->objSort = NOSORTHANDLE;
1878 noSort->members = smemberInfo_undefined;
1879 noSort->export = FALSE;
1880 noSort->mutable = FALSE;
1881 noSort->abstract = FALSE;
1882 noSort->imported = FALSE;
1883 noSort->handle = NOSORTHANDLE;
616915dd 1884
28bf4b0b 1885 HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1886 HOFSort->kind = SRT_HOF;
1887 HOFSort->handle = HOFSORTHANDLE;
1888 HOFSort->name = lsymbol_undefined;
1889 HOFSort->tag = lsymbol_undefined;
1890 HOFSort->realtag = FALSE;
1891 HOFSort->baseSort = NOSORTHANDLE;
1892 HOFSort->objSort = NOSORTHANDLE;
1893 HOFSort->members = smemberInfo_undefined;
1894 HOFSort->export = FALSE;
1895 HOFSort->mutable = FALSE;
1896 HOFSort->abstract = FALSE;
1897 HOFSort->imported = FALSE;
1898
616915dd 1899 /*
1900 ** Store the null sort into table, and in the process initialize the sort table.
1901 ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1902 ** for HOFSORTHANDLE = 1.
1903 */
1904
28bf4b0b 1905 (void) sort_enterGlobal (noSort);
616915dd 1906 (void) sort_enterGlobal (HOFSort);
1907
1908 /* Other builtin sorts */
1909
2a6e9c30 1910 g_sortBool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1911 g_sortCapBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
616915dd 1912
1913 llassert (sortTable != NULL);
1914
2a6e9c30 1915 /* make g_sortBool a synonym for g_sortBool */
1916 sortTable[g_sortCapBool]->kind = SRT_SYN;
1917 sortTable[g_sortCapBool]->baseSort = g_sortBool;
1918 sortTable[g_sortCapBool]->mutable = FALSE;
1919 sortTable[g_sortCapBool]->abstract = TRUE;
616915dd 1920
2a6e9c30 1921 g_sortInt = sort_makeLiteralSort (ltoken_undefined,
616915dd 1922 lsymbol_fromChars ("int"));
2a6e9c30 1923 g_sortChar = sort_makeLiteralSort (ltoken_undefined,
616915dd 1924 lsymbol_fromChars ("char"));
1925 sort_void = sort_makeLiteralSort (ltoken_undefined,
1926 lsymbol_fromChars ("void"));
1927
2a6e9c30 1928 /* g_sortCstring is char__Vec, for C strings eg: "xyz" */
1929 char_obj_ptrSort = sort_makePtr (ltoken_undefined, g_sortChar);
1930 char_obj_ArrSort = sort_makeArr (ltoken_undefined, g_sortChar);
616915dd 1931
2a6e9c30 1932 g_sortCstring = sort_makeVal (char_obj_ArrSort);
1933 g_sortFloat = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1934 g_sortDouble = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
616915dd 1935}
1936
1937sort
1938sort_lookupName (lsymbol name)
1939{
1940 long int i;
1941
1942 if (name == lsymbol_undefined)
1943 {
1944 return NOSORTHANDLE;
1945 }
1946
1947 llassert (sortTable != NULL);
1948
1949 for (i = 0; i < sortTableSize; i++)
1950 {
28bf4b0b 1951 if (sortTable[i]->name == name)
616915dd 1952 {
1953 return i;
1954 }
1955 }
1956
1957 return NOSORTHANDLE;
1958}
1959
1960static bool
1961sort_isNewEntry (sortNode s)
1962{
1963 int i;
1964
1965 for (i = 0; i < sortTableSize; i++)
1966 {
1967 llassert (sortTable != NULL);
1968
28bf4b0b 1969 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
616915dd 1970 {
1971 return FALSE;
1972 }
1973 }
1974 return TRUE;
1975}
1976
1977static sort
1978sort_enterGlobal (sortNode s)
1979{
28bf4b0b 1980 return (sort_enterNew (s));
616915dd 1981}
1982
1983static sort
1984sort_enterNew (sortNode s)
1985{
28bf4b0b 1986 /*
1987 ** This ensures that the argument sortNode is not entered into
1988 ** the sort table more than once. isNew flag will tell the
1989 ** caller this info, and the caller will decide whether to generate
1990 ** operators for this sort.
1991 */
1992
616915dd 1993 long int i;
1994
1995 for (i = 0; i < sortTableSize; i++)
1996 {
1997 llassert (sortTable != NULL);
1998
28bf4b0b 1999 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
616915dd 2000 {
2001 sortNode_free (s);
2002 return i;
2003 }
2004 }
2005
2006 if (sortTableSize >= sortTableAlloc)
2007 {
2008 sortNode *oldSortTable = sortTable;
2009
2010 sortTableAlloc += DELTA;
2011 sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2012
2013 if (sortTableSize > 0)
2014 {
2015 llassert (oldSortTable != NULL);
2016 for (i = 0; i < sortTableSize; i++)
2017 {
2018 sortTable[i] = oldSortTable[i];
2019 }
2020 }
2021
2022 sfree (oldSortTable);
2023 }
2024
2025 llassert (sortTable != NULL);
2026
28bf4b0b 2027 s->handle = sortTableSize;
616915dd 2028 sortTable[sortTableSize++] = s;
2029
2030 /*@-compdef@*/
28bf4b0b 2031 return s->handle;
616915dd 2032} /*=compdef@*/
2033
2034static sort sort_enterNewForce (sortNode s)
2035{
28bf4b0b 2036 sort sor = sort_lookupName (s->name);
616915dd 2037
28bf4b0b 2038 if (sort_isNoSort (sor))
2039 {
2040 sor = sort_enterNew (s);
2041 llassert (sortTable != NULL);
2042 /*@-usereleased@*/
2043 llassert (sortTable[sor] == s);
2044 /*@=usereleased@*/
2045 }
2046 else
2047 {
2048 s->handle = sor;
2049 llassert (sortTable != NULL);
2050 sortTable[sor] = s;
2051 }
616915dd 2052
2053 /*@-globstate@*/ return (sor); /*@=globstate@*/
2054}
2055
2056void
2057sort_printStats (void)
2058{
2059 /* only for debugging */
2060 printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2061 sortTableAlloc);
2062}
2063
2064sortNode
2065sort_lookup (sort sor)
2066{
2067 /* ymtan: can sor be 0 ? */
2068 /* evs --- yup...0 should return noSort ? */
2069
2070 if (sor > 0U && sor < (unsigned) sortTableSize)
2071 {
2072 llassert (sortTable != NULL);
2073 return sortTable[sor];
2074 }
2075
2076 llassert (sor == 0);
28bf4b0b 2077 llassert (sor == NOSORTHANDLE);
2078 llassert (sortTable != NULL);
2079 return sortTable[NOSORTHANDLE];
616915dd 2080}
2081
2082sortNode
2083sort_quietLookup (sort sor)
2084{
2085 /* ymtan: can sor be 0 ? */
2086 if (sor > 0U && sor < (unsigned) sortTableSize)
2087 {
2088 llassert (sortTable != NULL);
2089 return (sortTable[sor]);
2090 }
2091 else
2092 {
28bf4b0b 2093 llassert (sortTable != NULL);
2094 return (sortTable[NOSORTHANDLE]);
616915dd 2095 }
2096}
2097
2098static cstring
2099printEnumMembers (/*@null@*/ smemberInfo *list)
2100{
2101 cstring out = cstring_undefined;
2102 smemberInfo *m;
2103
2104 for (m = list; m != (smemberInfo *) 0; m = m->next)
2105 {
2106 out = cstring_concat (out, lsymbol_toString (m->name));
2107
2108 if (m->next != (smemberInfo *) 0)
2109 {
2110 out = cstring_concatChars (out, ", ");
2111 }
2112 }
2113 return out;
2114}
2115
2116static /*@only@*/ cstring
2117printStructMembers (/*@null@*/ smemberInfo *list)
2118{
2119 cstring ret = cstring_undefined;
2120 smemberInfo *m;
2121
2122 for (m = list; m != (smemberInfo *) 0; m = m->next)
2123 {
2124 ret = message ("%q%q %s; ",
2125 ret, sort_unparse (m->sort),
2126 cstring_fromChars (lsymbol_toChars (m->name)));
2127 }
2128
2129 return ret;
2130}
2131
2132/*@only@*/ cstring
2133sort_unparse (sort s)
2134{
2135 /* printing routine for sorts */
2136 sortNode sn;
2137 lsymbol name;
2138
2139 sn = sort_quietLookup (s);
28bf4b0b 2140 name = sn->name;
616915dd 2141
28bf4b0b 2142 switch (sn->kind)
616915dd 2143 {
2144 case SRT_NONE:
2145 if (name == lsymbol_undefined)
2146 {
2147 return cstring_makeLiteral ("_unknown");
2148 }
2149
2150 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2151 case SRT_HOF:
2152 return cstring_makeLiteral ("procedural");
2153 case SRT_PRIM:
2154 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2155 case SRT_SYN:
2156 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2157
2158 case SRT_PTR:
28bf4b0b 2159 return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
616915dd 2160 case SRT_OBJ:
28bf4b0b 2161 return (message ("obj %q", sort_unparse (sn->baseSort)));
616915dd 2162 case SRT_ARRAY:
28bf4b0b 2163 return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
616915dd 2164 case SRT_VECTOR:
28bf4b0b 2165 return (message ("vector of %q", sort_unparse (sn->baseSort)));
616915dd 2166 case SRT_TUPLE:
28bf4b0b 2167 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2168 {
28bf4b0b 2169 return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2170 }
2171 else
2172 {
28bf4b0b 2173 return (message ("struct {%q}", printStructMembers (sn->members)));
616915dd 2174 }
2175 case SRT_UNIONVAL:
28bf4b0b 2176 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2177 {
28bf4b0b 2178 return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2179 }
2180 else
2181 {
28bf4b0b 2182 return (message ("union {%q}", printStructMembers (sn->members)));
616915dd 2183 }
2184 case SRT_ENUM:
28bf4b0b 2185 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2186 {
28bf4b0b 2187 return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2188 }
2189 else
2190 {
28bf4b0b 2191 return (message ("enum {%q}", printEnumMembers (sn->members)));
616915dd 2192 }
2193 case SRT_STRUCT:
28bf4b0b 2194 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2195 {
28bf4b0b 2196 return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2197 }
2198 else
2199 {
28bf4b0b 2200 return (message ("obj struct {%q}", printStructMembers (sn->members)));
616915dd 2201 }
2202 case SRT_UNION:
28bf4b0b 2203 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2204 {
28bf4b0b 2205 return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2206 }
2207 else
2208 {
28bf4b0b 2209 return (message ("obj union {%q}", printStructMembers (sn->members)));
616915dd 2210 }
2211 default:
2212 return (cstring_makeLiteral ("illegal"));
2213 }
2214}
2215
2216static lsymbol
2217sp (lsymbol s1, lsymbol s2)
2218{
2219 char buff[MAXBUFFLEN];
2220 char *name1Ptr;
2221 char *name2Ptr;
2222 int temp_length;
2223
2224 name1Ptr = lsymbol_toCharsSafe (s1);
2225 name2Ptr = lsymbol_toCharsSafe (s2);
2226
2227 if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2228 {
2229 temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2230 llfatalbug (message ("sp: name too long: %s%s",
2231 cstring_fromChars (name1Ptr),
2232 cstring_fromChars (name2Ptr)));
2233 }
2234
2235 strcpy (&buff[0], name1Ptr);
2236 strcat (&buff[0], name2Ptr);
2237
2238 return lsymbol_fromChars (&buff[0]);
2239}
2240
2241static lsymbol
2242sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2243{
2244 /*
2245 ** kind could be struct, union or enum. Create a unique sort
2246 ** name based on the given info. But first check that tagid
2247 ** has not been defined already. (ok if it is a forward decl)
2248 **/
2249
2250 tagInfo to;
2251
2252 if (ltoken_isUndefined (tagid))
2253 {
2254 *isNew = TRUE;
2255 return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2256 }
2257 else
2258 {
2259 to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2260
2261 if (tagInfo_exists (to))
2262 {
2263 *isNew = FALSE;
2264 }
2265 else
2266 {
2267 *isNew = TRUE;
2268 }
2269
2270 return (cstring_toSymbol (message ("_%s_%s",
2271 ltoken_unparse (tagid),
2272 cstring_fromChars (kind))));
2273 }
2274}
2275
2276/*@constant int MAX_SORT_DEPTH@*/
2277# define MAX_SORT_DEPTH 10
2278
2279static sort
2280sort_getUnderlyingAux (sort s, int depth)
2281{
2282 sortNode sn = sort_quietLookup (s);
2283
28bf4b0b 2284 if (sn->kind == SRT_SYN)
616915dd 2285 {
2286 if (depth > MAX_SORT_DEPTH)
2287 {
2288 llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2289 return s;
2290 }
2291
28bf4b0b 2292 return sort_getUnderlyingAux (sn->baseSort, depth + 1);
616915dd 2293 }
2294
2295 return s;
2296}
2297
2298sort
2299sort_getUnderlying (sort s)
2300{
2301 return sort_getUnderlyingAux (s, 0);
2302}
2303
2304static lsymbol
2305underlyingSortName (sortNode sn)
2306{
28bf4b0b 2307 if (sn->kind == SRT_SYN)
2308 return underlyingSortName (sort_quietLookup (sn->baseSort));
2309 return sn->name;
616915dd 2310}
2311
2312static /*@observer@*/ sortNode
2313underlyingSortNode (sortNode sn)
2314{
28bf4b0b 2315 if (sn->kind == SRT_SYN)
616915dd 2316 {
28bf4b0b 2317 return underlyingSortNode (sort_quietLookup (sn->baseSort));
616915dd 2318 }
2319
2320 return sn;
2321}
2322
2323bool
2324sort_mutable (sort s)
2325{
2326 /* if s is not a valid sort, then returns false */
2327 sortNode sn = sort_quietLookup (s);
28bf4b0b 2328 if (sn->mutable)
616915dd 2329 return TRUE;
2330 return FALSE;
2331}
2332
2333bool
2334sort_setExporting (bool flag)
2335{
2336 bool old;
2337 old = exporting;
2338 exporting = flag;
2339 return old;
2340}
2341
2342/*@observer@*/ static cstring
2343sort_unparseKind (sortKind k)
2344{
2345 if (k > SRT_FIRST && k < SRT_LAST)
2346 return (cstring_fromChars (sortKindName[(int)k]));
2347 else
2348 return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2349}
2350
2351bool
2352sort_isValidSort (sort s)
2353{
2354 sortNode sn = sort_quietLookup (s);
28bf4b0b 2355 sortKind k = sn->kind;
616915dd 2356 if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2357 return TRUE;
2358 else
2359 return FALSE;
2360}
2361
2362void
2363sort_dump (FILE *f, bool lco)
2364{
2365 int i;
2366 sortNode s;
2367 smemberInfo *mem;
2368
2369 fprintf (f, "%s\n", BEGINSORTTABLE);
2370 llassert (sortTable != NULL);
2371
2372 for (i = 2; i < sortTableSize; i++)
2373 {
2374 /* skips 0 and 1, noSort and HOFSort */
2375 s = sortTable[i];
2376
2377 /* if (lco && !s.export) continue; */
2378 /* Difficult to keep track of where each op and sort belong to
2379 which LCL type. Easiest to export them all (even private sorts and
2380 op's) but for checking imported modules, we only use LCL types and
2381 variables to check, i.e., we don't rely on sorts and op's for such
2382 checking. */
2383
28bf4b0b 2384 if (s->kind == SRT_NONE)
616915dd 2385 continue;
2386
2387 if (lco)
2388 {
2389 fprintf (f, "%%LCL");
2390 }
2391
28bf4b0b 2392 if (lsymbol_isDefined (s->name))
616915dd 2393 {
28bf4b0b 2394 fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
616915dd 2395 }
2396 else
2397 {
1b8ae690 2398 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2399 "This may result from using .lcs files produced by an old version of Splint. "
2400 "Remove the .lcs files, and rerun Splint.",
28bf4b0b 2401 i, lsymbol_toString (s->name)));
616915dd 2402 fprintf (f, "sort _error_ ");
2403 }
2404
28bf4b0b 2405 if (!lco && !s->export)
616915dd 2406 fprintf (f, "private ");
2407
2408 /*@-loopswitchbreak@*/
28bf4b0b 2409 switch (s->kind)
616915dd 2410 {
2411 case SRT_HOF:
2412 fprintf (f, "hof nil nil\n");
2413 break;
2414 case SRT_PRIM:
28bf4b0b 2415 if (s->abstract)
616915dd 2416 fprintf (f, "immutable nil nil\n");
2417 else
2418 fprintf (f, "primitive nil nil\n");
2419 break;
2420 case SRT_OBJ:
28bf4b0b 2421 if (s->abstract)
616915dd 2422 fprintf (f, "mutable %s nil\n",
28bf4b0b 2423 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2424 else
2425 fprintf (f, "obj %s nil\n",
28bf4b0b 2426 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2427 break;
2428 case SRT_SYN:
2429 fprintf (f, "synonym %s nil\n",
28bf4b0b 2430 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2431 break;
2432 case SRT_PTR:
28bf4b0b 2433 fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2434 break;
2435 case SRT_ARRAY:
2436 fprintf (f, "arr %s nil\n",
28bf4b0b 2437 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2438 break;
2439 case SRT_VECTOR:
2440 fprintf (f, "vec %s %s\n",
28bf4b0b 2441 lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2442 lsymbol_toCharsSafe (sortTable[s->objSort]->name));
616915dd 2443 break;
2444 case SRT_STRUCT:
28bf4b0b 2445 if (s->tag == lsymbol_undefined)
616915dd 2446 {
2447 /* we need to make up a tag to prevent excessive
2448 growth of .lcs files when tags are overloaded
2449 */
2450 llbuglit ("Struct has no tag");
2451 }
2452 else
28bf4b0b 2453 fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
616915dd 2454
28bf4b0b 2455 for (mem = s->members;
616915dd 2456 mem != smemberInfo_undefined; mem = mem->next)
2457 {
2458 if (lco)
2459 fprintf (f, "%%LCL");
2460 fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
28bf4b0b 2461 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
616915dd 2462 }
2463 if (lco)
2464 fprintf (f, "%%LCL");
2465 fprintf (f, "sort strEnd nil nil nil\n");
2466 break;
2467 case SRT_UNION:
28bf4b0b 2468 if (s->tag == lsymbol_undefined)
616915dd 2469 llbuglit ("Union has no tag");
2470 else
28bf4b0b 2471 fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2472 for (mem = s->members;
616915dd 2473 mem != smemberInfo_undefined; mem = mem->next)
2474 {
2475 if (lco)
2476 fprintf (f, "%%LCL");
2477 fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
28bf4b0b 2478 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
616915dd 2479 }
2480 if (lco)
2481 fprintf (f, "%%LCL");
2482 fprintf (f, "sort unionEnd nil nil nil\n");
2483 break;
2484 case SRT_ENUM:
28bf4b0b 2485 if (s->tag == lsymbol_undefined)
616915dd 2486 {
2487 llbuglit ("Enum has no tag");
2488 }
2489
28bf4b0b 2490 fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
616915dd 2491
28bf4b0b 2492 for (mem = s->members;
616915dd 2493 mem != smemberInfo_undefined; mem = mem->next)
2494 {
2495 if (lco)
2496 fprintf (f, "%%LCL");
2497 fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2498 }
2499 if (lco)
2500 fprintf (f, "%%LCL");
2501 fprintf (f, "sort enumEnd nil nil nil\n");
2502 break;
2503 case SRT_TUPLE:
28bf4b0b 2504 fprintf (f, "tup %s nil\n",
2505 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2506 break;
2507 case SRT_UNIONVAL:
2508 fprintf (f, "unionval %s nil\n",
28bf4b0b 2509 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2510 break;
2511 default:
28bf4b0b 2512 fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
616915dd 2513 } /* switch */
2514 /*@=loopswitchbreak@*/
2515 }
2516
2517 fprintf (f, "%s\n", SORTTABLEEND);
2518}
2519
2520static void
2521sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2522{
2523 if (strcmp (kstr, "synonym") == 0)
2524 {
2525 (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2526 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2527 }
2528 else if (strcmp (kstr, "mutable") == 0)
2529 {
2530 (void) sort_constructAbstract (sname, TRUE, bsort);
2531 }
2532 else if (strcmp (kstr, "obj") == 0)
2533 {
2534 (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2535 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2536 }
2537 else if (strcmp (kstr, "ptr") == 0)
2538 {
2539 (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2540 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2541 }
2542 else if (strcmp (kstr, "arr") == 0)
2543 {
2544 (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2545 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2546 }
2547 else if (strcmp (kstr, "tup") == 0)
2548 {
2549 (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2550 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2551 }
2552 else if (strcmp (kstr, "unionval") == 0)
2553 {
2554 (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2555 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2556 }
2557 else
2558 {
2559 llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2560 }
2561}
2562
2563static void
28bf4b0b 2564parseSortLine (char *line, ltoken t, inputStream s,
2565 mapping map, lsymbolList slist)
616915dd 2566{
2567 /* caller expects that map and slist are updated */
2568 /* t and importfle are only used for error messages */
2569 static lsymbol strName = lsymbol_undefined;
2570 static smemberInfo *strMemList = NULL;
2571 static lsymbol unionName = lsymbol_undefined;
2572 static smemberInfo *unionMemList = NULL;
2573 static lsymbol enumName = lsymbol_undefined;
2574 static smemberInfo *enumMemList = NULL;
2575 static lsymbol tagName = lsymbol_undefined;
2576
28bf4b0b 2577 cstring importfile = inputStream_fileName (s);
616915dd 2578 char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2579 bool tmp;
2580 tagInfo ti;
2581 lsymbol sname, bname, new_name, objName;
2582 sort objSort;
2583 char *lineptr;
2584 int col; /* for keeping column number */
2585 ltoken tagid;
2586
2587 if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2588 &(basedstr[0]), &(objstr[0])) != 4)
2589 {
2590 /* if this fails, can have weird errors */
2591 /* strEnd, unionEnd, enumEnd won't return 4 args */
2592 lclplainerror
2593 (message ("%q: Imported file contains illegal sort declaration. "
2594 "Skipping this line: \n%s\n",
28bf4b0b 2595 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
616915dd 2596 cstring_fromChars (line)));
2597 return;
2598 }
2599
2600 sname = lsymbol_fromChars (sostr);
2601 if (sname == lsymbol_fromChars ("nil"))
2602 {
2603 /* No given sort name. Use lsymbol_undefined and generate sort name
2604 in sort building routines. */
2605 sname = lsymbol_undefined;
2606 lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
28bf4b0b 2607 importfile,
616915dd 2608 cstring_fromChars (line)));
2609 }
2610
2611 /* Assume that when we encounter a sort S1 that is based on sort
2612 S2, S2 is before S1 in the imported file. sort table is a
2613 linear list and we create base sorts before other sorts. */
2614
2615 bname = lsymbol_fromChars (basedstr);
2616 if (strcmp (kstr, "primitive") == 0)
2617 {
2618 new_name = lsymbol_translateSort (map, sname);
2619 (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2620 lsymbol_undefined, FALSE,
2621 NOSORTHANDLE, smemberInfo_undefined);
2622 }
2623 else if (strcmp (kstr, "strMem") == 0)
2624 {
2625 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2626 mem->next = strMemList;
2627 mem->name = sname;
2628 mem->sortname = bname;
2629 mem->sort = NOSORTHANDLE;
2630 strMemList = mem;
2631 }
2632 else if (strcmp (sostr, "strEnd") == 0)
2633 { /* now process it */
2634 if (strName != lsymbol_undefined && strMemList != NULL)
2635 {
2636 sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
107b60d6 2637 TRUE, NOSORTHANDLE, strMemList);
616915dd 2638
2639 if (tagName != lsymbol_undefined)
2640 {
2641 tagid = ltoken_create (simpleId, tagName);
2642
2643 ti = (tagInfo) dmalloc (sizeof (*ti));
2644 ti->sort = asort;
2645 ti->kind = TAG_STRUCT;
2646 ti->id = tagid;
2647 ti->imported = FALSE;
2648
2649 (void) symtable_enterTagForce (g_symtab, ti);
2650 }
2651 }
2652 else
2653 {
2654 if (strName == lsymbol_undefined)
2655 {
2656 lclbug (message ("%q: Imported file contains unexpected null struct sort",
28bf4b0b 2657 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2658 }
2659 else
2660 {
2661 /*
2662 ** no members -> its a forward struct
2663 */
2664
2665 if (tagName != lsymbol_undefined)
2666 {
2667 tagid = ltoken_create (simpleId, tagName);
2668 (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2669 }
2670 }
2671 }
2672 strName = lsymbol_undefined;
2673 strMemList = NULL;
2674 tagName = lsymbol_undefined;
2675 }
2676 else if (strcmp (kstr, "str") == 0)
2677 {
2678 if (strName != lsymbol_undefined || strMemList != NULL)
2679 {
2680 lclbug (message ("%q: unexpected non-null struct sort or "
2681 "non-empty member list",
28bf4b0b 2682 fileloc_unparseRaw (importfile,
2683 inputStream_thisLineNumber (s))));
616915dd 2684 }
2685 /* see if a tag is associated with this sort */
2686 if (strcmp (basedstr, "nil") == 0)
2687 {
2688 llfatalerror (message ("%s: Struct missing tag. Obsolete .lcs file, remove and rerun lcl.",
28bf4b0b 2689 importfile));
616915dd 2690 /*
2691 strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2692 tagName = lsymbol_undefined;
2693 mapping_bind (map, sname, strName);
2694 */
2695 }
2696 else /* a tag exists */
2697 { /* create tag in symbol table and add tagged sort in sort table */
2698 tagName = bname;
2699 tagid = ltoken_create (simpleId, bname);
2700
2701 strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2702 ti = symtable_tagInfo (g_symtab, tagName);
2703
2704 /*
2705 ** No error for redefining a tag in an import.
2706 */
2707 }
2708 /* to be processed later in sort_import */
2709 lsymbolList_addh (slist, strName);
2710 }
2711 else if (strcmp (kstr, "enumMem") == 0)
2712 {
2713 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2714 mem->next = enumMemList;
2715 mem->sortname = enumName;
2716 mem->name = sname;
2717 mem->sort = NOSORTHANDLE;
2718 enumMemList = mem;
2719 }
2720 else if (strcmp (sostr, "enumEnd") == 0)
2721 {
2722 if (enumName != lsymbol_undefined && enumMemList != NULL)
2723 {
2724 sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2725 FALSE, NOSORTHANDLE, enumMemList);
2726
2727 if (tagName != lsymbol_undefined)
2728 {
2729 tagid = ltoken_create (simpleId, tagName);
2730
2731 ti = (tagInfo) dmalloc (sizeof (*ti));
2732 ti->sort = asort;
2733 ti->kind = TAG_ENUM;
2734 ti->id = tagid;
2735 ti->imported = FALSE;
2736
2737 (void) symtable_enterTagForce (g_symtab, ti);
2738 }
2739 }
2740 else
2741 {
2742 lclbug (message ("%q: unexpected null enum sort or empty member list",
28bf4b0b 2743 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2744 }
2745 enumName = lsymbol_undefined;
2746 enumMemList = NULL;
2747 tagName = lsymbol_undefined;
2748 }
2749 else if (strcmp (kstr, "enum") == 0)
2750 {
2751 if (enumName != lsymbol_undefined || enumMemList != NULL)
2752 {
2753 lclbug (message ("%q: Unexpected non-null enum sort or "
2754 "non-empty member list",
28bf4b0b 2755 fileloc_unparseRaw (importfile,
2756 inputStream_thisLineNumber (s))));
616915dd 2757 }
2758
2759 /* see if a tag is associated with this sort */
2760 if (strcmp (basedstr, "nil") == 0)
2761 {
2762 llfatalerror (message ("%s: Enum missing tag. Obsolete .lcs file, "
2763 "remove and rerun lcl.",
28bf4b0b 2764 importfile));
616915dd 2765 }
2766 else
2767 { /* a tag exists */
2768 tagName = bname;
2769 tagid = ltoken_create (simpleId, bname);
2770 enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2771 ti = symtable_tagInfo (g_symtab, bname);
2772 }
2773 }
2774 else if (strcmp (kstr, "unionMem") == 0)
2775 {
2776 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2777 mem->next = unionMemList;
2778 mem->sortname = bname;
2779 mem->name = sname;
2780 mem->sort = NOSORTHANDLE;
2781 unionMemList = mem;
2782 }
2783 else if (strcmp (sostr, "unionEnd") == 0)
2784 {
2785 if (unionName != lsymbol_undefined && unionMemList != NULL)
2786 {
2787 sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2788 FALSE, NOSORTHANDLE, unionMemList);
2789
2790 if (tagName != lsymbol_undefined)
2791 {
2792 tagid = ltoken_create (simpleId, tagName);
2793
2794 ti = (tagInfo) dmalloc (sizeof (*ti));
2795 ti->sort = asort;
2796 ti->kind = TAG_UNION;
2797 ti->id = tagid;
2798 ti->imported = FALSE;
2799
2800 (void) symtable_enterTagForce (g_symtab, ti);
2801 }
2802 }
2803 else
2804 {
2805 if (unionName == lsymbol_undefined)
2806 {
2807 lclbug
2808 (message ("%q: Imported file contains unexpected null union sort",
28bf4b0b 2809 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2810 }
2811 else
2812 {
2813 /*
2814 ** no members -> its a forward struct
2815 */
2816
2817 if (tagName != lsymbol_undefined)
2818 {
2819 tagid = ltoken_create (simpleId, tagName);
2820
2821 (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2822 }
2823 }
2824 }
2825
2826 unionName = lsymbol_undefined;
2827 unionMemList = NULL;
2828 tagName = lsymbol_undefined;
2829 }
2830 else if (strcmp (kstr, "union") == 0)
2831 {
2832 if (unionName != lsymbol_undefined || unionMemList != NULL)
2833 {
2834 lclbug
2835 (message
2836 ("%q: Unexpected non-null union sort or non-empty "
2837 "member list",
28bf4b0b 2838 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2839 }
2840 /* see if a tag is associated with this sort */
2841 if (strcmp (basedstr, "nil") == 0)
2842 {
2843 llfatalerror
2844 (message ("%s: Union missing tag. Obsolete .lcs file, "
2845 "remove and rerun lcl.",
28bf4b0b 2846 importfile));
616915dd 2847 }
2848 else
2849 { /* a tag exists */
2850 tagName = bname;
2851 tagid = ltoken_create (simpleId, bname);
2852
2853 unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2854 ti = symtable_tagInfo (g_symtab, bname);
2855 }
2856 lsymbolList_addh (slist, unionName);
2857 }
2858 else if (strcmp (kstr, "immutable") == 0)
2859 {
2860 (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2861 }
2862 else if (strcmp (kstr, "hof") == 0)
2863 {
2864 (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2865 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2866 }
2867 else
2868 {
2869 sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2870
2871 if (sort_isNoSort (bsort))
2872 {
2873 lineptr = strchr (line, ' '); /* go past "sort" */
2874 llassert (lineptr != NULL);
2875 lineptr = strchr (lineptr + 1, ' '); /* go past sostr */
2876 llassert (lineptr != NULL);
2877 lineptr = strchr (lineptr + 1, ' '); /* go past kstr */
2878 llassert (lineptr != NULL);
2879 col = 5 + lineptr - line; /* 5 for initial "%LCL "*/
2880
2881 llbug
2882 (message ("%q: Imported file contains unknown base sort: %s",
28bf4b0b 2883 fileloc_unparseRawCol (importfile,
2884 inputStream_thisLineNumber (s), col),
616915dd 2885 cstring_fromChars (lsymbol_toCharsSafe (bname))));
2886 }
2887
2888 if (strcmp (kstr, "vec") == 0)
2889 {
2890 objName = lsymbol_fromChars (objstr);
2891 objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2892 (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2893 FALSE, objSort, smemberInfo_undefined);
2894 }
2895 else
2896 {
2897 sort_loadOther (kstr, sname, bsort);
2898 }
2899 }
2900}
2901
2902void
28bf4b0b 2903sort_import (inputStream imported, ltoken tok, mapping map)
616915dd 2904{
2905 /* tok is only used for error message line number */
28bf4b0b 2906 char *buf;
2907 cstring importfile;
2908 inputStream lclsource;
616915dd 2909 sort bsort;
2910 lsymbolList slist = lsymbolList_new ();
2911
28bf4b0b 2912 buf = inputStream_nextLine (imported);
616915dd 2913
2914 llassert (buf != NULL);
2915
28bf4b0b 2916 importfile = inputStream_fileName (imported);
616915dd 2917
2918 if (!firstWord (buf, "%LCLSortTable"))
2919 {
2920 lclsource = LCLScanSource ();
2921
2922 lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2923 "in import file %s:\n%s",
28bf4b0b 2924 importfile,
616915dd 2925 cstring_fromChars (buf)));
2926
2927 }
2928
2929 for (;;)
2930 {
28bf4b0b 2931 buf = inputStream_nextLine (imported);
616915dd 2932
2933 llassert (buf != NULL);
2934
2935 if (firstWord (buf, "%LCLSortTableEnd"))
2936 {
2937 break;
2938 }
2939 else
2940 { /* a good line, remove %LCL from line first */
2941 if (firstWord (buf, "%LCL"))
2942 {
2943 parseSortLine (buf + 4, tok, imported, map, slist);
2944 }
2945 else
2946 {
2947 lclsource = LCLScanSource ();
2948 lclfatalerror
2949 (tok,
2950 message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
28bf4b0b 2951 importfile,
616915dd 2952 cstring_fromChars (buf)));
2953 }
2954 }
2955 }
2956
2957 /* now process the smemberInfo in the sort List */
2958 lsymbolList_elements (slist, s)
2959 {
2960 if (s != lsymbol_undefined)
2961 {
2962 sort sor;
2963 sortNode sn;
2964
2965 sor = sort_lookupName (s);
2966 sn = sort_quietLookup (sor);
2967
28bf4b0b 2968 switch (sn->kind)
616915dd 2969 {
2970 case SRT_ENUM:
2971 { /* update the symbol table with members of enum */
2972 varInfo vi;
28bf4b0b 2973 smemberInfo *mlist = sn->members;
616915dd 2974 for (; mlist != NULL; mlist = mlist->next)
2975 {
2976 /* check that enumeration constants are unique */
2977 vi = symtable_varInfo (g_symtab, mlist->name);
2978 if (!varInfo_exists (vi))
2979 { /* put info into symbol table */
2980 vi = (varInfo) dmalloc (sizeof (*vi));
2981 vi->id = ltoken_create (NOTTOKEN, mlist->name);
2982 vi->kind = VRK_ENUM;
2983 vi->sort = sor;
2984 vi->export = TRUE;
2985
2986 (void) symtable_enterVar (g_symtab, vi);
2987 varInfo_free (vi);
2988 }
2989 else
2990 {
2991 lclplainerror
2992 (message ("%s: enum member %s of %s has already been declared",
28bf4b0b 2993 importfile,
616915dd 2994 lsymbol_toString (mlist->name),
28bf4b0b 2995 lsymbol_toString (sn->name)));
616915dd 2996 }
2997 }
2998 /*@switchbreak@*/ break;
2999 }
3000 case SRT_STRUCT:
3001 case SRT_UNION:
3002 {
28bf4b0b 3003 smemberInfo *mlist = sn->members;
616915dd 3004
3005 for (; mlist != NULL; mlist = mlist->next)
3006 {
3007 bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3008 if (sort_isNoSort (bsort))
3009 {
3010 lclbug (message ("%s: member %s of %s has unknown sort\n",
28bf4b0b 3011 importfile,
616915dd 3012 cstring_fromChars (lsymbol_toChars (mlist->name)),
28bf4b0b 3013 cstring_fromChars (lsymbol_toChars (sn->name))));
616915dd 3014 }
3015 else
3016 {
3017 mlist->sort = bsort;
3018 }
3019 }
3020 /*@switchbreak@*/ break;
3021 }
3022 default:
3023 lclbug (message ("%s: %s has unexpected sort kind %s",
28bf4b0b 3024 importfile,
3025 cstring_fromChars (lsymbol_toChars (sn->name)),
3026 sort_unparseKind (sn->kind)));
616915dd 3027 }
3028 }
3029 } end_lsymbolList_elements;
3030
3031 /* list and sorts in it are not used anymore */
3032 lsymbolList_free (slist);
3033}
3034
3035bool
28bf4b0b 3036sort_equal (sort s1, sort s2)
616915dd 3037{
3038 sort syn1, syn2;
28bf4b0b 3039
3040 if (s1 == s2) return TRUE;
3041
3042 /* handle synonym sorts */
3043 syn1 = sort_getUnderlying (s1);
3044 syn2 = sort_getUnderlying (s2);
3045
3046 if (syn1 == syn2) return TRUE;
3047 /* makes bool and Bool equal */
3048
616915dd 3049 return FALSE;
3050}
3051
3052bool
3053sort_compatible (sort s1, sort s2)
3054{
3055 sort syn1, syn2;
28bf4b0b 3056 /* later: might consider "char" and enum types the same as "int" */
616915dd 3057 if (s1 == s2)
3058 return TRUE;
28bf4b0b 3059 /* handle synonym sorts */
616915dd 3060 syn1 = sort_getUnderlying (s1);
3061 syn2 = sort_getUnderlying (s2);
3062 if (syn1 == syn2)
3063 return TRUE;
3064 /* makes bool and Bool equal */
3065 return FALSE;
3066}
3067
3068bool
3069sort_compatible_modulo_cstring (sort s1, sort s2)
3070{
3071 /* like sort_compatible but also handles special cstring inits,
3072 allows the following 2 cases:
28bf4b0b 3073 char c[] = "abc"; (LHS: char_Obj_Arr, RHS = char_Vec)
3074 (c as implicitly coerced into c^)
3075 char *d = "abc"; (LHS: char_Obj_Ptr, RHS = char_Vec)
3076 (d as implicitly coerced into d[]^)
3077 */
616915dd 3078 sort syn1, syn2;
3079 if (sort_compatible (s1, s2))
3080 return TRUE;
3081 syn1 = sort_getUnderlying (s1);
3082 syn2 = sort_getUnderlying (s2);
2a6e9c30 3083 if (g_sortCstring == syn2 &&
616915dd 3084 (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3085 return TRUE;
3086 return FALSE;
3087}
3088
3089lsymbol
3090sort_getLsymbol (sort sor)
3091{
616915dd 3092 sortNode sn = sort_quietLookup (sor);
28bf4b0b 3093 return sn->name;
616915dd 3094}
3095
3096/* a few handy routines for debugging */
3097
3098char *sort_getName (sort s)
3099{
3100 return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3101}
3102
3103/*@exposed@*/ cstring
3104sort_unparseName (sort s)
3105{
28bf4b0b 3106 return (cstring_fromChars (sort_getName (s)));
616915dd 3107}
3108
3109static void
3110sortError (ltoken t, sort oldsort, sortNode newnode)
3111{
3112 sortNode old = sort_quietLookup (oldsort);
28bf4b0b 3113
3114 if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3115 (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
616915dd 3116 {
3117 llbuglit ("sortError: illegal sort kind");
3118 }
3119
3120 llassert (sortTable != NULL);
3121
3122 lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
28bf4b0b 3123 cstring_fromChars (lsymbol_toChars (newnode->name)),
616915dd 3124 sort_unparseKindName (sortTable[oldsort]),
3125 sort_unparseKindName (newnode)));
3126}
3127
3128static /*@observer@*/ cstring
3129 sort_unparseKindName (sortNode s)
3130{
28bf4b0b 3131 switch (s->kind)
616915dd 3132 {
3133 case SRT_NONE:
28bf4b0b 3134 return cstring_fromChars (sortKindName[(int)s->kind]);
616915dd 3135 default:
28bf4b0b 3136 if (s->abstract)
616915dd 3137 {
28bf4b0b 3138 if (s->mutable)
616915dd 3139 {
3140 return cstring_makeLiteralTemp ("MUTABLE");
3141 }
3142 else
3143 {
3144 return cstring_makeLiteralTemp ("IMMUTABLE");
3145 }
3146 }
3147 else
28bf4b0b 3148 return cstring_fromChars (sortKindName[(int)s->kind]);
616915dd 3149 }
3150
3151 BADEXIT;
3152}
3153
3154sort
3155sort_fromLsymbol (lsymbol sortid)
3156{
3157 /* like sort_lookupName but creates sort if not already present */
3158 sort sort = sort_lookupName (sortid);
3159 if (sort == NOSORTHANDLE)
3160 sort = sort_makeSort (ltoken_undefined, sortid);
3161 return sort;
3162}
3163
3164bool
3165sort_isHOFSortKind (sort s)
3166{
3167 sortNode sn = sort_quietLookup (s);
28bf4b0b 3168 if (sn->kind == SRT_HOF)
616915dd 3169 return TRUE;
3170 return FALSE;
3171}
3172
3173/*
3174** returns TRUE iff s has State operators (', ~, ^)
3175*/
3176
3177static bool
3178sort_hasStateFcns (sort s)
3179{
3180 sortNode sn = sort_quietLookup (s);
28bf4b0b 3181 sortKind kind = sn->kind;
3182
616915dd 3183 if (kind == SRT_SYN)
3184 {
28bf4b0b 3185 return (sort_hasStateFcns (sn->baseSort));
616915dd 3186 }
28bf4b0b 3187
616915dd 3188 return ((kind == SRT_PTR) ||
3189 (kind == SRT_OBJ) ||
3190 (kind == SRT_ARRAY) ||
3191 (kind == SRT_STRUCT) ||
3192 (kind == SRT_UNION));
3193}
3194
3195
git-cvsimport mirror of splint
This page took 0.52128 seconds and 5 git commands to generate.