]> andersk Git - splint.git/blame - src/sort.c
andersk / splint.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Cleaned up flags to generate manual help.
[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**
20** For information on lclint: lclint-request@cs.virginia.edu
21** To report a bug: lclint-bug@cs.virginia.edu
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
38# include "lclintMacros.nf"
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
680sort_makePtrN (sort s, int pointers)
681{
682 llassert (pointers >= 0);
683
684 if (pointers == 0)
685 {
686 return s;
687 }
688 else
689 {
690 return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
691 pointers - 1);
692 }
693}
694
695sort
696sort_makeArr (ltoken t, sort baseSort)
697{
698 sortNode s, outSort, old;
699 sort handle, vecHandle;
700 int dim;
701 lsymbol name;
702
703 s = sort_lookup (baseSort);
704
28bf4b0b 705 if (s->kind == SRT_HOF)
616915dd 706 return baseSort;
28bf4b0b 707 if (s->kind == SRT_NONE)
616915dd 708 return baseSort;
709
28bf4b0b 710 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
711 s->kind != SRT_UNION && s->kind != SRT_OBJ)
616915dd 712 /* base is not an array, struct or obj. Need to insert a Obj. */
713 baseSort = sort_makeObj (baseSort);
714
715 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
716 lsymbol_fromChars ("_Arr"));
717 handle = sort_lookupName (name);
718
28bf4b0b 719 /* must not clash with any LSL sorts */
720 outSort = (sortNode) dmalloc (sizeof (*outSort));
721 outSort->name = name;
722 outSort->kind = SRT_ARRAY;
723 outSort->baseSort = baseSort;
724 outSort->objSort = NOSORTHANDLE;
725 outSort->members = smemberInfo_undefined;
726 outSort->mutable = TRUE;
727 outSort->export = exporting;
728 outSort->imported = context_inImport ();
729 outSort->abstract = FALSE;
730 outSort->handle = handle;
616915dd 731
732 if (handle == NOSORTHANDLE)
733 {
734 if (sort_isNewEntry (outSort))
735 {
28bf4b0b 736 handle = sort_enterNew (outSort);
737 outSort = sort_lookup (handle);
616915dd 738
739 for (old = outSort, dim = 0;
28bf4b0b 740 old->kind == SRT_ARRAY;
741 dim++, old = sort_lookup (old->baseSort))
616915dd 742 {
743 ;
744 }
745
746 vecHandle = sort_makeVec (t, handle);
747 genArrOps (baseSort, handle, dim, vecHandle);
748 }
749 else
750 {
28bf4b0b 751 outSort->handle = handle = sort_enterNew (outSort);
616915dd 752 }
753 }
754 else
755 {
756 llassert (sortTable != NULL);
757
28bf4b0b 758 if (sortTable[handle]->kind != SRT_ARRAY)
616915dd 759 {
760 sortError (t, handle, outSort);
761 }
762
28bf4b0b 763 sortNode_free (outSort);
616915dd 764 }
765
766 return handle;
767}
768
769sort
770sort_makeVec (ltoken t, sort arraySort)
771{
772 sortNode s, outSort, old;
773 sort baseSort, handle, elementSort;
774 int dim; /* array dimension count. */
775 lsymbol name;
776
777 s = sort_lookup (arraySort);
778
28bf4b0b 779 if (s->kind == SRT_HOF)
616915dd 780 return arraySort;
28bf4b0b 781 if (s->kind == SRT_NONE)
616915dd 782 return arraySort;
783
28bf4b0b 784 if (s->kind != SRT_ARRAY)
616915dd 785 {
786 llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
28bf4b0b 787 sort_unparseKind (s->kind)));
616915dd 788 }
789
28bf4b0b 790 if (s->baseSort == NOSORTHANDLE)
616915dd 791 llbuglit ("sort_makeVec: arrays must have base (element) sort");
792
793 /* Vectors return "values", so make array elements values. */
794
28bf4b0b 795 baseSort = s->baseSort;
616915dd 796 elementSort = sort_makeVal (baseSort);
797
798 name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
799 lsymbol_fromChars ("_Vec"));
800 handle = sort_lookupName (name);
801
28bf4b0b 802 outSort = (sortNode) dmalloc (sizeof (*outSort));
803 outSort->baseSort = elementSort;
804 outSort->name = name;
805 outSort->objSort = arraySort;
806 outSort->kind = SRT_VECTOR;
807 outSort->members = smemberInfo_undefined;
808 outSort->mutable = FALSE;
809 outSort->export = exporting;
810 outSort->imported = context_inImport ();
811 outSort->abstract = FALSE;
812 outSort->handle = handle;
616915dd 813
814 if (handle == NOSORTHANDLE)
815 {
816 if (sort_isNewEntry (outSort))
817 {
28bf4b0b 818 outSort = sort_lookup (handle = sort_enterNew (outSort));
616915dd 819
820 for (old = outSort, dim = 0;
28bf4b0b 821 old->kind == SRT_VECTOR;
822 dim++, old = sort_lookup (old->baseSort))
616915dd 823 {
824 ;
825 }
826
827 genVecOps (elementSort, handle, dim);
828 }
829 else
830 {
28bf4b0b 831 outSort->handle = handle = sort_enterNew (outSort);
616915dd 832 }
833 }
834 else
835 {
836 llassert (sortTable != NULL);
837
28bf4b0b 838 if (sortTable[handle]->kind != SRT_VECTOR)
616915dd 839 {
840 sortError (t, handle, outSort);
841 }
842
28bf4b0b 843 sortNode_free (outSort);
616915dd 844 }
845
846 return handle;
847}
848
849sort
850sort_makeVal (sort sor)
851{
852 sort retSort = sor;
853 sortNode rsn, s;
854
855 llassert (sortTable != NULL);
856 s = sort_quietLookup (sor);
857
28bf4b0b 858 switch (s->kind)
616915dd 859 {
860 case SRT_PRIM:
861 case SRT_ENUM:
862 case SRT_PTR:
863 case SRT_TUPLE:
864 case SRT_UNIONVAL:
865 case SRT_VECTOR:
866 case SRT_HOF:
867 case SRT_NONE:
868 /* Do nothing for basic types and pointers. */
869 retSort = sor;
870 break;
871 case SRT_SYN:
28bf4b0b 872 return sort_makeVal (sortTable[sor]->baseSort);
616915dd 873 case SRT_OBJ:
874 /* Strip out the last Obj's */
28bf4b0b 875 if (s->baseSort == NOSORTHANDLE)
616915dd 876 {
877 llbuglit ("sort_makeVal: expecting a base sort for Obj");
878 }
28bf4b0b 879 retSort = s->baseSort;
616915dd 880 break;
881 case SRT_ARRAY:
882 retSort = sort_makeVec (ltoken_undefined, sor);
883 break;
884 case SRT_STRUCT:
885 retSort = sort_makeTuple (ltoken_undefined, sor);
886 break;
887 case SRT_UNION:
888 retSort = sort_makeUnionVal (ltoken_undefined, sor);
889 break;
890 default:
891 llbuglit ("sort_makeVal: invalid sort kind");
892 }
893 rsn = sort_quietLookup (retSort);
28bf4b0b 894 if (rsn->kind == SRT_NONE)
616915dd 895 {
28bf4b0b 896 llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
616915dd 897 }
898 return retSort;
899}
900
901sort
902sort_makeImmutable (ltoken t, lsymbol name)
903{
904 sortNode outSort;
905 sort handle;
906
907 handle = sort_lookupName (name);
908
28bf4b0b 909 outSort = (sortNode) dmalloc (sizeof (*outSort));
910 outSort->kind = SRT_PRIM;
911 outSort->name = name;
912 outSort->baseSort = NOSORTHANDLE;
913 outSort->objSort = NOSORTHANDLE;
914 outSort->members = smemberInfo_undefined;
915 outSort->export = exporting;
916 outSort->mutable = FALSE;
917 outSort->imported = context_inImport ();
918 outSort->abstract = TRUE;
919 outSort->handle = handle;
616915dd 920
921 if (handle == NOSORTHANDLE)
922 {
28bf4b0b 923 handle = sort_enterNew (outSort);
924 outSort = sort_lookup (handle);
616915dd 925 overloadSizeof (handle);
926 }
927 else
928 { /* complain */
929 llassert (sortTable != NULL);
930
28bf4b0b 931 if ((sortTable[handle]->kind != SRT_PRIM) &&
932 (sortTable[handle]->abstract) &&
933 (!sortTable[handle]->mutable))
616915dd 934 {
935 sortError (t, handle, outSort);
936 }
937
28bf4b0b 938 sortNode_free (outSort);
616915dd 939 }
940
941 return handle;
942}
943
944sort
945sort_makeMutable (ltoken t, lsymbol name)
946{
947 sort immutable_old, handle, baseSort;
948 lsymbol objName;
949
950 immutable_old = sort_lookupName (name);
951
952 /* First generate the value sort */
953 baseSort = sort_makeImmutable (t, name);
954
955 llassert (sortTable != NULL);
956
957 /* to prevent duplicate error messages */
958 if (immutable_old != NOSORTHANDLE &&
28bf4b0b 959 (sortTable[baseSort]->kind != SRT_PRIM) &&
960 (sortTable[baseSort]->abstract) &&
961 (!sortTable[baseSort]->mutable))
616915dd 962 {
963 /* already complained */
964 handle = NOSORTHANDLE;
965 }
966 else
967 { /* sort_makeImmutable must have succeeded */
968 sortNode outSort;
969
970 /* must not clash with any LSL sorts */
971 objName = sp (sp (underscoreSymbol, name),
972 lsymbol_fromChars ("_Obj"));
973 handle = sort_lookupName (objName);
974
28bf4b0b 975 outSort = (sortNode) dmalloc (sizeof (*outSort));
976 outSort->kind = SRT_OBJ;
977 outSort->name = objName;
978 outSort->tag = lsymbol_undefined;
979 outSort->baseSort = baseSort;
980 outSort->objSort = NOSORTHANDLE;
981 outSort->members = smemberInfo_undefined;
982 outSort->mutable = TRUE;
983 outSort->export = exporting;
984 outSort->imported = context_inImport ();
985 outSort->abstract = TRUE;
986 outSort->handle = handle;
616915dd 987
988 if (handle == NOSORTHANDLE)
989 {
990 if (sort_isNewEntry (outSort))
991 {
28bf4b0b 992 outSort->handle = handle = sort_enterNew (outSort);
616915dd 993 }
994 else
995 {
996 handle = sort_enterNew (outSort);
997 }
998 }
999 else
1000 {
1001 llassert (sortTable != NULL);
1002
28bf4b0b 1003 if ((sortTable[handle]->kind != SRT_OBJ)
1004 && sortTable[handle]->abstract
1005 && sortTable[handle]->mutable)
616915dd 1006 {
1007 sortError (t, handle, outSort);
1008 }
1009
28bf4b0b 1010 sortNode_free (outSort);
616915dd 1011 }
1012 }
1013 return handle;
1014}
1015
1016sort
1017sort_makeStr (ltoken opttagid)
1018{
1019 sortNode outSort;
1020 sort handle;
1021 bool isNewTag;
1022 lsymbol name;
1023
28bf4b0b 1024 outSort = (sortNode) dmalloc (sizeof (*outSort));
1025
616915dd 1026 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1027 /* isNewTag true means that the name generated is new */
1028
1029 if (ltoken_isUndefined (opttagid))
1030 {
1031 opttagid = ltoken_create (simpleId, newStructTag ());
1032
28bf4b0b 1033 outSort->realtag = FALSE;
616915dd 1034 }
1035 else
1036 {
28bf4b0b 1037 outSort->realtag = TRUE;
616915dd 1038 }
1039
1040 name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1041
1042 llassert (sortTable != NULL);
1043 handle = sort_lookupName (name);
28bf4b0b 1044 outSort->name = name;
1045 outSort->kind = SRT_STRUCT;
1046 outSort->tag = ltoken_getText (opttagid);
1047 outSort->baseSort = NOSORTHANDLE;
1048 outSort->objSort = NOSORTHANDLE;
1049 outSort->members = smemberInfo_undefined;
1050 outSort->export = exporting;
1051 outSort->mutable = TRUE;
1052 outSort->imported = context_inImport ();
1053 outSort->abstract = FALSE;
1054 outSort->handle = handle;
616915dd 1055
1056 if (handle == NOSORTHANDLE)
1057 {
1058 if (sort_isNewEntry (outSort))
1059 {
28bf4b0b 1060 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1061 }
1062 else
1063 {
28bf4b0b 1064 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1065 }
1066 }
1067 else
1068 {
28bf4b0b 1069 if (sortTable[handle]->kind != SRT_STRUCT)
616915dd 1070 {
1071 sortError (opttagid, handle, outSort);
1072 }
1073
28bf4b0b 1074 sortNode_free (outSort);
616915dd 1075 }
1076
1077 return handle;
1078}
1079
1080bool
1081sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1082{
1083 /* expect strSort to be in sort table but not yet filled in */
1084 /* return TRUE if it is "new" */
1085 sort tupleSort;
1086 sortNode sn;
1087
1088 llassert (sortTable != NULL);
1089 sn = sort_lookup (strSort);
1090
28bf4b0b 1091 if (sn->members == (smemberInfo *) 0)
616915dd 1092 {
28bf4b0b 1093 sortTable[strSort]->members = info;
616915dd 1094 tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1095 genStrOps (strSort, tupleSort);
1096 return TRUE;
1097 }
1098 else
1099 {
1100 smemberInfo_free (info);
1101 return FALSE;
1102 }
1103}
1104
1105sort
1106sort_makeTuple (ltoken t, sort strSort)
1107{
1108 sort handle;
1109 sortNode outSort, s = sort_lookup (strSort);
1110 lsymbol name;
1111
28bf4b0b 1112 if (s->kind != SRT_STRUCT)
616915dd 1113 {
1114 llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
28bf4b0b 1115 sort_unparseKind (s->kind)));
616915dd 1116 }
1117
28bf4b0b 1118 name = sp (s->name, lsymbol_fromChars ("_Tuple"));
616915dd 1119 llassert (sortTable != NULL);
1120 handle = sort_lookupName (name);
1121
28bf4b0b 1122 outSort = (sortNode) dmalloc (sizeof (*outSort));
1123 outSort->kind = SRT_TUPLE;
1124 outSort->name = name;
1125 outSort->tag = s->tag;
1126 outSort->realtag = s->realtag;
1127 outSort->baseSort = strSort;
1128 outSort->objSort = NOSORTHANDLE;
1129 outSort->members = smemberInfo_undefined;
1130 outSort->export = exporting;
1131 outSort->abstract = FALSE;
1132 outSort->imported = context_inImport ();
1133 outSort->mutable = FALSE;
1134 outSort->handle = handle;
616915dd 1135
1136 if (handle == NOSORTHANDLE)
1137 {
1138 if (sort_isNewEntry (outSort))
1139 {
28bf4b0b 1140 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1141
1142 sort_addTupleMembers (handle, strSort);
1143 genTupleOps (handle);
1144 }
1145 else
1146 {
28bf4b0b 1147 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1148 }
1149 }
1150 else
1151 {
28bf4b0b 1152 if (sortTable[handle]->kind != SRT_TUPLE)
616915dd 1153 {
1154 sortError (t, handle, outSort);
1155 }
1156
28bf4b0b 1157 sortNode_free (outSort);
616915dd 1158 }
1159
1160 return handle;
1161}
1162
1163static void
1164sort_addTupleMembers (sort tupleSort, sort strSort)
1165{
1166 smemberInfo *mem, *tail = smemberInfo_undefined;
1167 smemberInfo *top = smemberInfo_undefined;
1168 smemberInfo *newinfo;
1169
1170 /* make sure it works for empty smemberInfo */
1171
1172 llassert (sortTable != NULL);
28bf4b0b 1173
1174 for (mem = sortTable[strSort]->members;
616915dd 1175 mem != smemberInfo_undefined; mem = mem->next)
1176 {
1177 newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1178 newinfo->name = mem->name;
1179 newinfo->sort = sort_makeVal (mem->sort);
1180 newinfo->next = smemberInfo_undefined;
1181
1182 if (top == smemberInfo_undefined)
1183 { /* start of iteration */
1184 top = newinfo;
1185 tail = newinfo;
1186 }
1187 else
1188 {
1189 llassert (tail != smemberInfo_undefined);
1190
1191 tail->next = newinfo;
1192 tail = newinfo;
1193 /*@-branchstate@*/ /* tail is dependent */
1194 }
1195 /*@=branchstate@*/
1196 }
1197
28bf4b0b 1198 sortTable[tupleSort]->members = top;
616915dd 1199}
1200
1201static
1202void genTupleOps (sort tupleSort)
1203{
1204 ltoken range, dom;
1205 sort fieldsort;
1206 smemberInfo *m;
1207 unsigned int memCount;
1208 ltokenList domain = ltokenList_new ();
1209 sigNode signature;
1210 opFormUnion u;
1211 opFormNode opform;
1212 nameNode nn;
1213
1214 memCount = 0;
1215 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1216
1217 llassert (sortTable != NULL);
28bf4b0b 1218 for (m = sortTable[tupleSort]->members;
616915dd 1219 m != smemberInfo_undefined; m = m->next)
1220 {
1221 fieldsort = sort_makeVal (m->sort);
1222 overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1223
1224 dom = ltoken_createType (simpleId, SID_SORT,
1225 sort_getLsymbol (fieldsort));
1226 ltokenList_addh (domain, dom);
1227 memCount++;
1228 }
1229
1230 /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1231 signature = makesigNode (ltoken_undefined, domain, range);
1232 u.middle = memCount;
1233
1234 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1235 OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1236
1237 nn = makeNameNodeForm (opform);
1238 symtable_enterOp (g_symtab, nn, signature);
1239
1240 /*
1241 ** should not be able to take sizeof (struct^) ...
1242 */
1243}
1244
1245static
1246void genUnionOps (sort tupleSort)
1247{
1248 /* like genTupleOps but no constructor [ ...]: -> unionSort */
1249 smemberInfo *m;
1250 sort sort;
1251
1252 llassert (sortTable != NULL);
28bf4b0b 1253 for (m = sortTable[tupleSort]->members;
616915dd 1254 m != smemberInfo_undefined; m = m->next)
1255 {
1256 /* Generate __.memName: strSort ->memSortObj */
1257 overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1258 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1259 sort_getName (tupleSort), sort_getName (m->sort)); */
1260 /* __->memName : Union_Ptr -> memSortObj */
1261 sort = sort_makePtr (ltoken_undefined, tupleSort);
1262 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1263 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1264 sort_getName (sort), sort_getName (m->sort)); */
1265 }
1266}
1267
1268static
1269void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1270{
1271 smemberInfo *m;
1272 sort sort;
1273
1274 llassert (sortTable != NULL);
28bf4b0b 1275 for (m = sortTable[strSort]->members;
616915dd 1276 m != smemberInfo_undefined; m = m->next)
1277 {
1278 /* Generate __.memName: strSort ->memSortObj */
1279 overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1280 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1281 sort_getName (strSort), sort_getName (m->sort)); */
1282 /* __->memName : Struct_Ptr -> memSortObj */
1283 sort = sort_makePtr (ltoken_undefined, strSort);
1284 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1285 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1286 sort_getName (sort), sort_getName (m->sort)); */
1287 }
1288 /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1289 /* Generate __any, __pre, __post: nStruct -> nTuple */
1290 /* Generate sizeof: strSort -> int */
1291 /* overloadStateFcns (strSort, tupleSort); */
1292}
1293
1294sort
1295sort_makeUnion (ltoken opttagid)
1296{
1297 sortNode outSort;
1298 sort handle;
1299 bool isNewTag;
1300 lsymbol name;
1301
1302 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1303 /* isNewTag true means that the name generated is new */
1304
28bf4b0b 1305 outSort = (sortNode) dmalloc (sizeof (*outSort));
1306
616915dd 1307 if (ltoken_isUndefined (opttagid))
1308 {
1309 opttagid = ltoken_create (simpleId, newUnionTag ());
28bf4b0b 1310 outSort->realtag = FALSE;
616915dd 1311 }
1312 else
28bf4b0b 1313 {
1314 outSort->realtag = TRUE;
1315 }
616915dd 1316
1317 llassert (sortTable != NULL);
1318 name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1319 handle = sort_lookupName (name);
28bf4b0b 1320 outSort->name = name;
1321 outSort->kind = SRT_UNION;
1322 outSort->tag = ltoken_getText (opttagid);
1323 outSort->baseSort = NOSORTHANDLE;
1324 outSort->objSort = NOSORTHANDLE;
1325 outSort->members = smemberInfo_undefined;
1326 outSort->export = exporting;
1327 outSort->mutable = TRUE;
1328 outSort->imported = context_inImport ();
1329 outSort->abstract = FALSE;
1330 outSort->handle = handle;
616915dd 1331
1332 if (handle == NOSORTHANDLE)
1333 {
1334 if (sort_isNewEntry (outSort))
1335 {
28bf4b0b 1336 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1337 }
1338 else
1339 {
28bf4b0b 1340 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1341 }
1342 }
1343 else
1344 {
28bf4b0b 1345 if (sortTable[handle]->kind != SRT_UNION)
616915dd 1346 {
1347 sortError (opttagid, handle, outSort);
1348 }
1349
28bf4b0b 1350 sortNode_free (outSort);
616915dd 1351 }
1352
1353 return handle;
1354}
1355
1356bool
1357sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1358{
1359 /* expect unionSort to be in sort table but not yet filled in */
1360 /* return TRUE if it is "new" */
1361 sort uValSort;
1362 sortNode sn;
1363
1364 llassert (sortTable != NULL);
1365
1366 sn = sort_lookup (unionSort);
1367
28bf4b0b 1368 if (sn->members == (smemberInfo *) 0)
616915dd 1369 {
28bf4b0b 1370 sortTable[unionSort]->members = info;
616915dd 1371 uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1372 /* same as struct operations */
1373 genStrOps (unionSort, uValSort);
1374 return TRUE;
1375 }
1376 else
1377 {
1378 smemberInfo_free (info);
1379 return FALSE;
1380 }
1381}
1382
1383sort
1384sort_makeUnionVal (ltoken t, sort unionSort)
1385{
1386 sort handle;
1387 sortNode outSort, s = sort_lookup (unionSort);
1388 lsymbol name;
1389
28bf4b0b 1390 if (s->kind != SRT_UNION)
616915dd 1391 {
1392 llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
28bf4b0b 1393 sort_unparseKind (s->kind)));
616915dd 1394 }
1395
1396 llassert (sortTable != NULL);
1397
28bf4b0b 1398 name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
616915dd 1399 handle = sort_lookupName (name);
1400
28bf4b0b 1401 outSort = (sortNode) dmalloc (sizeof (*outSort));
1402 outSort->kind = SRT_UNIONVAL;
1403 outSort->name = name;
1404 outSort->tag = s->tag;
1405 outSort->realtag = s->realtag;
1406 outSort->baseSort = unionSort;
1407 outSort->objSort = NOSORTHANDLE;
1408 outSort->members = smemberInfo_undefined;
1409 outSort->export = exporting;
1410 outSort->abstract = FALSE;
1411 outSort->imported = context_inImport ();
1412 outSort->mutable = FALSE;
1413 outSort->handle = handle;
616915dd 1414
1415 if (handle == NOSORTHANDLE)
1416 {
1417 if (sort_isNewEntry (outSort))
1418 {
28bf4b0b 1419 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1420
1421 /* Add members to the unionVal's. */
1422 /* same as structs and tuples */
1423
1424 sort_addTupleMembers (handle, unionSort);
1425 genUnionOps (handle);
1426 }
1427 else
1428 {
28bf4b0b 1429 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1430 }
1431 }
1432 else
1433 {
28bf4b0b 1434 if (sortTable[handle]->kind != SRT_UNIONVAL)
616915dd 1435 {
1436 sortError (t, handle, outSort);
1437 }
1438
28bf4b0b 1439 sortNode_free (outSort);
616915dd 1440 }
1441
1442 return handle;
1443}
1444
1445static lsymbol
1446newEnumTag ()
1447{
1448 static int ecount = 0;
1449
1450 return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1451}
1452
1453static lsymbol
1454newStructTag ()
1455{
1456 static int ecount = 0;
1457
1458 return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1459}
1460
1461static lsymbol
1462newUnionTag ()
1463{
1464 static int ecount = 0;
1465
1466 return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1467}
1468
1469sort
1470sort_makeEnum (ltoken opttagid)
1471{
1472 sortNode outSort;
1473 sort handle;
1474 bool isNew;
1475 lsymbol name;
1476
1477 llassert (sortTable != NULL);
1478
28bf4b0b 1479 outSort = (sortNode) dmalloc (sizeof (*outSort));
1480
616915dd 1481 if (ltoken_isUndefined (opttagid))
1482 {
1483 opttagid = ltoken_create (simpleId, newEnumTag ());
28bf4b0b 1484 outSort->realtag = FALSE;
616915dd 1485 }
1486 else
28bf4b0b 1487 {
1488 outSort->realtag = TRUE;
1489 }
616915dd 1490
1491 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1492
1493 name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1494 handle = sort_lookupName (name);
28bf4b0b 1495 outSort->name = name;
1496 outSort->kind = SRT_ENUM;
1497 outSort->tag = ltoken_getText (opttagid);
1498 outSort->baseSort = NOSORTHANDLE;
1499 outSort->objSort = NOSORTHANDLE;
1500 outSort->members = smemberInfo_undefined;
1501 outSort->export = exporting;
1502 outSort->mutable = FALSE;
1503 outSort->imported = context_inImport ();
1504 outSort->abstract = FALSE;
1505 outSort->handle = handle;
616915dd 1506
1507 if (handle == NOSORTHANDLE)
1508 {
1509 if (sort_isNewEntry (outSort))
1510 {
28bf4b0b 1511 outSort->handle = handle = sort_enterNew (outSort);
616915dd 1512 }
1513 else
1514 {
28bf4b0b 1515 outSort->handle = handle = sort_enterNewForce (outSort);
616915dd 1516 }
1517 }
1518 else
1519 {
28bf4b0b 1520 if (sortTable[handle]->kind != SRT_ENUM)
616915dd 1521 {
1522 sortError (opttagid, handle, outSort);
1523 }
1524
28bf4b0b 1525 sortNode_free (outSort);
616915dd 1526 }
1527
1528 return handle;
1529}
1530
1531bool
1532sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1533{
1534 /*
1535 ** Expect enumSort to be in sort table but not yet filled in.
1536 ** Return TRUE if it is "new"
1537 */
1538
1539 sortNode sn;
1540
1541 llassert (sortTable != NULL);
1542
1543 sn = sort_lookup (enumSort);
28bf4b0b 1544 if (sn->members == (smemberInfo *) 0)
616915dd 1545 {
28bf4b0b 1546 sortTable[enumSort]->members = info;
616915dd 1547 genEnumOps (enumSort);
1548 return TRUE;
1549 }
1550 else
1551 {
1552 smemberInfo_free (info);
1553 return FALSE;
1554 }
1555}
1556
1557static
1558void genEnumOps (sort enumSort)
1559{
1560 smemberInfo *ei;
1561 ltokenList domain = ltokenList_new ();
1562 ltoken range, mem;
1563 nameNode nn;
1564 sigNode signature;
1565
1566 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1567 signature = makesigNode (ltoken_undefined, domain, range);
1568
1569 llassert (sortTable != NULL);
1570
28bf4b0b 1571 for (ei = sortTable[enumSort]->members;
616915dd 1572 ei != (smemberInfo *) 0; ei = ei->next)
1573 {
1574 mem = ltoken_createType (simpleId, SID_OP, ei->name);
1575 nn = makeNameNodeId (mem);
1576 symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1577 }
1578
1579 sigNode_free (signature);
1580 overloadSizeof (enumSort);
1581}
1582
1583static void
1584genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1585{
1586 /* Generate *__: xPtr -> x */
1587
1588 /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1589
1590 /* Generate maxIndex, minIndex: xPtr -> int */
1591 /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1592 /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1593
1594 /* Generate __[]: pointer -> array */
1595 overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1596
1597 /* Generate __+__, __-__: pointer, int -> pointer */
1598 overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1599 ltoken_copy (intToken), ptrSort);
1600
1601 overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1602 ltoken_copy (intToken), ptrSort);
1603
1604 /* Generate NIL: -> xPtr */
1605 /* Generate __+__: int, pointer -> pointer */
1606 /* Generate __-__: pointer, pointer -> int */
1607 overloadPtrFcns (ptrSort);
1608}
1609
1610static void
1611genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1612{
1613 /* Generate __[__]: nArr, int -> n */
1614 overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1615 ltoken_copy (intToken), baseSort);
1616
1617 /* Generate maxIndex, minIndex: sort -> int */
1618 /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1619 /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1620
1621 /* Generate isSub: arraySort, int, ... -> bool */
1622 overloadIsSub (arraySort, dim);
1623
1624 /* Generate fresh, trashed, modifies, unchanged: array -> bool */
1625 /* Generate any, pre, post: array -> vector */
1626
1627 /* overloadStateFcns (arraySort, vecSort); */
1628 /* overloadObjFcns (arraySort); */
1629}
1630
1631/*
1632** overloadPtrFcns:
1633** generate NIL: -> ptrSort
1634** __+__: int, ptrSort -> ptrSort
1635** __-__: ptrSort, ptrSort -> int
1636*/
1637static void
1638overloadPtrFcns (sort ptrSort)
1639{
1640 ltokenList domain = ltokenList_new ();
1641 ltoken range;
1642 sigNode signature;
1643
1644 /* NIL: -> ptrSort */
1645
1646 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1647 signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1648 symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1649
1650 /* __+__: int, ptrSort -> ptrSort */
1651
1652 ltokenList_addh (domain, ltoken_copy (intToken));
1653 ltokenList_addh (domain, ltoken_copy (range));
1654
1655 signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1656 symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1657
1658 /* __-__: ptrSort, ptrSort -> int */
1659
1660 domain = ltokenList_new ();
1661 ltokenList_addh (domain, ltoken_copy (range));
1662 ltokenList_addh (domain, range);
1663 range = ltoken_copy (intToken);
1664 signature = makesigNode (ltoken_undefined, domain, range);
1665 symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1666}
1667
1668static void
1669genVecOps (sort baseSort, sort vecSort, int dim)
1670{
1671 /* Generate __[__]: vecSort, int -> baseSort */
1672
1673 overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1674 ltoken_copy (intToken), baseSort);
1675
1676 /* sizeof: vecSort -> int */
1677 /* Generate isSub: vecSort, int, ... -> bool */
1678
1679 overloadIsSub (vecSort, dim);
1680}
1681
1682static void
1683overloadIsSub (sort s, int dim)
1684{
1685 /* Generate isSub: s, int, ... -> bool */
1686 int j, i;
1687 ltoken dom, nulltok = ltoken_undefined;
1688 ltokenList domain;
1689 sigNode signature;
1690
1691 for (j = 1; j <= dim; j++)
1692 {
1693 nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1694
1695 isSubNameNode->isOpId = TRUE;
1696 isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1697 lsymbol_fromChars ("isSub"));
1698 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1699
1700 domain = ltokenList_singleton (dom);
1701
1702 for (i = 1; i <= j; i++)
1703 {
1704 ltokenList_addh (domain, ltoken_copy (intToken));
1705 }
1706
1707 signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1708 symtable_enterOp (g_symtab, isSubNameNode, signature);
1709 }
1710}
1711
1712static void
1713overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1714{
1715 /* Generate <nn>: domainSort -> rangeTok */
1716 sigNode signature;
1717 ltoken dom;
1718 ltokenList domain;
1719
1720 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1721 domain = ltokenList_singleton (dom);
1722 signature = makesigNode (ltoken_undefined, domain, range);
1723 symtable_enterOp (g_symtab, nn, signature);
1724}
1725
1726static void
1727overloadSizeof (sort domainSort)
1728{
1729 nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1730
1731 sizeofNameNode->isOpId = TRUE;
1732 sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1733 lsymbol_fromChars ("sizeof"));
1734
1735 overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1736}
1737
1738static void
1739overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1740{
1741 ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1742
1743 overloadUnaryTok (nn, domainSort, range);
1744}
1745
1746static void
1747overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1748{
1749 /* Generate <nn>: s, dTok -> rs */
1750 sigNode signature;
1751 ltoken range, dom;
1752 ltokenList domain = ltokenList_new ();
1753
1754 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1755 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1756
1757 ltokenList_addh (domain, dom);
1758 ltokenList_addh (domain, dTok);
1759
1760 signature = makesigNode (ltoken_undefined, domain, range);
1761 symtable_enterOp (g_symtab, nn, signature);
1762}
1763
1764static /*@only@*/ nameNode
1765makeFieldOp (lsymbol field)
1766{
1767 /* operator: __.<field> */
1768 nameNode nn;
1769 opFormUnion u;
1770 opFormNode opform;
1771
1772 u.id = ltoken_createType (simpleId, SID_OP, field);
1773 opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1774 nn = makeNameNodeForm (opform);
1775 return nn;
1776}
1777
1778static /*@only@*/ nameNode
1779makeArrowFieldOp (lsymbol field)
1780{
1781 /* operator: __-><field> */
1782 nameNode nn;
1783 opFormUnion u;
1784 opFormNode opform;
1785
1786 u.id = ltoken_createType (simpleId, SID_OP, field);
1787 opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1788 nn = makeNameNodeForm (opform);
1789 return nn;
1790}
1791
1792void
1793sort_init (void)
28bf4b0b 1794 /*@globals undef arrayRefNameNode,
616915dd 1795 undef ptr2arrayNameNode,
1796 undef deRefNameNode,
1797 undef nilNameNode,
1798 undef plusNameNode,
1799 undef minusNameNode,
1800 undef condNameNode,
1801 undef eqNameNode,
1802 undef neqNameNode,
1803 undef intToken; @*/
1804{
1805 /* on alpha, declaration does not allocate storage */
28bf4b0b 1806 sortNode noSort, HOFSort;
616915dd 1807 opFormNode opform;
1808 opFormUnion u;
1809 underscoreSymbol = lsymbol_fromChars ("_");
1810
1811 /*
1812 ** commonly used data for generating operators
1813 */
1814
1815 lsymbol_setbool (lsymbol_fromChars ("bool"));
1816 intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1817
1818 /*
1819 ** __ \eq __: sort, sort -> bool
1820 */
1821
1822 u.anyop = ltoken_copy (ltoken_eq);
1823 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1824 eqNameNode = makeNameNodeForm (opform);
1825
1826 /*
1827 ** __ \neq __: sort, sort -> bool
1828 */
1829
1830 u.anyop = ltoken_copy (ltoken_neq);
1831 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1832 neqNameNode = makeNameNodeForm (opform);
1833
1834 /*
1835 **if __ then __ else __: bool, sort, sort -> sort
1836 */
1837
1838 opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1839 opFormUnion_createMiddle (0), ltoken_undefined);
1840 condNameNode = makeNameNodeForm (opform);
1841
1842 /* operator: __[__]: arraySort, int -> elementSort_Obj */
1843 u.middle = 1;
1844 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1845 ltoken_copy (ltoken_rbracket));
1846 arrayRefNameNode = makeNameNodeForm (opform);
1847
1848 /* operator: __[]: ptrSort -> arraySort */
1849 u.middle = 0;
1850 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1851 OPF_BMMIDDLE, u,
1852 ltoken_copy (ltoken_rbracket));
1853 ptr2arrayNameNode = makeNameNodeForm (opform);
1854
1855 /* operator: *__ */
1856 u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1857 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1858 deRefNameNode = makeNameNodeForm (opform);
1859
1860 /* operator: __ + __ */
1861 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1862 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1863 plusNameNode = makeNameNodeForm (opform);
1864
1865 /* operator: __ - __ */
1866 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1867 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1868 minusNameNode = makeNameNodeForm (opform);
1869
1870 /* operator: NIL */
1871 nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1872 nilNameNode->isOpId = TRUE;
1873 nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1874 lsymbol_fromChars ("NIL"));
1875
28bf4b0b 1876 noSort = (sortNode) dmalloc (sizeof (*noSort));
1877 noSort->kind = SRT_NONE;
1878 noSort->name = lsymbol_fromChars ("_unknown");;
1879 noSort->tag = lsymbol_undefined;
1880 noSort->baseSort = NOSORTHANDLE;
1881 noSort->objSort = NOSORTHANDLE;
1882 noSort->members = smemberInfo_undefined;
1883 noSort->export = FALSE;
1884 noSort->mutable = FALSE;
1885 noSort->abstract = FALSE;
1886 noSort->imported = FALSE;
1887 noSort->handle = NOSORTHANDLE;
616915dd 1888
28bf4b0b 1889 HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1890 HOFSort->kind = SRT_HOF;
1891 HOFSort->handle = HOFSORTHANDLE;
1892 HOFSort->name = lsymbol_undefined;
1893 HOFSort->tag = lsymbol_undefined;
1894 HOFSort->realtag = FALSE;
1895 HOFSort->baseSort = NOSORTHANDLE;
1896 HOFSort->objSort = NOSORTHANDLE;
1897 HOFSort->members = smemberInfo_undefined;
1898 HOFSort->export = FALSE;
1899 HOFSort->mutable = FALSE;
1900 HOFSort->abstract = FALSE;
1901 HOFSort->imported = FALSE;
1902
616915dd 1903 /*
1904 ** Store the null sort into table, and in the process initialize the sort table.
1905 ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1906 ** for HOFSORTHANDLE = 1.
1907 */
1908
28bf4b0b 1909 (void) sort_enterGlobal (noSort);
616915dd 1910 (void) sort_enterGlobal (HOFSort);
1911
1912 /* Other builtin sorts */
1913
1914 sort_bool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1915 sort_capBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1916
1917 llassert (sortTable != NULL);
1918
1919 /* make sort_Bool a synonym for sort_bool */
28bf4b0b 1920 sortTable[sort_capBool]->kind = SRT_SYN;
1921 sortTable[sort_capBool]->baseSort = sort_bool;
1922 sortTable[sort_capBool]->mutable = FALSE;
1923 sortTable[sort_capBool]->abstract = TRUE;
616915dd 1924
1925 sort_int = sort_makeLiteralSort (ltoken_undefined,
1926 lsymbol_fromChars ("int"));
1927 sort_char = sort_makeLiteralSort (ltoken_undefined,
1928 lsymbol_fromChars ("char"));
1929 sort_void = sort_makeLiteralSort (ltoken_undefined,
1930 lsymbol_fromChars ("void"));
1931
1932 /* sort_cstring is char__Vec, for C strings eg: "xyz" */
1933 char_obj_ptrSort = sort_makePtr (ltoken_undefined, sort_char);
1934 char_obj_ArrSort = sort_makeArr (ltoken_undefined, sort_char);
1935
1936 sort_cstring = sort_makeVal (char_obj_ArrSort);
1937 sort_float = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1938 sort_double = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1939}
1940
1941sort
1942sort_lookupName (lsymbol name)
1943{
1944 long int i;
1945
1946 if (name == lsymbol_undefined)
1947 {
1948 return NOSORTHANDLE;
1949 }
1950
1951 llassert (sortTable != NULL);
1952
1953 for (i = 0; i < sortTableSize; i++)
1954 {
28bf4b0b 1955 if (sortTable[i]->name == name)
616915dd 1956 {
1957 return i;
1958 }
1959 }
1960
1961 return NOSORTHANDLE;
1962}
1963
1964static bool
1965sort_isNewEntry (sortNode s)
1966{
1967 int i;
1968
1969 for (i = 0; i < sortTableSize; i++)
1970 {
1971 llassert (sortTable != NULL);
1972
28bf4b0b 1973 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
616915dd 1974 {
1975 return FALSE;
1976 }
1977 }
1978 return TRUE;
1979}
1980
1981static sort
1982sort_enterGlobal (sortNode s)
1983{
28bf4b0b 1984 return (sort_enterNew (s));
616915dd 1985}
1986
1987static sort
1988sort_enterNew (sortNode s)
1989{
28bf4b0b 1990 /*
1991 ** This ensures that the argument sortNode is not entered into
1992 ** the sort table more than once. isNew flag will tell the
1993 ** caller this info, and the caller will decide whether to generate
1994 ** operators for this sort.
1995 */
1996
616915dd 1997 long int i;
1998
1999 for (i = 0; i < sortTableSize; i++)
2000 {
2001 llassert (sortTable != NULL);
2002
28bf4b0b 2003 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
616915dd 2004 {
2005 sortNode_free (s);
2006 return i;
2007 }
2008 }
2009
2010 if (sortTableSize >= sortTableAlloc)
2011 {
2012 sortNode *oldSortTable = sortTable;
2013
2014 sortTableAlloc += DELTA;
2015 sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2016
2017 if (sortTableSize > 0)
2018 {
2019 llassert (oldSortTable != NULL);
2020 for (i = 0; i < sortTableSize; i++)
2021 {
2022 sortTable[i] = oldSortTable[i];
2023 }
2024 }
2025
2026 sfree (oldSortTable);
2027 }
2028
2029 llassert (sortTable != NULL);
2030
28bf4b0b 2031 s->handle = sortTableSize;
616915dd 2032 sortTable[sortTableSize++] = s;
2033
2034 /*@-compdef@*/
28bf4b0b 2035 return s->handle;
616915dd 2036} /*=compdef@*/
2037
2038static sort sort_enterNewForce (sortNode s)
2039{
28bf4b0b 2040 sort sor = sort_lookupName (s->name);
616915dd 2041
28bf4b0b 2042 if (sort_isNoSort (sor))
2043 {
2044 sor = sort_enterNew (s);
2045 llassert (sortTable != NULL);
2046 /*@-usereleased@*/
2047 llassert (sortTable[sor] == s);
2048 /*@=usereleased@*/
2049 }
2050 else
2051 {
2052 s->handle = sor;
2053 llassert (sortTable != NULL);
2054 sortTable[sor] = s;
2055 }
616915dd 2056
2057 /*@-globstate@*/ return (sor); /*@=globstate@*/
2058}
2059
2060void
2061sort_printStats (void)
2062{
2063 /* only for debugging */
2064 printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2065 sortTableAlloc);
2066}
2067
2068sortNode
2069sort_lookup (sort sor)
2070{
2071 /* ymtan: can sor be 0 ? */
2072 /* evs --- yup...0 should return noSort ? */
2073
2074 if (sor > 0U && sor < (unsigned) sortTableSize)
2075 {
2076 llassert (sortTable != NULL);
2077 return sortTable[sor];
2078 }
2079
2080 llassert (sor == 0);
28bf4b0b 2081 llassert (sor == NOSORTHANDLE);
2082 llassert (sortTable != NULL);
2083 return sortTable[NOSORTHANDLE];
616915dd 2084}
2085
2086sortNode
2087sort_quietLookup (sort sor)
2088{
2089 /* ymtan: can sor be 0 ? */
2090 if (sor > 0U && sor < (unsigned) sortTableSize)
2091 {
2092 llassert (sortTable != NULL);
2093 return (sortTable[sor]);
2094 }
2095 else
2096 {
28bf4b0b 2097 llassert (sortTable != NULL);
2098 return (sortTable[NOSORTHANDLE]);
616915dd 2099 }
2100}
2101
2102static cstring
2103printEnumMembers (/*@null@*/ smemberInfo *list)
2104{
2105 cstring out = cstring_undefined;
2106 smemberInfo *m;
2107
2108 for (m = list; m != (smemberInfo *) 0; m = m->next)
2109 {
2110 out = cstring_concat (out, lsymbol_toString (m->name));
2111
2112 if (m->next != (smemberInfo *) 0)
2113 {
2114 out = cstring_concatChars (out, ", ");
2115 }
2116 }
2117 return out;
2118}
2119
2120static /*@only@*/ cstring
2121printStructMembers (/*@null@*/ smemberInfo *list)
2122{
2123 cstring ret = cstring_undefined;
2124 smemberInfo *m;
2125
2126 for (m = list; m != (smemberInfo *) 0; m = m->next)
2127 {
2128 ret = message ("%q%q %s; ",
2129 ret, sort_unparse (m->sort),
2130 cstring_fromChars (lsymbol_toChars (m->name)));
2131 }
2132
2133 return ret;
2134}
2135
2136/*@only@*/ cstring
2137sort_unparse (sort s)
2138{
2139 /* printing routine for sorts */
2140 sortNode sn;
2141 lsymbol name;
2142
2143 sn = sort_quietLookup (s);
28bf4b0b 2144 name = sn->name;
616915dd 2145
28bf4b0b 2146 switch (sn->kind)
616915dd 2147 {
2148 case SRT_NONE:
2149 if (name == lsymbol_undefined)
2150 {
2151 return cstring_makeLiteral ("_unknown");
2152 }
2153
2154 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2155 case SRT_HOF:
2156 return cstring_makeLiteral ("procedural");
2157 case SRT_PRIM:
2158 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2159 case SRT_SYN:
2160 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2161
2162 case SRT_PTR:
28bf4b0b 2163 return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
616915dd 2164 case SRT_OBJ:
28bf4b0b 2165 return (message ("obj %q", sort_unparse (sn->baseSort)));
616915dd 2166 case SRT_ARRAY:
28bf4b0b 2167 return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
616915dd 2168 case SRT_VECTOR:
28bf4b0b 2169 return (message ("vector of %q", sort_unparse (sn->baseSort)));
616915dd 2170 case SRT_TUPLE:
28bf4b0b 2171 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2172 {
28bf4b0b 2173 return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2174 }
2175 else
2176 {
28bf4b0b 2177 return (message ("struct {%q}", printStructMembers (sn->members)));
616915dd 2178 }
2179 case SRT_UNIONVAL:
28bf4b0b 2180 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2181 {
28bf4b0b 2182 return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2183 }
2184 else
2185 {
28bf4b0b 2186 return (message ("union {%q}", printStructMembers (sn->members)));
616915dd 2187 }
2188 case SRT_ENUM:
28bf4b0b 2189 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2190 {
28bf4b0b 2191 return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2192 }
2193 else
2194 {
28bf4b0b 2195 return (message ("enum {%q}", printEnumMembers (sn->members)));
616915dd 2196 }
2197 case SRT_STRUCT:
28bf4b0b 2198 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2199 {
28bf4b0b 2200 return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2201 }
2202 else
2203 {
28bf4b0b 2204 return (message ("obj struct {%q}", printStructMembers (sn->members)));
616915dd 2205 }
2206 case SRT_UNION:
28bf4b0b 2207 if (sn->tag != lsymbol_undefined && sn->realtag)
616915dd 2208 {
28bf4b0b 2209 return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
616915dd 2210 }
2211 else
2212 {
28bf4b0b 2213 return (message ("obj union {%q}", printStructMembers (sn->members)));
616915dd 2214 }
2215 default:
2216 return (cstring_makeLiteral ("illegal"));
2217 }
2218}
2219
2220static lsymbol
2221sp (lsymbol s1, lsymbol s2)
2222{
2223 char buff[MAXBUFFLEN];
2224 char *name1Ptr;
2225 char *name2Ptr;
2226 int temp_length;
2227
2228 name1Ptr = lsymbol_toCharsSafe (s1);
2229 name2Ptr = lsymbol_toCharsSafe (s2);
2230
2231 if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2232 {
2233 temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2234 llfatalbug (message ("sp: name too long: %s%s",
2235 cstring_fromChars (name1Ptr),
2236 cstring_fromChars (name2Ptr)));
2237 }
2238
2239 strcpy (&buff[0], name1Ptr);
2240 strcat (&buff[0], name2Ptr);
2241
2242 return lsymbol_fromChars (&buff[0]);
2243}
2244
2245static lsymbol
2246sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2247{
2248 /*
2249 ** kind could be struct, union or enum. Create a unique sort
2250 ** name based on the given info. But first check that tagid
2251 ** has not been defined already. (ok if it is a forward decl)
2252 **/
2253
2254 tagInfo to;
2255
2256 if (ltoken_isUndefined (tagid))
2257 {
2258 *isNew = TRUE;
2259 return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2260 }
2261 else
2262 {
2263 to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2264
2265 if (tagInfo_exists (to))
2266 {
2267 *isNew = FALSE;
2268 }
2269 else
2270 {
2271 *isNew = TRUE;
2272 }
2273
2274 return (cstring_toSymbol (message ("_%s_%s",
2275 ltoken_unparse (tagid),
2276 cstring_fromChars (kind))));
2277 }
2278}
2279
2280/*@constant int MAX_SORT_DEPTH@*/
2281# define MAX_SORT_DEPTH 10
2282
2283static sort
2284sort_getUnderlyingAux (sort s, int depth)
2285{
2286 sortNode sn = sort_quietLookup (s);
2287
28bf4b0b 2288 if (sn->kind == SRT_SYN)
616915dd 2289 {
2290 if (depth > MAX_SORT_DEPTH)
2291 {
2292 llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2293 return s;
2294 }
2295
28bf4b0b 2296 return sort_getUnderlyingAux (sn->baseSort, depth + 1);
616915dd 2297 }
2298
2299 return s;
2300}
2301
2302sort
2303sort_getUnderlying (sort s)
2304{
2305 return sort_getUnderlyingAux (s, 0);
2306}
2307
2308static lsymbol
2309underlyingSortName (sortNode sn)
2310{
28bf4b0b 2311 if (sn->kind == SRT_SYN)
2312 return underlyingSortName (sort_quietLookup (sn->baseSort));
2313 return sn->name;
616915dd 2314}
2315
2316static /*@observer@*/ sortNode
2317underlyingSortNode (sortNode sn)
2318{
28bf4b0b 2319 if (sn->kind == SRT_SYN)
616915dd 2320 {
28bf4b0b 2321 return underlyingSortNode (sort_quietLookup (sn->baseSort));
616915dd 2322 }
2323
2324 return sn;
2325}
2326
2327bool
2328sort_mutable (sort s)
2329{
2330 /* if s is not a valid sort, then returns false */
2331 sortNode sn = sort_quietLookup (s);
28bf4b0b 2332 if (sn->mutable)
616915dd 2333 return TRUE;
2334 return FALSE;
2335}
2336
2337bool
2338sort_setExporting (bool flag)
2339{
2340 bool old;
2341 old = exporting;
2342 exporting = flag;
2343 return old;
2344}
2345
2346/*@observer@*/ static cstring
2347sort_unparseKind (sortKind k)
2348{
2349 if (k > SRT_FIRST && k < SRT_LAST)
2350 return (cstring_fromChars (sortKindName[(int)k]));
2351 else
2352 return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2353}
2354
2355bool
2356sort_isValidSort (sort s)
2357{
2358 sortNode sn = sort_quietLookup (s);
28bf4b0b 2359 sortKind k = sn->kind;
616915dd 2360 if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2361 return TRUE;
2362 else
2363 return FALSE;
2364}
2365
2366void
2367sort_dump (FILE *f, bool lco)
2368{
2369 int i;
2370 sortNode s;
2371 smemberInfo *mem;
2372
2373 fprintf (f, "%s\n", BEGINSORTTABLE);
2374 llassert (sortTable != NULL);
2375
2376 for (i = 2; i < sortTableSize; i++)
2377 {
2378 /* skips 0 and 1, noSort and HOFSort */
2379 s = sortTable[i];
2380
2381 /* if (lco && !s.export) continue; */
2382 /* Difficult to keep track of where each op and sort belong to
2383 which LCL type. Easiest to export them all (even private sorts and
2384 op's) but for checking imported modules, we only use LCL types and
2385 variables to check, i.e., we don't rely on sorts and op's for such
2386 checking. */
2387
28bf4b0b 2388 if (s->kind == SRT_NONE)
616915dd 2389 continue;
2390
2391 if (lco)
2392 {
2393 fprintf (f, "%%LCL");
2394 }
2395
28bf4b0b 2396 if (lsymbol_isDefined (s->name))
616915dd 2397 {
28bf4b0b 2398 fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
616915dd 2399 }
2400 else
2401 {
11db3170 2402 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. This may result from using .lcs files produced by an old version of LCLint. 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.596488 seconds and 5 git commands to generate.