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, int pointers)
682 llassert (pointers >= 0);
690 return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
696 sort_makeArr (ltoken t, sort baseSort)
698 sortNode s, outSort, old;
699 sort handle, vecHandle;
703 s = sort_lookup (baseSort);
705 if (s->kind == SRT_HOF)
707 if (s->kind == SRT_NONE)
710 if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
711 s->kind != SRT_UNION && s->kind != SRT_OBJ)
712 /* base is not an array, struct or obj. Need to insert a Obj. */
713 baseSort = sort_makeObj (baseSort);
715 name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
716 lsymbol_fromChars ("_Arr"));
717 handle = sort_lookupName (name);
719 /* must not clash with any LSL sorts */
720 outSort = (sortNode) dmalloc (sizeof (*outSort));
721 outSort->name = name;
722 outSort->kind = SRT_ARRAY;
723 outSort->baseSort = baseSort;
724 outSort->objSort = NOSORTHANDLE;
725 outSort->members = smemberInfo_undefined;
726 outSort->mutable = TRUE;
727 outSort->export = exporting;
728 outSort->imported = context_inImport ();
729 outSort->abstract = FALSE;
730 outSort->handle = handle;
732 if (handle == NOSORTHANDLE)
734 if (sort_isNewEntry (outSort))
736 handle = sort_enterNew (outSort);
737 outSort = sort_lookup (handle);
739 for (old = outSort, dim = 0;
740 old->kind == SRT_ARRAY;
741 dim++, old = sort_lookup (old->baseSort))
746 vecHandle = sort_makeVec (t, handle);
747 genArrOps (baseSort, handle, dim, vecHandle);
751 outSort->handle = handle = sort_enterNew (outSort);
756 llassert (sortTable != NULL);
758 if (sortTable[handle]->kind != SRT_ARRAY)
760 sortError (t, handle, outSort);
763 sortNode_free (outSort);
770 sort_makeVec (ltoken t, sort arraySort)
772 sortNode s, outSort, old;
773 sort baseSort, handle, elementSort;
774 int dim; /* array dimension count. */
777 s = sort_lookup (arraySort);
779 if (s->kind == SRT_HOF)
781 if (s->kind == SRT_NONE)
784 if (s->kind != SRT_ARRAY)
786 llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
787 sort_unparseKind (s->kind)));
790 if (s->baseSort == NOSORTHANDLE)
791 llbuglit ("sort_makeVec: arrays must have base (element) sort");
793 /* Vectors return "values", so make array elements values. */
795 baseSort = s->baseSort;
796 elementSort = sort_makeVal (baseSort);
798 name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
799 lsymbol_fromChars ("_Vec"));
800 handle = sort_lookupName (name);
802 outSort = (sortNode) dmalloc (sizeof (*outSort));
803 outSort->baseSort = elementSort;
804 outSort->name = name;
805 outSort->objSort = arraySort;
806 outSort->kind = SRT_VECTOR;
807 outSort->members = smemberInfo_undefined;
808 outSort->mutable = FALSE;
809 outSort->export = exporting;
810 outSort->imported = context_inImport ();
811 outSort->abstract = FALSE;
812 outSort->handle = handle;
814 if (handle == NOSORTHANDLE)
816 if (sort_isNewEntry (outSort))
818 outSort = sort_lookup (handle = sort_enterNew (outSort));
820 for (old = outSort, dim = 0;
821 old->kind == SRT_VECTOR;
822 dim++, old = sort_lookup (old->baseSort))
827 genVecOps (elementSort, handle, dim);
831 outSort->handle = handle = sort_enterNew (outSort);
836 llassert (sortTable != NULL);
838 if (sortTable[handle]->kind != SRT_VECTOR)
840 sortError (t, handle, outSort);
843 sortNode_free (outSort);
850 sort_makeVal (sort sor)
855 llassert (sortTable != NULL);
856 s = sort_quietLookup (sor);
868 /* Do nothing for basic types and pointers. */
872 return sort_makeVal (sortTable[sor]->baseSort);
874 /* Strip out the last Obj's */
875 if (s->baseSort == NOSORTHANDLE)
877 llbuglit ("sort_makeVal: expecting a base sort for Obj");
879 retSort = s->baseSort;
882 retSort = sort_makeVec (ltoken_undefined, sor);
885 retSort = sort_makeTuple (ltoken_undefined, sor);
888 retSort = sort_makeUnionVal (ltoken_undefined, sor);
891 llbuglit ("sort_makeVal: invalid sort kind");
893 rsn = sort_quietLookup (retSort);
894 if (rsn->kind == SRT_NONE)
896 llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
902 sort_makeImmutable (ltoken t, lsymbol name)
907 handle = sort_lookupName (name);
909 outSort = (sortNode) dmalloc (sizeof (*outSort));
910 outSort->kind = SRT_PRIM;
911 outSort->name = name;
912 outSort->baseSort = NOSORTHANDLE;
913 outSort->objSort = NOSORTHANDLE;
914 outSort->members = smemberInfo_undefined;
915 outSort->export = exporting;
916 outSort->mutable = FALSE;
917 outSort->imported = context_inImport ();
918 outSort->abstract = TRUE;
919 outSort->handle = handle;
921 if (handle == NOSORTHANDLE)
923 handle = sort_enterNew (outSort);
924 outSort = sort_lookup (handle);
925 overloadSizeof (handle);
929 llassert (sortTable != NULL);
931 if ((sortTable[handle]->kind != SRT_PRIM) &&
932 (sortTable[handle]->abstract) &&
933 (!sortTable[handle]->mutable))
935 sortError (t, handle, outSort);
938 sortNode_free (outSort);
945 sort_makeMutable (ltoken t, lsymbol name)
947 sort immutable_old, handle, baseSort;
950 immutable_old = sort_lookupName (name);
952 /* First generate the value sort */
953 baseSort = sort_makeImmutable (t, name);
955 llassert (sortTable != NULL);
957 /* to prevent duplicate error messages */
958 if (immutable_old != NOSORTHANDLE &&
959 (sortTable[baseSort]->kind != SRT_PRIM) &&
960 (sortTable[baseSort]->abstract) &&
961 (!sortTable[baseSort]->mutable))
963 /* already complained */
964 handle = NOSORTHANDLE;
967 { /* sort_makeImmutable must have succeeded */
970 /* must not clash with any LSL sorts */
971 objName = sp (sp (underscoreSymbol, name),
972 lsymbol_fromChars ("_Obj"));
973 handle = sort_lookupName (objName);
975 outSort = (sortNode) dmalloc (sizeof (*outSort));
976 outSort->kind = SRT_OBJ;
977 outSort->name = objName;
978 outSort->tag = lsymbol_undefined;
979 outSort->baseSort = baseSort;
980 outSort->objSort = NOSORTHANDLE;
981 outSort->members = smemberInfo_undefined;
982 outSort->mutable = TRUE;
983 outSort->export = exporting;
984 outSort->imported = context_inImport ();
985 outSort->abstract = TRUE;
986 outSort->handle = handle;
988 if (handle == NOSORTHANDLE)
990 if (sort_isNewEntry (outSort))
992 outSort->handle = handle = sort_enterNew (outSort);
996 handle = sort_enterNew (outSort);
1001 llassert (sortTable != NULL);
1003 if ((sortTable[handle]->kind != SRT_OBJ)
1004 && sortTable[handle]->abstract
1005 && sortTable[handle]->mutable)
1007 sortError (t, handle, outSort);
1010 sortNode_free (outSort);
1017 sort_makeStr (ltoken opttagid)
1024 outSort = (sortNode) dmalloc (sizeof (*outSort));
1026 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1027 /* isNewTag true means that the name generated is new */
1029 if (ltoken_isUndefined (opttagid))
1031 opttagid = ltoken_create (simpleId, newStructTag ());
1033 outSort->realtag = FALSE;
1037 outSort->realtag = TRUE;
1040 name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1042 llassert (sortTable != NULL);
1043 handle = sort_lookupName (name);
1044 outSort->name = name;
1045 outSort->kind = SRT_STRUCT;
1046 outSort->tag = ltoken_getText (opttagid);
1047 outSort->baseSort = NOSORTHANDLE;
1048 outSort->objSort = NOSORTHANDLE;
1049 outSort->members = smemberInfo_undefined;
1050 outSort->export = exporting;
1051 outSort->mutable = TRUE;
1052 outSort->imported = context_inImport ();
1053 outSort->abstract = FALSE;
1054 outSort->handle = handle;
1056 if (handle == NOSORTHANDLE)
1058 if (sort_isNewEntry (outSort))
1060 outSort->handle = handle = sort_enterNew (outSort);
1064 outSort->handle = handle = sort_enterNewForce (outSort);
1069 if (sortTable[handle]->kind != SRT_STRUCT)
1071 sortError (opttagid, handle, outSort);
1074 sortNode_free (outSort);
1081 sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1083 /* expect strSort to be in sort table but not yet filled in */
1084 /* return TRUE if it is "new" */
1088 llassert (sortTable != NULL);
1089 sn = sort_lookup (strSort);
1091 if (sn->members == (smemberInfo *) 0)
1093 sortTable[strSort]->members = info;
1094 tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1095 genStrOps (strSort, tupleSort);
1100 smemberInfo_free (info);
1106 sort_makeTuple (ltoken t, sort strSort)
1109 sortNode outSort, s = sort_lookup (strSort);
1112 if (s->kind != SRT_STRUCT)
1114 llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
1115 sort_unparseKind (s->kind)));
1118 name = sp (s->name, lsymbol_fromChars ("_Tuple"));
1119 llassert (sortTable != NULL);
1120 handle = sort_lookupName (name);
1122 outSort = (sortNode) dmalloc (sizeof (*outSort));
1123 outSort->kind = SRT_TUPLE;
1124 outSort->name = name;
1125 outSort->tag = s->tag;
1126 outSort->realtag = s->realtag;
1127 outSort->baseSort = strSort;
1128 outSort->objSort = NOSORTHANDLE;
1129 outSort->members = smemberInfo_undefined;
1130 outSort->export = exporting;
1131 outSort->abstract = FALSE;
1132 outSort->imported = context_inImport ();
1133 outSort->mutable = FALSE;
1134 outSort->handle = handle;
1136 if (handle == NOSORTHANDLE)
1138 if (sort_isNewEntry (outSort))
1140 outSort->handle = handle = sort_enterNew (outSort);
1142 sort_addTupleMembers (handle, strSort);
1143 genTupleOps (handle);
1147 outSort->handle = handle = sort_enterNew (outSort);
1152 if (sortTable[handle]->kind != SRT_TUPLE)
1154 sortError (t, handle, outSort);
1157 sortNode_free (outSort);
1164 sort_addTupleMembers (sort tupleSort, sort strSort)
1166 smemberInfo *mem, *tail = smemberInfo_undefined;
1167 smemberInfo *top = smemberInfo_undefined;
1168 smemberInfo *newinfo;
1170 /* make sure it works for empty smemberInfo */
1172 llassert (sortTable != NULL);
1174 for (mem = sortTable[strSort]->members;
1175 mem != smemberInfo_undefined; mem = mem->next)
1177 newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1178 newinfo->name = mem->name;
1179 newinfo->sort = sort_makeVal (mem->sort);
1180 newinfo->next = smemberInfo_undefined;
1182 if (top == smemberInfo_undefined)
1183 { /* start of iteration */
1189 llassert (tail != smemberInfo_undefined);
1191 tail->next = newinfo;
1193 /*@-branchstate@*/ /* tail is dependent */
1198 sortTable[tupleSort]->members = top;
1202 void genTupleOps (sort tupleSort)
1207 unsigned int memCount;
1208 ltokenList domain = ltokenList_new ();
1215 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1217 llassert (sortTable != NULL);
1218 for (m = sortTable[tupleSort]->members;
1219 m != smemberInfo_undefined; m = m->next)
1221 fieldsort = sort_makeVal (m->sort);
1222 overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1224 dom = ltoken_createType (simpleId, SID_SORT,
1225 sort_getLsymbol (fieldsort));
1226 ltokenList_addh (domain, dom);
1230 /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1231 signature = makesigNode (ltoken_undefined, domain, range);
1232 u.middle = memCount;
1234 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1235 OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1237 nn = makeNameNodeForm (opform);
1238 symtable_enterOp (g_symtab, nn, signature);
1241 ** should not be able to take sizeof (struct^) ...
1246 void genUnionOps (sort tupleSort)
1248 /* like genTupleOps but no constructor [ ...]: -> unionSort */
1252 llassert (sortTable != NULL);
1253 for (m = sortTable[tupleSort]->members;
1254 m != smemberInfo_undefined; m = m->next)
1256 /* Generate __.memName: strSort ->memSortObj */
1257 overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1258 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1259 sort_getName (tupleSort), sort_getName (m->sort)); */
1260 /* __->memName : Union_Ptr -> memSortObj */
1261 sort = sort_makePtr (ltoken_undefined, tupleSort);
1262 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1263 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1264 sort_getName (sort), sort_getName (m->sort)); */
1269 void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1274 llassert (sortTable != NULL);
1275 for (m = sortTable[strSort]->members;
1276 m != smemberInfo_undefined; m = m->next)
1278 /* Generate __.memName: strSort ->memSortObj */
1279 overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1280 /* printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1281 sort_getName (strSort), sort_getName (m->sort)); */
1282 /* __->memName : Struct_Ptr -> memSortObj */
1283 sort = sort_makePtr (ltoken_undefined, strSort);
1284 overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1285 /* printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1286 sort_getName (sort), sort_getName (m->sort)); */
1288 /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1289 /* Generate __any, __pre, __post: nStruct -> nTuple */
1290 /* Generate sizeof: strSort -> int */
1291 /* overloadStateFcns (strSort, tupleSort); */
1295 sort_makeUnion (ltoken opttagid)
1302 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1303 /* isNewTag true means that the name generated is new */
1305 outSort = (sortNode) dmalloc (sizeof (*outSort));
1307 if (ltoken_isUndefined (opttagid))
1309 opttagid = ltoken_create (simpleId, newUnionTag ());
1310 outSort->realtag = FALSE;
1314 outSort->realtag = TRUE;
1317 llassert (sortTable != NULL);
1318 name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1319 handle = sort_lookupName (name);
1320 outSort->name = name;
1321 outSort->kind = SRT_UNION;
1322 outSort->tag = ltoken_getText (opttagid);
1323 outSort->baseSort = NOSORTHANDLE;
1324 outSort->objSort = NOSORTHANDLE;
1325 outSort->members = smemberInfo_undefined;
1326 outSort->export = exporting;
1327 outSort->mutable = TRUE;
1328 outSort->imported = context_inImport ();
1329 outSort->abstract = FALSE;
1330 outSort->handle = handle;
1332 if (handle == NOSORTHANDLE)
1334 if (sort_isNewEntry (outSort))
1336 outSort->handle = handle = sort_enterNew (outSort);
1340 outSort->handle = handle = sort_enterNewForce (outSort);
1345 if (sortTable[handle]->kind != SRT_UNION)
1347 sortError (opttagid, handle, outSort);
1350 sortNode_free (outSort);
1357 sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1359 /* expect unionSort to be in sort table but not yet filled in */
1360 /* return TRUE if it is "new" */
1364 llassert (sortTable != NULL);
1366 sn = sort_lookup (unionSort);
1368 if (sn->members == (smemberInfo *) 0)
1370 sortTable[unionSort]->members = info;
1371 uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1372 /* same as struct operations */
1373 genStrOps (unionSort, uValSort);
1378 smemberInfo_free (info);
1384 sort_makeUnionVal (ltoken t, sort unionSort)
1387 sortNode outSort, s = sort_lookup (unionSort);
1390 if (s->kind != SRT_UNION)
1392 llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
1393 sort_unparseKind (s->kind)));
1396 llassert (sortTable != NULL);
1398 name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
1399 handle = sort_lookupName (name);
1401 outSort = (sortNode) dmalloc (sizeof (*outSort));
1402 outSort->kind = SRT_UNIONVAL;
1403 outSort->name = name;
1404 outSort->tag = s->tag;
1405 outSort->realtag = s->realtag;
1406 outSort->baseSort = unionSort;
1407 outSort->objSort = NOSORTHANDLE;
1408 outSort->members = smemberInfo_undefined;
1409 outSort->export = exporting;
1410 outSort->abstract = FALSE;
1411 outSort->imported = context_inImport ();
1412 outSort->mutable = FALSE;
1413 outSort->handle = handle;
1415 if (handle == NOSORTHANDLE)
1417 if (sort_isNewEntry (outSort))
1419 outSort->handle = handle = sort_enterNew (outSort);
1421 /* Add members to the unionVal's. */
1422 /* same as structs and tuples */
1424 sort_addTupleMembers (handle, unionSort);
1425 genUnionOps (handle);
1429 outSort->handle = handle = sort_enterNew (outSort);
1434 if (sortTable[handle]->kind != SRT_UNIONVAL)
1436 sortError (t, handle, outSort);
1439 sortNode_free (outSort);
1448 static int ecount = 0;
1450 return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1456 static int ecount = 0;
1458 return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1464 static int ecount = 0;
1466 return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1470 sort_makeEnum (ltoken opttagid)
1477 llassert (sortTable != NULL);
1479 outSort = (sortNode) dmalloc (sizeof (*outSort));
1481 if (ltoken_isUndefined (opttagid))
1483 opttagid = ltoken_create (simpleId, newEnumTag ());
1484 outSort->realtag = FALSE;
1488 outSort->realtag = TRUE;
1491 /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1493 name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1494 handle = sort_lookupName (name);
1495 outSort->name = name;
1496 outSort->kind = SRT_ENUM;
1497 outSort->tag = ltoken_getText (opttagid);
1498 outSort->baseSort = NOSORTHANDLE;
1499 outSort->objSort = NOSORTHANDLE;
1500 outSort->members = smemberInfo_undefined;
1501 outSort->export = exporting;
1502 outSort->mutable = FALSE;
1503 outSort->imported = context_inImport ();
1504 outSort->abstract = FALSE;
1505 outSort->handle = handle;
1507 if (handle == NOSORTHANDLE)
1509 if (sort_isNewEntry (outSort))
1511 outSort->handle = handle = sort_enterNew (outSort);
1515 outSort->handle = handle = sort_enterNewForce (outSort);
1520 if (sortTable[handle]->kind != SRT_ENUM)
1522 sortError (opttagid, handle, outSort);
1525 sortNode_free (outSort);
1532 sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1535 ** Expect enumSort to be in sort table but not yet filled in.
1536 ** Return TRUE if it is "new"
1541 llassert (sortTable != NULL);
1543 sn = sort_lookup (enumSort);
1544 if (sn->members == (smemberInfo *) 0)
1546 sortTable[enumSort]->members = info;
1547 genEnumOps (enumSort);
1552 smemberInfo_free (info);
1558 void genEnumOps (sort enumSort)
1561 ltokenList domain = ltokenList_new ();
1566 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1567 signature = makesigNode (ltoken_undefined, domain, range);
1569 llassert (sortTable != NULL);
1571 for (ei = sortTable[enumSort]->members;
1572 ei != (smemberInfo *) 0; ei = ei->next)
1574 mem = ltoken_createType (simpleId, SID_OP, ei->name);
1575 nn = makeNameNodeId (mem);
1576 symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1579 sigNode_free (signature);
1580 overloadSizeof (enumSort);
1584 genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1586 /* Generate *__: xPtr -> x */
1588 /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1590 /* Generate maxIndex, minIndex: xPtr -> int */
1591 /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1592 /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1594 /* Generate __[]: pointer -> array */
1595 overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1597 /* Generate __+__, __-__: pointer, int -> pointer */
1598 overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1599 ltoken_copy (intToken), ptrSort);
1601 overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1602 ltoken_copy (intToken), ptrSort);
1604 /* Generate NIL: -> xPtr */
1605 /* Generate __+__: int, pointer -> pointer */
1606 /* Generate __-__: pointer, pointer -> int */
1607 overloadPtrFcns (ptrSort);
1611 genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1613 /* Generate __[__]: nArr, int -> n */
1614 overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1615 ltoken_copy (intToken), baseSort);
1617 /* Generate maxIndex, minIndex: sort -> int */
1618 /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1619 /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1621 /* Generate isSub: arraySort, int, ... -> bool */
1622 overloadIsSub (arraySort, dim);
1624 /* Generate fresh, trashed, modifies, unchanged: array -> bool */
1625 /* Generate any, pre, post: array -> vector */
1627 /* overloadStateFcns (arraySort, vecSort); */
1628 /* overloadObjFcns (arraySort); */
1633 ** generate NIL: -> ptrSort
1634 ** __+__: int, ptrSort -> ptrSort
1635 ** __-__: ptrSort, ptrSort -> int
1638 overloadPtrFcns (sort ptrSort)
1640 ltokenList domain = ltokenList_new ();
1644 /* NIL: -> ptrSort */
1646 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1647 signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1648 symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1650 /* __+__: int, ptrSort -> ptrSort */
1652 ltokenList_addh (domain, ltoken_copy (intToken));
1653 ltokenList_addh (domain, ltoken_copy (range));
1655 signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1656 symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1658 /* __-__: ptrSort, ptrSort -> int */
1660 domain = ltokenList_new ();
1661 ltokenList_addh (domain, ltoken_copy (range));
1662 ltokenList_addh (domain, range);
1663 range = ltoken_copy (intToken);
1664 signature = makesigNode (ltoken_undefined, domain, range);
1665 symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1669 genVecOps (sort baseSort, sort vecSort, int dim)
1671 /* Generate __[__]: vecSort, int -> baseSort */
1673 overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1674 ltoken_copy (intToken), baseSort);
1676 /* sizeof: vecSort -> int */
1677 /* Generate isSub: vecSort, int, ... -> bool */
1679 overloadIsSub (vecSort, dim);
1683 overloadIsSub (sort s, int dim)
1685 /* Generate isSub: s, int, ... -> bool */
1687 ltoken dom, nulltok = ltoken_undefined;
1691 for (j = 1; j <= dim; j++)
1693 nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1695 isSubNameNode->isOpId = TRUE;
1696 isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1697 lsymbol_fromChars ("isSub"));
1698 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1700 domain = ltokenList_singleton (dom);
1702 for (i = 1; i <= j; i++)
1704 ltokenList_addh (domain, ltoken_copy (intToken));
1707 signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1708 symtable_enterOp (g_symtab, isSubNameNode, signature);
1713 overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1715 /* Generate <nn>: domainSort -> rangeTok */
1720 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1721 domain = ltokenList_singleton (dom);
1722 signature = makesigNode (ltoken_undefined, domain, range);
1723 symtable_enterOp (g_symtab, nn, signature);
1727 overloadSizeof (sort domainSort)
1729 nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1731 sizeofNameNode->isOpId = TRUE;
1732 sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1733 lsymbol_fromChars ("sizeof"));
1735 overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1739 overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1741 ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1743 overloadUnaryTok (nn, domainSort, range);
1747 overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1749 /* Generate <nn>: s, dTok -> rs */
1752 ltokenList domain = ltokenList_new ();
1754 range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1755 dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1757 ltokenList_addh (domain, dom);
1758 ltokenList_addh (domain, dTok);
1760 signature = makesigNode (ltoken_undefined, domain, range);
1761 symtable_enterOp (g_symtab, nn, signature);
1764 static /*@only@*/ nameNode
1765 makeFieldOp (lsymbol field)
1767 /* operator: __.<field> */
1772 u.id = ltoken_createType (simpleId, SID_OP, field);
1773 opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1774 nn = makeNameNodeForm (opform);
1778 static /*@only@*/ nameNode
1779 makeArrowFieldOp (lsymbol field)
1781 /* operator: __-><field> */
1786 u.id = ltoken_createType (simpleId, SID_OP, field);
1787 opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1788 nn = makeNameNodeForm (opform);
1794 /*@globals undef arrayRefNameNode,
1795 undef ptr2arrayNameNode,
1796 undef deRefNameNode,
1799 undef minusNameNode,
1805 /* on alpha, declaration does not allocate storage */
1806 sortNode noSort, HOFSort;
1809 underscoreSymbol = lsymbol_fromChars ("_");
1812 ** commonly used data for generating operators
1815 lsymbol_setbool (lsymbol_fromChars ("bool"));
1816 intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1819 ** __ \eq __: sort, sort -> bool
1822 u.anyop = ltoken_copy (ltoken_eq);
1823 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1824 eqNameNode = makeNameNodeForm (opform);
1827 ** __ \neq __: sort, sort -> bool
1830 u.anyop = ltoken_copy (ltoken_neq);
1831 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1832 neqNameNode = makeNameNodeForm (opform);
1835 **if __ then __ else __: bool, sort, sort -> sort
1838 opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1839 opFormUnion_createMiddle (0), ltoken_undefined);
1840 condNameNode = makeNameNodeForm (opform);
1842 /* operator: __[__]: arraySort, int -> elementSort_Obj */
1844 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1845 ltoken_copy (ltoken_rbracket));
1846 arrayRefNameNode = makeNameNodeForm (opform);
1848 /* operator: __[]: ptrSort -> arraySort */
1850 opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1852 ltoken_copy (ltoken_rbracket));
1853 ptr2arrayNameNode = makeNameNodeForm (opform);
1856 u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1857 opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1858 deRefNameNode = makeNameNodeForm (opform);
1860 /* operator: __ + __ */
1861 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1862 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1863 plusNameNode = makeNameNodeForm (opform);
1865 /* operator: __ - __ */
1866 u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1867 opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1868 minusNameNode = makeNameNodeForm (opform);
1871 nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1872 nilNameNode->isOpId = TRUE;
1873 nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1874 lsymbol_fromChars ("NIL"));
1876 noSort = (sortNode) dmalloc (sizeof (*noSort));
1877 noSort->kind = SRT_NONE;
1878 noSort->name = lsymbol_fromChars ("_unknown");;
1879 noSort->tag = lsymbol_undefined;
1880 noSort->baseSort = NOSORTHANDLE;
1881 noSort->objSort = NOSORTHANDLE;
1882 noSort->members = smemberInfo_undefined;
1883 noSort->export = FALSE;
1884 noSort->mutable = FALSE;
1885 noSort->abstract = FALSE;
1886 noSort->imported = FALSE;
1887 noSort->handle = NOSORTHANDLE;
1889 HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1890 HOFSort->kind = SRT_HOF;
1891 HOFSort->handle = HOFSORTHANDLE;
1892 HOFSort->name = lsymbol_undefined;
1893 HOFSort->tag = lsymbol_undefined;
1894 HOFSort->realtag = FALSE;
1895 HOFSort->baseSort = NOSORTHANDLE;
1896 HOFSort->objSort = NOSORTHANDLE;
1897 HOFSort->members = smemberInfo_undefined;
1898 HOFSort->export = FALSE;
1899 HOFSort->mutable = FALSE;
1900 HOFSort->abstract = FALSE;
1901 HOFSort->imported = FALSE;
1904 ** Store the null sort into table, and in the process initialize the sort table.
1905 ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1906 ** for HOFSORTHANDLE = 1.
1909 (void) sort_enterGlobal (noSort);
1910 (void) sort_enterGlobal (HOFSort);
1912 /* Other builtin sorts */
1914 sort_bool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1915 sort_capBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1917 llassert (sortTable != NULL);
1919 /* make sort_Bool a synonym for sort_bool */
1920 sortTable[sort_capBool]->kind = SRT_SYN;
1921 sortTable[sort_capBool]->baseSort = sort_bool;
1922 sortTable[sort_capBool]->mutable = FALSE;
1923 sortTable[sort_capBool]->abstract = TRUE;
1925 sort_int = sort_makeLiteralSort (ltoken_undefined,
1926 lsymbol_fromChars ("int"));
1927 sort_char = sort_makeLiteralSort (ltoken_undefined,
1928 lsymbol_fromChars ("char"));
1929 sort_void = sort_makeLiteralSort (ltoken_undefined,
1930 lsymbol_fromChars ("void"));
1932 /* sort_cstring is char__Vec, for C strings eg: "xyz" */
1933 char_obj_ptrSort = sort_makePtr (ltoken_undefined, sort_char);
1934 char_obj_ArrSort = sort_makeArr (ltoken_undefined, sort_char);
1936 sort_cstring = sort_makeVal (char_obj_ArrSort);
1937 sort_float = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1938 sort_double = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1942 sort_lookupName (lsymbol name)
1946 if (name == lsymbol_undefined)
1948 return NOSORTHANDLE;
1951 llassert (sortTable != NULL);
1953 for (i = 0; i < sortTableSize; i++)
1955 if (sortTable[i]->name == name)
1961 return NOSORTHANDLE;
1965 sort_isNewEntry (sortNode s)
1969 for (i = 0; i < sortTableSize; i++)
1971 llassert (sortTable != NULL);
1973 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
1982 sort_enterGlobal (sortNode s)
1984 return (sort_enterNew (s));
1988 sort_enterNew (sortNode s)
1991 ** This ensures that the argument sortNode is not entered into
1992 ** the sort table more than once. isNew flag will tell the
1993 ** caller this info, and the caller will decide whether to generate
1994 ** operators for this sort.
1999 for (i = 0; i < sortTableSize; i++)
2001 llassert (sortTable != NULL);
2003 if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
2010 if (sortTableSize >= sortTableAlloc)
2012 sortNode *oldSortTable = sortTable;
2014 sortTableAlloc += DELTA;
2015 sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2017 if (sortTableSize > 0)
2019 llassert (oldSortTable != NULL);
2020 for (i = 0; i < sortTableSize; i++)
2022 sortTable[i] = oldSortTable[i];
2026 sfree (oldSortTable);
2029 llassert (sortTable != NULL);
2031 s->handle = sortTableSize;
2032 sortTable[sortTableSize++] = s;
2038 static sort sort_enterNewForce (sortNode s)
2040 sort sor = sort_lookupName (s->name);
2042 if (sort_isNoSort (sor))
2044 sor = sort_enterNew (s);
2045 llassert (sortTable != NULL);
2047 llassert (sortTable[sor] == s);
2053 llassert (sortTable != NULL);
2057 /*@-globstate@*/ return (sor); /*@=globstate@*/
2061 sort_printStats (void)
2063 /* only for debugging */
2064 printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2069 sort_lookup (sort sor)
2071 /* ymtan: can sor be 0 ? */
2072 /* evs --- yup...0 should return noSort ? */
2074 if (sor > 0U && sor < (unsigned) sortTableSize)
2076 llassert (sortTable != NULL);
2077 return sortTable[sor];
2080 llassert (sor == 0);
2081 llassert (sor == NOSORTHANDLE);
2082 llassert (sortTable != NULL);
2083 return sortTable[NOSORTHANDLE];
2087 sort_quietLookup (sort sor)
2089 /* ymtan: can sor be 0 ? */
2090 if (sor > 0U && sor < (unsigned) sortTableSize)
2092 llassert (sortTable != NULL);
2093 return (sortTable[sor]);
2097 llassert (sortTable != NULL);
2098 return (sortTable[NOSORTHANDLE]);
2103 printEnumMembers (/*@null@*/ smemberInfo *list)
2105 cstring out = cstring_undefined;
2108 for (m = list; m != (smemberInfo *) 0; m = m->next)
2110 out = cstring_concat (out, lsymbol_toString (m->name));
2112 if (m->next != (smemberInfo *) 0)
2114 out = cstring_concatChars (out, ", ");
2120 static /*@only@*/ cstring
2121 printStructMembers (/*@null@*/ smemberInfo *list)
2123 cstring ret = cstring_undefined;
2126 for (m = list; m != (smemberInfo *) 0; m = m->next)
2128 ret = message ("%q%q %s; ",
2129 ret, sort_unparse (m->sort),
2130 cstring_fromChars (lsymbol_toChars (m->name)));
2137 sort_unparse (sort s)
2139 /* printing routine for sorts */
2143 sn = sort_quietLookup (s);
2149 if (name == lsymbol_undefined)
2151 return cstring_makeLiteral ("_unknown");
2154 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2156 return cstring_makeLiteral ("procedural");
2158 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2160 return (cstring_fromCharsNew (lsymbol_toChars (name)));
2163 return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
2165 return (message ("obj %q", sort_unparse (sn->baseSort)));
2167 return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
2169 return (message ("vector of %q", sort_unparse (sn->baseSort)));
2171 if (sn->tag != lsymbol_undefined && sn->realtag)
2173 return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2177 return (message ("struct {%q}", printStructMembers (sn->members)));
2180 if (sn->tag != lsymbol_undefined && sn->realtag)
2182 return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2186 return (message ("union {%q}", printStructMembers (sn->members)));
2189 if (sn->tag != lsymbol_undefined && sn->realtag)
2191 return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2195 return (message ("enum {%q}", printEnumMembers (sn->members)));
2198 if (sn->tag != lsymbol_undefined && sn->realtag)
2200 return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2204 return (message ("obj struct {%q}", printStructMembers (sn->members)));
2207 if (sn->tag != lsymbol_undefined && sn->realtag)
2209 return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2213 return (message ("obj union {%q}", printStructMembers (sn->members)));
2216 return (cstring_makeLiteral ("illegal"));
2221 sp (lsymbol s1, lsymbol s2)
2223 char buff[MAXBUFFLEN];
2228 name1Ptr = lsymbol_toCharsSafe (s1);
2229 name2Ptr = lsymbol_toCharsSafe (s2);
2231 if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2233 temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2234 llfatalbug (message ("sp: name too long: %s%s",
2235 cstring_fromChars (name1Ptr),
2236 cstring_fromChars (name2Ptr)));
2239 strcpy (&buff[0], name1Ptr);
2240 strcat (&buff[0], name2Ptr);
2242 return lsymbol_fromChars (&buff[0]);
2246 sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2249 ** kind could be struct, union or enum. Create a unique sort
2250 ** name based on the given info. But first check that tagid
2251 ** has not been defined already. (ok if it is a forward decl)
2256 if (ltoken_isUndefined (tagid))
2259 return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2263 to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2265 if (tagInfo_exists (to))
2274 return (cstring_toSymbol (message ("_%s_%s",
2275 ltoken_unparse (tagid),
2276 cstring_fromChars (kind))));
2280 /*@constant int MAX_SORT_DEPTH@*/
2281 # define MAX_SORT_DEPTH 10
2284 sort_getUnderlyingAux (sort s, int depth)
2286 sortNode sn = sort_quietLookup (s);
2288 if (sn->kind == SRT_SYN)
2290 if (depth > MAX_SORT_DEPTH)
2292 llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2296 return sort_getUnderlyingAux (sn->baseSort, depth + 1);
2303 sort_getUnderlying (sort s)
2305 return sort_getUnderlyingAux (s, 0);
2309 underlyingSortName (sortNode sn)
2311 if (sn->kind == SRT_SYN)
2312 return underlyingSortName (sort_quietLookup (sn->baseSort));
2316 static /*@observer@*/ sortNode
2317 underlyingSortNode (sortNode sn)
2319 if (sn->kind == SRT_SYN)
2321 return underlyingSortNode (sort_quietLookup (sn->baseSort));
2328 sort_mutable (sort s)
2330 /* if s is not a valid sort, then returns false */
2331 sortNode sn = sort_quietLookup (s);
2338 sort_setExporting (bool flag)
2346 /*@observer@*/ static cstring
2347 sort_unparseKind (sortKind k)
2349 if (k > SRT_FIRST && k < SRT_LAST)
2350 return (cstring_fromChars (sortKindName[(int)k]));
2352 return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2356 sort_isValidSort (sort s)
2358 sortNode sn = sort_quietLookup (s);
2359 sortKind k = sn->kind;
2360 if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2367 sort_dump (FILE *f, bool lco)
2373 fprintf (f, "%s\n", BEGINSORTTABLE);
2374 llassert (sortTable != NULL);
2376 for (i = 2; i < sortTableSize; i++)
2378 /* skips 0 and 1, noSort and HOFSort */
2381 /* if (lco && !s.export) continue; */
2382 /* Difficult to keep track of where each op and sort belong to
2383 which LCL type. Easiest to export them all (even private sorts and
2384 op's) but for checking imported modules, we only use LCL types and
2385 variables to check, i.e., we don't rely on sorts and op's for such
2388 if (s->kind == SRT_NONE)
2393 fprintf (f, "%%LCL");
2396 if (lsymbol_isDefined (s->name))
2398 fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
2402 llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2403 "This may result from using .lcs files produced by an old version of Splint. "
2404 "Remove the .lcs files, and rerun Splint.",
2405 i, lsymbol_toString (s->name)));
2406 fprintf (f, "sort _error_ ");
2409 if (!lco && !s->export)
2410 fprintf (f, "private ");
2412 /*@-loopswitchbreak@*/
2416 fprintf (f, "hof nil nil\n");
2420 fprintf (f, "immutable nil nil\n");
2422 fprintf (f, "primitive nil nil\n");
2426 fprintf (f, "mutable %s nil\n",
2427 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2429 fprintf (f, "obj %s nil\n",
2430 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2433 fprintf (f, "synonym %s nil\n",
2434 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2437 fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2440 fprintf (f, "arr %s nil\n",
2441 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2444 fprintf (f, "vec %s %s\n",
2445 lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2446 lsymbol_toCharsSafe (sortTable[s->objSort]->name));
2449 if (s->tag == lsymbol_undefined)
2451 /* we need to make up a tag to prevent excessive
2452 growth of .lcs files when tags are overloaded
2454 llbuglit ("Struct has no tag");
2457 fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
2459 for (mem = s->members;
2460 mem != smemberInfo_undefined; mem = mem->next)
2463 fprintf (f, "%%LCL");
2464 fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2465 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2468 fprintf (f, "%%LCL");
2469 fprintf (f, "sort strEnd nil nil nil\n");
2472 if (s->tag == lsymbol_undefined)
2473 llbuglit ("Union has no tag");
2475 fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2476 for (mem = s->members;
2477 mem != smemberInfo_undefined; mem = mem->next)
2480 fprintf (f, "%%LCL");
2481 fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2482 lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2485 fprintf (f, "%%LCL");
2486 fprintf (f, "sort unionEnd nil nil nil\n");
2489 if (s->tag == lsymbol_undefined)
2491 llbuglit ("Enum has no tag");
2494 fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
2496 for (mem = s->members;
2497 mem != smemberInfo_undefined; mem = mem->next)
2500 fprintf (f, "%%LCL");
2501 fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2504 fprintf (f, "%%LCL");
2505 fprintf (f, "sort enumEnd nil nil nil\n");
2508 fprintf (f, "tup %s nil\n",
2509 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2512 fprintf (f, "unionval %s nil\n",
2513 lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2516 fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
2518 /*@=loopswitchbreak@*/
2521 fprintf (f, "%s\n", SORTTABLEEND);
2525 sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2527 if (strcmp (kstr, "synonym") == 0)
2529 (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2530 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2532 else if (strcmp (kstr, "mutable") == 0)
2534 (void) sort_constructAbstract (sname, TRUE, bsort);
2536 else if (strcmp (kstr, "obj") == 0)
2538 (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2539 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2541 else if (strcmp (kstr, "ptr") == 0)
2543 (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2544 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2546 else if (strcmp (kstr, "arr") == 0)
2548 (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2549 TRUE, NOSORTHANDLE, smemberInfo_undefined);
2551 else if (strcmp (kstr, "tup") == 0)
2553 (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2554 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2556 else if (strcmp (kstr, "unionval") == 0)
2558 (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2559 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2563 llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2568 parseSortLine (char *line, ltoken t, inputStream s,
2569 mapping map, lsymbolList slist)
2571 /* caller expects that map and slist are updated */
2572 /* t and importfle are only used for error messages */
2573 static lsymbol strName = lsymbol_undefined;
2574 static smemberInfo *strMemList = NULL;
2575 static lsymbol unionName = lsymbol_undefined;
2576 static smemberInfo *unionMemList = NULL;
2577 static lsymbol enumName = lsymbol_undefined;
2578 static smemberInfo *enumMemList = NULL;
2579 static lsymbol tagName = lsymbol_undefined;
2581 cstring importfile = inputStream_fileName (s);
2582 char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2585 lsymbol sname, bname, new_name, objName;
2588 int col; /* for keeping column number */
2591 if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2592 &(basedstr[0]), &(objstr[0])) != 4)
2594 /* if this fails, can have weird errors */
2595 /* strEnd, unionEnd, enumEnd won't return 4 args */
2597 (message ("%q: Imported file contains illegal sort declaration. "
2598 "Skipping this line: \n%s\n",
2599 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
2600 cstring_fromChars (line)));
2604 sname = lsymbol_fromChars (sostr);
2605 if (sname == lsymbol_fromChars ("nil"))
2607 /* No given sort name. Use lsymbol_undefined and generate sort name
2608 in sort building routines. */
2609 sname = lsymbol_undefined;
2610 lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
2612 cstring_fromChars (line)));
2615 /* Assume that when we encounter a sort S1 that is based on sort
2616 S2, S2 is before S1 in the imported file. sort table is a
2617 linear list and we create base sorts before other sorts. */
2619 bname = lsymbol_fromChars (basedstr);
2620 if (strcmp (kstr, "primitive") == 0)
2622 new_name = lsymbol_translateSort (map, sname);
2623 (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2624 lsymbol_undefined, FALSE,
2625 NOSORTHANDLE, smemberInfo_undefined);
2627 else if (strcmp (kstr, "strMem") == 0)
2629 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2630 mem->next = strMemList;
2632 mem->sortname = bname;
2633 mem->sort = NOSORTHANDLE;
2636 else if (strcmp (sostr, "strEnd") == 0)
2637 { /* now process it */
2638 if (strName != lsymbol_undefined && strMemList != NULL)
2640 sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
2641 TRUE, NOSORTHANDLE, strMemList);
2643 if (tagName != lsymbol_undefined)
2645 tagid = ltoken_create (simpleId, tagName);
2647 ti = (tagInfo) dmalloc (sizeof (*ti));
2649 ti->kind = TAG_STRUCT;
2651 ti->imported = FALSE;
2653 (void) symtable_enterTagForce (g_symtab, ti);
2658 if (strName == lsymbol_undefined)
2660 lclbug (message ("%q: Imported file contains unexpected null struct sort",
2661 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2666 ** no members -> its a forward struct
2669 if (tagName != lsymbol_undefined)
2671 tagid = ltoken_create (simpleId, tagName);
2672 (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2676 strName = lsymbol_undefined;
2678 tagName = lsymbol_undefined;
2680 else if (strcmp (kstr, "str") == 0)
2682 if (strName != lsymbol_undefined || strMemList != NULL)
2684 lclbug (message ("%q: unexpected non-null struct sort or "
2685 "non-empty member list",
2686 fileloc_unparseRaw (importfile,
2687 inputStream_thisLineNumber (s))));
2689 /* see if a tag is associated with this sort */
2690 if (strcmp (basedstr, "nil") == 0)
2692 llfatalerror (message ("%s: Struct missing tag. Obsolete .lcs file, remove and rerun lcl.",
2695 strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2696 tagName = lsymbol_undefined;
2697 mapping_bind (map, sname, strName);
2700 else /* a tag exists */
2701 { /* create tag in symbol table and add tagged sort in sort table */
2703 tagid = ltoken_create (simpleId, bname);
2705 strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2706 ti = symtable_tagInfo (g_symtab, tagName);
2709 ** No error for redefining a tag in an import.
2712 /* to be processed later in sort_import */
2713 lsymbolList_addh (slist, strName);
2715 else if (strcmp (kstr, "enumMem") == 0)
2717 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2718 mem->next = enumMemList;
2719 mem->sortname = enumName;
2721 mem->sort = NOSORTHANDLE;
2724 else if (strcmp (sostr, "enumEnd") == 0)
2726 if (enumName != lsymbol_undefined && enumMemList != NULL)
2728 sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2729 FALSE, NOSORTHANDLE, enumMemList);
2731 if (tagName != lsymbol_undefined)
2733 tagid = ltoken_create (simpleId, tagName);
2735 ti = (tagInfo) dmalloc (sizeof (*ti));
2737 ti->kind = TAG_ENUM;
2739 ti->imported = FALSE;
2741 (void) symtable_enterTagForce (g_symtab, ti);
2746 lclbug (message ("%q: unexpected null enum sort or empty member list",
2747 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2749 enumName = lsymbol_undefined;
2751 tagName = lsymbol_undefined;
2753 else if (strcmp (kstr, "enum") == 0)
2755 if (enumName != lsymbol_undefined || enumMemList != NULL)
2757 lclbug (message ("%q: Unexpected non-null enum sort or "
2758 "non-empty member list",
2759 fileloc_unparseRaw (importfile,
2760 inputStream_thisLineNumber (s))));
2763 /* see if a tag is associated with this sort */
2764 if (strcmp (basedstr, "nil") == 0)
2766 llfatalerror (message ("%s: Enum missing tag. Obsolete .lcs file, "
2767 "remove and rerun lcl.",
2771 { /* a tag exists */
2773 tagid = ltoken_create (simpleId, bname);
2774 enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2775 ti = symtable_tagInfo (g_symtab, bname);
2778 else if (strcmp (kstr, "unionMem") == 0)
2780 smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2781 mem->next = unionMemList;
2782 mem->sortname = bname;
2784 mem->sort = NOSORTHANDLE;
2787 else if (strcmp (sostr, "unionEnd") == 0)
2789 if (unionName != lsymbol_undefined && unionMemList != NULL)
2791 sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2792 FALSE, NOSORTHANDLE, unionMemList);
2794 if (tagName != lsymbol_undefined)
2796 tagid = ltoken_create (simpleId, tagName);
2798 ti = (tagInfo) dmalloc (sizeof (*ti));
2800 ti->kind = TAG_UNION;
2802 ti->imported = FALSE;
2804 (void) symtable_enterTagForce (g_symtab, ti);
2809 if (unionName == lsymbol_undefined)
2812 (message ("%q: Imported file contains unexpected null union sort",
2813 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2818 ** no members -> its a forward struct
2821 if (tagName != lsymbol_undefined)
2823 tagid = ltoken_create (simpleId, tagName);
2825 (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2830 unionName = lsymbol_undefined;
2831 unionMemList = NULL;
2832 tagName = lsymbol_undefined;
2834 else if (strcmp (kstr, "union") == 0)
2836 if (unionName != lsymbol_undefined || unionMemList != NULL)
2840 ("%q: Unexpected non-null union sort or non-empty "
2842 fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2844 /* see if a tag is associated with this sort */
2845 if (strcmp (basedstr, "nil") == 0)
2848 (message ("%s: Union missing tag. Obsolete .lcs file, "
2849 "remove and rerun lcl.",
2853 { /* a tag exists */
2855 tagid = ltoken_create (simpleId, bname);
2857 unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2858 ti = symtable_tagInfo (g_symtab, bname);
2860 lsymbolList_addh (slist, unionName);
2862 else if (strcmp (kstr, "immutable") == 0)
2864 (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2866 else if (strcmp (kstr, "hof") == 0)
2868 (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2869 FALSE, NOSORTHANDLE, smemberInfo_undefined);
2873 sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2875 if (sort_isNoSort (bsort))
2877 lineptr = strchr (line, ' '); /* go past "sort" */
2878 llassert (lineptr != NULL);
2879 lineptr = strchr (lineptr + 1, ' '); /* go past sostr */
2880 llassert (lineptr != NULL);
2881 lineptr = strchr (lineptr + 1, ' '); /* go past kstr */
2882 llassert (lineptr != NULL);
2883 col = 5 + lineptr - line; /* 5 for initial "%LCL "*/
2886 (message ("%q: Imported file contains unknown base sort: %s",
2887 fileloc_unparseRawCol (importfile,
2888 inputStream_thisLineNumber (s), col),
2889 cstring_fromChars (lsymbol_toCharsSafe (bname))));
2892 if (strcmp (kstr, "vec") == 0)
2894 objName = lsymbol_fromChars (objstr);
2895 objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2896 (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2897 FALSE, objSort, smemberInfo_undefined);
2901 sort_loadOther (kstr, sname, bsort);
2907 sort_import (inputStream imported, ltoken tok, mapping map)
2909 /* tok is only used for error message line number */
2912 inputStream lclsource;
2914 lsymbolList slist = lsymbolList_new ();
2916 buf = inputStream_nextLine (imported);
2918 llassert (buf != NULL);
2920 importfile = inputStream_fileName (imported);
2922 if (!firstWord (buf, "%LCLSortTable"))
2924 lclsource = LCLScanSource ();
2926 lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2927 "in import file %s:\n%s",
2929 cstring_fromChars (buf)));
2935 buf = inputStream_nextLine (imported);
2937 llassert (buf != NULL);
2939 if (firstWord (buf, "%LCLSortTableEnd"))
2944 { /* a good line, remove %LCL from line first */
2945 if (firstWord (buf, "%LCL"))
2947 parseSortLine (buf + 4, tok, imported, map, slist);
2951 lclsource = LCLScanSource ();
2954 message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
2956 cstring_fromChars (buf)));
2961 /* now process the smemberInfo in the sort List */
2962 lsymbolList_elements (slist, s)
2964 if (s != lsymbol_undefined)
2969 sor = sort_lookupName (s);
2970 sn = sort_quietLookup (sor);
2975 { /* update the symbol table with members of enum */
2977 smemberInfo *mlist = sn->members;
2978 for (; mlist != NULL; mlist = mlist->next)
2980 /* check that enumeration constants are unique */
2981 vi = symtable_varInfo (g_symtab, mlist->name);
2982 if (!varInfo_exists (vi))
2983 { /* put info into symbol table */
2984 vi = (varInfo) dmalloc (sizeof (*vi));
2985 vi->id = ltoken_create (NOTTOKEN, mlist->name);
2986 vi->kind = VRK_ENUM;
2990 (void) symtable_enterVar (g_symtab, vi);
2996 (message ("%s: enum member %s of %s has already been declared",
2998 lsymbol_toString (mlist->name),
2999 lsymbol_toString (sn->name)));
3002 /*@switchbreak@*/ break;
3007 smemberInfo *mlist = sn->members;
3009 for (; mlist != NULL; mlist = mlist->next)
3011 bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3012 if (sort_isNoSort (bsort))
3014 lclbug (message ("%s: member %s of %s has unknown sort\n",
3016 cstring_fromChars (lsymbol_toChars (mlist->name)),
3017 cstring_fromChars (lsymbol_toChars (sn->name))));
3021 mlist->sort = bsort;
3024 /*@switchbreak@*/ break;
3027 lclbug (message ("%s: %s has unexpected sort kind %s",
3029 cstring_fromChars (lsymbol_toChars (sn->name)),
3030 sort_unparseKind (sn->kind)));
3033 } end_lsymbolList_elements;
3035 /* list and sorts in it are not used anymore */
3036 lsymbolList_free (slist);
3040 sort_equal (sort s1, sort s2)
3044 if (s1 == s2) return TRUE;
3046 /* handle synonym sorts */
3047 syn1 = sort_getUnderlying (s1);
3048 syn2 = sort_getUnderlying (s2);
3050 if (syn1 == syn2) return TRUE;
3051 /* makes bool and Bool equal */
3057 sort_compatible (sort s1, sort s2)
3060 /* later: might consider "char" and enum types the same as "int" */
3063 /* handle synonym sorts */
3064 syn1 = sort_getUnderlying (s1);
3065 syn2 = sort_getUnderlying (s2);
3068 /* makes bool and Bool equal */
3073 sort_compatible_modulo_cstring (sort s1, sort s2)
3075 /* like sort_compatible but also handles special cstring inits,
3076 allows the following 2 cases:
3077 char c[] = "abc"; (LHS: char_Obj_Arr, RHS = char_Vec)
3078 (c as implicitly coerced into c^)
3079 char *d = "abc"; (LHS: char_Obj_Ptr, RHS = char_Vec)
3080 (d as implicitly coerced into d[]^)
3083 if (sort_compatible (s1, s2))
3085 syn1 = sort_getUnderlying (s1);
3086 syn2 = sort_getUnderlying (s2);
3087 if (sort_cstring == syn2 &&
3088 (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3094 sort_getLsymbol (sort sor)
3096 sortNode sn = sort_quietLookup (sor);
3100 /* a few handy routines for debugging */
3102 char *sort_getName (sort s)
3104 return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3107 /*@exposed@*/ cstring
3108 sort_unparseName (sort s)
3110 return (cstring_fromChars (sort_getName (s)));
3114 sortError (ltoken t, sort oldsort, sortNode newnode)
3116 sortNode old = sort_quietLookup (oldsort);
3118 if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3119 (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
3121 llbuglit ("sortError: illegal sort kind");
3124 llassert (sortTable != NULL);
3126 lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
3127 cstring_fromChars (lsymbol_toChars (newnode->name)),
3128 sort_unparseKindName (sortTable[oldsort]),
3129 sort_unparseKindName (newnode)));
3132 static /*@observer@*/ cstring
3133 sort_unparseKindName (sortNode s)
3138 return cstring_fromChars (sortKindName[(int)s->kind]);
3144 return cstring_makeLiteralTemp ("MUTABLE");
3148 return cstring_makeLiteralTemp ("IMMUTABLE");
3152 return cstring_fromChars (sortKindName[(int)s->kind]);
3159 sort_fromLsymbol (lsymbol sortid)
3161 /* like sort_lookupName but creates sort if not already present */
3162 sort sort = sort_lookupName (sortid);
3163 if (sort == NOSORTHANDLE)
3164 sort = sort_makeSort (ltoken_undefined, sortid);
3169 sort_isHOFSortKind (sort s)
3171 sortNode sn = sort_quietLookup (s);
3172 if (sn->kind == SRT_HOF)
3178 ** returns TRUE iff s has State operators (', ~, ^)
3182 sort_hasStateFcns (sort s)
3184 sortNode sn = sort_quietLookup (s);
3185 sortKind kind = sn->kind;
3187 if (kind == SRT_SYN)
3189 return (sort_hasStateFcns (sn->baseSort));
3192 return ((kind == SRT_PTR) ||
3193 (kind == SRT_OBJ) ||
3194 (kind == SRT_ARRAY) ||
3195 (kind == SRT_STRUCT) ||
3196 (kind == SRT_UNION));