2 ** Splint - annotation-assisted static program checker
3 ** Copyright (C) 1994-2003 University of Virginia,
4 ** Massachusetts Institute of Technology
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.
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.
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.
20 ** For information on splint: info@splint.org
21 ** To report a bug: splint-bug@splint.org
22 ** For more information: http://www.splint.org
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.
35 ** Massachusetts Institute of Technology
38 # include "splintMacros.nf"
40 # include "llgrammar.h"
45 static lsymbol newStructTag (void) /*@*/ ;
46 static lsymbol newEnumTag (void) /*@*/ ;
47 static lsymbol newUnionTag (void) /*@*/ ;
49 /*@constant static int MAXBUFFLEN; @*/
50 # define MAXBUFFLEN 1024
52 /*@constant static int DELTA; @*/
55 /*@constant static int NOSORTHANDLE; @*/
56 # define NOSORTHANDLE 0
58 /*@constant static int HOFSORTHANDLE; @*/
59 # define HOFSORTHANDLE 1
63 static void sort_addTupleMembers (sort p_tupleSort, sort p_strSort)
64 /*@modifies internalState@*/ ;
66 static bool sort_isNewEntry (sortNode p_s) /*@*/ ;
68 static sort sort_enterNew (/*@only@*/ sortNode p_s)
69 /*@modifies internalState@*/ ;
71 static sort sort_enterGlobal (/*@only@*/ sortNode p_s) /*@modifies internalState@*/ ;
73 static sort sort_enterNewForce (/*@only@*/ sortNode p_s)
74 /*@modifies internalState@*/ ;
76 static void genPtrOps (sort p_baseSort, sort p_ptrSort, sort p_arraySort);
77 static void genArrOps (sort p_baseSort, sort p_arraySort, int p_dim,
79 static void genVecOps (sort p_baseSort, sort p_vecSort, int p_dim);
80 static void genTupleOps (sort p_tupleSort);
81 static void genUnionOps (sort p_tupleSort);
82 static void genStrOps (sort p_strSort, sort p_tupleSort);
83 static void genEnumOps (sort p_enumSort);
85 static void overloadPtrFcns (sort p_ptrSort);
86 static void overloadIsSub (sort p_s, int p_dim);
87 static void overloadSizeof (sort p_domainSort);
89 /*@observer@*/ static cstring sort_unparseKind (sortKind p_k) /*@*/ ;
91 static /*@observer@*/ cstring
92 sort_unparseKindName (sortNode p_s) /*@*/ ;
95 sortTag_toSymbol (char *p_kind, ltoken p_tagid, /*@out@*/ bool *p_isNew);
98 overloadUnaryTok (/*@only@*/ nameNode p_nn,
99 sort p_domainSort, /*@only@*/ ltoken p_range);
101 overloadUnary (/*@only@*/ nameNode p_nn,
102 sort p_domainSort, sort p_rangeSort);
104 overloadBinary (/*@only@*/ nameNode p_nn,
105 sort p_s, /*@only@*/ ltoken p_dTok, sort p_rs);
106 static /*@only@*/ nameNode makeFieldOp (lsymbol p_field);
107 static /*@only@*/ nameNode makeArrowFieldOp (lsymbol p_field);
110 static lsymbol sp (lsymbol p_s1, lsymbol p_s2);
111 static void sortError (ltoken p_t, sort p_oldsort, sortNode p_newnode);
121 static sort sort_void;
122 static sort char_obj_ptrSort;
123 static sort char_obj_ArrSort;
125 /* This is used to uniqueize sort names, for anonymous C types */
126 static int sortUID = 1;
128 typedef /*@only@*/ sortNode o_sortNode;
130 static /*@only@*/ /*@null@*/ o_sortNode *sortTable = (sortNode *) 0;
132 static int sortTableSize = 0;
133 static int sortTableAlloc = 0;
135 /* Important to keep sorts in some order because importing routines
136 for sorts rely on this order to ensure that when we encounter a sort
137 S1 that is based on sort S2, S2 is before S1 in the imported file. */
139 static bool exporting = TRUE;
141 static lsymbol underscoreSymbol;
142 static /*@only@*/ ltoken intToken;
144 static /*@owned@*/ nameNode arrayRefNameNode;
145 static /*@owned@*/ nameNode ptr2arrayNameNode;
146 static /*@owned@*/ nameNode deRefNameNode;
147 static /*@owned@*/ nameNode nilNameNode;
148 static /*@owned@*/ nameNode plusNameNode;
149 static /*@owned@*/ nameNode minusNameNode;
150 static /*@owned@*/ nameNode condNameNode;
151 static /*@owned@*/ nameNode eqNameNode;
152 static /*@owned@*/ nameNode neqNameNode;
154 static ob_mstring sortKindName[] =
156 "FIRSTSORT", "NOSORT", "HOFSORT",
157 "PRIMITIVE", "SYNONYM", "POINTER", "OBJ", "ARRAY", "VECTOR",
158 "STRUCT", "TUPLE", "UNION", "UNIONVAL", "ENUM", "LASTSORT"
161 static void smemberInfo_free (/*@null@*/ /*@only@*/ smemberInfo *mem)
166 static void sortNode_free (/*@only@*/ sortNode sn)
168 smemberInfo_free (sn->members);
173 sort_destroyMod (void)
174 /*@globals killed sortTable, killed arrayRefNameNode,
175 killed ptr2arrayNameNode,killed deRefNameNode,
176 killed nilNameNode, killed plusNameNode,
177 killed minusNameNode, killed condNameNode,
178 killed eqNameNode, killed neqNameNode @*/
180 if (sortTable != NULL)
184 nameNode_free (arrayRefNameNode);
185 nameNode_free (ptr2arrayNameNode);
186 nameNode_free (deRefNameNode);
187 nameNode_free (nilNameNode);
188 nameNode_free (plusNameNode);
189 nameNode_free (minusNameNode);
190 nameNode_free (condNameNode);
191 nameNode_free (eqNameNode);
192 nameNode_free (neqNameNode);
194 for (i = 0; i < sortTableSize; i++)
196 sortNode_free (sortTable[i]);
205 sort_makeNoSort (void)
211 sort_makeHOFSort (sort base)
216 outSort = (sortNode) dmalloc (sizeof (*outSort));
217 outSort->kind = SRT_HOF;
218 outSort->name = cstring_toSymbol (message ("_HOF_sort_%d", sortTableSize));
219 outSort->tag = lsymbol_undefined;
220 outSort->baseSort = base;
221 outSort->objSort = NOSORTHANDLE;
222 outSort->members = smemberInfo_undefined;
223 outSort->export = exporting;
224 outSort->imported = context_inImport ();
225 outSort->mutable = FALSE;
226 outSort->abstract = FALSE;
228 llassert (sortTable != NULL);
230 outSort->handle = handle = sortTableSize;
231 sortTable[handle] = outSort;
238 sort_construct (lsymbol name, sortKind kind, sort baseSort,
240 bool mut, sort objSort, /*@null@*/ /*@only@*/ smemberInfo *members)
245 handle = sort_lookupName (name);
247 outSort = (sortNode) dmalloc (sizeof (*outSort));
248 outSort->kind = kind;
249 outSort->name = name;
250 outSort->tag = tagName;
251 outSort->realtag = TRUE;
252 outSort->baseSort = baseSort;
253 outSort->objSort = objSort;
254 outSort->members = members;
255 outSort->mutable = mut;
256 outSort->export = exporting;
257 outSort->imported = context_inImport ();
258 outSort->abstract = FALSE;
259 outSort->handle = handle;
261 if (handle == NOSORTHANDLE)
263 outSort->handle = handle = sort_enterNew (outSort);
268 llassert (sortTable != NULL);
270 if (sortTable[handle]->kind != kind)
272 sortError (ltoken_undefined, handle, outSort);
273 sortNode_free (outSort);
278 /* evs --- added 11 Mar 1994
279 ** the new entry should supercede the old one, since
280 ** it could be a forward reference to a struct, etc.
283 sortTable[handle] = outSort;
290 sort_constructAbstract (lsymbol name, bool mut, sort baseSort)
301 handle = sort_lookupName (name);
302 outSort = (sortNode) dmalloc (sizeof (*outSort));
303 outSort->kind = kind;
304 outSort->name = name;
305 outSort->tag = lsymbol_undefined;
306 outSort->baseSort = baseSort;
307 outSort->objSort = NOSORTHANDLE;
308 outSort->members = smemberInfo_undefined;
309 outSort->mutable = mut;
310 outSort->export = exporting;
311 outSort->imported = context_inImport ();
312 outSort->abstract = TRUE;
313 outSort->handle = handle;
315 if (handle == NOSORTHANDLE)
317 outSort->handle = handle = sort_enterNew (outSort);
318 /* do not make sort operators. */
322 llassert (sortTable != NULL);
324 if (sortTable[handle]->kind != kind)
326 sortError (ltoken_undefined, handle, outSort);
329 sortNode_free (outSort);
336 sort_makeSort (/*@unused@*/ ltoken t, lsymbol n)
339 ** Expects n to be a new sort.
340 ** Generate a sort with the given name. Useful for LSL sorts.
343 sort handle = sort_lookupName (n);
345 if (handle == NOSORTHANDLE)
349 outSort = (sortNode) dmalloc (sizeof (*outSort));
350 outSort->handle = handle;
351 outSort->kind = SRT_PRIM;
353 outSort->tag = lsymbol_undefined;
354 outSort->baseSort = NOSORTHANDLE;
355 outSort->objSort = NOSORTHANDLE;
356 outSort->members = smemberInfo_undefined;
357 outSort->export = exporting;
358 outSort->mutable = FALSE;
359 outSort->imported = context_inImport ();
360 outSort->abstract = FALSE;
362 /* Put into sort table, sort_enter checks for duplicates. */
363 handle = sort_enterNew (outSort);
367 /* don't override old info */
375 sort_makeSortNoOps (/*@unused@*/ ltoken t, lsymbol n) /*@modifies internalState@*/
379 handle = sort_lookupName (n);
381 if (handle == NOSORTHANDLE)
385 outSort = (sortNode) dmalloc (sizeof (*outSort));
386 outSort->handle = handle;
387 outSort->kind = SRT_PRIM;
389 outSort->tag = lsymbol_undefined;
390 outSort->baseSort = NOSORTHANDLE;
391 outSort->objSort = NOSORTHANDLE;
392 outSort->members = smemberInfo_undefined;
393 outSort->export = exporting;
394 outSort->mutable = FALSE;
395 outSort->imported = context_inImport ();
396 outSort->abstract = FALSE;
397 /* Put into sort table, sort_enter checks for duplicates. */
398 handle = sort_enterNew (outSort);
399 } /* Don't override old info */
405 sort_makeLiteralSort (ltoken t, lsymbol n)
406 /*@modifies internalState@*/
409 ** Like sort_makeSort, in addition, generate sizeof operator
410 ** t not currently used, may be useful for generating error msgs later
411 ** Also useful for abstract types, need sizeof operator.
414 sort handle = sort_makeSort (t, n);
416 overloadSizeof (handle);
421 sort_makeSyn (ltoken t, sort s, lsymbol n)
423 /* make a synonym sort with name n that is == to sort s */
424 /* expect n to be a new sort name */
427 /* must not clash with any LSL sorts */
428 lsymbol newname = sp (underscoreSymbol, n);
430 if (n == lsymbol_undefined)
432 llbuglit ("sort_makeSyn: synonym must have name");
435 handle = sort_lookupName (newname);
437 outSort = (sortNode) dmalloc (sizeof (*outSort));
438 outSort->kind = SRT_SYN;
439 outSort->name = newname;
440 outSort->baseSort = s;
441 outSort->objSort = NOSORTHANDLE;
442 /* info is not duplicated */
443 outSort->tag = lsymbol_undefined;
444 outSort->members = smemberInfo_undefined;
445 outSort->export = exporting;
446 outSort->mutable = FALSE;
447 outSort->imported = context_inImport ();
448 outSort->abstract = FALSE;
449 outSort->handle = handle;
451 if (handle == NOSORTHANDLE)
453 outSort->handle = handle = sort_enterNew (outSort);
454 /* No operators to generate for synonyms */
458 llassert (sortTable != NULL);
460 if (sortTable[handle]->kind != SRT_SYN)
462 sortError (t, handle, outSort);
465 sortNode_free (outSort);
472 sort_makeFormal (sort insort)
477 sor = sort_getUnderlying (insort);
479 s = sort_lookup (sor);
484 handle = sort_makeTuple (ltoken_undefined, sor);
487 handle = sort_makeUnionVal (ltoken_undefined, sor);
497 sort_makeGlobal (sort insort)
499 /* Make a Obj if not an array or a struct */
502 sor = sort_getUnderlying (insort);
504 s = sort_lookup (sor);
517 llcontbuglit ("sort_makeGlobal: can't make vectors, tuples, or unionvals global");
520 handle = sort_makeObj (sor);
527 sort_makeObj (sort sor)
529 sortNode baseSortNode, outSort;
530 sort baseSort, handle;
533 /* skip the synonym sort */
534 baseSort = sort_getUnderlying (sor);
535 baseSortNode = sort_quietLookup (baseSort);
536 switch (baseSortNode->kind)
542 if (baseSortNode->objSort != 0)
543 return baseSortNode->objSort;
544 else /* must have well-defined objSort field */
546 llcontbuglit ("sort_makeObj: Inconsistent vector reps:invalid objSort field");
551 /* need to map *_Struct_Tuple to *_Struct and *_Union_UnionVal to
552 *_Union, according to sort naming conventions */
553 if (baseSortNode->baseSort != NOSORTHANDLE)
554 /* for tuples and unionvals, baseSort field keeps the map from
555 value sort to obj sort-> */
556 return baseSortNode->baseSort;
557 else /* valid tuples and unionvals must have baseSort fields */
559 llcontbuglit ("sort_makeObj: Inconsistent tuples or unionvals reps: invalid baseSort field");
563 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
564 lsymbol_fromChars ("_Obj"));
565 handle = sort_lookupName (name);
567 outSort = (sortNode) dmalloc (sizeof (*outSort));
568 outSort->kind = SRT_OBJ;
569 /* must not clash with any LSL sorts */
570 outSort->name = name;
571 outSort->tag = lsymbol_undefined;
572 outSort->baseSort = baseSort;
573 outSort->objSort = NOSORTHANDLE;
574 outSort->members = smemberInfo_undefined;
575 outSort->mutable = TRUE;
576 outSort->export = exporting;
577 outSort->abstract = FALSE;
578 outSort->handle = handle;
579 outSort->imported = TRUE;
581 if (handle == NOSORTHANDLE)
583 if (sort_isNewEntry (outSort))
585 outSort->handle = handle = sort_enterNew (outSort);
589 outSort->handle = handle = sort_enterNew (outSort);
594 llassert (sortTable != NULL);
596 if (sortTable[handle]->kind != SRT_OBJ)
598 sortError (ltoken_undefined, handle, outSort);
601 sortNode_free (outSort);
609 sort_makePtr (ltoken t, sort baseSort)
612 sort handle, arrayHandle;
615 s = sort_lookup (baseSort);
617 if (s->kind == SRT_HOF)
621 if (s->kind == SRT_NONE)
626 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
627 s->kind != SRT_UNION)
628 /* && s->kind != SRT_OBJ) */
629 /* base is not an SRT_ARRAY, struct or union. Need to insert a obj. */
630 baseSort = sort_makeObj (baseSort);
632 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
633 lsymbol_fromChars ("_Ptr"));
634 handle = sort_lookupName (name);
636 outSort = (sortNode) dmalloc (sizeof (*outSort));
637 outSort->kind = SRT_PTR;
638 outSort->name = name;
639 outSort->tag = lsymbol_undefined;
640 outSort->baseSort = baseSort;
641 outSort->objSort = NOSORTHANDLE;
642 outSort->members = smemberInfo_undefined;
643 outSort->mutable = FALSE;
644 outSort->export = exporting;
645 outSort->imported = context_inImport ();
646 outSort->abstract = FALSE;
647 outSort->handle = handle;
649 if (handle == NOSORTHANDLE)
651 if (sort_isNewEntry (outSort))
653 outSort->handle = handle = sort_enterNew (outSort);
654 arrayHandle = sort_makeArr (t, baseSort);
655 genPtrOps (baseSort, handle, arrayHandle);
659 outSort->handle = handle = sort_enterNew (outSort);
664 llassert (sortTable != NULL);
666 if (sortTable[handle]->kind != SRT_PTR)
668 sortError (t, handle, outSort);
671 sortNode_free (outSort);
678 sort_makePtrN (sort s, pointers p)
680 if (pointers_isUndefined (p))
686 return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
687 pointers_getRest (p));
692 sort_makeArr (ltoken t, sort baseSort)
694 sortNode s, outSort, old;
695 sort handle, vecHandle;
699 s = sort_lookup (baseSort);
701 if (s->kind == SRT_HOF)
703 if (s->kind == SRT_NONE)
706 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
707 s->kind != SRT_UNION && s->kind != SRT_OBJ)
708 /* base is not an array, struct or obj. Need to insert a Obj. */
709 baseSort = sort_makeObj (baseSort);
711 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
712 lsymbol_fromChars ("_Arr"));
713 handle = sort_lookupName (name);
715 /* must not clash with any LSL sorts */
716 outSort = (sortNode) dmalloc (sizeof (*outSort));
717 outSort->name = name;
718 outSort->kind = SRT_ARRAY;
719 outSort->baseSort = baseSort;
720 outSort->objSort = NOSORTHANDLE;
721 outSort->members = smemberInfo_undefined;
722 outSort->mutable = TRUE;
723 outSort->export = exporting;
724 outSort->imported = context_inImport ();
725 outSort->abstract = FALSE;
726 outSort->handle = handle;
728 if (handle == NOSORTHANDLE)
730 if (sort_isNewEntry (outSort))
732 handle = sort_enterNew (outSort);
733 outSort = sort_lookup (handle);
735 for (old = outSort, dim = 0;
736 old->kind == SRT_ARRAY;
737 dim++, old = sort_lookup (old->baseSort))
742 vecHandle = sort_makeVec (t, handle);
743 genArrOps (baseSort, handle, dim, vecHandle);
747 outSort->handle = handle = sort_enterNew (outSort);
752 llassert (sortTable != NULL);
754 if (sortTable[handle]->kind != SRT_ARRAY)
756 sortError (t, handle, outSort);
759 sortNode_free (outSort);
766 sort_makeVec (ltoken t, sort arraySort)
768 sortNode s, outSort, old;
769 sort baseSort, handle, elementSort;
770 int dim; /* array dimension count. */
773 s = sort_lookup (arraySort);
775 if (s->kind == SRT_HOF)
777 if (s->kind == SRT_NONE)
780 if (s->kind != SRT_ARRAY)
782 llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
783 sort_unparseKind (s->kind)));
786 if (s->baseSort == NOSORTHANDLE)
787 llbuglit ("sort_makeVec: arrays must have base (element) sort");
789 /* Vectors return "values", so make array elements values. */
791 baseSort = s->baseSort;
792 elementSort = sort_makeVal (baseSort);
794 name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
795 lsymbol_fromChars ("_Vec"));
796 handle = sort_lookupName (name);
798 outSort = (sortNode) dmalloc (sizeof (*outSort));
799 outSort->baseSort = elementSort;
800 outSort->name = name;
801 outSort->objSort = arraySort;
802 outSort->kind = SRT_VECTOR;
803 outSort->members = smemberInfo_undefined;
804 outSort->mutable = FALSE;
805 outSort->export = exporting;
806 outSort->imported = context_inImport ();
807 outSort->abstract = FALSE;
808 outSort->handle = handle;
810 if (handle == NOSORTHANDLE)
812 if (sort_isNewEntry (outSort))
814 outSort = sort_lookup (handle = sort_enterNew (outSort));
816 for (old = outSort, dim = 0;
817 old->kind == SRT_VECTOR;
818 dim++, old = sort_lookup (old->baseSort))
823 genVecOps (elementSort, handle, dim);
827 outSort->handle = handle = sort_enterNew (outSort);
832 llassert (sortTable != NULL);
834 if (sortTable[handle]->kind != SRT_VECTOR)
836 sortError (t, handle, outSort);
839 sortNode_free (outSort);
846 sort_makeVal (sort sor)
851 llassert (sortTable != NULL);
852 s = sort_quietLookup (sor);
864 /* Do nothing for basic types and pointers. */
868 return sort_makeVal (sortTable[sor]->baseSort);
870 /* Strip out the last Obj's */
871 if (s->baseSort == NOSORTHANDLE)
873 llbuglit ("sort_makeVal: expecting a base sort for Obj");
875 retSort = s->baseSort;
878 retSort = sort_makeVec (ltoken_undefined, sor);
881 retSort = sort_makeTuple (ltoken_undefined, sor);
884 retSort = sort_makeUnionVal (ltoken_undefined, sor);
887 llbuglit ("sort_makeVal: invalid sort kind");
889 rsn = sort_quietLookup (retSort);
890 if (rsn->kind == SRT_NONE)
892 llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
898 sort_makeImmutable (ltoken t, lsymbol name)
903 handle = sort_lookupName (name);
905 outSort = (sortNode) dmalloc (sizeof (*outSort));
906 outSort->kind = SRT_PRIM;
907 outSort->name = name;
908 outSort->baseSort = NOSORTHANDLE;
909 outSort->objSort = NOSORTHANDLE;
910 outSort->members = smemberInfo_undefined;
911 outSort->export = exporting;
912 outSort->mutable = FALSE;
913 outSort->imported = context_inImport ();
914 outSort->abstract = TRUE;
915 outSort->handle = handle;
917 if (handle == NOSORTHANDLE)
919 handle = sort_enterNew (outSort);
920 outSort = sort_lookup (handle);
921 overloadSizeof (handle);
925 llassert (sortTable != NULL);
927 if ((sortTable[handle]->kind != SRT_PRIM) &&
928 (sortTable[handle]->abstract) &&
929 (!sortTable[handle]->mutable))
931 sortError (t, handle, outSort);
934 sortNode_free (outSort);
941 sort_makeMutable (ltoken t, lsymbol name)
943 sort immutable_old, handle, baseSort;
946 immutable_old = sort_lookupName (name);
948 /* First generate the value sort */
949 baseSort = sort_makeImmutable (t, name);
951 llassert (sortTable != NULL);
953 /* to prevent duplicate error messages */
954 if (immutable_old != NOSORTHANDLE &&
955 (sortTable[baseSort]->kind != SRT_PRIM) &&
956 (sortTable[baseSort]->abstract) &&
957 (!sortTable[baseSort]->mutable))
959 /* already complained */
960 handle = NOSORTHANDLE;
963 { /* sort_makeImmutable must have succeeded */
966 /* must not clash with any LSL sorts */
967 objName = sp (sp (underscoreSymbol, name),
968 lsymbol_fromChars ("_Obj"));
969 handle = sort_lookupName (objName);
971 outSort = (sortNode) dmalloc (sizeof (*outSort));
972 outSort->kind = SRT_OBJ;
973 outSort->name = objName;
974 outSort->tag = lsymbol_undefined;
975 outSort->baseSort = baseSort;
976 outSort->objSort = NOSORTHANDLE;
977 outSort->members = smemberInfo_undefined;
978 outSort->mutable = TRUE;
979 outSort->export = exporting;
980 outSort->imported = context_inImport ();
981 outSort->abstract = TRUE;
982 outSort->handle = handle;
984 if (handle == NOSORTHANDLE)
986 if (sort_isNewEntry (outSort))
988 outSort->handle = handle = sort_enterNew (outSort);
992 handle = sort_enterNew (outSort);
997 llassert (sortTable != NULL);
999 if ((sortTable[handle]->kind != SRT_OBJ)
1000 && sortTable[handle]->abstract
1001 && sortTable[handle]->mutable)
1003 sortError (t, handle, outSort);
1006 sortNode_free (outSort);
1013 sort_makeStr (ltoken opttagid)
1020 outSort = (sortNode) dmalloc (sizeof (*outSort));
1022 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1023 /* isNewTag true means that the name generated is new */
1025 if (ltoken_isUndefined (opttagid))
1027 opttagid = ltoken_create (simpleId, newStructTag ());
1029 outSort->realtag = FALSE;
1033 outSort->realtag = TRUE;
1036 name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1038 llassert (sortTable != NULL);
1039 handle = sort_lookupName (name);
1040 outSort->name = name;
1041 outSort->kind = SRT_STRUCT;
1042 outSort->tag = ltoken_getText (opttagid);
1043 outSort->baseSort = NOSORTHANDLE;
1044 outSort->objSort = NOSORTHANDLE;
1045 outSort->members = smemberInfo_undefined;
1046 outSort->export = exporting;
1047 outSort->mutable = TRUE;
1048 outSort->imported = context_inImport ();
1049 outSort->abstract = FALSE;
1050 outSort->handle = handle;
1052 if (handle == NOSORTHANDLE)
1054 if (sort_isNewEntry (outSort))
1056 outSort->handle = handle = sort_enterNew (outSort);
1060 outSort->handle = handle = sort_enterNewForce (outSort);
1065 if (sortTable[handle]->kind != SRT_STRUCT)
1067 sortError (opttagid, handle, outSort);
1070 sortNode_free (outSort);
1077 sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1079 /* expect strSort to be in sort table but not yet filled in */
1080 /* return TRUE if it is "new" */
1084 llassert (sortTable != NULL);
1085 sn = sort_lookup (strSort);
1087 if (sn->members == (smemberInfo *) 0)
1089 sortTable[strSort]->members = info;
1090 tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1091 genStrOps (strSort, tupleSort);
1096 smemberInfo_free (info);
1102 sort_makeTuple (ltoken t, sort strSort)
1105 sortNode outSort, s = sort_lookup (strSort);
1108 if (s->kind != SRT_STRUCT)
1110 llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
1111 sort_unparseKind (s->kind)));
1114 name = sp (s->name, lsymbol_fromChars ("_Tuple"));
1115 llassert (sortTable != NULL);
1116 handle = sort_lookupName (name);
1118 outSort = (sortNode) dmalloc (sizeof (*outSort));
1119 outSort->kind = SRT_TUPLE;
1120 outSort->name = name;
1121 outSort->tag = s->tag;
1122 outSort->realtag = s->realtag;
1123 outSort->baseSort = strSort;
1124 outSort->objSort = NOSORTHANDLE;
1125 outSort->members = smemberInfo_undefined;
1126 outSort->export = exporting;
1127 outSort->abstract = FALSE;
1128 outSort->imported = context_inImport ();
1129 outSort->mutable = FALSE;
1130 outSort->handle = handle;
1132 if (handle == NOSORTHANDLE)
1134 if (sort_isNewEntry (outSort))
1136 outSort->handle = handle = sort_enterNew (outSort);
1138 sort_addTupleMembers (handle, strSort);
1139 genTupleOps (handle);
1143 outSort->handle = handle = sort_enterNew (outSort);
1148 if (sortTable[handle]->kind != SRT_TUPLE)
1150 sortError (t, handle, outSort);
1153 sortNode_free (outSort);
1160 sort_addTupleMembers (sort tupleSort, sort strSort)
1162 smemberInfo *mem, *tail = smemberInfo_undefined;
1163 smemberInfo *top = smemberInfo_undefined;
1164 smemberInfo *newinfo;
1166 /* make sure it works for empty smemberInfo */
1168 llassert (sortTable != NULL);
1170 for (mem = sortTable[strSort]->members;
1171 mem != smemberInfo_undefined; mem = mem->next)
1173 newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1174 newinfo->name = mem->name;
1175 newinfo->sort = sort_makeVal (mem->sort);
1176 newinfo->next = smemberInfo_undefined;
1178 if (top == smemberInfo_undefined)
1179 { /* start of iteration */
1185 llassert (tail != smemberInfo_undefined);
1187 tail->next = newinfo;
1189 /*@-branchstate@*/ /* tail is dependent */
1194 sortTable[tupleSort]->members = top;
1198 void genTupleOps (sort tupleSort)
1203 unsigned int memCount;
1204 ltokenList domain = ltokenList_new ();
1211 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1213 llassert (sortTable != NULL);
1214 for (m = sortTable[tupleSort]->members;
1215 m != smemberInfo_undefined; m = m->next)
1217 fieldsort = sort_makeVal (m->sort);
1218 overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1220 dom = ltoken_createType (simpleId, SID_SORT,
1221 sort_getLsymbol (fieldsort));
1222 ltokenList_addh (domain, dom);
1226 /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1227 signature = makesigNode (ltoken_undefined, domain, range);
1228 u.middle = memCount;
1230 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1231 OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1233 nn = makeNameNodeForm (opform);
1234 symtable_enterOp (g_symtab, nn, signature);
1237 ** should not be able to take sizeof (struct^) ...
1242 void genUnionOps (sort tupleSort)
1244 /* like genTupleOps but no constructor [ ...]: -> unionSort */
1248 llassert (sortTable != NULL);
1249 for (m = sortTable[tupleSort]->members;
1250 m != smemberInfo_undefined; m = m->next)
1252 /* Generate __.memName: strSort ->memSortObj */
1253 overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1254 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1255 sort_getName (tupleSort), sort_getName (m->sort)); */
1256 /* __->memName : Union_Ptr -> memSortObj */
1257 sort = sort_makePtr (ltoken_undefined, tupleSort);
1258 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1259 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1260 sort_getName (sort), sort_getName (m->sort)); */
1265 void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1270 llassert (sortTable != NULL);
1271 for (m = sortTable[strSort]->members;
1272 m != smemberInfo_undefined; m = m->next)
1274 /* Generate __.memName: strSort ->memSortObj */
1275 overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1276 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1277 sort_getName (strSort), sort_getName (m->sort)); */
1278 /* __->memName : Struct_Ptr -> memSortObj */
1279 sort = sort_makePtr (ltoken_undefined, strSort);
1280 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1281 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1282 sort_getName (sort), sort_getName (m->sort)); */
1284 /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1285 /* Generate __any, __pre, __post: nStruct -> nTuple */
1286 /* Generate sizeof: strSort -> int */
1287 /* overloadStateFcns (strSort, tupleSort); */
1291 sort_makeUnion (ltoken opttagid)
1298 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1299 /* isNewTag true means that the name generated is new */
1301 outSort = (sortNode) dmalloc (sizeof (*outSort));
1303 if (ltoken_isUndefined (opttagid))
1305 opttagid = ltoken_create (simpleId, newUnionTag ());
1306 outSort->realtag = FALSE;
1310 outSort->realtag = TRUE;
1313 llassert (sortTable != NULL);
1314 name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1315 handle = sort_lookupName (name);
1316 outSort->name = name;
1317 outSort->kind = SRT_UNION;
1318 outSort->tag = ltoken_getText (opttagid);
1319 outSort->baseSort = NOSORTHANDLE;
1320 outSort->objSort = NOSORTHANDLE;
1321 outSort->members = smemberInfo_undefined;
1322 outSort->export = exporting;
1323 outSort->mutable = TRUE;
1324 outSort->imported = context_inImport ();
1325 outSort->abstract = FALSE;
1326 outSort->handle = handle;
1328 if (handle == NOSORTHANDLE)
1330 if (sort_isNewEntry (outSort))
1332 outSort->handle = handle = sort_enterNew (outSort);
1336 outSort->handle = handle = sort_enterNewForce (outSort);
1341 if (sortTable[handle]->kind != SRT_UNION)
1343 sortError (opttagid, handle, outSort);
1346 sortNode_free (outSort);
1353 sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1355 /* expect unionSort to be in sort table but not yet filled in */
1356 /* return TRUE if it is "new" */
1360 llassert (sortTable != NULL);
1362 sn = sort_lookup (unionSort);
1364 if (sn->members == (smemberInfo *) 0)
1366 sortTable[unionSort]->members = info;
1367 uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1368 /* same as struct operations */
1369 genStrOps (unionSort, uValSort);
1374 smemberInfo_free (info);
1380 sort_makeUnionVal (ltoken t, sort unionSort)
1383 sortNode outSort, s = sort_lookup (unionSort);
1386 if (s->kind != SRT_UNION)
1388 llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
1389 sort_unparseKind (s->kind)));
1392 llassert (sortTable != NULL);
1394 name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
1395 handle = sort_lookupName (name);
1397 outSort = (sortNode) dmalloc (sizeof (*outSort));
1398 outSort->kind = SRT_UNIONVAL;
1399 outSort->name = name;
1400 outSort->tag = s->tag;
1401 outSort->realtag = s->realtag;
1402 outSort->baseSort = unionSort;
1403 outSort->objSort = NOSORTHANDLE;
1404 outSort->members = smemberInfo_undefined;
1405 outSort->export = exporting;
1406 outSort->abstract = FALSE;
1407 outSort->imported = context_inImport ();
1408 outSort->mutable = FALSE;
1409 outSort->handle = handle;
1411 if (handle == NOSORTHANDLE)
1413 if (sort_isNewEntry (outSort))
1415 outSort->handle = handle = sort_enterNew (outSort);
1417 /* Add members to the unionVal's. */
1418 /* same as structs and tuples */
1420 sort_addTupleMembers (handle, unionSort);
1421 genUnionOps (handle);
1425 outSort->handle = handle = sort_enterNew (outSort);
1430 if (sortTable[handle]->kind != SRT_UNIONVAL)
1432 sortError (t, handle, outSort);
1435 sortNode_free (outSort);
1444 static int ecount = 0;
1446 return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1452 static int ecount = 0;
1454 return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1460 static int ecount = 0;
1462 return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1466 sort_makeEnum (ltoken opttagid)
1473 llassert (sortTable != NULL);
1475 outSort = (sortNode) dmalloc (sizeof (*outSort));
1477 if (ltoken_isUndefined (opttagid))
1479 opttagid = ltoken_create (simpleId, newEnumTag ());
1480 outSort->realtag = FALSE;
1484 outSort->realtag = TRUE;
1487 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1489 name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1490 handle = sort_lookupName (name);
1491 outSort->name = name;
1492 outSort->kind = SRT_ENUM;
1493 outSort->tag = ltoken_getText (opttagid);
1494 outSort->baseSort = NOSORTHANDLE;
1495 outSort->objSort = NOSORTHANDLE;
1496 outSort->members = smemberInfo_undefined;
1497 outSort->export = exporting;
1498 outSort->mutable = FALSE;
1499 outSort->imported = context_inImport ();
1500 outSort->abstract = FALSE;
1501 outSort->handle = handle;
1503 if (handle == NOSORTHANDLE)
1505 if (sort_isNewEntry (outSort))
1507 outSort->handle = handle = sort_enterNew (outSort);
1511 outSort->handle = handle = sort_enterNewForce (outSort);
1516 if (sortTable[handle]->kind != SRT_ENUM)
1518 sortError (opttagid, handle, outSort);
1521 sortNode_free (outSort);
1528 sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1531 ** Expect enumSort to be in sort table but not yet filled in.
1532 ** Return TRUE if it is "new"
1537 llassert (sortTable != NULL);
1539 sn = sort_lookup (enumSort);
1540 if (sn->members == (smemberInfo *) 0)
1542 sortTable[enumSort]->members = info;
1543 genEnumOps (enumSort);
1548 smemberInfo_free (info);
1554 void genEnumOps (sort enumSort)
1557 ltokenList domain = ltokenList_new ();
1562 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1563 signature = makesigNode (ltoken_undefined, domain, range);
1565 llassert (sortTable != NULL);
1567 for (ei = sortTable[enumSort]->members;
1568 ei != (smemberInfo *) 0; ei = ei->next)
1570 mem = ltoken_createType (simpleId, SID_OP, ei->name);
1571 nn = makeNameNodeId (mem);
1572 symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1575 sigNode_free (signature);
1576 overloadSizeof (enumSort);
1580 genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1582 /* Generate *__: xPtr -> x */
1584 /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1586 /* Generate maxIndex, minIndex: xPtr -> int */
1587 /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1588 /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1590 /* Generate __[]: pointer -> array */
1591 overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1593 /* Generate __+__, __-__: pointer, int -> pointer */
1594 overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1595 ltoken_copy (intToken), ptrSort);
1597 overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1598 ltoken_copy (intToken), ptrSort);
1600 /* Generate NIL: -> xPtr */
1601 /* Generate __+__: int, pointer -> pointer */
1602 /* Generate __-__: pointer, pointer -> int */
1603 overloadPtrFcns (ptrSort);
1607 genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1609 /* Generate __[__]: nArr, int -> n */
1610 overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1611 ltoken_copy (intToken), baseSort);
1613 /* Generate maxIndex, minIndex: sort -> int */
1614 /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1615 /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1617 /* Generate isSub: arraySort, int, ... -> bool */
1618 overloadIsSub (arraySort, dim);
1620 /* Generate fresh, trashed, modifies, unchanged: array -> bool */
1621 /* Generate any, pre, post: array -> vector */
1623 /* overloadStateFcns (arraySort, vecSort); */
1624 /* overloadObjFcns (arraySort); */
1629 ** generate NIL: -> ptrSort
1630 ** __+__: int, ptrSort -> ptrSort
1631 ** __-__: ptrSort, ptrSort -> int
1634 overloadPtrFcns (sort ptrSort)
1636 ltokenList domain = ltokenList_new ();
1640 /* NIL: -> ptrSort */
1642 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1643 signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1644 symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1646 /* __+__: int, ptrSort -> ptrSort */
1648 ltokenList_addh (domain, ltoken_copy (intToken));
1649 ltokenList_addh (domain, ltoken_copy (range));
1651 signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1652 symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1654 /* __-__: ptrSort, ptrSort -> int */
1656 domain = ltokenList_new ();
1657 ltokenList_addh (domain, ltoken_copy (range));
1658 ltokenList_addh (domain, range);
1659 range = ltoken_copy (intToken);
1660 signature = makesigNode (ltoken_undefined, domain, range);
1661 symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1665 genVecOps (sort baseSort, sort vecSort, int dim)
1667 /* Generate __[__]: vecSort, int -> baseSort */
1669 overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1670 ltoken_copy (intToken), baseSort);
1672 /* sizeof: vecSort -> int */
1673 /* Generate isSub: vecSort, int, ... -> bool */
1675 overloadIsSub (vecSort, dim);
1679 overloadIsSub (sort s, int dim)
1681 /* Generate isSub: s, int, ... -> bool */
1683 ltoken dom, nulltok = ltoken_undefined;
1687 for (j = 1; j <= dim; j++)
1689 nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1691 isSubNameNode->isOpId = TRUE;
1692 isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1693 lsymbol_fromChars ("isSub"));
1694 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1696 domain = ltokenList_singleton (dom);
1698 for (i = 1; i <= j; i++)
1700 ltokenList_addh (domain, ltoken_copy (intToken));
1703 signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1704 symtable_enterOp (g_symtab, isSubNameNode, signature);
1709 overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1711 /* Generate <nn>: domainSort -> rangeTok */
1716 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1717 domain = ltokenList_singleton (dom);
1718 signature = makesigNode (ltoken_undefined, domain, range);
1719 symtable_enterOp (g_symtab, nn, signature);
1723 overloadSizeof (sort domainSort)
1725 nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1727 sizeofNameNode->isOpId = TRUE;
1728 sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1729 lsymbol_fromChars ("sizeof"));
1731 overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1735 overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1737 ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1739 overloadUnaryTok (nn, domainSort, range);
1743 overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1745 /* Generate <nn>: s, dTok -> rs */
1748 ltokenList domain = ltokenList_new ();
1750 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1751 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1753 ltokenList_addh (domain, dom);
1754 ltokenList_addh (domain, dTok);
1756 signature = makesigNode (ltoken_undefined, domain, range);
1757 symtable_enterOp (g_symtab, nn, signature);
1760 static /*@only@*/ nameNode
1761 makeFieldOp (lsymbol field)
1763 /* operator: __.<field> */
1768 u.id = ltoken_createType (simpleId, SID_OP, field);
1769 opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1770 nn = makeNameNodeForm (opform);
1774 static /*@only@*/ nameNode
1775 makeArrowFieldOp (lsymbol field)
1777 /* operator: __-><field> */
1782 u.id = ltoken_createType (simpleId, SID_OP, field);
1783 opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1784 nn = makeNameNodeForm (opform);
1790 /*@globals undef arrayRefNameNode,
1791 undef ptr2arrayNameNode,
1792 undef deRefNameNode,
1795 undef minusNameNode,
1801 /* on alpha, declaration does not allocate storage */
1802 sortNode noSort, HOFSort;
1805 underscoreSymbol = lsymbol_fromChars ("_");
1808 ** commonly used data for generating operators
1811 lsymbol_setbool (lsymbol_fromChars ("bool"));
1812 intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1815 ** __ \eq __: sort, sort -> bool
1818 u.anyop = ltoken_copy (ltoken_eq);
1819 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1820 eqNameNode = makeNameNodeForm (opform);
1823 ** __ \neq __: sort, sort -> bool
1826 u.anyop = ltoken_copy (ltoken_neq);
1827 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1828 neqNameNode = makeNameNodeForm (opform);
1831 **if __ then __ else __: bool, sort, sort -> sort
1834 opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1835 opFormUnion_createMiddle (0), ltoken_undefined);
1836 condNameNode = makeNameNodeForm (opform);
1838 /* operator: __[__]: arraySort, int -> elementSort_Obj */
1840 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1841 ltoken_copy (ltoken_rbracket));
1842 arrayRefNameNode = makeNameNodeForm (opform);
1844 /* operator: __[]: ptrSort -> arraySort */
1846 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1848 ltoken_copy (ltoken_rbracket));
1849 ptr2arrayNameNode = makeNameNodeForm (opform);
1852 u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1853 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1854 deRefNameNode = makeNameNodeForm (opform);
1856 /* operator: __ + __ */
1857 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1858 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1859 plusNameNode = makeNameNodeForm (opform);
1861 /* operator: __ - __ */
1862 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1863 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1864 minusNameNode = makeNameNodeForm (opform);
1867 nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1868 nilNameNode->isOpId = TRUE;
1869 nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1870 lsymbol_fromChars ("NIL"));
1872 noSort = (sortNode) dmalloc (sizeof (*noSort));
1873 noSort->kind = SRT_NONE;
1874 noSort->name = lsymbol_fromChars ("_unknown");;
1875 noSort->tag = lsymbol_undefined;
1876 noSort->baseSort = NOSORTHANDLE;
1877 noSort->objSort = NOSORTHANDLE;
1878 noSort->members = smemberInfo_undefined;
1879 noSort->export = FALSE;
1880 noSort->mutable = FALSE;
1881 noSort->abstract = FALSE;
1882 noSort->imported = FALSE;
1883 noSort->handle = NOSORTHANDLE;
1885 HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1886 HOFSort->kind = SRT_HOF;
1887 HOFSort->handle = HOFSORTHANDLE;
1888 HOFSort->name = lsymbol_undefined;
1889 HOFSort->tag = lsymbol_undefined;
1890 HOFSort->realtag = FALSE;
1891 HOFSort->baseSort = NOSORTHANDLE;
1892 HOFSort->objSort = NOSORTHANDLE;
1893 HOFSort->members = smemberInfo_undefined;
1894 HOFSort->export = FALSE;
1895 HOFSort->mutable = FALSE;
1896 HOFSort->abstract = FALSE;
1897 HOFSort->imported = FALSE;
1900 ** Store the null sort into table, and in the process initialize the sort table.
1901 ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1902 ** for HOFSORTHANDLE = 1.
1905 (void) sort_enterGlobal (noSort);
1906 (void) sort_enterGlobal (HOFSort);
1908 /* Other builtin sorts */
1910 g_sortBool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1911 g_sortCapBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1913 llassert (sortTable != NULL);
1915 /* make g_sortBool a synonym for g_sortBool */
1916 sortTable[g_sortCapBool]->kind = SRT_SYN;
1917 sortTable[g_sortCapBool]->baseSort = g_sortBool;
1918 sortTable[g_sortCapBool]->mutable = FALSE;
1919 sortTable[g_sortCapBool]->abstract = TRUE;
1921 g_sortInt = sort_makeLiteralSort (ltoken_undefined,
1922 lsymbol_fromChars ("int"));
1923 g_sortChar = sort_makeLiteralSort (ltoken_undefined,
1924 lsymbol_fromChars ("char"));
1925 sort_void = sort_makeLiteralSort (ltoken_undefined,
1926 lsymbol_fromChars ("void"));
1928 /* g_sortCstring is char__Vec, for C strings eg: "xyz" */
1929 char_obj_ptrSort = sort_makePtr (ltoken_undefined, g_sortChar);
1930 char_obj_ArrSort = sort_makeArr (ltoken_undefined, g_sortChar);
1932 g_sortCstring = sort_makeVal (char_obj_ArrSort);
1933 g_sortFloat = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1934 g_sortDouble = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1938 sort_lookupName (lsymbol name)
1942 if (name == lsymbol_undefined)
1944 return NOSORTHANDLE;
1947 llassert (sortTable != NULL);
1949 for (i = 0; i < sortTableSize; i++)
1951 if (sortTable[i]->name == name)
1957 return NOSORTHANDLE;
1961 sort_isNewEntry (sortNode s)
1965 for (i = 0; i < sortTableSize; i++)
1967 llassert (sortTable != NULL);
1969 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
1978 sort_enterGlobal (sortNode s)
1980 return (sort_enterNew (s));
1984 sort_enterNew (sortNode s)
1987 ** This ensures that the argument sortNode is not entered into
1988 ** the sort table more than once. isNew flag will tell the
1989 ** caller this info, and the caller will decide whether to generate
1990 ** operators for this sort.
1995 for (i = 0; i < sortTableSize; i++)
1997 llassert (sortTable != NULL);
1999 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
2006 if (sortTableSize >= sortTableAlloc)
2008 sortNode *oldSortTable = sortTable;
2010 sortTableAlloc += DELTA;
2011 sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2013 if (sortTableSize > 0)
2015 llassert (oldSortTable != NULL);
2016 for (i = 0; i < sortTableSize; i++)
2018 sortTable[i] = oldSortTable[i];
2022 sfree (oldSortTable);
2025 llassert (sortTable != NULL);
2027 s->handle = sortTableSize;
2028 sortTable[sortTableSize++] = s;
2034 static sort sort_enterNewForce (sortNode s)
2036 sort sor = sort_lookupName (s->name);
2038 if (sort_isNoSort (sor))
2040 sor = sort_enterNew (s);
2041 llassert (sortTable != NULL);
2043 llassert (sortTable[sor] == s);
2049 llassert (sortTable != NULL);
2053 /*@-globstate@*/ return (sor); /*@=globstate@*/
2057 sort_printStats (void)
2059 /* only for debugging */
2060 printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2065 sort_lookup (sort sor)
2067 /* ymtan: can sor be 0 ? */
2068 /* evs --- yup...0 should return noSort ? */
2070 if (sor > 0U && sor < (unsigned) sortTableSize)
2072 llassert (sortTable != NULL);
2073 return sortTable[sor];
2076 llassert (sor == 0);
2077 llassert (sor == NOSORTHANDLE);
2078 llassert (sortTable != NULL);
2079 return sortTable[NOSORTHANDLE];
2083 sort_quietLookup (sort sor)
2085 /* ymtan: can sor be 0 ? */
2086 if (sor > 0U && sor < (unsigned) sortTableSize)
2088 llassert (sortTable != NULL);
2089 return (sortTable[sor]);
2093 llassert (sortTable != NULL);
2094 return (sortTable[NOSORTHANDLE]);
2099 printEnumMembers (/*@null@*/ smemberInfo *list)
2101 cstring out = cstring_undefined;
2104 for (m = list; m != (smemberInfo *) 0; m = m->next)
2106 out = cstring_concat (out, lsymbol_toString (m->name));
2108 if (m->next != (smemberInfo *) 0)
2110 out = cstring_concatChars (out, ", ");
2116 static /*@only@*/ cstring
2117 printStructMembers (/*@null@*/ smemberInfo *list)
2119 cstring ret = cstring_undefined;
2122 for (m = list; m != (smemberInfo *) 0; m = m->next)
2124 ret = message ("%q%q %s; ",
2125 ret, sort_unparse (m->sort),
2126 cstring_fromChars (lsymbol_toChars (m->name)));
2133 sort_unparse (sort s)
2135 /* printing routine for sorts */
2139 sn = sort_quietLookup (s);
2145 if (name == lsymbol_undefined)
2147 return cstring_makeLiteral ("_unknown");
2150 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2152 return cstring_makeLiteral ("procedural");
2154 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2156 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2159 return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
2161 return (message ("obj %q", sort_unparse (sn->baseSort)));
2163 return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
2165 return (message ("vector of %q", sort_unparse (sn->baseSort)));
2167 if (sn->tag != lsymbol_undefined && sn->realtag)
2169 return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2173 return (message ("struct {%q}", printStructMembers (sn->members)));
2176 if (sn->tag != lsymbol_undefined && sn->realtag)
2178 return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2182 return (message ("union {%q}", printStructMembers (sn->members)));
2185 if (sn->tag != lsymbol_undefined && sn->realtag)
2187 return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2191 return (message ("enum {%q}", printEnumMembers (sn->members)));
2194 if (sn->tag != lsymbol_undefined && sn->realtag)
2196 return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2200 return (message ("obj struct {%q}", printStructMembers (sn->members)));
2203 if (sn->tag != lsymbol_undefined && sn->realtag)
2205 return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2209 return (message ("obj union {%q}", printStructMembers (sn->members)));
2212 return (cstring_makeLiteral ("illegal"));
2217 sp (lsymbol s1, lsymbol s2)
2219 char buff[MAXBUFFLEN];
2224 name1Ptr = lsymbol_toCharsSafe (s1);
2225 name2Ptr = lsymbol_toCharsSafe (s2);
2227 if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2229 temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2230 llfatalbug (message ("sp: name too long: %s%s",
2231 cstring_fromChars (name1Ptr),
2232 cstring_fromChars (name2Ptr)));
2235 strcpy (&buff[0], name1Ptr);
2236 strcat (&buff[0], name2Ptr);
2238 return lsymbol_fromChars (&buff[0]);
2242 sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2245 ** kind could be struct, union or enum. Create a unique sort
2246 ** name based on the given info. But first check that tagid
2247 ** has not been defined already. (ok if it is a forward decl)
2252 if (ltoken_isUndefined (tagid))
2255 return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2259 to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2261 if (tagInfo_exists (to))
2270 return (cstring_toSymbol (message ("_%s_%s",
2271 ltoken_unparse (tagid),
2272 cstring_fromChars (kind))));
2276 /*@constant int MAX_SORT_DEPTH@*/
2277 # define MAX_SORT_DEPTH 10
2280 sort_getUnderlyingAux (sort s, int depth)
2282 sortNode sn = sort_quietLookup (s);
2284 if (sn->kind == SRT_SYN)
2286 if (depth > MAX_SORT_DEPTH)
2288 llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2292 return sort_getUnderlyingAux (sn->baseSort, depth + 1);
2299 sort_getUnderlying (sort s)
2301 return sort_getUnderlyingAux (s, 0);
2305 underlyingSortName (sortNode sn)
2307 if (sn->kind == SRT_SYN)
2308 return underlyingSortName (sort_quietLookup (sn->baseSort));
2312 static /*@observer@*/ sortNode
2313 underlyingSortNode (sortNode sn)
2315 if (sn->kind == SRT_SYN)
2317 return underlyingSortNode (sort_quietLookup (sn->baseSort));
2324 sort_mutable (sort s)
2326 /* if s is not a valid sort, then returns false */
2327 sortNode sn = sort_quietLookup (s);
2334 sort_setExporting (bool flag)
2342 /*@observer@*/ static cstring
2343 sort_unparseKind (sortKind k)
2345 if (k > SRT_FIRST && k < SRT_LAST)
2346 return (cstring_fromChars (sortKindName[(int)k]));
2348 return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2352 sort_isValidSort (sort s)
2354 sortNode sn = sort_quietLookup (s);
2355 sortKind k = sn->kind;
2356 if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2363 sort_dump (FILE *f, bool lco)
2369 fprintf (f, "%s\n", BEGINSORTTABLE);
2370 llassert (sortTable != NULL);
2372 for (i = 2; i < sortTableSize; i++)
2374 /* skips 0 and 1, noSort and HOFSort */
2377 /* if (lco && !s.export) continue; */
2378 /* Difficult to keep track of where each op and sort belong to
2379 which LCL type. Easiest to export them all (even private sorts and
2380 op's) but for checking imported modules, we only use LCL types and
2381 variables to check, i.e., we don't rely on sorts and op's for such
2384 if (s->kind == SRT_NONE)
2389 fprintf (f, "%%LCL");
2392 if (lsymbol_isDefined (s->name))
2394 fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
2398 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2399 "This may result from using .lcs files produced by an old version of Splint. "
2400 "Remove the .lcs files, and rerun Splint.",
2401 i, lsymbol_toString (s->name)));
2402 fprintf (f, "sort _error_ ");
2405 if (!lco && !s->export)
2406 fprintf (f, "private ");
2408 /*@-loopswitchbreak@*/
2412 fprintf (f, "hof nil nil\n");
2416 fprintf (f, "immutable nil nil\n");
2418 fprintf (f, "primitive nil nil\n");
2422 fprintf (f, "mutable %s nil\n",
2423 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2425 fprintf (f, "obj %s nil\n",
2426 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2429 fprintf (f, "synonym %s nil\n",
2430 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2433 fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2436 fprintf (f, "arr %s nil\n",
2437 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2440 fprintf (f, "vec %s %s\n",
2441 lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2442 lsymbol_toCharsSafe (sortTable[s->objSort]->name));
2445 if (s->tag == lsymbol_undefined)
2447 /* we need to make up a tag to prevent excessive
2448 growth of .lcs files when tags are overloaded
2450 llbuglit ("Struct has no tag");
2453 fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
2455 for (mem = s->members;
2456 mem != smemberInfo_undefined; mem = mem->next)
2459 fprintf (f, "%%LCL");
2460 fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2461 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2464 fprintf (f, "%%LCL");
2465 fprintf (f, "sort strEnd nil nil nil\n");
2468 if (s->tag == lsymbol_undefined)
2469 llbuglit ("Union has no tag");
2471 fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2472 for (mem = s->members;
2473 mem != smemberInfo_undefined; mem = mem->next)
2476 fprintf (f, "%%LCL");
2477 fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2478 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2481 fprintf (f, "%%LCL");
2482 fprintf (f, "sort unionEnd nil nil nil\n");
2485 if (s->tag == lsymbol_undefined)
2487 llbuglit ("Enum has no tag");
2490 fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
2492 for (mem = s->members;
2493 mem != smemberInfo_undefined; mem = mem->next)
2496 fprintf (f, "%%LCL");
2497 fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2500 fprintf (f, "%%LCL");
2501 fprintf (f, "sort enumEnd nil nil nil\n");
2504 fprintf (f, "tup %s nil\n",
2505 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2508 fprintf (f, "unionval %s nil\n",
2509 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2512 fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
2514 /*@=loopswitchbreak@*/
2517 fprintf (f, "%s\n", SORTTABLEEND);
2521 sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2523 if (strcmp (kstr, "synonym") == 0)
2525 (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2526 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2528 else if (strcmp (kstr, "mutable") == 0)
2530 (void) sort_constructAbstract (sname, TRUE, bsort);
2532 else if (strcmp (kstr, "obj") == 0)
2534 (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2535 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2537 else if (strcmp (kstr, "ptr") == 0)
2539 (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2540 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2542 else if (strcmp (kstr, "arr") == 0)
2544 (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2545 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2547 else if (strcmp (kstr, "tup") == 0)
2549 (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2550 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2552 else if (strcmp (kstr, "unionval") == 0)
2554 (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2555 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2559 llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2564 parseSortLine (char *line, ltoken t, inputStream s,
2565 mapping map, lsymbolList slist)
2567 /* caller expects that map and slist are updated */
2568 /* t and importfle are only used for error messages */
2569 static lsymbol strName = lsymbol_undefined;
2570 static smemberInfo *strMemList = NULL;
2571 static lsymbol unionName = lsymbol_undefined;
2572 static smemberInfo *unionMemList = NULL;
2573 static lsymbol enumName = lsymbol_undefined;
2574 static smemberInfo *enumMemList = NULL;
2575 static lsymbol tagName = lsymbol_undefined;
2577 cstring importfile = inputStream_fileName (s);
2578 char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2581 lsymbol sname, bname, new_name, objName;
2584 int col; /* for keeping column number */
2587 if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2588 &(basedstr[0]), &(objstr[0])) != 4)
2590 /* if this fails, can have weird errors */
2591 /* strEnd, unionEnd, enumEnd won't return 4 args */
2593 (message ("%q: Imported file contains illegal sort declaration. "
2594 "Skipping this line: \n%s\n",
2595 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
2596 cstring_fromChars (line)));
2600 sname = lsymbol_fromChars (sostr);
2601 if (sname == lsymbol_fromChars ("nil"))
2603 /* No given sort name. Use lsymbol_undefined and generate sort name
2604 in sort building routines. */
2605 sname = lsymbol_undefined;
2606 lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
2608 cstring_fromChars (line)));
2611 /* Assume that when we encounter a sort S1 that is based on sort
2612 S2, S2 is before S1 in the imported file. sort table is a
2613 linear list and we create base sorts before other sorts. */
2615 bname = lsymbol_fromChars (basedstr);
2616 if (strcmp (kstr, "primitive") == 0)
2618 new_name = lsymbol_translateSort (map, sname);
2619 (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2620 lsymbol_undefined, FALSE,
2621 NOSORTHANDLE, smemberInfo_undefined);
2623 else if (strcmp (kstr, "strMem") == 0)
2625 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2626 mem->next = strMemList;
2628 mem->sortname = bname;
2629 mem->sort = NOSORTHANDLE;
2632 else if (strcmp (sostr, "strEnd") == 0)
2633 { /* now process it */
2634 if (strName != lsymbol_undefined && strMemList != NULL)
2636 sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
2637 TRUE, NOSORTHANDLE, strMemList);
2639 if (tagName != lsymbol_undefined)
2641 tagid = ltoken_create (simpleId, tagName);
2643 ti = (tagInfo) dmalloc (sizeof (*ti));
2645 ti->kind = TAG_STRUCT;
2647 ti->imported = FALSE;
2649 (void) symtable_enterTagForce (g_symtab, ti);
2654 if (strName == lsymbol_undefined)
2656 lclbug (message ("%q: Imported file contains unexpected null struct sort",
2657 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2662 ** no members -> its a forward struct
2665 if (tagName != lsymbol_undefined)
2667 tagid = ltoken_create (simpleId, tagName);
2668 (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2672 strName = lsymbol_undefined;
2674 tagName = lsymbol_undefined;
2676 else if (strcmp (kstr, "str") == 0)
2678 if (strName != lsymbol_undefined || strMemList != NULL)
2680 lclbug (message ("%q: unexpected non-null struct sort or "
2681 "non-empty member list",
2682 fileloc_unparseRaw (importfile,
2683 inputStream_thisLineNumber (s))));
2685 /* see if a tag is associated with this sort */
2686 if (strcmp (basedstr, "nil") == 0)
2688 llfatalerror (message ("%s: Struct missing tag. Obsolete .lcs file, remove and rerun lcl.",
2691 strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2692 tagName = lsymbol_undefined;
2693 mapping_bind (map, sname, strName);
2696 else /* a tag exists */
2697 { /* create tag in symbol table and add tagged sort in sort table */
2699 tagid = ltoken_create (simpleId, bname);
2701 strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2702 ti = symtable_tagInfo (g_symtab, tagName);
2705 ** No error for redefining a tag in an import.
2708 /* to be processed later in sort_import */
2709 lsymbolList_addh (slist, strName);
2711 else if (strcmp (kstr, "enumMem") == 0)
2713 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2714 mem->next = enumMemList;
2715 mem->sortname = enumName;
2717 mem->sort = NOSORTHANDLE;
2720 else if (strcmp (sostr, "enumEnd") == 0)
2722 if (enumName != lsymbol_undefined && enumMemList != NULL)
2724 sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2725 FALSE, NOSORTHANDLE, enumMemList);
2727 if (tagName != lsymbol_undefined)
2729 tagid = ltoken_create (simpleId, tagName);
2731 ti = (tagInfo) dmalloc (sizeof (*ti));
2733 ti->kind = TAG_ENUM;
2735 ti->imported = FALSE;
2737 (void) symtable_enterTagForce (g_symtab, ti);
2742 lclbug (message ("%q: unexpected null enum sort or empty member list",
2743 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2745 enumName = lsymbol_undefined;
2747 tagName = lsymbol_undefined;
2749 else if (strcmp (kstr, "enum") == 0)
2751 if (enumName != lsymbol_undefined || enumMemList != NULL)
2753 lclbug (message ("%q: Unexpected non-null enum sort or "
2754 "non-empty member list",
2755 fileloc_unparseRaw (importfile,
2756 inputStream_thisLineNumber (s))));
2759 /* see if a tag is associated with this sort */
2760 if (strcmp (basedstr, "nil") == 0)
2762 llfatalerror (message ("%s: Enum missing tag. Obsolete .lcs file, "
2763 "remove and rerun lcl.",
2767 { /* a tag exists */
2769 tagid = ltoken_create (simpleId, bname);
2770 enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2771 ti = symtable_tagInfo (g_symtab, bname);
2774 else if (strcmp (kstr, "unionMem") == 0)
2776 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2777 mem->next = unionMemList;
2778 mem->sortname = bname;
2780 mem->sort = NOSORTHANDLE;
2783 else if (strcmp (sostr, "unionEnd") == 0)
2785 if (unionName != lsymbol_undefined && unionMemList != NULL)
2787 sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2788 FALSE, NOSORTHANDLE, unionMemList);
2790 if (tagName != lsymbol_undefined)
2792 tagid = ltoken_create (simpleId, tagName);
2794 ti = (tagInfo) dmalloc (sizeof (*ti));
2796 ti->kind = TAG_UNION;
2798 ti->imported = FALSE;
2800 (void) symtable_enterTagForce (g_symtab, ti);
2805 if (unionName == lsymbol_undefined)
2808 (message ("%q: Imported file contains unexpected null union sort",
2809 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2814 ** no members -> its a forward struct
2817 if (tagName != lsymbol_undefined)
2819 tagid = ltoken_create (simpleId, tagName);
2821 (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2826 unionName = lsymbol_undefined;
2827 unionMemList = NULL;
2828 tagName = lsymbol_undefined;
2830 else if (strcmp (kstr, "union") == 0)
2832 if (unionName != lsymbol_undefined || unionMemList != NULL)
2836 ("%q: Unexpected non-null union sort or non-empty "
2838 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2840 /* see if a tag is associated with this sort */
2841 if (strcmp (basedstr, "nil") == 0)
2844 (message ("%s: Union missing tag. Obsolete .lcs file, "
2845 "remove and rerun lcl.",
2849 { /* a tag exists */
2851 tagid = ltoken_create (simpleId, bname);
2853 unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2854 ti = symtable_tagInfo (g_symtab, bname);
2856 lsymbolList_addh (slist, unionName);
2858 else if (strcmp (kstr, "immutable") == 0)
2860 (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2862 else if (strcmp (kstr, "hof") == 0)
2864 (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2865 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2869 sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2871 if (sort_isNoSort (bsort))
2873 lineptr = strchr (line, ' '); /* go past "sort" */
2874 llassert (lineptr != NULL);
2875 lineptr = strchr (lineptr + 1, ' '); /* go past sostr */
2876 llassert (lineptr != NULL);
2877 lineptr = strchr (lineptr + 1, ' '); /* go past kstr */
2878 llassert (lineptr != NULL);
2879 col = 5 + lineptr - line; /* 5 for initial "%LCL "*/
2882 (message ("%q: Imported file contains unknown base sort: %s",
2883 fileloc_unparseRawCol (importfile,
2884 inputStream_thisLineNumber (s), col),
2885 cstring_fromChars (lsymbol_toCharsSafe (bname))));
2888 if (strcmp (kstr, "vec") == 0)
2890 objName = lsymbol_fromChars (objstr);
2891 objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2892 (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2893 FALSE, objSort, smemberInfo_undefined);
2897 sort_loadOther (kstr, sname, bsort);
2903 sort_import (inputStream imported, ltoken tok, mapping map)
2905 /* tok is only used for error message line number */
2908 inputStream lclsource;
2910 lsymbolList slist = lsymbolList_new ();
2912 buf = inputStream_nextLine (imported);
2914 llassert (buf != NULL);
2916 importfile = inputStream_fileName (imported);
2918 if (!firstWord (buf, "%LCLSortTable"))
2920 lclsource = LCLScanSource ();
2922 lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2923 "in import file %s:\n%s",
2925 cstring_fromChars (buf)));
2931 buf = inputStream_nextLine (imported);
2933 llassert (buf != NULL);
2935 if (firstWord (buf, "%LCLSortTableEnd"))
2940 { /* a good line, remove %LCL from line first */
2941 if (firstWord (buf, "%LCL"))
2943 parseSortLine (buf + 4, tok, imported, map, slist);
2947 lclsource = LCLScanSource ();
2950 message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
2952 cstring_fromChars (buf)));
2957 /* now process the smemberInfo in the sort List */
2958 lsymbolList_elements (slist, s)
2960 if (s != lsymbol_undefined)
2965 sor = sort_lookupName (s);
2966 sn = sort_quietLookup (sor);
2971 { /* update the symbol table with members of enum */
2973 smemberInfo *mlist = sn->members;
2974 for (; mlist != NULL; mlist = mlist->next)
2976 /* check that enumeration constants are unique */
2977 vi = symtable_varInfo (g_symtab, mlist->name);
2978 if (!varInfo_exists (vi))
2979 { /* put info into symbol table */
2980 vi = (varInfo) dmalloc (sizeof (*vi));
2981 vi->id = ltoken_create (NOTTOKEN, mlist->name);
2982 vi->kind = VRK_ENUM;
2986 (void) symtable_enterVar (g_symtab, vi);
2992 (message ("%s: enum member %s of %s has already been declared",
2994 lsymbol_toString (mlist->name),
2995 lsymbol_toString (sn->name)));
2998 /*@switchbreak@*/ break;
3003 smemberInfo *mlist = sn->members;
3005 for (; mlist != NULL; mlist = mlist->next)
3007 bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3008 if (sort_isNoSort (bsort))
3010 lclbug (message ("%s: member %s of %s has unknown sort\n",
3012 cstring_fromChars (lsymbol_toChars (mlist->name)),
3013 cstring_fromChars (lsymbol_toChars (sn->name))));
3017 mlist->sort = bsort;
3020 /*@switchbreak@*/ break;
3023 lclbug (message ("%s: %s has unexpected sort kind %s",
3025 cstring_fromChars (lsymbol_toChars (sn->name)),
3026 sort_unparseKind (sn->kind)));
3029 } end_lsymbolList_elements;
3031 /* list and sorts in it are not used anymore */
3032 lsymbolList_free (slist);
3036 sort_equal (sort s1, sort s2)
3040 if (s1 == s2) return TRUE;
3042 /* handle synonym sorts */
3043 syn1 = sort_getUnderlying (s1);
3044 syn2 = sort_getUnderlying (s2);
3046 if (syn1 == syn2) return TRUE;
3047 /* makes bool and Bool equal */
3053 sort_compatible (sort s1, sort s2)
3056 /* later: might consider "char" and enum types the same as "int" */
3059 /* handle synonym sorts */
3060 syn1 = sort_getUnderlying (s1);
3061 syn2 = sort_getUnderlying (s2);
3064 /* makes bool and Bool equal */
3069 sort_compatible_modulo_cstring (sort s1, sort s2)
3071 /* like sort_compatible but also handles special cstring inits,
3072 allows the following 2 cases:
3073 char c[] = "abc"; (LHS: char_Obj_Arr, RHS = char_Vec)
3074 (c as implicitly coerced into c^)
3075 char *d = "abc"; (LHS: char_Obj_Ptr, RHS = char_Vec)
3076 (d as implicitly coerced into d[]^)
3079 if (sort_compatible (s1, s2))
3081 syn1 = sort_getUnderlying (s1);
3082 syn2 = sort_getUnderlying (s2);
3083 if (g_sortCstring == syn2 &&
3084 (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3090 sort_getLsymbol (sort sor)
3092 sortNode sn = sort_quietLookup (sor);
3096 /* a few handy routines for debugging */
3098 char *sort_getName (sort s)
3100 return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3103 /*@exposed@*/ cstring
3104 sort_unparseName (sort s)
3106 return (cstring_fromChars (sort_getName (s)));
3110 sortError (ltoken t, sort oldsort, sortNode newnode)
3112 sortNode old = sort_quietLookup (oldsort);
3114 if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3115 (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
3117 llbuglit ("sortError: illegal sort kind");
3120 llassert (sortTable != NULL);
3122 lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
3123 cstring_fromChars (lsymbol_toChars (newnode->name)),
3124 sort_unparseKindName (sortTable[oldsort]),
3125 sort_unparseKindName (newnode)));
3128 static /*@observer@*/ cstring
3129 sort_unparseKindName (sortNode s)
3134 return cstring_fromChars (sortKindName[(int)s->kind]);
3140 return cstring_makeLiteralTemp ("MUTABLE");
3144 return cstring_makeLiteralTemp ("IMMUTABLE");
3148 return cstring_fromChars (sortKindName[(int)s->kind]);
3155 sort_fromLsymbol (lsymbol sortid)
3157 /* like sort_lookupName but creates sort if not already present */
3158 sort sort = sort_lookupName (sortid);
3159 if (sort == NOSORTHANDLE)
3160 sort = sort_makeSort (ltoken_undefined, sortid);
3165 sort_isHOFSortKind (sort s)
3167 sortNode sn = sort_quietLookup (s);
3168 if (sn->kind == SRT_HOF)
3174 ** returns TRUE iff s has State operators (', ~, ^)
3178 sort_hasStateFcns (sort s)
3180 sortNode sn = sort_quietLookup (s);
3181 sortKind kind = sn->kind;
3183 if (kind == SRT_SYN)
3185 return (sort_hasStateFcns (sn->baseSort));
3188 return ((kind == SRT_PTR) ||
3189 (kind == SRT_OBJ) ||
3190 (kind == SRT_ARRAY) ||
3191 (kind == SRT_STRUCT) ||
3192 (kind == SRT_UNION));