]> andersk Git - splint.git/blame - src/sort.c
andersk / splint.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update test results.
[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
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 {
1b8ae690 2402 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2403 "This may result from using .lcs files produced by an old version of Splint. "
2404 "Remove the .lcs files, and rerun Splint.",
28bf4b0b 2405 i, lsymbol_toString (s->name)));
616915dd 2406 fprintf (f, "sort _error_ ");
2407 }
2408
28bf4b0b 2409 if (!lco && !s->export)
616915dd 2410 fprintf (f, "private ");
2411
2412 /*@-loopswitchbreak@*/
28bf4b0b 2413 switch (s->kind)
616915dd 2414 {
2415 case SRT_HOF:
2416 fprintf (f, "hof nil nil\n");
2417 break;
2418 case SRT_PRIM:
28bf4b0b 2419 if (s->abstract)
616915dd 2420 fprintf (f, "immutable nil nil\n");
2421 else
2422 fprintf (f, "primitive nil nil\n");
2423 break;
2424 case SRT_OBJ:
28bf4b0b 2425 if (s->abstract)
616915dd 2426 fprintf (f, "mutable %s nil\n",
28bf4b0b 2427 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2428 else
2429 fprintf (f, "obj %s nil\n",
28bf4b0b 2430 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2431 break;
2432 case SRT_SYN:
2433 fprintf (f, "synonym %s nil\n",
28bf4b0b 2434 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2435 break;
2436 case SRT_PTR:
28bf4b0b 2437 fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2438 break;
2439 case SRT_ARRAY:
2440 fprintf (f, "arr %s nil\n",
28bf4b0b 2441 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2442 break;
2443 case SRT_VECTOR:
2444 fprintf (f, "vec %s %s\n",
28bf4b0b 2445 lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2446 lsymbol_toCharsSafe (sortTable[s->objSort]->name));
616915dd 2447 break;
2448 case SRT_STRUCT:
28bf4b0b 2449 if (s->tag == lsymbol_undefined)
616915dd 2450 {
2451 /* we need to make up a tag to prevent excessive
2452 growth of .lcs files when tags are overloaded
2453 */
2454 llbuglit ("Struct has no tag");
2455 }
2456 else
28bf4b0b 2457 fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
616915dd 2458
28bf4b0b 2459 for (mem = s->members;
616915dd 2460 mem != smemberInfo_undefined; mem = mem->next)
2461 {
2462 if (lco)
2463 fprintf (f, "%%LCL");
2464 fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
28bf4b0b 2465 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
616915dd 2466 }
2467 if (lco)
2468 fprintf (f, "%%LCL");
2469 fprintf (f, "sort strEnd nil nil nil\n");
2470 break;
2471 case SRT_UNION:
28bf4b0b 2472 if (s->tag == lsymbol_undefined)
616915dd 2473 llbuglit ("Union has no tag");
2474 else
28bf4b0b 2475 fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2476 for (mem = s->members;
616915dd 2477 mem != smemberInfo_undefined; mem = mem->next)
2478 {
2479 if (lco)
2480 fprintf (f, "%%LCL");
2481 fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
28bf4b0b 2482 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
616915dd 2483 }
2484 if (lco)
2485 fprintf (f, "%%LCL");
2486 fprintf (f, "sort unionEnd nil nil nil\n");
2487 break;
2488 case SRT_ENUM:
28bf4b0b 2489 if (s->tag == lsymbol_undefined)
616915dd 2490 {
2491 llbuglit ("Enum has no tag");
2492 }
2493
28bf4b0b 2494 fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
616915dd 2495
28bf4b0b 2496 for (mem = s->members;
616915dd 2497 mem != smemberInfo_undefined; mem = mem->next)
2498 {
2499 if (lco)
2500 fprintf (f, "%%LCL");
2501 fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2502 }
2503 if (lco)
2504 fprintf (f, "%%LCL");
2505 fprintf (f, "sort enumEnd nil nil nil\n");
2506 break;
2507 case SRT_TUPLE:
28bf4b0b 2508 fprintf (f, "tup %s nil\n",
2509 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2510 break;
2511 case SRT_UNIONVAL:
2512 fprintf (f, "unionval %s nil\n",
28bf4b0b 2513 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
616915dd 2514 break;
2515 default:
28bf4b0b 2516 fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
616915dd 2517 } /* switch */
2518 /*@=loopswitchbreak@*/
2519 }
2520
2521 fprintf (f, "%s\n", SORTTABLEEND);
2522}
2523
2524static void
2525sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2526{
2527 if (strcmp (kstr, "synonym") == 0)
2528 {
2529 (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2530 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2531 }
2532 else if (strcmp (kstr, "mutable") == 0)
2533 {
2534 (void) sort_constructAbstract (sname, TRUE, bsort);
2535 }
2536 else if (strcmp (kstr, "obj") == 0)
2537 {
2538 (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2539 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2540 }
2541 else if (strcmp (kstr, "ptr") == 0)
2542 {
2543 (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2544 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2545 }
2546 else if (strcmp (kstr, "arr") == 0)
2547 {
2548 (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2549 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2550 }
2551 else if (strcmp (kstr, "tup") == 0)
2552 {
2553 (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2554 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2555 }
2556 else if (strcmp (kstr, "unionval") == 0)
2557 {
2558 (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2559 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2560 }
2561 else
2562 {
2563 llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2564 }
2565}
2566
2567static void
28bf4b0b 2568parseSortLine (char *line, ltoken t, inputStream s,
2569 mapping map, lsymbolList slist)
616915dd 2570{
2571 /* caller expects that map and slist are updated */
2572 /* t and importfle are only used for error messages */
2573 static lsymbol strName = lsymbol_undefined;
2574 static smemberInfo *strMemList = NULL;
2575 static lsymbol unionName = lsymbol_undefined;
2576 static smemberInfo *unionMemList = NULL;
2577 static lsymbol enumName = lsymbol_undefined;
2578 static smemberInfo *enumMemList = NULL;
2579 static lsymbol tagName = lsymbol_undefined;
2580
28bf4b0b 2581 cstring importfile = inputStream_fileName (s);
616915dd 2582 char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2583 bool tmp;
2584 tagInfo ti;
2585 lsymbol sname, bname, new_name, objName;
2586 sort objSort;
2587 char *lineptr;
2588 int col; /* for keeping column number */
2589 ltoken tagid;
2590
2591 if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2592 &(basedstr[0]), &(objstr[0])) != 4)
2593 {
2594 /* if this fails, can have weird errors */
2595 /* strEnd, unionEnd, enumEnd won't return 4 args */
2596 lclplainerror
2597 (message ("%q: Imported file contains illegal sort declaration. "
2598 "Skipping this line: \n%s\n",
28bf4b0b 2599 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
616915dd 2600 cstring_fromChars (line)));
2601 return;
2602 }
2603
2604 sname = lsymbol_fromChars (sostr);
2605 if (sname == lsymbol_fromChars ("nil"))
2606 {
2607 /* No given sort name. Use lsymbol_undefined and generate sort name
2608 in sort building routines. */
2609 sname = lsymbol_undefined;
2610 lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
28bf4b0b 2611 importfile,
616915dd 2612 cstring_fromChars (line)));
2613 }
2614
2615 /* Assume that when we encounter a sort S1 that is based on sort
2616 S2, S2 is before S1 in the imported file. sort table is a
2617 linear list and we create base sorts before other sorts. */
2618
2619 bname = lsymbol_fromChars (basedstr);
2620 if (strcmp (kstr, "primitive") == 0)
2621 {
2622 new_name = lsymbol_translateSort (map, sname);
2623 (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2624 lsymbol_undefined, FALSE,
2625 NOSORTHANDLE, smemberInfo_undefined);
2626 }
2627 else if (strcmp (kstr, "strMem") == 0)
2628 {
2629 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2630 mem->next = strMemList;
2631 mem->name = sname;
2632 mem->sortname = bname;
2633 mem->sort = NOSORTHANDLE;
2634 strMemList = mem;
2635 }
2636 else if (strcmp (sostr, "strEnd") == 0)
2637 { /* now process it */
2638 if (strName != lsymbol_undefined && strMemList != NULL)
2639 {
2640 sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
107b60d6 2641 TRUE, NOSORTHANDLE, strMemList);
616915dd 2642
2643 if (tagName != lsymbol_undefined)
2644 {
2645 tagid = ltoken_create (simpleId, tagName);
2646
2647 ti = (tagInfo) dmalloc (sizeof (*ti));
2648 ti->sort = asort;
2649 ti->kind = TAG_STRUCT;
2650 ti->id = tagid;
2651 ti->imported = FALSE;
2652
2653 (void) symtable_enterTagForce (g_symtab, ti);
2654 }
2655 }
2656 else
2657 {
2658 if (strName == lsymbol_undefined)
2659 {
2660 lclbug (message ("%q: Imported file contains unexpected null struct sort",
28bf4b0b 2661 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2662 }
2663 else
2664 {
2665 /*
2666 ** no members -> its a forward struct
2667 */
2668
2669 if (tagName != lsymbol_undefined)
2670 {
2671 tagid = ltoken_create (simpleId, tagName);
2672 (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2673 }
2674 }
2675 }
2676 strName = lsymbol_undefined;
2677 strMemList = NULL;
2678 tagName = lsymbol_undefined;
2679 }
2680 else if (strcmp (kstr, "str") == 0)
2681 {
2682 if (strName != lsymbol_undefined || strMemList != NULL)
2683 {
2684 lclbug (message ("%q: unexpected non-null struct sort or "
2685 "non-empty member list",
28bf4b0b 2686 fileloc_unparseRaw (importfile,
2687 inputStream_thisLineNumber (s))));
616915dd 2688 }
2689 /* see if a tag is associated with this sort */
2690 if (strcmp (basedstr, "nil") == 0)
2691 {
2692 llfatalerror (message ("%s: Struct missing tag. Obsolete .lcs file, remove and rerun lcl.",
28bf4b0b 2693 importfile));
616915dd 2694 /*
2695 strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2696 tagName = lsymbol_undefined;
2697 mapping_bind (map, sname, strName);
2698 */
2699 }
2700 else /* a tag exists */
2701 { /* create tag in symbol table and add tagged sort in sort table */
2702 tagName = bname;
2703 tagid = ltoken_create (simpleId, bname);
2704
2705 strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2706 ti = symtable_tagInfo (g_symtab, tagName);
2707
2708 /*
2709 ** No error for redefining a tag in an import.
2710 */
2711 }
2712 /* to be processed later in sort_import */
2713 lsymbolList_addh (slist, strName);
2714 }
2715 else if (strcmp (kstr, "enumMem") == 0)
2716 {
2717 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2718 mem->next = enumMemList;
2719 mem->sortname = enumName;
2720 mem->name = sname;
2721 mem->sort = NOSORTHANDLE;
2722 enumMemList = mem;
2723 }
2724 else if (strcmp (sostr, "enumEnd") == 0)
2725 {
2726 if (enumName != lsymbol_undefined && enumMemList != NULL)
2727 {
2728 sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2729 FALSE, NOSORTHANDLE, enumMemList);
2730
2731 if (tagName != lsymbol_undefined)
2732 {
2733 tagid = ltoken_create (simpleId, tagName);
2734
2735 ti = (tagInfo) dmalloc (sizeof (*ti));
2736 ti->sort = asort;
2737 ti->kind = TAG_ENUM;
2738 ti->id = tagid;
2739 ti->imported = FALSE;
2740
2741 (void) symtable_enterTagForce (g_symtab, ti);
2742 }
2743 }
2744 else
2745 {
2746 lclbug (message ("%q: unexpected null enum sort or empty member list",
28bf4b0b 2747 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2748 }
2749 enumName = lsymbol_undefined;
2750 enumMemList = NULL;
2751 tagName = lsymbol_undefined;
2752 }
2753 else if (strcmp (kstr, "enum") == 0)
2754 {
2755 if (enumName != lsymbol_undefined || enumMemList != NULL)
2756 {
2757 lclbug (message ("%q: Unexpected non-null enum sort or "
2758 "non-empty member list",
28bf4b0b 2759 fileloc_unparseRaw (importfile,
2760 inputStream_thisLineNumber (s))));
616915dd 2761 }
2762
2763 /* see if a tag is associated with this sort */
2764 if (strcmp (basedstr, "nil") == 0)
2765 {
2766 llfatalerror (message ("%s: Enum missing tag. Obsolete .lcs file, "
2767 "remove and rerun lcl.",
28bf4b0b 2768 importfile));
616915dd 2769 }
2770 else
2771 { /* a tag exists */
2772 tagName = bname;
2773 tagid = ltoken_create (simpleId, bname);
2774 enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2775 ti = symtable_tagInfo (g_symtab, bname);
2776 }
2777 }
2778 else if (strcmp (kstr, "unionMem") == 0)
2779 {
2780 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2781 mem->next = unionMemList;
2782 mem->sortname = bname;
2783 mem->name = sname;
2784 mem->sort = NOSORTHANDLE;
2785 unionMemList = mem;
2786 }
2787 else if (strcmp (sostr, "unionEnd") == 0)
2788 {
2789 if (unionName != lsymbol_undefined && unionMemList != NULL)
2790 {
2791 sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2792 FALSE, NOSORTHANDLE, unionMemList);
2793
2794 if (tagName != lsymbol_undefined)
2795 {
2796 tagid = ltoken_create (simpleId, tagName);
2797
2798 ti = (tagInfo) dmalloc (sizeof (*ti));
2799 ti->sort = asort;
2800 ti->kind = TAG_UNION;
2801 ti->id = tagid;
2802 ti->imported = FALSE;
2803
2804 (void) symtable_enterTagForce (g_symtab, ti);
2805 }
2806 }
2807 else
2808 {
2809 if (unionName == lsymbol_undefined)
2810 {
2811 lclbug
2812 (message ("%q: Imported file contains unexpected null union sort",
28bf4b0b 2813 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2814 }
2815 else
2816 {
2817 /*
2818 ** no members -> its a forward struct
2819 */
2820
2821 if (tagName != lsymbol_undefined)
2822 {
2823 tagid = ltoken_create (simpleId, tagName);
2824
2825 (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2826 }
2827 }
2828 }
2829
2830 unionName = lsymbol_undefined;
2831 unionMemList = NULL;
2832 tagName = lsymbol_undefined;
2833 }
2834 else if (strcmp (kstr, "union") == 0)
2835 {
2836 if (unionName != lsymbol_undefined || unionMemList != NULL)
2837 {
2838 lclbug
2839 (message
2840 ("%q: Unexpected non-null union sort or non-empty "
2841 "member list",
28bf4b0b 2842 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
616915dd 2843 }
2844 /* see if a tag is associated with this sort */
2845 if (strcmp (basedstr, "nil") == 0)
2846 {
2847 llfatalerror
2848 (message ("%s: Union missing tag. Obsolete .lcs file, "
2849 "remove and rerun lcl.",
28bf4b0b 2850 importfile));
616915dd 2851 }
2852 else
2853 { /* a tag exists */
2854 tagName = bname;
2855 tagid = ltoken_create (simpleId, bname);
2856
2857 unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2858 ti = symtable_tagInfo (g_symtab, bname);
2859 }
2860 lsymbolList_addh (slist, unionName);
2861 }
2862 else if (strcmp (kstr, "immutable") == 0)
2863 {
2864 (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2865 }
2866 else if (strcmp (kstr, "hof") == 0)
2867 {
2868 (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2869 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2870 }
2871 else
2872 {
2873 sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2874
2875 if (sort_isNoSort (bsort))
2876 {
2877 lineptr = strchr (line, ' '); /* go past "sort" */
2878 llassert (lineptr != NULL);
2879 lineptr = strchr (lineptr + 1, ' '); /* go past sostr */
2880 llassert (lineptr != NULL);
2881 lineptr = strchr (lineptr + 1, ' '); /* go past kstr */
2882 llassert (lineptr != NULL);
2883 col = 5 + lineptr - line; /* 5 for initial "%LCL "*/
2884
2885 llbug
2886 (message ("%q: Imported file contains unknown base sort: %s",
28bf4b0b 2887 fileloc_unparseRawCol (importfile,
2888 inputStream_thisLineNumber (s), col),
616915dd 2889 cstring_fromChars (lsymbol_toCharsSafe (bname))));
2890 }
2891
2892 if (strcmp (kstr, "vec") == 0)
2893 {
2894 objName = lsymbol_fromChars (objstr);
2895 objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2896 (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2897 FALSE, objSort, smemberInfo_undefined);
2898 }
2899 else
2900 {
2901 sort_loadOther (kstr, sname, bsort);
2902 }
2903 }
2904}
2905
2906void
28bf4b0b 2907sort_import (inputStream imported, ltoken tok, mapping map)
616915dd 2908{
2909 /* tok is only used for error message line number */
28bf4b0b 2910 char *buf;
2911 cstring importfile;
2912 inputStream lclsource;
616915dd 2913 sort bsort;
2914 lsymbolList slist = lsymbolList_new ();
2915
28bf4b0b 2916 buf = inputStream_nextLine (imported);
616915dd 2917
2918 llassert (buf != NULL);
2919
28bf4b0b 2920 importfile = inputStream_fileName (imported);
616915dd 2921
2922 if (!firstWord (buf, "%LCLSortTable"))
2923 {
2924 lclsource = LCLScanSource ();
2925
2926 lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2927 "in import file %s:\n%s",
28bf4b0b 2928 importfile,
616915dd 2929 cstring_fromChars (buf)));
2930
2931 }
2932
2933 for (;;)
2934 {
28bf4b0b 2935 buf = inputStream_nextLine (imported);
616915dd 2936
2937 llassert (buf != NULL);
2938
2939 if (firstWord (buf, "%LCLSortTableEnd"))
2940 {
2941 break;
2942 }
2943 else
2944 { /* a good line, remove %LCL from line first */
2945 if (firstWord (buf, "%LCL"))
2946 {
2947 parseSortLine (buf + 4, tok, imported, map, slist);
2948 }
2949 else
2950 {
2951 lclsource = LCLScanSource ();
2952 lclfatalerror
2953 (tok,
2954 message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
28bf4b0b 2955 importfile,
616915dd 2956 cstring_fromChars (buf)));
2957 }
2958 }
2959 }
2960
2961 /* now process the smemberInfo in the sort List */
2962 lsymbolList_elements (slist, s)
2963 {
2964 if (s != lsymbol_undefined)
2965 {
2966 sort sor;
2967 sortNode sn;
2968
2969 sor = sort_lookupName (s);
2970 sn = sort_quietLookup (sor);
2971
28bf4b0b 2972 switch (sn->kind)
616915dd 2973 {
2974 case SRT_ENUM:
2975 { /* update the symbol table with members of enum */
2976 varInfo vi;
28bf4b0b 2977 smemberInfo *mlist = sn->members;
616915dd 2978 for (; mlist != NULL; mlist = mlist->next)
2979 {
2980 /* check that enumeration constants are unique */
2981 vi = symtable_varInfo (g_symtab, mlist->name);
2982 if (!varInfo_exists (vi))
2983 { /* put info into symbol table */
2984 vi = (varInfo) dmalloc (sizeof (*vi));
2985 vi->id = ltoken_create (NOTTOKEN, mlist->name);
2986 vi->kind = VRK_ENUM;
2987 vi->sort = sor;
2988 vi->export = TRUE;
2989
2990 (void) symtable_enterVar (g_symtab, vi);
2991 varInfo_free (vi);
2992 }
2993 else
2994 {
2995 lclplainerror
2996 (message ("%s: enum member %s of %s has already been declared",
28bf4b0b 2997 importfile,
616915dd 2998 lsymbol_toString (mlist->name),
28bf4b0b 2999 lsymbol_toString (sn->name)));
616915dd 3000 }
3001 }
3002 /*@switchbreak@*/ break;
3003 }
3004 case SRT_STRUCT:
3005 case SRT_UNION:
3006 {
28bf4b0b 3007 smemberInfo *mlist = sn->members;
616915dd 3008
3009 for (; mlist != NULL; mlist = mlist->next)
3010 {
3011 bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3012 if (sort_isNoSort (bsort))
3013 {
3014 lclbug (message ("%s: member %s of %s has unknown sort\n",
28bf4b0b 3015 importfile,
616915dd 3016 cstring_fromChars (lsymbol_toChars (mlist->name)),
28bf4b0b 3017 cstring_fromChars (lsymbol_toChars (sn->name))));
616915dd 3018 }
3019 else
3020 {
3021 mlist->sort = bsort;
3022 }
3023 }
3024 /*@switchbreak@*/ break;
3025 }
3026 default:
3027 lclbug (message ("%s: %s has unexpected sort kind %s",
28bf4b0b 3028 importfile,
3029 cstring_fromChars (lsymbol_toChars (sn->name)),
3030 sort_unparseKind (sn->kind)));
616915dd 3031 }
3032 }
3033 } end_lsymbolList_elements;
3034
3035 /* list and sorts in it are not used anymore */
3036 lsymbolList_free (slist);
3037}
3038
3039bool
28bf4b0b 3040sort_equal (sort s1, sort s2)
616915dd 3041{
3042 sort syn1, syn2;
28bf4b0b 3043
3044 if (s1 == s2) return TRUE;
3045
3046 /* handle synonym sorts */
3047 syn1 = sort_getUnderlying (s1);
3048 syn2 = sort_getUnderlying (s2);
3049
3050 if (syn1 == syn2) return TRUE;
3051 /* makes bool and Bool equal */
3052
616915dd 3053 return FALSE;
3054}
3055
3056bool
3057sort_compatible (sort s1, sort s2)
3058{
3059 sort syn1, syn2;
28bf4b0b 3060 /* later: might consider "char" and enum types the same as "int" */
616915dd 3061 if (s1 == s2)
3062 return TRUE;
28bf4b0b 3063 /* handle synonym sorts */
616915dd 3064 syn1 = sort_getUnderlying (s1);
3065 syn2 = sort_getUnderlying (s2);
3066 if (syn1 == syn2)
3067 return TRUE;
3068 /* makes bool and Bool equal */
3069 return FALSE;
3070}
3071
3072bool
3073sort_compatible_modulo_cstring (sort s1, sort s2)
3074{
3075 /* like sort_compatible but also handles special cstring inits,
3076 allows the following 2 cases:
28bf4b0b 3077 char c[] = "abc"; (LHS: char_Obj_Arr, RHS = char_Vec)
3078 (c as implicitly coerced into c^)
3079 char *d = "abc"; (LHS: char_Obj_Ptr, RHS = char_Vec)
3080 (d as implicitly coerced into d[]^)
3081 */
616915dd 3082 sort syn1, syn2;
3083 if (sort_compatible (s1, s2))
3084 return TRUE;
3085 syn1 = sort_getUnderlying (s1);
3086 syn2 = sort_getUnderlying (s2);
3087 if (sort_cstring == syn2 &&
3088 (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3089 return TRUE;
3090 return FALSE;
3091}
3092
3093lsymbol
3094sort_getLsymbol (sort sor)
3095{
616915dd 3096 sortNode sn = sort_quietLookup (sor);
28bf4b0b 3097 return sn->name;
616915dd 3098}
3099
3100/* a few handy routines for debugging */
3101
3102char *sort_getName (sort s)
3103{
3104 return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3105}
3106
3107/*@exposed@*/ cstring
3108sort_unparseName (sort s)
3109{
28bf4b0b 3110 return (cstring_fromChars (sort_getName (s)));
616915dd 3111}
3112
3113static void
3114sortError (ltoken t, sort oldsort, sortNode newnode)
3115{
3116 sortNode old = sort_quietLookup (oldsort);
28bf4b0b 3117
3118 if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3119 (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
616915dd 3120 {
3121 llbuglit ("sortError: illegal sort kind");
3122 }
3123
3124 llassert (sortTable != NULL);
3125
3126 lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
28bf4b0b 3127 cstring_fromChars (lsymbol_toChars (newnode->name)),
616915dd 3128 sort_unparseKindName (sortTable[oldsort]),
3129 sort_unparseKindName (newnode)));
3130}
3131
3132static /*@observer@*/ cstring
3133 sort_unparseKindName (sortNode s)
3134{
28bf4b0b 3135 switch (s->kind)
616915dd 3136 {
3137 case SRT_NONE:
28bf4b0b 3138 return cstring_fromChars (sortKindName[(int)s->kind]);
616915dd 3139 default:
28bf4b0b 3140 if (s->abstract)
616915dd 3141 {
28bf4b0b 3142 if (s->mutable)
616915dd 3143 {
3144 return cstring_makeLiteralTemp ("MUTABLE");
3145 }
3146 else
3147 {
3148 return cstring_makeLiteralTemp ("IMMUTABLE");
3149 }
3150 }
3151 else
28bf4b0b 3152 return cstring_fromChars (sortKindName[(int)s->kind]);
616915dd 3153 }
3154
3155 BADEXIT;
3156}
3157
3158sort
3159sort_fromLsymbol (lsymbol sortid)
3160{
3161 /* like sort_lookupName but creates sort if not already present */
3162 sort sort = sort_lookupName (sortid);
3163 if (sort == NOSORTHANDLE)
3164 sort = sort_makeSort (ltoken_undefined, sortid);
3165 return sort;
3166}
3167
3168bool
3169sort_isHOFSortKind (sort s)
3170{
3171 sortNode sn = sort_quietLookup (s);
28bf4b0b 3172 if (sn->kind == SRT_HOF)
616915dd 3173 return TRUE;
3174 return FALSE;
3175}
3176
3177/*
3178** returns TRUE iff s has State operators (', ~, ^)
3179*/
3180
3181static bool
3182sort_hasStateFcns (sort s)
3183{
3184 sortNode sn = sort_quietLookup (s);
28bf4b0b 3185 sortKind kind = sn->kind;
3186
616915dd 3187 if (kind == SRT_SYN)
3188 {
28bf4b0b 3189 return (sort_hasStateFcns (sn->baseSort));
616915dd 3190 }
28bf4b0b 3191
616915dd 3192 return ((kind == SRT_PTR) ||
3193 (kind == SRT_OBJ) ||
3194 (kind == SRT_ARRAY) ||
3195 (kind == SRT_STRUCT) ||
3196 (kind == SRT_UNION));
3197}
3198
3199
git-cvsimport mirror of splint
This page took 0.519187 seconds and 5 git commands to generate.