2 ** Splint - annotation-assisted static program checker
3 ** Copyright (C) 1994-2002 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);
123 static sort sort_void;
124 static sort char_obj_ptrSort;
125 static sort char_obj_ArrSort;
127 /* This is used to uniqueize sort names, for anonymous C types */
128 static int sortUID = 1;
130 typedef /*@only@*/ sortNode o_sortNode;
132 static /*@only@*/ /*@null@*/ o_sortNode *sortTable = (sortNode *) 0;
134 static int sortTableSize = 0;
135 static int sortTableAlloc = 0;
137 /* Important to keep sorts in some order because importing routines
138 for sorts rely on this order to ensure that when we encounter a sort
139 S1 that is based on sort S2, S2 is before S1 in the imported file. */
141 static bool exporting = TRUE;
143 static lsymbol underscoreSymbol;
144 static /*@only@*/ ltoken intToken;
146 static /*@owned@*/ nameNode arrayRefNameNode;
147 static /*@owned@*/ nameNode ptr2arrayNameNode;
148 static /*@owned@*/ nameNode deRefNameNode;
149 static /*@owned@*/ nameNode nilNameNode;
150 static /*@owned@*/ nameNode plusNameNode;
151 static /*@owned@*/ nameNode minusNameNode;
152 static /*@owned@*/ nameNode condNameNode;
153 static /*@owned@*/ nameNode eqNameNode;
154 static /*@owned@*/ nameNode neqNameNode;
156 static ob_mstring sortKindName[] =
158 "FIRSTSORT", "NOSORT", "HOFSORT",
159 "PRIMITIVE", "SYNONYM", "POINTER", "OBJ", "ARRAY", "VECTOR",
160 "STRUCT", "TUPLE", "UNION", "UNIONVAL", "ENUM", "LASTSORT"
163 static void smemberInfo_free (/*@null@*/ /*@only@*/ smemberInfo *mem)
168 static void sortNode_free (/*@only@*/ sortNode sn)
170 smemberInfo_free (sn->members);
175 sort_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 @*/
182 if (sortTable != NULL)
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);
196 for (i = 0; i < sortTableSize; i++)
198 sortNode_free (sortTable[i]);
207 sort_makeNoSort (void)
213 sort_makeHOFSort (sort base)
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;
230 llassert (sortTable != NULL);
232 outSort->handle = handle = sortTableSize;
233 sortTable[handle] = outSort;
240 sort_construct (lsymbol name, sortKind kind, sort baseSort,
242 bool mut, sort objSort, /*@null@*/ /*@only@*/ smemberInfo *members)
247 handle = sort_lookupName (name);
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;
263 if (handle == NOSORTHANDLE)
265 outSort->handle = handle = sort_enterNew (outSort);
270 llassert (sortTable != NULL);
272 if (sortTable[handle]->kind != kind)
274 sortError (ltoken_undefined, handle, outSort);
275 sortNode_free (outSort);
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.
285 sortTable[handle] = outSort;
292 sort_constructAbstract (lsymbol name, bool mut, sort baseSort)
303 handle = sort_lookupName (name);
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;
317 if (handle == NOSORTHANDLE)
319 outSort->handle = handle = sort_enterNew (outSort);
320 /* do not make sort operators. */
324 llassert (sortTable != NULL);
326 if (sortTable[handle]->kind != kind)
328 sortError (ltoken_undefined, handle, outSort);
331 sortNode_free (outSort);
338 sort_makeSort (/*@unused@*/ ltoken t, lsymbol n)
341 ** Expects n to be a new sort.
342 ** Generate a sort with the given name. Useful for LSL sorts.
345 sort handle = sort_lookupName (n);
347 if (handle == NOSORTHANDLE)
351 outSort = (sortNode) dmalloc (sizeof (*outSort));
352 outSort->handle = handle;
353 outSort->kind = SRT_PRIM;
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;
364 /* Put into sort table, sort_enter checks for duplicates. */
365 handle = sort_enterNew (outSort);
369 /* don't override old info */
377 sort_makeSortNoOps (/*@unused@*/ ltoken t, lsymbol n) /*@modifies internalState@*/
381 handle = sort_lookupName (n);
383 if (handle == NOSORTHANDLE)
387 outSort = (sortNode) dmalloc (sizeof (*outSort));
388 outSort->handle = handle;
389 outSort->kind = SRT_PRIM;
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;
399 /* Put into sort table, sort_enter checks for duplicates. */
400 handle = sort_enterNew (outSort);
401 } /* Don't override old info */
407 sort_makeLiteralSort (ltoken t, lsymbol n)
408 /*@modifies internalState@*/
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.
416 sort handle = sort_makeSort (t, n);
418 overloadSizeof (handle);
423 sort_makeSyn (ltoken t, sort s, lsymbol n)
425 /* make a synonym sort with name n that is == to sort s */
426 /* expect n to be a new sort name */
429 /* must not clash with any LSL sorts */
430 lsymbol newname = sp (underscoreSymbol, n);
432 if (n == lsymbol_undefined)
434 llbuglit ("sort_makeSyn: synonym must have name");
437 handle = sort_lookupName (newname);
439 outSort = (sortNode) dmalloc (sizeof (*outSort));
440 outSort->kind = SRT_SYN;
441 outSort->name = newname;
442 outSort->baseSort = s;
443 outSort->objSort = NOSORTHANDLE;
444 /* info is not duplicated */
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;
453 if (handle == NOSORTHANDLE)
455 outSort->handle = handle = sort_enterNew (outSort);
456 /* No operators to generate for synonyms */
460 llassert (sortTable != NULL);
462 if (sortTable[handle]->kind != SRT_SYN)
464 sortError (t, handle, outSort);
467 sortNode_free (outSort);
474 sort_makeFormal (sort insort)
479 sor = sort_getUnderlying (insort);
481 s = sort_lookup (sor);
486 handle = sort_makeTuple (ltoken_undefined, sor);
489 handle = sort_makeUnionVal (ltoken_undefined, sor);
499 sort_makeGlobal (sort insort)
501 /* Make a Obj if not an array or a struct */
504 sor = sort_getUnderlying (insort);
506 s = sort_lookup (sor);
519 llcontbuglit ("sort_makeGlobal: can't make vectors, tuples, or unionvals global");
522 handle = sort_makeObj (sor);
529 sort_makeObj (sort sor)
531 sortNode baseSortNode, outSort;
532 sort baseSort, handle;
535 /* skip the synonym sort */
536 baseSort = sort_getUnderlying (sor);
537 baseSortNode = sort_quietLookup (baseSort);
538 switch (baseSortNode->kind)
544 if (baseSortNode->objSort != 0)
545 return baseSortNode->objSort;
546 else /* must have well-defined objSort field */
548 llcontbuglit ("sort_makeObj: Inconsistent vector reps:invalid objSort field");
553 /* need to map *_Struct_Tuple to *_Struct and *_Union_UnionVal to
554 *_Union, according to sort naming conventions */
555 if (baseSortNode->baseSort != NOSORTHANDLE)
556 /* for tuples and unionvals, baseSort field keeps the map from
557 value sort to obj sort-> */
558 return baseSortNode->baseSort;
559 else /* valid tuples and unionvals must have baseSort fields */
561 llcontbuglit ("sort_makeObj: Inconsistent tuples or unionvals reps: invalid baseSort field");
565 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
566 lsymbol_fromChars ("_Obj"));
567 handle = sort_lookupName (name);
569 outSort = (sortNode) dmalloc (sizeof (*outSort));
570 outSort->kind = SRT_OBJ;
571 /* must not clash with any LSL sorts */
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;
583 if (handle == NOSORTHANDLE)
585 if (sort_isNewEntry (outSort))
587 outSort->handle = handle = sort_enterNew (outSort);
591 outSort->handle = handle = sort_enterNew (outSort);
596 llassert (sortTable != NULL);
598 if (sortTable[handle]->kind != SRT_OBJ)
600 sortError (ltoken_undefined, handle, outSort);
603 sortNode_free (outSort);
611 sort_makePtr (ltoken t, sort baseSort)
614 sort handle, arrayHandle;
617 s = sort_lookup (baseSort);
619 if (s->kind == SRT_HOF)
623 if (s->kind == SRT_NONE)
628 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
629 s->kind != SRT_UNION)
630 /* && s->kind != SRT_OBJ) */
631 /* base is not an SRT_ARRAY, struct or union. Need to insert a obj. */
632 baseSort = sort_makeObj (baseSort);
634 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
635 lsymbol_fromChars ("_Ptr"));
636 handle = sort_lookupName (name);
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;
651 if (handle == NOSORTHANDLE)
653 if (sort_isNewEntry (outSort))
655 outSort->handle = handle = sort_enterNew (outSort);
656 arrayHandle = sort_makeArr (t, baseSort);
657 genPtrOps (baseSort, handle, arrayHandle);
661 outSort->handle = handle = sort_enterNew (outSort);
666 llassert (sortTable != NULL);
668 if (sortTable[handle]->kind != SRT_PTR)
670 sortError (t, handle, outSort);
673 sortNode_free (outSort);
680 sort_makePtrN (sort s, pointers p)
682 if (pointers_isUndefined (p))
688 return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
689 pointers_getRest (p));
694 sort_makeArr (ltoken t, sort baseSort)
696 sortNode s, outSort, old;
697 sort handle, vecHandle;
701 s = sort_lookup (baseSort);
703 if (s->kind == SRT_HOF)
705 if (s->kind == SRT_NONE)
708 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
709 s->kind != SRT_UNION && s->kind != SRT_OBJ)
710 /* base is not an array, struct or obj. Need to insert a Obj. */
711 baseSort = sort_makeObj (baseSort);
713 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
714 lsymbol_fromChars ("_Arr"));
715 handle = sort_lookupName (name);
717 /* must not clash with any LSL sorts */
718 outSort = (sortNode) dmalloc (sizeof (*outSort));
719 outSort->name = name;
720 outSort->kind = SRT_ARRAY;
721 outSort->baseSort = baseSort;
722 outSort->objSort = NOSORTHANDLE;
723 outSort->members = smemberInfo_undefined;
724 outSort->mutable = TRUE;
725 outSort->export = exporting;
726 outSort->imported = context_inImport ();
727 outSort->abstract = FALSE;
728 outSort->handle = handle;
730 if (handle == NOSORTHANDLE)
732 if (sort_isNewEntry (outSort))
734 handle = sort_enterNew (outSort);
735 outSort = sort_lookup (handle);
737 for (old = outSort, dim = 0;
738 old->kind == SRT_ARRAY;
739 dim++, old = sort_lookup (old->baseSort))
744 vecHandle = sort_makeVec (t, handle);
745 genArrOps (baseSort, handle, dim, vecHandle);
749 outSort->handle = handle = sort_enterNew (outSort);
754 llassert (sortTable != NULL);
756 if (sortTable[handle]->kind != SRT_ARRAY)
758 sortError (t, handle, outSort);
761 sortNode_free (outSort);
768 sort_makeVec (ltoken t, sort arraySort)
770 sortNode s, outSort, old;
771 sort baseSort, handle, elementSort;
772 int dim; /* array dimension count. */
775 s = sort_lookup (arraySort);
777 if (s->kind == SRT_HOF)
779 if (s->kind == SRT_NONE)
782 if (s->kind != SRT_ARRAY)
784 llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
785 sort_unparseKind (s->kind)));
788 if (s->baseSort == NOSORTHANDLE)
789 llbuglit ("sort_makeVec: arrays must have base (element) sort");
791 /* Vectors return "values", so make array elements values. */
793 baseSort = s->baseSort;
794 elementSort = sort_makeVal (baseSort);
796 name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
797 lsymbol_fromChars ("_Vec"));
798 handle = sort_lookupName (name);
800 outSort = (sortNode) dmalloc (sizeof (*outSort));
801 outSort->baseSort = elementSort;
802 outSort->name = name;
803 outSort->objSort = arraySort;
804 outSort->kind = SRT_VECTOR;
805 outSort->members = smemberInfo_undefined;
806 outSort->mutable = FALSE;
807 outSort->export = exporting;
808 outSort->imported = context_inImport ();
809 outSort->abstract = FALSE;
810 outSort->handle = handle;
812 if (handle == NOSORTHANDLE)
814 if (sort_isNewEntry (outSort))
816 outSort = sort_lookup (handle = sort_enterNew (outSort));
818 for (old = outSort, dim = 0;
819 old->kind == SRT_VECTOR;
820 dim++, old = sort_lookup (old->baseSort))
825 genVecOps (elementSort, handle, dim);
829 outSort->handle = handle = sort_enterNew (outSort);
834 llassert (sortTable != NULL);
836 if (sortTable[handle]->kind != SRT_VECTOR)
838 sortError (t, handle, outSort);
841 sortNode_free (outSort);
848 sort_makeVal (sort sor)
853 llassert (sortTable != NULL);
854 s = sort_quietLookup (sor);
866 /* Do nothing for basic types and pointers. */
870 return sort_makeVal (sortTable[sor]->baseSort);
872 /* Strip out the last Obj's */
873 if (s->baseSort == NOSORTHANDLE)
875 llbuglit ("sort_makeVal: expecting a base sort for Obj");
877 retSort = s->baseSort;
880 retSort = sort_makeVec (ltoken_undefined, sor);
883 retSort = sort_makeTuple (ltoken_undefined, sor);
886 retSort = sort_makeUnionVal (ltoken_undefined, sor);
889 llbuglit ("sort_makeVal: invalid sort kind");
891 rsn = sort_quietLookup (retSort);
892 if (rsn->kind == SRT_NONE)
894 llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
900 sort_makeImmutable (ltoken t, lsymbol name)
905 handle = sort_lookupName (name);
907 outSort = (sortNode) dmalloc (sizeof (*outSort));
908 outSort->kind = SRT_PRIM;
909 outSort->name = name;
910 outSort->baseSort = NOSORTHANDLE;
911 outSort->objSort = NOSORTHANDLE;
912 outSort->members = smemberInfo_undefined;
913 outSort->export = exporting;
914 outSort->mutable = FALSE;
915 outSort->imported = context_inImport ();
916 outSort->abstract = TRUE;
917 outSort->handle = handle;
919 if (handle == NOSORTHANDLE)
921 handle = sort_enterNew (outSort);
922 outSort = sort_lookup (handle);
923 overloadSizeof (handle);
927 llassert (sortTable != NULL);
929 if ((sortTable[handle]->kind != SRT_PRIM) &&
930 (sortTable[handle]->abstract) &&
931 (!sortTable[handle]->mutable))
933 sortError (t, handle, outSort);
936 sortNode_free (outSort);
943 sort_makeMutable (ltoken t, lsymbol name)
945 sort immutable_old, handle, baseSort;
948 immutable_old = sort_lookupName (name);
950 /* First generate the value sort */
951 baseSort = sort_makeImmutable (t, name);
953 llassert (sortTable != NULL);
955 /* to prevent duplicate error messages */
956 if (immutable_old != NOSORTHANDLE &&
957 (sortTable[baseSort]->kind != SRT_PRIM) &&
958 (sortTable[baseSort]->abstract) &&
959 (!sortTable[baseSort]->mutable))
961 /* already complained */
962 handle = NOSORTHANDLE;
965 { /* sort_makeImmutable must have succeeded */
968 /* must not clash with any LSL sorts */
969 objName = sp (sp (underscoreSymbol, name),
970 lsymbol_fromChars ("_Obj"));
971 handle = sort_lookupName (objName);
973 outSort = (sortNode) dmalloc (sizeof (*outSort));
974 outSort->kind = SRT_OBJ;
975 outSort->name = objName;
976 outSort->tag = lsymbol_undefined;
977 outSort->baseSort = baseSort;
978 outSort->objSort = NOSORTHANDLE;
979 outSort->members = smemberInfo_undefined;
980 outSort->mutable = TRUE;
981 outSort->export = exporting;
982 outSort->imported = context_inImport ();
983 outSort->abstract = TRUE;
984 outSort->handle = handle;
986 if (handle == NOSORTHANDLE)
988 if (sort_isNewEntry (outSort))
990 outSort->handle = handle = sort_enterNew (outSort);
994 handle = sort_enterNew (outSort);
999 llassert (sortTable != NULL);
1001 if ((sortTable[handle]->kind != SRT_OBJ)
1002 && sortTable[handle]->abstract
1003 && sortTable[handle]->mutable)
1005 sortError (t, handle, outSort);
1008 sortNode_free (outSort);
1015 sort_makeStr (ltoken opttagid)
1022 outSort = (sortNode) dmalloc (sizeof (*outSort));
1024 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1025 /* isNewTag true means that the name generated is new */
1027 if (ltoken_isUndefined (opttagid))
1029 opttagid = ltoken_create (simpleId, newStructTag ());
1031 outSort->realtag = FALSE;
1035 outSort->realtag = TRUE;
1038 name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1040 llassert (sortTable != NULL);
1041 handle = sort_lookupName (name);
1042 outSort->name = name;
1043 outSort->kind = SRT_STRUCT;
1044 outSort->tag = ltoken_getText (opttagid);
1045 outSort->baseSort = NOSORTHANDLE;
1046 outSort->objSort = NOSORTHANDLE;
1047 outSort->members = smemberInfo_undefined;
1048 outSort->export = exporting;
1049 outSort->mutable = TRUE;
1050 outSort->imported = context_inImport ();
1051 outSort->abstract = FALSE;
1052 outSort->handle = handle;
1054 if (handle == NOSORTHANDLE)
1056 if (sort_isNewEntry (outSort))
1058 outSort->handle = handle = sort_enterNew (outSort);
1062 outSort->handle = handle = sort_enterNewForce (outSort);
1067 if (sortTable[handle]->kind != SRT_STRUCT)
1069 sortError (opttagid, handle, outSort);
1072 sortNode_free (outSort);
1079 sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1081 /* expect strSort to be in sort table but not yet filled in */
1082 /* return TRUE if it is "new" */
1086 llassert (sortTable != NULL);
1087 sn = sort_lookup (strSort);
1089 if (sn->members == (smemberInfo *) 0)
1091 sortTable[strSort]->members = info;
1092 tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1093 genStrOps (strSort, tupleSort);
1098 smemberInfo_free (info);
1104 sort_makeTuple (ltoken t, sort strSort)
1107 sortNode outSort, s = sort_lookup (strSort);
1110 if (s->kind != SRT_STRUCT)
1112 llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
1113 sort_unparseKind (s->kind)));
1116 name = sp (s->name, lsymbol_fromChars ("_Tuple"));
1117 llassert (sortTable != NULL);
1118 handle = sort_lookupName (name);
1120 outSort = (sortNode) dmalloc (sizeof (*outSort));
1121 outSort->kind = SRT_TUPLE;
1122 outSort->name = name;
1123 outSort->tag = s->tag;
1124 outSort->realtag = s->realtag;
1125 outSort->baseSort = strSort;
1126 outSort->objSort = NOSORTHANDLE;
1127 outSort->members = smemberInfo_undefined;
1128 outSort->export = exporting;
1129 outSort->abstract = FALSE;
1130 outSort->imported = context_inImport ();
1131 outSort->mutable = FALSE;
1132 outSort->handle = handle;
1134 if (handle == NOSORTHANDLE)
1136 if (sort_isNewEntry (outSort))
1138 outSort->handle = handle = sort_enterNew (outSort);
1140 sort_addTupleMembers (handle, strSort);
1141 genTupleOps (handle);
1145 outSort->handle = handle = sort_enterNew (outSort);
1150 if (sortTable[handle]->kind != SRT_TUPLE)
1152 sortError (t, handle, outSort);
1155 sortNode_free (outSort);
1162 sort_addTupleMembers (sort tupleSort, sort strSort)
1164 smemberInfo *mem, *tail = smemberInfo_undefined;
1165 smemberInfo *top = smemberInfo_undefined;
1166 smemberInfo *newinfo;
1168 /* make sure it works for empty smemberInfo */
1170 llassert (sortTable != NULL);
1172 for (mem = sortTable[strSort]->members;
1173 mem != smemberInfo_undefined; mem = mem->next)
1175 newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1176 newinfo->name = mem->name;
1177 newinfo->sort = sort_makeVal (mem->sort);
1178 newinfo->next = smemberInfo_undefined;
1180 if (top == smemberInfo_undefined)
1181 { /* start of iteration */
1187 llassert (tail != smemberInfo_undefined);
1189 tail->next = newinfo;
1191 /*@-branchstate@*/ /* tail is dependent */
1196 sortTable[tupleSort]->members = top;
1200 void genTupleOps (sort tupleSort)
1205 unsigned int memCount;
1206 ltokenList domain = ltokenList_new ();
1213 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1215 llassert (sortTable != NULL);
1216 for (m = sortTable[tupleSort]->members;
1217 m != smemberInfo_undefined; m = m->next)
1219 fieldsort = sort_makeVal (m->sort);
1220 overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1222 dom = ltoken_createType (simpleId, SID_SORT,
1223 sort_getLsymbol (fieldsort));
1224 ltokenList_addh (domain, dom);
1228 /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1229 signature = makesigNode (ltoken_undefined, domain, range);
1230 u.middle = memCount;
1232 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1233 OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1235 nn = makeNameNodeForm (opform);
1236 symtable_enterOp (g_symtab, nn, signature);
1239 ** should not be able to take sizeof (struct^) ...
1244 void genUnionOps (sort tupleSort)
1246 /* like genTupleOps but no constructor [ ...]: -> unionSort */
1250 llassert (sortTable != NULL);
1251 for (m = sortTable[tupleSort]->members;
1252 m != smemberInfo_undefined; m = m->next)
1254 /* Generate __.memName: strSort ->memSortObj */
1255 overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1256 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1257 sort_getName (tupleSort), sort_getName (m->sort)); */
1258 /* __->memName : Union_Ptr -> memSortObj */
1259 sort = sort_makePtr (ltoken_undefined, tupleSort);
1260 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1261 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1262 sort_getName (sort), sort_getName (m->sort)); */
1267 void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1272 llassert (sortTable != NULL);
1273 for (m = sortTable[strSort]->members;
1274 m != smemberInfo_undefined; m = m->next)
1276 /* Generate __.memName: strSort ->memSortObj */
1277 overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1278 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1279 sort_getName (strSort), sort_getName (m->sort)); */
1280 /* __->memName : Struct_Ptr -> memSortObj */
1281 sort = sort_makePtr (ltoken_undefined, strSort);
1282 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1283 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1284 sort_getName (sort), sort_getName (m->sort)); */
1286 /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1287 /* Generate __any, __pre, __post: nStruct -> nTuple */
1288 /* Generate sizeof: strSort -> int */
1289 /* overloadStateFcns (strSort, tupleSort); */
1293 sort_makeUnion (ltoken opttagid)
1300 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1301 /* isNewTag true means that the name generated is new */
1303 outSort = (sortNode) dmalloc (sizeof (*outSort));
1305 if (ltoken_isUndefined (opttagid))
1307 opttagid = ltoken_create (simpleId, newUnionTag ());
1308 outSort->realtag = FALSE;
1312 outSort->realtag = TRUE;
1315 llassert (sortTable != NULL);
1316 name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1317 handle = sort_lookupName (name);
1318 outSort->name = name;
1319 outSort->kind = SRT_UNION;
1320 outSort->tag = ltoken_getText (opttagid);
1321 outSort->baseSort = NOSORTHANDLE;
1322 outSort->objSort = NOSORTHANDLE;
1323 outSort->members = smemberInfo_undefined;
1324 outSort->export = exporting;
1325 outSort->mutable = TRUE;
1326 outSort->imported = context_inImport ();
1327 outSort->abstract = FALSE;
1328 outSort->handle = handle;
1330 if (handle == NOSORTHANDLE)
1332 if (sort_isNewEntry (outSort))
1334 outSort->handle = handle = sort_enterNew (outSort);
1338 outSort->handle = handle = sort_enterNewForce (outSort);
1343 if (sortTable[handle]->kind != SRT_UNION)
1345 sortError (opttagid, handle, outSort);
1348 sortNode_free (outSort);
1355 sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1357 /* expect unionSort to be in sort table but not yet filled in */
1358 /* return TRUE if it is "new" */
1362 llassert (sortTable != NULL);
1364 sn = sort_lookup (unionSort);
1366 if (sn->members == (smemberInfo *) 0)
1368 sortTable[unionSort]->members = info;
1369 uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1370 /* same as struct operations */
1371 genStrOps (unionSort, uValSort);
1376 smemberInfo_free (info);
1382 sort_makeUnionVal (ltoken t, sort unionSort)
1385 sortNode outSort, s = sort_lookup (unionSort);
1388 if (s->kind != SRT_UNION)
1390 llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
1391 sort_unparseKind (s->kind)));
1394 llassert (sortTable != NULL);
1396 name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
1397 handle = sort_lookupName (name);
1399 outSort = (sortNode) dmalloc (sizeof (*outSort));
1400 outSort->kind = SRT_UNIONVAL;
1401 outSort->name = name;
1402 outSort->tag = s->tag;
1403 outSort->realtag = s->realtag;
1404 outSort->baseSort = unionSort;
1405 outSort->objSort = NOSORTHANDLE;
1406 outSort->members = smemberInfo_undefined;
1407 outSort->export = exporting;
1408 outSort->abstract = FALSE;
1409 outSort->imported = context_inImport ();
1410 outSort->mutable = FALSE;
1411 outSort->handle = handle;
1413 if (handle == NOSORTHANDLE)
1415 if (sort_isNewEntry (outSort))
1417 outSort->handle = handle = sort_enterNew (outSort);
1419 /* Add members to the unionVal's. */
1420 /* same as structs and tuples */
1422 sort_addTupleMembers (handle, unionSort);
1423 genUnionOps (handle);
1427 outSort->handle = handle = sort_enterNew (outSort);
1432 if (sortTable[handle]->kind != SRT_UNIONVAL)
1434 sortError (t, handle, outSort);
1437 sortNode_free (outSort);
1446 static int ecount = 0;
1448 return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1454 static int ecount = 0;
1456 return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1462 static int ecount = 0;
1464 return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1468 sort_makeEnum (ltoken opttagid)
1475 llassert (sortTable != NULL);
1477 outSort = (sortNode) dmalloc (sizeof (*outSort));
1479 if (ltoken_isUndefined (opttagid))
1481 opttagid = ltoken_create (simpleId, newEnumTag ());
1482 outSort->realtag = FALSE;
1486 outSort->realtag = TRUE;
1489 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1491 name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1492 handle = sort_lookupName (name);
1493 outSort->name = name;
1494 outSort->kind = SRT_ENUM;
1495 outSort->tag = ltoken_getText (opttagid);
1496 outSort->baseSort = NOSORTHANDLE;
1497 outSort->objSort = NOSORTHANDLE;
1498 outSort->members = smemberInfo_undefined;
1499 outSort->export = exporting;
1500 outSort->mutable = FALSE;
1501 outSort->imported = context_inImport ();
1502 outSort->abstract = FALSE;
1503 outSort->handle = handle;
1505 if (handle == NOSORTHANDLE)
1507 if (sort_isNewEntry (outSort))
1509 outSort->handle = handle = sort_enterNew (outSort);
1513 outSort->handle = handle = sort_enterNewForce (outSort);
1518 if (sortTable[handle]->kind != SRT_ENUM)
1520 sortError (opttagid, handle, outSort);
1523 sortNode_free (outSort);
1530 sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1533 ** Expect enumSort to be in sort table but not yet filled in.
1534 ** Return TRUE if it is "new"
1539 llassert (sortTable != NULL);
1541 sn = sort_lookup (enumSort);
1542 if (sn->members == (smemberInfo *) 0)
1544 sortTable[enumSort]->members = info;
1545 genEnumOps (enumSort);
1550 smemberInfo_free (info);
1556 void genEnumOps (sort enumSort)
1559 ltokenList domain = ltokenList_new ();
1564 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1565 signature = makesigNode (ltoken_undefined, domain, range);
1567 llassert (sortTable != NULL);
1569 for (ei = sortTable[enumSort]->members;
1570 ei != (smemberInfo *) 0; ei = ei->next)
1572 mem = ltoken_createType (simpleId, SID_OP, ei->name);
1573 nn = makeNameNodeId (mem);
1574 symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1577 sigNode_free (signature);
1578 overloadSizeof (enumSort);
1582 genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1584 /* Generate *__: xPtr -> x */
1586 /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1588 /* Generate maxIndex, minIndex: xPtr -> int */
1589 /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1590 /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1592 /* Generate __[]: pointer -> array */
1593 overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1595 /* Generate __+__, __-__: pointer, int -> pointer */
1596 overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1597 ltoken_copy (intToken), ptrSort);
1599 overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1600 ltoken_copy (intToken), ptrSort);
1602 /* Generate NIL: -> xPtr */
1603 /* Generate __+__: int, pointer -> pointer */
1604 /* Generate __-__: pointer, pointer -> int */
1605 overloadPtrFcns (ptrSort);
1609 genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1611 /* Generate __[__]: nArr, int -> n */
1612 overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1613 ltoken_copy (intToken), baseSort);
1615 /* Generate maxIndex, minIndex: sort -> int */
1616 /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1617 /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1619 /* Generate isSub: arraySort, int, ... -> bool */
1620 overloadIsSub (arraySort, dim);
1622 /* Generate fresh, trashed, modifies, unchanged: array -> bool */
1623 /* Generate any, pre, post: array -> vector */
1625 /* overloadStateFcns (arraySort, vecSort); */
1626 /* overloadObjFcns (arraySort); */
1631 ** generate NIL: -> ptrSort
1632 ** __+__: int, ptrSort -> ptrSort
1633 ** __-__: ptrSort, ptrSort -> int
1636 overloadPtrFcns (sort ptrSort)
1638 ltokenList domain = ltokenList_new ();
1642 /* NIL: -> ptrSort */
1644 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1645 signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1646 symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1648 /* __+__: int, ptrSort -> ptrSort */
1650 ltokenList_addh (domain, ltoken_copy (intToken));
1651 ltokenList_addh (domain, ltoken_copy (range));
1653 signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1654 symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1656 /* __-__: ptrSort, ptrSort -> int */
1658 domain = ltokenList_new ();
1659 ltokenList_addh (domain, ltoken_copy (range));
1660 ltokenList_addh (domain, range);
1661 range = ltoken_copy (intToken);
1662 signature = makesigNode (ltoken_undefined, domain, range);
1663 symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1667 genVecOps (sort baseSort, sort vecSort, int dim)
1669 /* Generate __[__]: vecSort, int -> baseSort */
1671 overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1672 ltoken_copy (intToken), baseSort);
1674 /* sizeof: vecSort -> int */
1675 /* Generate isSub: vecSort, int, ... -> bool */
1677 overloadIsSub (vecSort, dim);
1681 overloadIsSub (sort s, int dim)
1683 /* Generate isSub: s, int, ... -> bool */
1685 ltoken dom, nulltok = ltoken_undefined;
1689 for (j = 1; j <= dim; j++)
1691 nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1693 isSubNameNode->isOpId = TRUE;
1694 isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1695 lsymbol_fromChars ("isSub"));
1696 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1698 domain = ltokenList_singleton (dom);
1700 for (i = 1; i <= j; i++)
1702 ltokenList_addh (domain, ltoken_copy (intToken));
1705 signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1706 symtable_enterOp (g_symtab, isSubNameNode, signature);
1711 overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1713 /* Generate <nn>: domainSort -> rangeTok */
1718 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1719 domain = ltokenList_singleton (dom);
1720 signature = makesigNode (ltoken_undefined, domain, range);
1721 symtable_enterOp (g_symtab, nn, signature);
1725 overloadSizeof (sort domainSort)
1727 nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1729 sizeofNameNode->isOpId = TRUE;
1730 sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1731 lsymbol_fromChars ("sizeof"));
1733 overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1737 overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1739 ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1741 overloadUnaryTok (nn, domainSort, range);
1745 overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1747 /* Generate <nn>: s, dTok -> rs */
1750 ltokenList domain = ltokenList_new ();
1752 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1753 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1755 ltokenList_addh (domain, dom);
1756 ltokenList_addh (domain, dTok);
1758 signature = makesigNode (ltoken_undefined, domain, range);
1759 symtable_enterOp (g_symtab, nn, signature);
1762 static /*@only@*/ nameNode
1763 makeFieldOp (lsymbol field)
1765 /* operator: __.<field> */
1770 u.id = ltoken_createType (simpleId, SID_OP, field);
1771 opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1772 nn = makeNameNodeForm (opform);
1776 static /*@only@*/ nameNode
1777 makeArrowFieldOp (lsymbol field)
1779 /* operator: __-><field> */
1784 u.id = ltoken_createType (simpleId, SID_OP, field);
1785 opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1786 nn = makeNameNodeForm (opform);
1792 /*@globals undef arrayRefNameNode,
1793 undef ptr2arrayNameNode,
1794 undef deRefNameNode,
1797 undef minusNameNode,
1803 /* on alpha, declaration does not allocate storage */
1804 sortNode noSort, HOFSort;
1807 underscoreSymbol = lsymbol_fromChars ("_");
1810 ** commonly used data for generating operators
1813 lsymbol_setbool (lsymbol_fromChars ("bool"));
1814 intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1817 ** __ \eq __: sort, sort -> bool
1820 u.anyop = ltoken_copy (ltoken_eq);
1821 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1822 eqNameNode = makeNameNodeForm (opform);
1825 ** __ \neq __: sort, sort -> bool
1828 u.anyop = ltoken_copy (ltoken_neq);
1829 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1830 neqNameNode = makeNameNodeForm (opform);
1833 **if __ then __ else __: bool, sort, sort -> sort
1836 opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1837 opFormUnion_createMiddle (0), ltoken_undefined);
1838 condNameNode = makeNameNodeForm (opform);
1840 /* operator: __[__]: arraySort, int -> elementSort_Obj */
1842 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1843 ltoken_copy (ltoken_rbracket));
1844 arrayRefNameNode = makeNameNodeForm (opform);
1846 /* operator: __[]: ptrSort -> arraySort */
1848 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1850 ltoken_copy (ltoken_rbracket));
1851 ptr2arrayNameNode = makeNameNodeForm (opform);
1854 u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1855 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1856 deRefNameNode = makeNameNodeForm (opform);
1858 /* operator: __ + __ */
1859 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1860 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1861 plusNameNode = makeNameNodeForm (opform);
1863 /* operator: __ - __ */
1864 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1865 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1866 minusNameNode = makeNameNodeForm (opform);
1869 nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1870 nilNameNode->isOpId = TRUE;
1871 nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1872 lsymbol_fromChars ("NIL"));
1874 noSort = (sortNode) dmalloc (sizeof (*noSort));
1875 noSort->kind = SRT_NONE;
1876 noSort->name = lsymbol_fromChars ("_unknown");;
1877 noSort->tag = lsymbol_undefined;
1878 noSort->baseSort = NOSORTHANDLE;
1879 noSort->objSort = NOSORTHANDLE;
1880 noSort->members = smemberInfo_undefined;
1881 noSort->export = FALSE;
1882 noSort->mutable = FALSE;
1883 noSort->abstract = FALSE;
1884 noSort->imported = FALSE;
1885 noSort->handle = NOSORTHANDLE;
1887 HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1888 HOFSort->kind = SRT_HOF;
1889 HOFSort->handle = HOFSORTHANDLE;
1890 HOFSort->name = lsymbol_undefined;
1891 HOFSort->tag = lsymbol_undefined;
1892 HOFSort->realtag = FALSE;
1893 HOFSort->baseSort = NOSORTHANDLE;
1894 HOFSort->objSort = NOSORTHANDLE;
1895 HOFSort->members = smemberInfo_undefined;
1896 HOFSort->export = FALSE;
1897 HOFSort->mutable = FALSE;
1898 HOFSort->abstract = FALSE;
1899 HOFSort->imported = FALSE;
1902 ** Store the null sort into table, and in the process initialize the sort table.
1903 ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1904 ** for HOFSORTHANDLE = 1.
1907 (void) sort_enterGlobal (noSort);
1908 (void) sort_enterGlobal (HOFSort);
1910 /* Other builtin sorts */
1912 sort_bool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1913 sort_capBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1915 llassert (sortTable != NULL);
1917 /* make sort_Bool a synonym for sort_bool */
1918 sortTable[sort_capBool]->kind = SRT_SYN;
1919 sortTable[sort_capBool]->baseSort = sort_bool;
1920 sortTable[sort_capBool]->mutable = FALSE;
1921 sortTable[sort_capBool]->abstract = TRUE;
1923 sort_int = sort_makeLiteralSort (ltoken_undefined,
1924 lsymbol_fromChars ("int"));
1925 sort_char = sort_makeLiteralSort (ltoken_undefined,
1926 lsymbol_fromChars ("char"));
1927 sort_void = sort_makeLiteralSort (ltoken_undefined,
1928 lsymbol_fromChars ("void"));
1930 /* sort_cstring is char__Vec, for C strings eg: "xyz" */
1931 char_obj_ptrSort = sort_makePtr (ltoken_undefined, sort_char);
1932 char_obj_ArrSort = sort_makeArr (ltoken_undefined, sort_char);
1934 sort_cstring = sort_makeVal (char_obj_ArrSort);
1935 sort_float = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1936 sort_double = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1940 sort_lookupName (lsymbol name)
1944 if (name == lsymbol_undefined)
1946 return NOSORTHANDLE;
1949 llassert (sortTable != NULL);
1951 for (i = 0; i < sortTableSize; i++)
1953 if (sortTable[i]->name == name)
1959 return NOSORTHANDLE;
1963 sort_isNewEntry (sortNode s)
1967 for (i = 0; i < sortTableSize; i++)
1969 llassert (sortTable != NULL);
1971 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
1980 sort_enterGlobal (sortNode s)
1982 return (sort_enterNew (s));
1986 sort_enterNew (sortNode s)
1989 ** This ensures that the argument sortNode is not entered into
1990 ** the sort table more than once. isNew flag will tell the
1991 ** caller this info, and the caller will decide whether to generate
1992 ** operators for this sort.
1997 for (i = 0; i < sortTableSize; i++)
1999 llassert (sortTable != NULL);
2001 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
2008 if (sortTableSize >= sortTableAlloc)
2010 sortNode *oldSortTable = sortTable;
2012 sortTableAlloc += DELTA;
2013 sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2015 if (sortTableSize > 0)
2017 llassert (oldSortTable != NULL);
2018 for (i = 0; i < sortTableSize; i++)
2020 sortTable[i] = oldSortTable[i];
2024 sfree (oldSortTable);
2027 llassert (sortTable != NULL);
2029 s->handle = sortTableSize;
2030 sortTable[sortTableSize++] = s;
2036 static sort sort_enterNewForce (sortNode s)
2038 sort sor = sort_lookupName (s->name);
2040 if (sort_isNoSort (sor))
2042 sor = sort_enterNew (s);
2043 llassert (sortTable != NULL);
2045 llassert (sortTable[sor] == s);
2051 llassert (sortTable != NULL);
2055 /*@-globstate@*/ return (sor); /*@=globstate@*/
2059 sort_printStats (void)
2061 /* only for debugging */
2062 printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2067 sort_lookup (sort sor)
2069 /* ymtan: can sor be 0 ? */
2070 /* evs --- yup...0 should return noSort ? */
2072 if (sor > 0U && sor < (unsigned) sortTableSize)
2074 llassert (sortTable != NULL);
2075 return sortTable[sor];
2078 llassert (sor == 0);
2079 llassert (sor == NOSORTHANDLE);
2080 llassert (sortTable != NULL);
2081 return sortTable[NOSORTHANDLE];
2085 sort_quietLookup (sort sor)
2087 /* ymtan: can sor be 0 ? */
2088 if (sor > 0U && sor < (unsigned) sortTableSize)
2090 llassert (sortTable != NULL);
2091 return (sortTable[sor]);
2095 llassert (sortTable != NULL);
2096 return (sortTable[NOSORTHANDLE]);
2101 printEnumMembers (/*@null@*/ smemberInfo *list)
2103 cstring out = cstring_undefined;
2106 for (m = list; m != (smemberInfo *) 0; m = m->next)
2108 out = cstring_concat (out, lsymbol_toString (m->name));
2110 if (m->next != (smemberInfo *) 0)
2112 out = cstring_concatChars (out, ", ");
2118 static /*@only@*/ cstring
2119 printStructMembers (/*@null@*/ smemberInfo *list)
2121 cstring ret = cstring_undefined;
2124 for (m = list; m != (smemberInfo *) 0; m = m->next)
2126 ret = message ("%q%q %s; ",
2127 ret, sort_unparse (m->sort),
2128 cstring_fromChars (lsymbol_toChars (m->name)));
2135 sort_unparse (sort s)
2137 /* printing routine for sorts */
2141 sn = sort_quietLookup (s);
2147 if (name == lsymbol_undefined)
2149 return cstring_makeLiteral ("_unknown");
2152 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2154 return cstring_makeLiteral ("procedural");
2156 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2158 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2161 return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
2163 return (message ("obj %q", sort_unparse (sn->baseSort)));
2165 return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
2167 return (message ("vector of %q", sort_unparse (sn->baseSort)));
2169 if (sn->tag != lsymbol_undefined && sn->realtag)
2171 return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2175 return (message ("struct {%q}", printStructMembers (sn->members)));
2178 if (sn->tag != lsymbol_undefined && sn->realtag)
2180 return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2184 return (message ("union {%q}", printStructMembers (sn->members)));
2187 if (sn->tag != lsymbol_undefined && sn->realtag)
2189 return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2193 return (message ("enum {%q}", printEnumMembers (sn->members)));
2196 if (sn->tag != lsymbol_undefined && sn->realtag)
2198 return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2202 return (message ("obj struct {%q}", printStructMembers (sn->members)));
2205 if (sn->tag != lsymbol_undefined && sn->realtag)
2207 return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2211 return (message ("obj union {%q}", printStructMembers (sn->members)));
2214 return (cstring_makeLiteral ("illegal"));
2219 sp (lsymbol s1, lsymbol s2)
2221 char buff[MAXBUFFLEN];
2226 name1Ptr = lsymbol_toCharsSafe (s1);
2227 name2Ptr = lsymbol_toCharsSafe (s2);
2229 if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2231 temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2232 llfatalbug (message ("sp: name too long: %s%s",
2233 cstring_fromChars (name1Ptr),
2234 cstring_fromChars (name2Ptr)));
2237 strcpy (&buff[0], name1Ptr);
2238 strcat (&buff[0], name2Ptr);
2240 return lsymbol_fromChars (&buff[0]);
2244 sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2247 ** kind could be struct, union or enum. Create a unique sort
2248 ** name based on the given info. But first check that tagid
2249 ** has not been defined already. (ok if it is a forward decl)
2254 if (ltoken_isUndefined (tagid))
2257 return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2261 to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2263 if (tagInfo_exists (to))
2272 return (cstring_toSymbol (message ("_%s_%s",
2273 ltoken_unparse (tagid),
2274 cstring_fromChars (kind))));
2278 /*@constant int MAX_SORT_DEPTH@*/
2279 # define MAX_SORT_DEPTH 10
2282 sort_getUnderlyingAux (sort s, int depth)
2284 sortNode sn = sort_quietLookup (s);
2286 if (sn->kind == SRT_SYN)
2288 if (depth > MAX_SORT_DEPTH)
2290 llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2294 return sort_getUnderlyingAux (sn->baseSort, depth + 1);
2301 sort_getUnderlying (sort s)
2303 return sort_getUnderlyingAux (s, 0);
2307 underlyingSortName (sortNode sn)
2309 if (sn->kind == SRT_SYN)
2310 return underlyingSortName (sort_quietLookup (sn->baseSort));
2314 static /*@observer@*/ sortNode
2315 underlyingSortNode (sortNode sn)
2317 if (sn->kind == SRT_SYN)
2319 return underlyingSortNode (sort_quietLookup (sn->baseSort));
2326 sort_mutable (sort s)
2328 /* if s is not a valid sort, then returns false */
2329 sortNode sn = sort_quietLookup (s);
2336 sort_setExporting (bool flag)
2344 /*@observer@*/ static cstring
2345 sort_unparseKind (sortKind k)
2347 if (k > SRT_FIRST && k < SRT_LAST)
2348 return (cstring_fromChars (sortKindName[(int)k]));
2350 return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2354 sort_isValidSort (sort s)
2356 sortNode sn = sort_quietLookup (s);
2357 sortKind k = sn->kind;
2358 if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2365 sort_dump (FILE *f, bool lco)
2371 fprintf (f, "%s\n", BEGINSORTTABLE);
2372 llassert (sortTable != NULL);
2374 for (i = 2; i < sortTableSize; i++)
2376 /* skips 0 and 1, noSort and HOFSort */
2379 /* if (lco && !s.export) continue; */
2380 /* Difficult to keep track of where each op and sort belong to
2381 which LCL type. Easiest to export them all (even private sorts and
2382 op's) but for checking imported modules, we only use LCL types and
2383 variables to check, i.e., we don't rely on sorts and op's for such
2386 if (s->kind == SRT_NONE)
2391 fprintf (f, "%%LCL");
2394 if (lsymbol_isDefined (s->name))
2396 fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
2400 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2401 "This may result from using .lcs files produced by an old version of Splint. "
2402 "Remove the .lcs files, and rerun Splint.",
2403 i, lsymbol_toString (s->name)));
2404 fprintf (f, "sort _error_ ");
2407 if (!lco && !s->export)
2408 fprintf (f, "private ");
2410 /*@-loopswitchbreak@*/
2414 fprintf (f, "hof nil nil\n");
2418 fprintf (f, "immutable nil nil\n");
2420 fprintf (f, "primitive nil nil\n");
2424 fprintf (f, "mutable %s nil\n",
2425 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2427 fprintf (f, "obj %s nil\n",
2428 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2431 fprintf (f, "synonym %s nil\n",
2432 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2435 fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2438 fprintf (f, "arr %s nil\n",
2439 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2442 fprintf (f, "vec %s %s\n",
2443 lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2444 lsymbol_toCharsSafe (sortTable[s->objSort]->name));
2447 if (s->tag == lsymbol_undefined)
2449 /* we need to make up a tag to prevent excessive
2450 growth of .lcs files when tags are overloaded
2452 llbuglit ("Struct has no tag");
2455 fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
2457 for (mem = s->members;
2458 mem != smemberInfo_undefined; mem = mem->next)
2461 fprintf (f, "%%LCL");
2462 fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2463 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2466 fprintf (f, "%%LCL");
2467 fprintf (f, "sort strEnd nil nil nil\n");
2470 if (s->tag == lsymbol_undefined)
2471 llbuglit ("Union has no tag");
2473 fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2474 for (mem = s->members;
2475 mem != smemberInfo_undefined; mem = mem->next)
2478 fprintf (f, "%%LCL");
2479 fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2480 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2483 fprintf (f, "%%LCL");
2484 fprintf (f, "sort unionEnd nil nil nil\n");
2487 if (s->tag == lsymbol_undefined)
2489 llbuglit ("Enum has no tag");
2492 fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
2494 for (mem = s->members;
2495 mem != smemberInfo_undefined; mem = mem->next)
2498 fprintf (f, "%%LCL");
2499 fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2502 fprintf (f, "%%LCL");
2503 fprintf (f, "sort enumEnd nil nil nil\n");
2506 fprintf (f, "tup %s nil\n",
2507 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2510 fprintf (f, "unionval %s nil\n",
2511 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2514 fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
2516 /*@=loopswitchbreak@*/
2519 fprintf (f, "%s\n", SORTTABLEEND);
2523 sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2525 if (strcmp (kstr, "synonym") == 0)
2527 (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2528 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2530 else if (strcmp (kstr, "mutable") == 0)
2532 (void) sort_constructAbstract (sname, TRUE, bsort);
2534 else if (strcmp (kstr, "obj") == 0)
2536 (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2537 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2539 else if (strcmp (kstr, "ptr") == 0)
2541 (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2542 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2544 else if (strcmp (kstr, "arr") == 0)
2546 (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2547 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2549 else if (strcmp (kstr, "tup") == 0)
2551 (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2552 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2554 else if (strcmp (kstr, "unionval") == 0)
2556 (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2557 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2561 llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2566 parseSortLine (char *line, ltoken t, inputStream s,
2567 mapping map, lsymbolList slist)
2569 /* caller expects that map and slist are updated */
2570 /* t and importfle are only used for error messages */
2571 static lsymbol strName = lsymbol_undefined;
2572 static smemberInfo *strMemList = NULL;
2573 static lsymbol unionName = lsymbol_undefined;
2574 static smemberInfo *unionMemList = NULL;
2575 static lsymbol enumName = lsymbol_undefined;
2576 static smemberInfo *enumMemList = NULL;
2577 static lsymbol tagName = lsymbol_undefined;
2579 cstring importfile = inputStream_fileName (s);
2580 char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2583 lsymbol sname, bname, new_name, objName;
2586 int col; /* for keeping column number */
2589 if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2590 &(basedstr[0]), &(objstr[0])) != 4)
2592 /* if this fails, can have weird errors */
2593 /* strEnd, unionEnd, enumEnd won't return 4 args */
2595 (message ("%q: Imported file contains illegal sort declaration. "
2596 "Skipping this line: \n%s\n",
2597 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
2598 cstring_fromChars (line)));
2602 sname = lsymbol_fromChars (sostr);
2603 if (sname == lsymbol_fromChars ("nil"))
2605 /* No given sort name. Use lsymbol_undefined and generate sort name
2606 in sort building routines. */
2607 sname = lsymbol_undefined;
2608 lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
2610 cstring_fromChars (line)));
2613 /* Assume that when we encounter a sort S1 that is based on sort
2614 S2, S2 is before S1 in the imported file. sort table is a
2615 linear list and we create base sorts before other sorts. */
2617 bname = lsymbol_fromChars (basedstr);
2618 if (strcmp (kstr, "primitive") == 0)
2620 new_name = lsymbol_translateSort (map, sname);
2621 (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2622 lsymbol_undefined, FALSE,
2623 NOSORTHANDLE, smemberInfo_undefined);
2625 else if (strcmp (kstr, "strMem") == 0)
2627 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2628 mem->next = strMemList;
2630 mem->sortname = bname;
2631 mem->sort = NOSORTHANDLE;
2634 else if (strcmp (sostr, "strEnd") == 0)
2635 { /* now process it */
2636 if (strName != lsymbol_undefined && strMemList != NULL)
2638 sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
2639 TRUE, NOSORTHANDLE, strMemList);
2641 if (tagName != lsymbol_undefined)
2643 tagid = ltoken_create (simpleId, tagName);
2645 ti = (tagInfo) dmalloc (sizeof (*ti));
2647 ti->kind = TAG_STRUCT;
2649 ti->imported = FALSE;
2651 (void) symtable_enterTagForce (g_symtab, ti);
2656 if (strName == lsymbol_undefined)
2658 lclbug (message ("%q: Imported file contains unexpected null struct sort",
2659 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2664 ** no members -> its a forward struct
2667 if (tagName != lsymbol_undefined)
2669 tagid = ltoken_create (simpleId, tagName);
2670 (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2674 strName = lsymbol_undefined;
2676 tagName = lsymbol_undefined;
2678 else if (strcmp (kstr, "str") == 0)
2680 if (strName != lsymbol_undefined || strMemList != NULL)
2682 lclbug (message ("%q: unexpected non-null struct sort or "
2683 "non-empty member list",
2684 fileloc_unparseRaw (importfile,
2685 inputStream_thisLineNumber (s))));
2687 /* see if a tag is associated with this sort */
2688 if (strcmp (basedstr, "nil") == 0)
2690 llfatalerror (message ("%s: Struct missing tag. Obsolete .lcs file, remove and rerun lcl.",
2693 strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2694 tagName = lsymbol_undefined;
2695 mapping_bind (map, sname, strName);
2698 else /* a tag exists */
2699 { /* create tag in symbol table and add tagged sort in sort table */
2701 tagid = ltoken_create (simpleId, bname);
2703 strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2704 ti = symtable_tagInfo (g_symtab, tagName);
2707 ** No error for redefining a tag in an import.
2710 /* to be processed later in sort_import */
2711 lsymbolList_addh (slist, strName);
2713 else if (strcmp (kstr, "enumMem") == 0)
2715 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2716 mem->next = enumMemList;
2717 mem->sortname = enumName;
2719 mem->sort = NOSORTHANDLE;
2722 else if (strcmp (sostr, "enumEnd") == 0)
2724 if (enumName != lsymbol_undefined && enumMemList != NULL)
2726 sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2727 FALSE, NOSORTHANDLE, enumMemList);
2729 if (tagName != lsymbol_undefined)
2731 tagid = ltoken_create (simpleId, tagName);
2733 ti = (tagInfo) dmalloc (sizeof (*ti));
2735 ti->kind = TAG_ENUM;
2737 ti->imported = FALSE;
2739 (void) symtable_enterTagForce (g_symtab, ti);
2744 lclbug (message ("%q: unexpected null enum sort or empty member list",
2745 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2747 enumName = lsymbol_undefined;
2749 tagName = lsymbol_undefined;
2751 else if (strcmp (kstr, "enum") == 0)
2753 if (enumName != lsymbol_undefined || enumMemList != NULL)
2755 lclbug (message ("%q: Unexpected non-null enum sort or "
2756 "non-empty member list",
2757 fileloc_unparseRaw (importfile,
2758 inputStream_thisLineNumber (s))));
2761 /* see if a tag is associated with this sort */
2762 if (strcmp (basedstr, "nil") == 0)
2764 llfatalerror (message ("%s: Enum missing tag. Obsolete .lcs file, "
2765 "remove and rerun lcl.",
2769 { /* a tag exists */
2771 tagid = ltoken_create (simpleId, bname);
2772 enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2773 ti = symtable_tagInfo (g_symtab, bname);
2776 else if (strcmp (kstr, "unionMem") == 0)
2778 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2779 mem->next = unionMemList;
2780 mem->sortname = bname;
2782 mem->sort = NOSORTHANDLE;
2785 else if (strcmp (sostr, "unionEnd") == 0)
2787 if (unionName != lsymbol_undefined && unionMemList != NULL)
2789 sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2790 FALSE, NOSORTHANDLE, unionMemList);
2792 if (tagName != lsymbol_undefined)
2794 tagid = ltoken_create (simpleId, tagName);
2796 ti = (tagInfo) dmalloc (sizeof (*ti));
2798 ti->kind = TAG_UNION;
2800 ti->imported = FALSE;
2802 (void) symtable_enterTagForce (g_symtab, ti);
2807 if (unionName == lsymbol_undefined)
2810 (message ("%q: Imported file contains unexpected null union sort",
2811 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2816 ** no members -> its a forward struct
2819 if (tagName != lsymbol_undefined)
2821 tagid = ltoken_create (simpleId, tagName);
2823 (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2828 unionName = lsymbol_undefined;
2829 unionMemList = NULL;
2830 tagName = lsymbol_undefined;
2832 else if (strcmp (kstr, "union") == 0)
2834 if (unionName != lsymbol_undefined || unionMemList != NULL)
2838 ("%q: Unexpected non-null union sort or non-empty "
2840 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2842 /* see if a tag is associated with this sort */
2843 if (strcmp (basedstr, "nil") == 0)
2846 (message ("%s: Union missing tag. Obsolete .lcs file, "
2847 "remove and rerun lcl.",
2851 { /* a tag exists */
2853 tagid = ltoken_create (simpleId, bname);
2855 unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2856 ti = symtable_tagInfo (g_symtab, bname);
2858 lsymbolList_addh (slist, unionName);
2860 else if (strcmp (kstr, "immutable") == 0)
2862 (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2864 else if (strcmp (kstr, "hof") == 0)
2866 (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2867 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2871 sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2873 if (sort_isNoSort (bsort))
2875 lineptr = strchr (line, ' '); /* go past "sort" */
2876 llassert (lineptr != NULL);
2877 lineptr = strchr (lineptr + 1, ' '); /* go past sostr */
2878 llassert (lineptr != NULL);
2879 lineptr = strchr (lineptr + 1, ' '); /* go past kstr */
2880 llassert (lineptr != NULL);
2881 col = 5 + lineptr - line; /* 5 for initial "%LCL "*/
2884 (message ("%q: Imported file contains unknown base sort: %s",
2885 fileloc_unparseRawCol (importfile,
2886 inputStream_thisLineNumber (s), col),
2887 cstring_fromChars (lsymbol_toCharsSafe (bname))));
2890 if (strcmp (kstr, "vec") == 0)
2892 objName = lsymbol_fromChars (objstr);
2893 objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2894 (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2895 FALSE, objSort, smemberInfo_undefined);
2899 sort_loadOther (kstr, sname, bsort);
2905 sort_import (inputStream imported, ltoken tok, mapping map)
2907 /* tok is only used for error message line number */
2910 inputStream lclsource;
2912 lsymbolList slist = lsymbolList_new ();
2914 buf = inputStream_nextLine (imported);
2916 llassert (buf != NULL);
2918 importfile = inputStream_fileName (imported);
2920 if (!firstWord (buf, "%LCLSortTable"))
2922 lclsource = LCLScanSource ();
2924 lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2925 "in import file %s:\n%s",
2927 cstring_fromChars (buf)));
2933 buf = inputStream_nextLine (imported);
2935 llassert (buf != NULL);
2937 if (firstWord (buf, "%LCLSortTableEnd"))
2942 { /* a good line, remove %LCL from line first */
2943 if (firstWord (buf, "%LCL"))
2945 parseSortLine (buf + 4, tok, imported, map, slist);
2949 lclsource = LCLScanSource ();
2952 message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
2954 cstring_fromChars (buf)));
2959 /* now process the smemberInfo in the sort List */
2960 lsymbolList_elements (slist, s)
2962 if (s != lsymbol_undefined)
2967 sor = sort_lookupName (s);
2968 sn = sort_quietLookup (sor);
2973 { /* update the symbol table with members of enum */
2975 smemberInfo *mlist = sn->members;
2976 for (; mlist != NULL; mlist = mlist->next)
2978 /* check that enumeration constants are unique */
2979 vi = symtable_varInfo (g_symtab, mlist->name);
2980 if (!varInfo_exists (vi))
2981 { /* put info into symbol table */
2982 vi = (varInfo) dmalloc (sizeof (*vi));
2983 vi->id = ltoken_create (NOTTOKEN, mlist->name);
2984 vi->kind = VRK_ENUM;
2988 (void) symtable_enterVar (g_symtab, vi);
2994 (message ("%s: enum member %s of %s has already been declared",
2996 lsymbol_toString (mlist->name),
2997 lsymbol_toString (sn->name)));
3000 /*@switchbreak@*/ break;
3005 smemberInfo *mlist = sn->members;
3007 for (; mlist != NULL; mlist = mlist->next)
3009 bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3010 if (sort_isNoSort (bsort))
3012 lclbug (message ("%s: member %s of %s has unknown sort\n",
3014 cstring_fromChars (lsymbol_toChars (mlist->name)),
3015 cstring_fromChars (lsymbol_toChars (sn->name))));
3019 mlist->sort = bsort;
3022 /*@switchbreak@*/ break;
3025 lclbug (message ("%s: %s has unexpected sort kind %s",
3027 cstring_fromChars (lsymbol_toChars (sn->name)),
3028 sort_unparseKind (sn->kind)));
3031 } end_lsymbolList_elements;
3033 /* list and sorts in it are not used anymore */
3034 lsymbolList_free (slist);
3038 sort_equal (sort s1, sort s2)
3042 if (s1 == s2) return TRUE;
3044 /* handle synonym sorts */
3045 syn1 = sort_getUnderlying (s1);
3046 syn2 = sort_getUnderlying (s2);
3048 if (syn1 == syn2) return TRUE;
3049 /* makes bool and Bool equal */
3055 sort_compatible (sort s1, sort s2)
3058 /* later: might consider "char" and enum types the same as "int" */
3061 /* handle synonym sorts */
3062 syn1 = sort_getUnderlying (s1);
3063 syn2 = sort_getUnderlying (s2);
3066 /* makes bool and Bool equal */
3071 sort_compatible_modulo_cstring (sort s1, sort s2)
3073 /* like sort_compatible but also handles special cstring inits,
3074 allows the following 2 cases:
3075 char c[] = "abc"; (LHS: char_Obj_Arr, RHS = char_Vec)
3076 (c as implicitly coerced into c^)
3077 char *d = "abc"; (LHS: char_Obj_Ptr, RHS = char_Vec)
3078 (d as implicitly coerced into d[]^)
3081 if (sort_compatible (s1, s2))
3083 syn1 = sort_getUnderlying (s1);
3084 syn2 = sort_getUnderlying (s2);
3085 if (sort_cstring == syn2 &&
3086 (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3092 sort_getLsymbol (sort sor)
3094 sortNode sn = sort_quietLookup (sor);
3098 /* a few handy routines for debugging */
3100 char *sort_getName (sort s)
3102 return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3105 /*@exposed@*/ cstring
3106 sort_unparseName (sort s)
3108 return (cstring_fromChars (sort_getName (s)));
3112 sortError (ltoken t, sort oldsort, sortNode newnode)
3114 sortNode old = sort_quietLookup (oldsort);
3116 if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3117 (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
3119 llbuglit ("sortError: illegal sort kind");
3122 llassert (sortTable != NULL);
3124 lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
3125 cstring_fromChars (lsymbol_toChars (newnode->name)),
3126 sort_unparseKindName (sortTable[oldsort]),
3127 sort_unparseKindName (newnode)));
3130 static /*@observer@*/ cstring
3131 sort_unparseKindName (sortNode s)
3136 return cstring_fromChars (sortKindName[(int)s->kind]);
3142 return cstring_makeLiteralTemp ("MUTABLE");
3146 return cstring_makeLiteralTemp ("IMMUTABLE");
3150 return cstring_fromChars (sortKindName[(int)s->kind]);
3157 sort_fromLsymbol (lsymbol sortid)
3159 /* like sort_lookupName but creates sort if not already present */
3160 sort sort = sort_lookupName (sortid);
3161 if (sort == NOSORTHANDLE)
3162 sort = sort_makeSort (ltoken_undefined, sortid);
3167 sort_isHOFSortKind (sort s)
3169 sortNode sn = sort_quietLookup (s);
3170 if (sn->kind == SRT_HOF)
3176 ** returns TRUE iff s has State operators (', ~, ^)
3180 sort_hasStateFcns (sort s)
3182 sortNode sn = sort_quietLookup (s);
3183 sortKind kind = sn->kind;
3185 if (kind == SRT_SYN)
3187 return (sort_hasStateFcns (sn->baseSort));
3190 return ((kind == SRT_PTR) ||
3191 (kind == SRT_OBJ) ||
3192 (kind == SRT_ARRAY) ||
3193 (kind == SRT_STRUCT) ||
3194 (kind == SRT_UNION));