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