src/sort.c

   1 /*
   2 ** Splint - annotation-assisted static program checker
   3 ** Copyright (C) 1994-2002 University of Virginia,
   4 **         Massachusetts Institute of Technology
   5 **
   6 ** This program is free software; you can redistribute it and/or modify it
   7 ** under the terms of the GNU General Public License as published by the
   8 ** Free Software Foundation; either version 2 of the License, or (at your
   9 ** option) any later version.
  10 **
  11 ** This program is distributed in the hope that it will be useful, but
  12 ** WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ** General Public License for more details.
  15 **
  16 ** The GNU General Public License is available from http://www.gnu.org/ or
  17 ** the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  18 ** MA 02111-1307, USA.
  19 **
  20 ** For information on splint: info@splint.org
  21 ** To report a bug: splint-bug@splint.org
  22 ** For more information: http://www.splint.org
  23 */
  24 /*
  25 ** sort.c
  26 **
  27 ** sort abstraction
  28 **
  29 **      NOTE: The structure of this module follows a similar one
  30 **            used in the previous LCL checker.  However, all other
  31 **            details are quite different.
  32 **
  33 **  AUTHOR:
  34 **      Yang Meng Tan,
  35 **         Massachusetts Institute of Technology
  36 */
  37
  38 # include "splintMacros.nf"
  39 # include "llbasic.h"
  40 # include "llgrammar.h"
  41 # include "lclscan.h"
  42
  43 /*@+ignorequals@*/
  44
  45 static lsymbol newStructTag (void) /*@*/ ;
  46 static lsymbol newEnumTag (void) /*@*/ ;
  47 static lsymbol newUnionTag (void) /*@*/ ;
  48
  49 /*@constant static int MAXBUFFLEN; @*/
  50 # define MAXBUFFLEN 1024
  51
  52 /*@constant static int DELTA; @*/
  53 # define DELTA 100
  54
  55 /*@constant static int NOSORTHANDLE; @*/
  56 # define NOSORTHANDLE 0
  57
  58 /*@constant static int HOFSORTHANDLE; @*/
  59 # define HOFSORTHANDLE 1
  60
  61 /* local routines */
  62
  63 static void sort_addTupleMembers (sort p_tupleSort, sort p_strSort)
  64    /*@modifies internalState@*/ ;
  65
  66 static bool sort_isNewEntry (sortNode p_s) /*@*/ ;
  67
  68 static sort sort_enterNew (/*@only@*/ sortNode p_s)
  69    /*@modifies internalState@*/ ;
  70
  71 static sort sort_enterGlobal (/*@only@*/ sortNode p_s) /*@modifies internalState@*/ ;
  72
  73 static sort sort_enterNewForce (/*@only@*/ sortNode p_s)
  74    /*@modifies internalState@*/ ;
  75
  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,
  78                        sort p_vecSort);
  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);
  84
  85 static void overloadPtrFcns (sort p_ptrSort);
  86 static void overloadIsSub (sort p_s, int p_dim);
  87 static void overloadSizeof (sort p_domainSort);
  88
  89 /*@observer@*/ static cstring sort_unparseKind (sortKind p_k) /*@*/ ;
  90
  91 static /*@observer@*/ cstring
  92   sort_unparseKindName (sortNode p_s) /*@*/ ;
  93
  94 static lsymbol
  95   sortTag_toSymbol (char *p_kind, ltoken p_tagid, /*@out@*/ bool *p_isNew);
  96
  97 static void
  98   overloadUnaryTok (/*@only@*/ nameNode p_nn,
  99                     sort p_domainSort, /*@only@*/ ltoken p_range);
 100 static void
 101   overloadUnary (/*@only@*/ nameNode p_nn,
 102                  sort p_domainSort, sort p_rangeSort);
 103 static void
 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);
 108
 109 # undef sp
 110 static lsymbol sp (lsymbol p_s1, lsymbol p_s2);
 111 static void sortError (ltoken p_t, sort p_oldsort, sortNode p_newnode);
 112
 113 /*@-namechecks@*/
 114 sort sort_bool;
 115 sort sort_capBool;
 116 sort sort_int;
 117 sort sort_char;
 118 sort sort_float;
 119 sort sort_double;
 120 sort sort_cstring;
 121 /*@=namechecks@*/
 122
 123 static sort sort_void;
 124 static sort char_obj_ptrSort;
 125 static sort char_obj_ArrSort;
 126
 127 /* This is used to uniqueize sort names, for anonymous C types */
 128 static int sortUID = 1;
 129
 130 typedef /*@only@*/ sortNode o_sortNode;
 131
 132 static /*@only@*/ /*@null@*/ o_sortNode *sortTable = (sortNode *) 0;
 133
 134 static int sortTableSize = 0;
 135 static int sortTableAlloc = 0;
 136
 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. */
 140
 141 static bool exporting = TRUE;
 142
 143 static lsymbol underscoreSymbol;
 144 static /*@only@*/ ltoken intToken;
 145
 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;
 155
 156 static ob_mstring sortKindName[] =
 157 {
 158   "FIRSTSORT", "NOSORT", "HOFSORT",
 159   "PRIMITIVE", "SYNONYM", "POINTER", "OBJ", "ARRAY", "VECTOR",
 160   "STRUCT", "TUPLE", "UNION", "UNIONVAL", "ENUM", "LASTSORT"
 161 } ;
 162
 163 static void smemberInfo_free (/*@null@*/ /*@only@*/ smemberInfo *mem)
 164 {
 165   sfree (mem);
 166 }
 167
 168 static void sortNode_free (/*@only@*/ sortNode sn)
 169 {
 170   smemberInfo_free (sn->members);
 171   sfree (sn);
 172 }
 173
 174 void
 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 @*/
 181 {
 182   if (sortTable != NULL)
 183     {
 184       int i;
 185
 186       nameNode_free (arrayRefNameNode);
 187       nameNode_free (ptr2arrayNameNode);
 188       nameNode_free (deRefNameNode);
 189       nameNode_free (nilNameNode);
 190       nameNode_free (plusNameNode);
 191       nameNode_free (minusNameNode);
 192       nameNode_free (condNameNode);
 193       nameNode_free (eqNameNode);
 194       nameNode_free (neqNameNode);
 195
 196       for (i = 0; i < sortTableSize; i++)
 197         {
 198           sortNode_free (sortTable[i]);
 199         }
 200
 201       sfree (sortTable);
 202       /*@-branchstate@*/
 203     }
 204 } /*@=branchstate@*/
 205
 206 sort
 207 sort_makeNoSort (void)
 208 {
 209   return NOSORTHANDLE;
 210 }
 211
 212 sort
 213 sort_makeHOFSort (sort base)
 214 {
 215   sortNode outSort;
 216   sort handle;
 217
 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;
 229
 230   llassert (sortTable != NULL);
 231
 232   outSort->handle = handle = sortTableSize;
 233   sortTable[handle] = outSort;
 234
 235   sortTableSize++;
 236   return handle;
 237 }
 238
 239 static sort
 240 sort_construct (lsymbol name, sortKind kind, sort baseSort,
 241                 lsymbol tagName,
 242                 bool mut, sort objSort, /*@null@*/ /*@only@*/ smemberInfo *members)
 243 {
 244   sortNode outSort;
 245   sort handle;
 246
 247   handle = sort_lookupName (name);
 248
 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;
 262
 263   if (handle == NOSORTHANDLE)
 264     {
 265       outSort->handle = handle = sort_enterNew (outSort);
 266       return handle;
 267     }
 268   else
 269     {
 270       llassert (sortTable != NULL);
 271
 272       if (sortTable[handle]->kind != kind)
 273         {
 274           sortError (ltoken_undefined, handle, outSort);
 275           sortNode_free (outSort);
 276           return handle;
 277         }
 278       else
 279         {
 280           /* evs --- added 11 Mar 1994
 281           ** the new entry should supercede the old one, since
 282           ** it could be a forward reference to a struct, etc.
 283           */
 284
 285           sortTable[handle] = outSort;
 286           return handle;
 287         }
 288     }
 289 }
 290
 291 static sort
 292   sort_constructAbstract (lsymbol name, bool mut, sort baseSort)
 293 {
 294   sortNode outSort;
 295   sortKind kind;
 296   sort handle;
 297
 298   if (mut)
 299     kind = SRT_OBJ;
 300   else
 301     kind = SRT_PRIM;
 302
 303   handle = sort_lookupName (name);
 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;
 316
 317   if (handle == NOSORTHANDLE)
 318     {
 319       outSort->handle = handle = sort_enterNew (outSort);
 320       /* do not make sort operators. */
 321     }
 322   else
 323     {
 324       llassert (sortTable != NULL);
 325
 326       if (sortTable[handle]->kind != kind)
 327         {
 328           sortError (ltoken_undefined, handle, outSort);
 329         }
 330
 331       sortNode_free (outSort);
 332     }
 333
 334   return handle;
 335 }
 336
 337 sort
 338 sort_makeSort (/*@unused@*/ ltoken t, lsymbol n)
 339 {
 340   /*
 341   ** Expects n to be a new sort.
 342   ** Generate a sort with the given name.  Useful for LSL sorts.
 343   */
 344
 345   sort handle = sort_lookupName (n);
 346
 347   if (handle == NOSORTHANDLE)
 348     {
 349       sortNode outSort;
 350
 351       outSort = (sortNode) dmalloc (sizeof (*outSort));
 352       outSort->handle = handle;
 353       outSort->kind = SRT_PRIM;
 354       outSort->name = n;
 355       outSort->tag = lsymbol_undefined;
 356       outSort->baseSort = NOSORTHANDLE;
 357       outSort->objSort = NOSORTHANDLE;
 358       outSort->members = smemberInfo_undefined;
 359       outSort->export = exporting;
 360       outSort->mutable = FALSE;
 361       outSort->imported = context_inImport ();
 362       outSort->abstract = FALSE;
 363
 364       /* Put into sort table, sort_enter checks for duplicates. */
 365       handle = sort_enterNew (outSort);
 366     }
 367   else
 368     {
 369       /* don't override old info */
 370      ;
 371     }
 372
 373   return handle;
 374 }
 375
 376 static sort
 377 sort_makeSortNoOps (/*@unused@*/ ltoken t, lsymbol n) /*@modifies internalState@*/
 378 {
 379   sort handle;
 380
 381   handle = sort_lookupName (n);
 382
 383   if (handle == NOSORTHANDLE)
 384     {
 385       sortNode outSort;
 386
 387       outSort = (sortNode) dmalloc (sizeof (*outSort));
 388       outSort->handle = handle;
 389       outSort->kind = SRT_PRIM;
 390       outSort->name = n;
 391       outSort->tag = lsymbol_undefined;
 392       outSort->baseSort = NOSORTHANDLE;
 393       outSort->objSort = NOSORTHANDLE;
 394       outSort->members = smemberInfo_undefined;
 395       outSort->export = exporting;
 396       outSort->mutable = FALSE;
 397       outSort->imported = context_inImport ();
 398       outSort->abstract = FALSE;
 399       /* Put into sort table, sort_enter checks for duplicates. */
 400       handle = sort_enterNew (outSort);
 401     } /* Don't override old info */
 402
 403   return handle;
 404 }
 405
 406 static sort
 407 sort_makeLiteralSort (ltoken t, lsymbol n)
 408    /*@modifies internalState@*/
 409 {
 410   /*
 411   ** Like sort_makeSort, in addition, generate sizeof operator
 412   ** t not currently used, may be useful for generating error msgs later
 413   ** Also useful for abstract types, need sizeof operator.
 414   */
 415
 416   sort handle = sort_makeSort (t, n);
 417
 418   overloadSizeof (handle);
 419   return handle;
 420 }
 421
 422 sort
 423 sort_makeSyn (ltoken t, sort s, lsymbol n)
 424 {
 425   /* make a synonym sort with name n that is == to sort s */
 426   /* expect n to be a new sort name */
 427   sortNode outSort;
 428   sort handle;
 429   /* must not clash with any LSL sorts */
 430   lsymbol newname = sp (underscoreSymbol, n);
 431
 432   if (n == lsymbol_undefined)
 433     {
 434       llbuglit ("sort_makeSyn: synonym must have name");
 435     }
 436
 437   handle = sort_lookupName (newname);
 438
 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;
 452
 453   if (handle == NOSORTHANDLE)
 454     {
 455       outSort->handle = handle = sort_enterNew (outSort);
 456       /* No operators to generate for synonyms */
 457     }
 458   else
 459     {
 460       llassert (sortTable != NULL);
 461
 462       if (sortTable[handle]->kind != SRT_SYN)
 463         {
 464           sortError (t, handle, outSort);
 465         }
 466
 467       sortNode_free (outSort);
 468     }
 469
 470   return handle;
 471 }
 472
 473 sort
 474 sort_makeFormal (sort insort)
 475 {
 476   sortNode s;
 477   sort sor, handle;
 478
 479   sor = sort_getUnderlying (insort);
 480   handle = sor;
 481   s = sort_lookup (sor);
 482
 483   switch (s->kind)
 484     {
 485     case SRT_STRUCT:
 486       handle = sort_makeTuple (ltoken_undefined, sor);
 487       break;
 488     case SRT_UNION:
 489       handle = sort_makeUnionVal (ltoken_undefined, sor);
 490       break;
 491     default:
 492       break;
 493     }
 494
 495   return handle;
 496 }
 497
 498 sort
 499 sort_makeGlobal (sort insort)
 500 {
 501   /* Make a Obj if not an array or a struct */
 502   sortNode s;
 503   sort sor, handle;
 504   sor = sort_getUnderlying (insort);
 505   handle = sor;
 506   s = sort_lookup (sor);
 507
 508   switch (s->kind)
 509     {
 510     case SRT_ARRAY:
 511     case SRT_STRUCT:
 512     case SRT_UNION:
 513     case SRT_HOF:
 514     case SRT_NONE:
 515       break;
 516     case SRT_VECTOR:
 517     case SRT_TUPLE:
 518     case SRT_UNIONVAL:
 519       llcontbuglit ("sort_makeGlobal: can't make vectors, tuples, or unionvals global");
 520       break;
 521     default:
 522       handle = sort_makeObj (sor);
 523       break;
 524     }
 525   return handle;
 526 }
 527
 528 sort
 529 sort_makeObj (sort sor)
 530 {
 531   sortNode baseSortNode, outSort;
 532   sort baseSort, handle;
 533   lsymbol name;
 534
 535  /* skip the synonym sort */
 536   baseSort = sort_getUnderlying (sor);
 537   baseSortNode = sort_quietLookup (baseSort);
 538   switch (baseSortNode->kind)
 539     {
 540     case SRT_HOF:
 541     case SRT_NONE:
 542       return baseSort;
 543     case SRT_VECTOR:
 544       if (baseSortNode->objSort != 0)
 545         return baseSortNode->objSort;
 546       else                      /* must have well-defined objSort field */
 547         {
 548           llcontbuglit ("sort_makeObj: Inconsistent vector reps:invalid objSort field");
 549           return baseSort;
 550         }
 551     case SRT_TUPLE:
 552     case SRT_UNIONVAL:
 553      /* need to map *_Struct_Tuple to *_Struct and *_Union_UnionVal to
 554       *_Union, according to sort naming conventions */
 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 */
 560         {
 561           llcontbuglit ("sort_makeObj: Inconsistent tuples or unionvals reps: invalid baseSort field");
 562           return baseSort;
 563         }
 564     default:
 565       name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
 566                  lsymbol_fromChars ("_Obj"));
 567       handle = sort_lookupName (name);
 568
 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;
 582
 583       if (handle == NOSORTHANDLE)
 584         {
 585           if (sort_isNewEntry (outSort))
 586             {
 587               outSort->handle = handle = sort_enterNew (outSort);
 588             }
 589           else
 590             {
 591               outSort->handle = handle = sort_enterNew (outSort);
 592             }
 593         }
 594       else
 595         {
 596           llassert (sortTable != NULL);
 597
 598           if (sortTable[handle]->kind != SRT_OBJ)
 599             {
 600               sortError (ltoken_undefined, handle, outSort);
 601             }
 602
 603           sortNode_free (outSort);
 604         }
 605
 606       return handle;
 607     }
 608 }
 609
 610 sort
 611 sort_makePtr (ltoken t, sort baseSort)
 612 {
 613   sortNode s, outSort;
 614   sort handle, arrayHandle;
 615   lsymbol name;
 616
 617   s = sort_lookup (baseSort);
 618
 619   if (s->kind == SRT_HOF)
 620     {
 621       return baseSort;
 622     }
 623   if (s->kind == SRT_NONE)
 624     {
 625       return baseSort;
 626     }
 627
 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);
 633
 634   name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
 635              lsymbol_fromChars ("_Ptr"));
 636   handle = sort_lookupName (name);
 637
 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;
 650
 651   if (handle == NOSORTHANDLE)
 652     {
 653       if (sort_isNewEntry (outSort))
 654         {
 655           outSort->handle = handle = sort_enterNew (outSort);
 656           arrayHandle = sort_makeArr (t, baseSort);
 657           genPtrOps (baseSort, handle, arrayHandle);
 658         }
 659       else
 660         {
 661           outSort->handle = handle = sort_enterNew (outSort);
 662         }
 663     }
 664   else
 665     {
 666       llassert (sortTable != NULL);
 667
 668       if (sortTable[handle]->kind != SRT_PTR)
 669         {
 670           sortError (t, handle, outSort);
 671         }
 672
 673       sortNode_free (outSort);
 674     }
 675
 676   return handle;
 677 }
 678
 679 sort
 680 sort_makePtrN (sort s, int pointers)
 681 {
 682   llassert (pointers >= 0);
 683
 684   if (pointers == 0)
 685     {
 686       return s;
 687     }
 688   else
 689     {
 690       return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
 691                             pointers - 1);
 692     }
 693 }
 694
 695 sort
 696 sort_makeArr (ltoken t, sort baseSort)
 697 {
 698   sortNode s, outSort, old;
 699   sort handle, vecHandle;
 700   int dim;
 701   lsymbol name;
 702
 703   s = sort_lookup (baseSort);
 704
 705   if (s->kind == SRT_HOF)
 706     return baseSort;
 707   if (s->kind == SRT_NONE)
 708     return baseSort;
 709
 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);
 714
 715   name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
 716              lsymbol_fromChars ("_Arr"));
 717   handle = sort_lookupName (name);
 718
 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;
 731
 732   if (handle == NOSORTHANDLE)
 733     {
 734       if (sort_isNewEntry (outSort))
 735         {
 736           handle = sort_enterNew (outSort);
 737           outSort = sort_lookup (handle);
 738
 739           for (old = outSort, dim = 0;
 740                old->kind == SRT_ARRAY;
 741                dim++, old = sort_lookup (old->baseSort))
 742             {
 743               ;
 744             }
 745
 746           vecHandle = sort_makeVec (t, handle);
 747           genArrOps (baseSort, handle, dim, vecHandle);
 748         }
 749       else
 750         {
 751           outSort->handle = handle = sort_enterNew (outSort);
 752         }
 753     }
 754   else
 755     {
 756       llassert (sortTable != NULL);
 757
 758       if (sortTable[handle]->kind != SRT_ARRAY)
 759         {
 760           sortError (t, handle, outSort);
 761         }
 762
 763       sortNode_free (outSort);
 764     }
 765
 766   return handle;
 767 }
 768
 769 sort
 770 sort_makeVec (ltoken t, sort arraySort)
 771 {
 772   sortNode s, outSort, old;
 773   sort baseSort, handle, elementSort;
 774   int dim;                      /* array dimension count. */
 775   lsymbol name;
 776
 777   s = sort_lookup (arraySort);
 778
 779   if (s->kind == SRT_HOF)
 780     return arraySort;
 781   if (s->kind == SRT_NONE)
 782     return arraySort;
 783
 784   if (s->kind != SRT_ARRAY)
 785     {
 786       llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
 787                       sort_unparseKind (s->kind)));
 788     }
 789
 790   if (s->baseSort == NOSORTHANDLE)
 791     llbuglit ("sort_makeVec: arrays must have base (element) sort");
 792
 793  /* Vectors return "values", so make array elements values. */
 794
 795   baseSort = s->baseSort;
 796   elementSort = sort_makeVal (baseSort);
 797
 798   name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
 799              lsymbol_fromChars ("_Vec"));
 800   handle = sort_lookupName (name);
 801
 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;
 813
 814   if (handle == NOSORTHANDLE)
 815     {
 816       if (sort_isNewEntry (outSort))
 817         {
 818           outSort = sort_lookup (handle = sort_enterNew (outSort));
 819
 820           for (old = outSort, dim = 0;
 821                old->kind == SRT_VECTOR;
 822                dim++, old = sort_lookup (old->baseSort))
 823             {
 824               ;
 825             }
 826
 827           genVecOps (elementSort, handle, dim);
 828         }
 829       else
 830         {
 831           outSort->handle = handle = sort_enterNew (outSort);
 832         }
 833     }
 834   else
 835     {
 836       llassert (sortTable != NULL);
 837
 838       if (sortTable[handle]->kind != SRT_VECTOR)
 839         {
 840           sortError (t, handle, outSort);
 841         }
 842
 843       sortNode_free (outSort);
 844     }
 845
 846   return handle;
 847 }
 848
 849 sort
 850 sort_makeVal (sort sor)
 851 {
 852   sort retSort = sor;
 853   sortNode rsn, s;
 854
 855   llassert (sortTable != NULL);
 856   s = sort_quietLookup (sor);
 857
 858   switch (s->kind)
 859     {
 860     case SRT_PRIM:
 861     case SRT_ENUM:
 862     case SRT_PTR:
 863     case SRT_TUPLE:
 864     case SRT_UNIONVAL:
 865     case SRT_VECTOR:
 866     case SRT_HOF:
 867     case SRT_NONE:
 868      /* Do nothing for basic types and pointers. */
 869       retSort = sor;
 870       break;
 871     case SRT_SYN:
 872       return sort_makeVal (sortTable[sor]->baseSort);
 873     case SRT_OBJ:
 874      /* Strip out the last Obj's */
 875       if (s->baseSort == NOSORTHANDLE)
 876         {
 877           llbuglit ("sort_makeVal: expecting a base sort for Obj");
 878         }
 879       retSort = s->baseSort;
 880       break;
 881     case SRT_ARRAY:
 882       retSort = sort_makeVec (ltoken_undefined, sor);
 883       break;
 884     case SRT_STRUCT:
 885       retSort = sort_makeTuple (ltoken_undefined, sor);
 886       break;
 887     case SRT_UNION:
 888       retSort = sort_makeUnionVal (ltoken_undefined, sor);
 889       break;
 890     default:
 891       llbuglit ("sort_makeVal: invalid sort kind");
 892     }
 893   rsn = sort_quietLookup (retSort);
 894   if (rsn->kind == SRT_NONE)
 895     {
 896       llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
 897     }
 898   return retSort;
 899 }
 900
 901 sort
 902 sort_makeImmutable (ltoken t, lsymbol name)
 903 {
 904   sortNode outSort;
 905   sort handle;
 906
 907   handle = sort_lookupName (name);
 908
 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;
 920
 921   if (handle == NOSORTHANDLE)
 922     {
 923       handle = sort_enterNew (outSort);
 924       outSort = sort_lookup (handle);
 925       overloadSizeof (handle);
 926     }
 927   else
 928     {                           /* complain */
 929       llassert (sortTable != NULL);
 930
 931       if ((sortTable[handle]->kind != SRT_PRIM) &&
 932           (sortTable[handle]->abstract) &&
 933           (!sortTable[handle]->mutable))
 934         {
 935           sortError (t, handle, outSort);
 936         }
 937
 938       sortNode_free (outSort);
 939     }
 940
 941   return handle;
 942 }
 943
 944 sort
 945 sort_makeMutable (ltoken t, lsymbol name)
 946 {
 947   sort immutable_old, handle, baseSort;
 948   lsymbol objName;
 949
 950   immutable_old = sort_lookupName (name);
 951
 952  /* First generate the value sort */
 953   baseSort = sort_makeImmutable (t, name);
 954
 955   llassert (sortTable != NULL);
 956
 957   /* to prevent duplicate error messages */
 958   if (immutable_old != NOSORTHANDLE &&
 959       (sortTable[baseSort]->kind != SRT_PRIM) &&
 960       (sortTable[baseSort]->abstract) &&
 961       (!sortTable[baseSort]->mutable))
 962     {
 963      /* already complained */
 964       handle = NOSORTHANDLE;
 965     }
 966   else
 967     {                           /* sort_makeImmutable must have succeeded */
 968       sortNode outSort;
 969
 970      /* must not clash with any LSL sorts */
 971       objName = sp (sp (underscoreSymbol, name),
 972                     lsymbol_fromChars ("_Obj"));
 973       handle = sort_lookupName (objName);
 974
 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;
 987
 988       if (handle == NOSORTHANDLE)
 989         {
 990           if (sort_isNewEntry (outSort))
 991             {
 992               outSort->handle = handle = sort_enterNew (outSort);
 993             }
 994           else
 995             {
 996               handle = sort_enterNew (outSort);
 997             }
 998         }
 999       else
1000         {
1001           llassert (sortTable != NULL);
1002
1003           if ((sortTable[handle]->kind != SRT_OBJ)
1004               && sortTable[handle]->abstract
1005               && sortTable[handle]->mutable)
1006             {
1007               sortError (t, handle, outSort);
1008             }
1009
1010           sortNode_free (outSort);
1011         }
1012     }
1013   return handle;
1014 }
1015
1016 sort
1017 sort_makeStr (ltoken opttagid)
1018 {
1019   sortNode outSort;
1020   sort handle;
1021   bool isNewTag;
1022   lsymbol name;
1023
1024   outSort = (sortNode) dmalloc (sizeof (*outSort));
1025
1026   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1027   /* isNewTag true means that the name generated is new */
1028
1029   if (ltoken_isUndefined (opttagid))
1030     {
1031       opttagid = ltoken_create (simpleId, newStructTag ());
1032
1033       outSort->realtag = FALSE;
1034     }
1035   else
1036     {
1037       outSort->realtag = TRUE;
1038     }
1039
1040   name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1041
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;
1055
1056   if (handle == NOSORTHANDLE)
1057     {
1058       if (sort_isNewEntry (outSort))
1059         {
1060           outSort->handle = handle = sort_enterNew (outSort);
1061         }
1062       else
1063         {
1064           outSort->handle = handle = sort_enterNewForce (outSort);
1065         }
1066     }
1067   else
1068     {
1069       if (sortTable[handle]->kind != SRT_STRUCT)
1070         {
1071           sortError (opttagid, handle, outSort);
1072         }
1073
1074       sortNode_free (outSort);
1075     }
1076
1077   return handle;
1078 }
1079
1080 bool
1081 sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1082 {
1083   /* expect strSort to be in sort table but not yet filled in */
1084   /* return TRUE if it is "new" */
1085   sort tupleSort;
1086   sortNode sn;
1087
1088   llassert (sortTable != NULL);
1089   sn = sort_lookup (strSort);
1090
1091   if (sn->members == (smemberInfo *) 0)
1092     {
1093       sortTable[strSort]->members = info;
1094       tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1095       genStrOps (strSort, tupleSort);
1096       return TRUE;
1097     }
1098   else
1099     {
1100       smemberInfo_free (info);
1101       return FALSE;
1102     }
1103 }
1104
1105 sort
1106 sort_makeTuple (ltoken t, sort strSort)
1107 {
1108   sort handle;
1109   sortNode outSort, s = sort_lookup (strSort);
1110   lsymbol name;
1111
1112   if (s->kind != SRT_STRUCT)
1113     {
1114       llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
1115                            sort_unparseKind (s->kind)));
1116     }
1117
1118   name = sp (s->name, lsymbol_fromChars ("_Tuple"));
1119   llassert (sortTable != NULL);
1120   handle = sort_lookupName (name);
1121
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;
1135
1136   if (handle == NOSORTHANDLE)
1137     {
1138       if (sort_isNewEntry (outSort))
1139         {
1140           outSort->handle = handle = sort_enterNew (outSort);
1141
1142           sort_addTupleMembers (handle, strSort);
1143           genTupleOps (handle);
1144         }
1145       else
1146         {
1147           outSort->handle = handle = sort_enterNew (outSort);
1148         }
1149     }
1150   else
1151     {
1152       if (sortTable[handle]->kind != SRT_TUPLE)
1153         {
1154           sortError (t, handle, outSort);
1155         }
1156
1157       sortNode_free (outSort);
1158     }
1159
1160   return handle;
1161 }
1162
1163 static void
1164 sort_addTupleMembers (sort tupleSort, sort strSort)
1165 {
1166   smemberInfo *mem, *tail = smemberInfo_undefined;
1167   smemberInfo *top = smemberInfo_undefined;
1168   smemberInfo *newinfo;
1169
1170   /* make sure it works for empty smemberInfo */
1171
1172   llassert (sortTable != NULL);
1173
1174   for (mem = sortTable[strSort]->members;
1175        mem != smemberInfo_undefined; mem = mem->next)
1176     {
1177       newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1178       newinfo->name = mem->name;
1179       newinfo->sort = sort_makeVal (mem->sort);
1180       newinfo->next = smemberInfo_undefined;
1181
1182       if (top == smemberInfo_undefined)
1183         {                       /* start of iteration */
1184           top = newinfo;
1185           tail = newinfo;
1186         }
1187       else
1188         {
1189           llassert (tail != smemberInfo_undefined);
1190
1191           tail->next = newinfo;
1192           tail = newinfo;
1193           /*@-branchstate@*/ /* tail is dependent */
1194         }
1195       /*@=branchstate@*/
1196     }
1197
1198   sortTable[tupleSort]->members = top;
1199 }
1200
1201 static
1202 void genTupleOps (sort tupleSort)
1203 {
1204   ltoken range, dom;
1205   sort fieldsort;
1206   smemberInfo *m;
1207   unsigned int memCount;
1208   ltokenList domain = ltokenList_new ();
1209   sigNode signature;
1210   opFormUnion u;
1211   opFormNode opform;
1212   nameNode nn;
1213
1214   memCount = 0;
1215   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1216
1217   llassert (sortTable != NULL);
1218   for (m = sortTable[tupleSort]->members;
1219        m != smemberInfo_undefined; m = m->next)
1220     {
1221       fieldsort = sort_makeVal (m->sort);
1222       overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1223
1224       dom = ltoken_createType (simpleId, SID_SORT,
1225                                sort_getLsymbol (fieldsort));
1226       ltokenList_addh (domain, dom);
1227       memCount++;
1228     }
1229
1230   /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1231   signature = makesigNode (ltoken_undefined, domain, range);
1232   u.middle = memCount;
1233
1234   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1235                            OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1236
1237   nn = makeNameNodeForm (opform);
1238   symtable_enterOp (g_symtab, nn, signature);
1239
1240   /*
1241   ** should not be able to take sizeof (struct^) ...
1242   */
1243 }
1244
1245 static
1246 void genUnionOps (sort tupleSort)
1247 {
1248  /* like genTupleOps but no constructor [ ...]: -> unionSort */
1249   smemberInfo *m;
1250   sort sort;
1251
1252   llassert (sortTable != NULL);
1253   for (m = sortTable[tupleSort]->members;
1254        m != smemberInfo_undefined; m = m->next)
1255     {
1256      /* Generate __.memName: strSort ->memSortObj */
1257       overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1258      /*    printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1259                 sort_getName (tupleSort), sort_getName (m->sort)); */
1260      /* __->memName : Union_Ptr -> memSortObj */
1261       sort = sort_makePtr (ltoken_undefined, tupleSort);
1262       overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1263      /*    printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1264                 sort_getName (sort), sort_getName (m->sort)); */
1265     }
1266 }
1267
1268 static
1269 void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1270 {
1271   smemberInfo *m;
1272   sort sort;
1273
1274   llassert (sortTable != NULL);
1275   for (m = sortTable[strSort]->members;
1276        m != smemberInfo_undefined; m = m->next)
1277     {
1278      /* Generate __.memName: strSort ->memSortObj */
1279       overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1280       /*    printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1281             sort_getName (strSort), sort_getName (m->sort)); */
1282       /* __->memName : Struct_Ptr -> memSortObj */
1283       sort = sort_makePtr (ltoken_undefined, strSort);
1284       overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1285       /*    printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1286             sort_getName (sort), sort_getName (m->sort)); */
1287     }
1288   /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1289   /* Generate __any, __pre, __post: nStruct -> nTuple */
1290   /* Generate sizeof: strSort -> int */
1291   /* overloadStateFcns (strSort, tupleSort); */
1292 }
1293
1294 sort
1295 sort_makeUnion (ltoken opttagid)
1296 {
1297   sortNode outSort;
1298   sort handle;
1299   bool isNewTag;
1300   lsymbol name;
1301
1302   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1303   /* isNewTag true means that the name generated is new */
1304
1305   outSort = (sortNode) dmalloc (sizeof (*outSort));
1306
1307   if (ltoken_isUndefined (opttagid))
1308     {
1309       opttagid = ltoken_create (simpleId, newUnionTag ());
1310       outSort->realtag = FALSE;
1311     }
1312   else
1313     {
1314       outSort->realtag = TRUE;
1315     }
1316
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;
1331
1332   if (handle == NOSORTHANDLE)
1333     {
1334       if (sort_isNewEntry (outSort))
1335         {
1336           outSort->handle = handle = sort_enterNew (outSort);
1337         }
1338       else
1339         {
1340           outSort->handle = handle = sort_enterNewForce (outSort);
1341         }
1342     }
1343   else
1344     {
1345       if (sortTable[handle]->kind != SRT_UNION)
1346         {
1347           sortError (opttagid, handle, outSort);
1348         }
1349
1350       sortNode_free (outSort);
1351     }
1352
1353   return handle;
1354 }
1355
1356 bool
1357 sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1358 {
1359  /* expect unionSort to be in sort table but not yet filled in */
1360  /* return TRUE if it is "new" */
1361   sort uValSort;
1362   sortNode sn;
1363
1364   llassert (sortTable != NULL);
1365
1366   sn = sort_lookup (unionSort);
1367
1368   if (sn->members == (smemberInfo *) 0)
1369     {
1370       sortTable[unionSort]->members = info;
1371       uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1372       /* same as struct operations */
1373       genStrOps (unionSort, uValSort);
1374       return TRUE;
1375     }
1376   else
1377     {
1378       smemberInfo_free (info);
1379       return FALSE;
1380     }
1381 }
1382
1383 sort
1384 sort_makeUnionVal (ltoken t, sort unionSort)
1385 {
1386   sort handle;
1387   sortNode outSort, s = sort_lookup (unionSort);
1388   lsymbol name;
1389
1390   if (s->kind != SRT_UNION)
1391     {
1392       llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
1393                            sort_unparseKind (s->kind)));
1394     }
1395
1396   llassert (sortTable != NULL);
1397
1398   name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
1399   handle = sort_lookupName (name);
1400
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;
1414
1415   if (handle == NOSORTHANDLE)
1416     {
1417       if (sort_isNewEntry (outSort))
1418         {
1419           outSort->handle = handle = sort_enterNew (outSort);
1420
1421           /* Add members to the unionVal's. */
1422           /* same as structs and tuples */
1423
1424           sort_addTupleMembers (handle, unionSort);
1425           genUnionOps (handle);
1426         }
1427       else
1428         {
1429           outSort->handle = handle = sort_enterNew (outSort);
1430         }
1431     }
1432   else
1433     {
1434       if (sortTable[handle]->kind != SRT_UNIONVAL)
1435         {
1436           sortError (t, handle, outSort);
1437         }
1438
1439       sortNode_free (outSort);
1440     }
1441
1442   return handle;
1443 }
1444
1445 static lsymbol
1446 newEnumTag ()
1447 {
1448   static int ecount = 0;
1449
1450   return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1451 }
1452
1453 static lsymbol
1454 newStructTag ()
1455 {
1456   static int ecount = 0;
1457
1458   return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1459 }
1460
1461 static lsymbol
1462 newUnionTag ()
1463 {
1464   static int ecount = 0;
1465
1466   return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1467 }
1468
1469 sort
1470 sort_makeEnum (ltoken opttagid)
1471 {
1472   sortNode outSort;
1473   sort handle;
1474   bool isNew;
1475   lsymbol name;
1476
1477   llassert (sortTable != NULL);
1478
1479   outSort = (sortNode) dmalloc (sizeof (*outSort));
1480
1481   if (ltoken_isUndefined (opttagid))
1482     {
1483       opttagid = ltoken_create (simpleId, newEnumTag ());
1484       outSort->realtag = FALSE;
1485     }
1486   else
1487     {
1488       outSort->realtag = TRUE;
1489     }
1490
1491   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1492
1493   name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1494   handle = sort_lookupName (name);
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;
1506
1507   if (handle == NOSORTHANDLE)
1508     {
1509       if (sort_isNewEntry (outSort))
1510         {
1511           outSort->handle = handle = sort_enterNew (outSort);
1512         }
1513       else
1514         {
1515           outSort->handle = handle = sort_enterNewForce (outSort);
1516         }
1517     }
1518   else
1519     {
1520       if (sortTable[handle]->kind != SRT_ENUM)
1521         {
1522           sortError (opttagid, handle, outSort);
1523         }
1524
1525       sortNode_free (outSort);
1526     }
1527
1528   return handle;
1529 }
1530
1531 bool
1532 sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1533 {
1534   /*
1535   ** Expect enumSort to be in sort table but not yet filled in.
1536   ** Return TRUE if it is "new"
1537   */
1538
1539   sortNode sn;
1540
1541   llassert (sortTable != NULL);
1542
1543   sn = sort_lookup (enumSort);
1544   if (sn->members == (smemberInfo *) 0)
1545     {
1546       sortTable[enumSort]->members = info;
1547       genEnumOps (enumSort);
1548       return TRUE;
1549     }
1550   else
1551     {
1552       smemberInfo_free (info);
1553       return FALSE;
1554     }
1555 }
1556
1557 static
1558 void genEnumOps (sort enumSort)
1559 {
1560   smemberInfo *ei;
1561   ltokenList domain = ltokenList_new ();
1562   ltoken range, mem;
1563   nameNode nn;
1564   sigNode signature;
1565
1566   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1567   signature = makesigNode (ltoken_undefined, domain, range);
1568
1569   llassert (sortTable != NULL);
1570
1571   for (ei = sortTable[enumSort]->members;
1572        ei != (smemberInfo *) 0; ei = ei->next)
1573     {
1574       mem = ltoken_createType (simpleId, SID_OP, ei->name);
1575       nn = makeNameNodeId (mem);
1576       symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1577     }
1578
1579   sigNode_free (signature);
1580   overloadSizeof (enumSort);
1581 }
1582
1583 static void
1584 genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1585 {
1586   /* Generate *__: xPtr -> x */
1587
1588   /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1589
1590   /* Generate maxIndex, minIndex: xPtr -> int */
1591   /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1592   /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1593
1594   /* Generate __[]: pointer -> array  */
1595   overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1596
1597   /* Generate __+__, __-__: pointer, int -> pointer  */
1598   overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1599                   ltoken_copy (intToken), ptrSort);
1600
1601   overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1602                   ltoken_copy (intToken), ptrSort);
1603
1604   /* Generate NIL: -> xPtr */
1605   /* Generate __+__: int, pointer -> pointer  */
1606   /* Generate __-__: pointer, pointer -> int  */
1607   overloadPtrFcns (ptrSort);
1608 }
1609
1610 static void
1611 genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1612 {
1613   /* Generate __[__]: nArr, int -> n */
1614   overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1615                   ltoken_copy (intToken), baseSort);
1616
1617   /* Generate maxIndex, minIndex: sort -> int */
1618   /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1619   /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1620
1621   /* Generate isSub: arraySort, int, ... -> bool */
1622   overloadIsSub (arraySort, dim);
1623
1624   /* Generate fresh, trashed, modifies, unchanged: array -> bool  */
1625   /* Generate any, pre, post: array -> vector */
1626
1627   /* overloadStateFcns (arraySort, vecSort); */
1628   /* overloadObjFcns (arraySort); */
1629 }
1630
1631 /*
1632 ** overloadPtrFcns:
1633 **   generate NIL: -> ptrSort
1634 **            __+__: int, ptrSort -> ptrSort
1635 **            __-__: ptrSort, ptrSort -> int
1636 */
1637 static void
1638 overloadPtrFcns (sort ptrSort)
1639 {
1640   ltokenList domain = ltokenList_new ();
1641   ltoken range;
1642   sigNode signature;
1643
1644   /* NIL: -> ptrSort */
1645
1646   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1647   signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1648   symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1649
1650   /* __+__: int, ptrSort -> ptrSort  */
1651
1652   ltokenList_addh (domain, ltoken_copy (intToken));
1653   ltokenList_addh (domain, ltoken_copy (range));
1654
1655   signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1656   symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1657
1658   /* __-__: ptrSort, ptrSort -> int  */
1659
1660   domain = ltokenList_new ();
1661   ltokenList_addh (domain, ltoken_copy (range));
1662   ltokenList_addh (domain, range);
1663   range = ltoken_copy (intToken);
1664   signature = makesigNode (ltoken_undefined, domain, range);
1665   symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1666 }
1667
1668 static void
1669 genVecOps (sort baseSort, sort vecSort, int dim)
1670 {
1671   /* Generate __[__]: vecSort, int -> baseSort */
1672
1673   overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1674                   ltoken_copy (intToken), baseSort);
1675
1676   /*          sizeof: vecSort -> int */
1677   /* Generate isSub: vecSort, int, ... -> bool */
1678
1679   overloadIsSub (vecSort, dim);
1680 }
1681
1682 static void
1683 overloadIsSub (sort s, int dim)
1684 {
1685   /* Generate isSub: s, int, ... -> bool */
1686   int j, i;
1687   ltoken dom, nulltok = ltoken_undefined;
1688   ltokenList domain;
1689   sigNode signature;
1690
1691   for (j = 1; j <= dim; j++)
1692     {
1693       nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1694
1695       isSubNameNode->isOpId = TRUE;
1696       isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1697                                                          lsymbol_fromChars ("isSub"));
1698       dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1699
1700       domain = ltokenList_singleton (dom);
1701
1702       for (i = 1; i <= j; i++)
1703         {
1704           ltokenList_addh (domain, ltoken_copy (intToken));
1705         }
1706
1707       signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1708       symtable_enterOp (g_symtab, isSubNameNode, signature);
1709     }
1710 }
1711
1712 static void
1713 overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1714 {
1715   /* Generate <nn>: domainSort -> rangeTok */
1716   sigNode signature;
1717   ltoken dom;
1718   ltokenList domain;
1719
1720   dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1721   domain = ltokenList_singleton (dom);
1722   signature = makesigNode (ltoken_undefined, domain, range);
1723   symtable_enterOp (g_symtab, nn, signature);
1724 }
1725
1726 static void
1727 overloadSizeof (sort domainSort)
1728 {
1729   nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1730
1731   sizeofNameNode->isOpId = TRUE;
1732   sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1733                                                       lsymbol_fromChars ("sizeof"));
1734
1735   overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1736 }
1737
1738 static void
1739 overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1740 {
1741   ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1742
1743   overloadUnaryTok (nn, domainSort, range);
1744 }
1745
1746 static void
1747 overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1748 {
1749   /* Generate <nn>: s, dTok -> rs */
1750   sigNode signature;
1751   ltoken range, dom;
1752   ltokenList domain = ltokenList_new ();
1753
1754   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1755   dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1756
1757   ltokenList_addh (domain, dom);
1758   ltokenList_addh (domain, dTok);
1759
1760   signature = makesigNode (ltoken_undefined, domain, range);
1761       symtable_enterOp (g_symtab, nn, signature);
1762 }
1763
1764 static /*@only@*/ nameNode
1765 makeFieldOp (lsymbol field)
1766 {
1767  /* operator: __.<field> */
1768   nameNode nn;
1769   opFormUnion u;
1770   opFormNode opform;
1771
1772   u.id = ltoken_createType (simpleId, SID_OP, field);
1773   opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1774   nn = makeNameNodeForm (opform);
1775   return nn;
1776 }
1777
1778 static /*@only@*/ nameNode
1779 makeArrowFieldOp (lsymbol field)
1780 {
1781  /* operator: __-><field> */
1782   nameNode nn;
1783   opFormUnion u;
1784   opFormNode opform;
1785
1786   u.id = ltoken_createType (simpleId, SID_OP, field);
1787   opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1788   nn = makeNameNodeForm (opform);
1789   return nn;
1790 }
1791
1792 void
1793 sort_init (void)
1794    /*@globals undef arrayRefNameNode,
1795               undef ptr2arrayNameNode,
1796               undef deRefNameNode,
1797               undef nilNameNode,
1798               undef plusNameNode,
1799               undef minusNameNode,
1800               undef condNameNode,
1801               undef eqNameNode,
1802               undef neqNameNode,
1803               undef intToken; @*/
1804 {
1805   /* on alpha, declaration does not allocate storage */
1806   sortNode noSort, HOFSort;
1807   opFormNode opform;
1808   opFormUnion u;
1809   underscoreSymbol = lsymbol_fromChars ("_");
1810
1811   /*
1812   ** commonly used data for generating operators
1813   */
1814
1815   lsymbol_setbool (lsymbol_fromChars ("bool"));
1816   intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1817
1818   /*
1819   ** __ \eq __: sort, sort -> bool
1820   */
1821
1822   u.anyop = ltoken_copy (ltoken_eq);
1823   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1824   eqNameNode = makeNameNodeForm (opform);
1825
1826   /*
1827   ** __ \neq __: sort, sort -> bool
1828   */
1829
1830   u.anyop = ltoken_copy (ltoken_neq);
1831   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1832   neqNameNode = makeNameNodeForm (opform);
1833
1834   /*
1835   **if __ then __ else __: bool, sort, sort -> sort
1836   */
1837
1838   opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1839                            opFormUnion_createMiddle (0), ltoken_undefined);
1840   condNameNode = makeNameNodeForm (opform);
1841
1842   /* operator: __[__]: arraySort, int -> elementSort_Obj */
1843   u.middle = 1;
1844   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1845                            ltoken_copy (ltoken_rbracket));
1846   arrayRefNameNode = makeNameNodeForm (opform);
1847
1848   /* operator: __[]: ptrSort -> arraySort */
1849   u.middle = 0;
1850   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1851                            OPF_BMMIDDLE, u,
1852                            ltoken_copy (ltoken_rbracket));
1853   ptr2arrayNameNode = makeNameNodeForm (opform);
1854
1855   /* operator: *__ */
1856   u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1857   opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1858   deRefNameNode = makeNameNodeForm (opform);
1859
1860   /* operator: __ + __ */
1861   u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1862   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1863   plusNameNode = makeNameNodeForm (opform);
1864
1865   /* operator: __ - __ */
1866   u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1867   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1868   minusNameNode = makeNameNodeForm (opform);
1869
1870   /* operator: NIL */
1871   nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1872   nilNameNode->isOpId = TRUE;
1873   nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1874                                                  lsymbol_fromChars ("NIL"));
1875
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;
1888
1889   HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1890   HOFSort->kind = SRT_HOF;
1891   HOFSort->handle = HOFSORTHANDLE;
1892   HOFSort->name = lsymbol_undefined;
1893   HOFSort->tag = lsymbol_undefined;
1894   HOFSort->realtag = FALSE;
1895   HOFSort->baseSort = NOSORTHANDLE;
1896   HOFSort->objSort = NOSORTHANDLE;
1897   HOFSort->members = smemberInfo_undefined;
1898   HOFSort->export = FALSE;
1899   HOFSort->mutable = FALSE;
1900   HOFSort->abstract = FALSE;
1901   HOFSort->imported = FALSE;
1902
1903   /*
1904   ** Store the null sort into table, and in the process initialize the sort table.
1905   ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1906   ** for HOFSORTHANDLE = 1.
1907   */
1908
1909   (void) sort_enterGlobal (noSort);
1910   (void) sort_enterGlobal (HOFSort);
1911
1912   /* Other builtin sorts */
1913
1914   sort_bool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1915   sort_capBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1916
1917   llassert (sortTable != NULL);
1918
1919   /* make sort_Bool a synonym for sort_bool */
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;
1924
1925   sort_int = sort_makeLiteralSort (ltoken_undefined,
1926                                    lsymbol_fromChars ("int"));
1927   sort_char = sort_makeLiteralSort (ltoken_undefined,
1928                                     lsymbol_fromChars ("char"));
1929   sort_void = sort_makeLiteralSort (ltoken_undefined,
1930                                     lsymbol_fromChars ("void"));
1931
1932   /* sort_cstring is char__Vec, for C strings eg: "xyz" */
1933   char_obj_ptrSort = sort_makePtr (ltoken_undefined, sort_char);
1934   char_obj_ArrSort = sort_makeArr (ltoken_undefined, sort_char);
1935
1936   sort_cstring = sort_makeVal (char_obj_ArrSort);
1937   sort_float = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1938   sort_double = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1939 }
1940
1941 sort
1942 sort_lookupName (lsymbol name)
1943 {
1944   long int i;
1945
1946   if (name == lsymbol_undefined)
1947     {
1948       return NOSORTHANDLE;
1949     }
1950
1951   llassert (sortTable != NULL);
1952
1953   for (i = 0; i < sortTableSize; i++)
1954     {
1955       if (sortTable[i]->name == name)
1956         {
1957           return i;
1958         }
1959     }
1960
1961   return NOSORTHANDLE;
1962 }
1963
1964 static bool
1965 sort_isNewEntry (sortNode s)
1966 {
1967   int i;
1968
1969   for (i = 0; i < sortTableSize; i++)
1970     {
1971       llassert (sortTable != NULL);
1972
1973       if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
1974         {
1975           return FALSE;
1976         }
1977     }
1978   return TRUE;
1979 }
1980
1981 static sort
1982 sort_enterGlobal (sortNode s)
1983 {
1984   return (sort_enterNew (s));
1985 }
1986
1987 static sort
1988 sort_enterNew (sortNode s)
1989 {
1990   /*
1991   ** This ensures that the argument sortNode is not entered into
1992   ** the sort table more than once.  isNew flag will tell the
1993   ** caller this info, and the caller will decide whether to generate
1994   ** operators for this sort.
1995   */
1996
1997   long int i;
1998
1999   for (i = 0; i < sortTableSize; i++)
2000     {
2001       llassert (sortTable != NULL);
2002
2003       if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
2004         {
2005           sortNode_free (s);
2006           return i;
2007         }
2008     }
2009
2010   if (sortTableSize >= sortTableAlloc)
2011     {
2012       sortNode *oldSortTable = sortTable;
2013
2014       sortTableAlloc += DELTA;
2015       sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2016
2017       if (sortTableSize > 0)
2018         {
2019           llassert (oldSortTable != NULL);
2020           for (i = 0; i < sortTableSize; i++)
2021             {
2022               sortTable[i] = oldSortTable[i];
2023             }
2024         }
2025
2026       sfree (oldSortTable);
2027     }
2028
2029   llassert (sortTable != NULL);
2030
2031   s->handle = sortTableSize;
2032   sortTable[sortTableSize++] = s;
2033
2034   /*@-compdef@*/
2035   return s->handle;
2036 } /*=compdef@*/
2037
2038 static sort sort_enterNewForce (sortNode s)
2039 {
2040   sort sor = sort_lookupName (s->name);
2041
2042   if (sort_isNoSort (sor))
2043     {
2044       sor = sort_enterNew (s);
2045       llassert (sortTable != NULL);
2046       /*@-usereleased@*/
2047       llassert (sortTable[sor] == s);
2048       /*@=usereleased@*/
2049     }
2050   else
2051     {
2052       s->handle = sor;
2053       llassert (sortTable != NULL);
2054       sortTable[sor] = s;
2055     }
2056
2057   /*@-globstate@*/ return (sor); /*@=globstate@*/
2058 }
2059
2060 void
2061 sort_printStats (void)
2062 {
2063   /* only for debugging */
2064   printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2065           sortTableAlloc);
2066 }
2067
2068 sortNode
2069 sort_lookup (sort sor)
2070 {
2071   /* ymtan: can sor be 0 ? */
2072   /* evs --- yup...0 should return noSort ? */
2073
2074   if (sor > 0U && sor < (unsigned) sortTableSize)
2075     {
2076       llassert (sortTable != NULL);
2077       return sortTable[sor];
2078     }
2079
2080   llassert (sor == 0);
2081   llassert (sor == NOSORTHANDLE);
2082   llassert (sortTable != NULL);
2083   return sortTable[NOSORTHANDLE];
2084 }
2085
2086 sortNode
2087 sort_quietLookup (sort sor)
2088 {
2089   /* ymtan: can sor be 0 ? */
2090   if (sor > 0U && sor < (unsigned) sortTableSize)
2091     {
2092       llassert (sortTable != NULL);
2093       return (sortTable[sor]);
2094     }
2095   else
2096     {
2097       llassert (sortTable != NULL);
2098       return (sortTable[NOSORTHANDLE]);
2099     }
2100 }
2101
2102 static cstring
2103 printEnumMembers (/*@null@*/ smemberInfo *list)
2104 {
2105   cstring out = cstring_undefined;
2106   smemberInfo *m;
2107
2108   for (m = list; m != (smemberInfo *) 0; m = m->next)
2109     {
2110       out = cstring_concat (out, lsymbol_toString (m->name));
2111
2112       if (m->next != (smemberInfo *) 0)
2113         {
2114           out = cstring_concatChars (out, ", ");
2115         }
2116     }
2117   return out;
2118 }
2119
2120 static /*@only@*/ cstring
2121 printStructMembers (/*@null@*/ smemberInfo *list)
2122 {
2123   cstring ret = cstring_undefined;
2124   smemberInfo *m;
2125
2126   for (m = list; m != (smemberInfo *) 0; m = m->next)
2127     {
2128       ret = message ("%q%q %s; ",
2129                      ret, sort_unparse (m->sort),
2130                      cstring_fromChars (lsymbol_toChars (m->name)));
2131     }
2132
2133   return ret;
2134 }
2135
2136 /*@only@*/ cstring
2137 sort_unparse (sort s)
2138 {
2139  /* printing routine for sorts */
2140   sortNode sn;
2141   lsymbol name;
2142
2143   sn = sort_quietLookup (s);
2144   name = sn->name;
2145
2146   switch (sn->kind)
2147     {
2148     case SRT_NONE:
2149       if (name == lsymbol_undefined)
2150         {
2151           return cstring_makeLiteral ("_unknown");
2152         }
2153
2154       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2155     case SRT_HOF:
2156       return cstring_makeLiteral ("procedural");
2157     case SRT_PRIM:
2158       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2159     case SRT_SYN:
2160       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2161
2162     case SRT_PTR:
2163       return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
2164     case SRT_OBJ:
2165       return (message ("obj %q", sort_unparse (sn->baseSort)));
2166     case SRT_ARRAY:
2167       return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
2168     case SRT_VECTOR:
2169       return (message ("vector of %q", sort_unparse (sn->baseSort)));
2170     case SRT_TUPLE:
2171       if (sn->tag != lsymbol_undefined && sn->realtag)
2172         {
2173           return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2174         }
2175       else
2176         {
2177           return (message ("struct {%q}", printStructMembers (sn->members)));
2178         }
2179     case SRT_UNIONVAL:
2180       if (sn->tag != lsymbol_undefined && sn->realtag)
2181         {
2182           return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2183         }
2184       else
2185         {
2186           return (message ("union {%q}", printStructMembers (sn->members)));
2187         }
2188     case SRT_ENUM:
2189       if (sn->tag != lsymbol_undefined && sn->realtag)
2190         {
2191           return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2192         }
2193       else
2194         {
2195           return (message ("enum {%q}", printEnumMembers (sn->members)));
2196         }
2197     case SRT_STRUCT:
2198       if (sn->tag != lsymbol_undefined && sn->realtag)
2199         {
2200           return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2201         }
2202       else
2203         {
2204           return (message ("obj struct {%q}", printStructMembers (sn->members)));
2205         }
2206     case SRT_UNION:
2207       if (sn->tag != lsymbol_undefined && sn->realtag)
2208         {
2209           return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2210         }
2211       else
2212         {
2213           return (message ("obj union {%q}", printStructMembers (sn->members)));
2214         }
2215     default:
2216       return (cstring_makeLiteral ("illegal"));
2217     }
2218 }
2219
2220 static lsymbol
2221 sp (lsymbol s1, lsymbol s2)
2222 {
2223   char buff[MAXBUFFLEN];
2224   char *name1Ptr;
2225   char *name2Ptr;
2226   int temp_length;
2227
2228   name1Ptr = lsymbol_toCharsSafe (s1);
2229   name2Ptr = lsymbol_toCharsSafe (s2);
2230
2231   if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2232     {
2233       temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2234       llfatalbug (message ("sp: name too long: %s%s",
2235                            cstring_fromChars (name1Ptr),
2236                            cstring_fromChars (name2Ptr)));
2237     }
2238
2239   strcpy (&buff[0], name1Ptr);
2240   strcat (&buff[0], name2Ptr);
2241
2242   return lsymbol_fromChars (&buff[0]);
2243 }
2244
2245 static lsymbol
2246 sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2247 {
2248   /*
2249   ** kind could be struct, union or enum.  Create a unique sort
2250   ** name based on the given info. But first check that tagid
2251   ** has not been defined already. (ok if it is a forward decl)
2252   **/
2253
2254   tagInfo to;
2255
2256   if (ltoken_isUndefined (tagid))
2257     {
2258       *isNew = TRUE;
2259       return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2260     }
2261   else
2262     {
2263       to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2264
2265       if (tagInfo_exists (to))
2266         {
2267           *isNew = FALSE;
2268         }
2269       else
2270         {
2271           *isNew = TRUE;
2272         }
2273
2274       return (cstring_toSymbol (message ("_%s_%s",
2275                                          ltoken_unparse (tagid),
2276                                          cstring_fromChars (kind))));
2277     }
2278 }
2279
2280 /*@constant int MAX_SORT_DEPTH@*/
2281 # define MAX_SORT_DEPTH 10
2282
2283 static sort
2284 sort_getUnderlyingAux (sort s, int depth)
2285 {
2286   sortNode sn = sort_quietLookup (s);
2287
2288   if (sn->kind == SRT_SYN)
2289     {
2290       if (depth > MAX_SORT_DEPTH)
2291         {
2292           llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2293           return s;
2294         }
2295
2296       return sort_getUnderlyingAux (sn->baseSort, depth + 1);
2297     }
2298
2299   return s;
2300 }
2301
2302 sort
2303 sort_getUnderlying (sort s)
2304 {
2305   return sort_getUnderlyingAux (s, 0);
2306 }
2307
2308 static lsymbol
2309 underlyingSortName (sortNode sn)
2310 {
2311   if (sn->kind == SRT_SYN)
2312     return underlyingSortName (sort_quietLookup (sn->baseSort));
2313   return sn->name;
2314 }
2315
2316 static /*@observer@*/ sortNode
2317 underlyingSortNode (sortNode sn)
2318 {
2319   if (sn->kind == SRT_SYN)
2320     {
2321       return underlyingSortNode (sort_quietLookup (sn->baseSort));
2322     }
2323
2324   return sn;
2325 }
2326
2327 bool
2328 sort_mutable (sort s)
2329 {
2330  /* if s is not a valid sort, then returns false */
2331   sortNode sn = sort_quietLookup (s);
2332   if (sn->mutable)
2333     return TRUE;
2334   return FALSE;
2335 }
2336
2337 bool
2338 sort_setExporting (bool flag)
2339 {
2340   bool old;
2341   old = exporting;
2342   exporting = flag;
2343   return old;
2344 }
2345
2346 /*@observer@*/ static cstring
2347 sort_unparseKind (sortKind k)
2348 {
2349   if (k > SRT_FIRST && k < SRT_LAST)
2350     return (cstring_fromChars (sortKindName[(int)k]));
2351   else
2352     return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2353 }
2354
2355 bool
2356 sort_isValidSort (sort s)
2357 {
2358   sortNode sn = sort_quietLookup (s);
2359   sortKind k = sn->kind;
2360   if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2361     return TRUE;
2362   else
2363     return FALSE;
2364 }
2365
2366 void
2367 sort_dump (FILE *f, bool lco)
2368 {
2369   int i;
2370   sortNode s;
2371   smemberInfo *mem;
2372
2373   fprintf (f, "%s\n", BEGINSORTTABLE);
2374   llassert (sortTable != NULL);
2375
2376   for (i = 2; i < sortTableSize; i++)
2377     {
2378       /* skips 0 and 1, noSort and HOFSort */
2379       s = sortTable[i];
2380
2381       /* if (lco && !s.export) continue; */
2382       /* Difficult to keep track of where each op and sort belong to
2383          which LCL type.  Easiest to export them all (even private sorts and
2384          op's) but for checking imported modules, we only use LCL types and
2385          variables to check, i.e., we don't rely on sorts and op's for such
2386          checking. */
2387
2388       if (s->kind == SRT_NONE)
2389         continue;
2390
2391       if (lco)
2392         {
2393           fprintf (f, "%%LCL");
2394         }
2395
2396       if (lsymbol_isDefined (s->name))
2397         {
2398           fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
2399         }
2400       else
2401         {
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_ ");
2407         }
2408
2409       if (!lco && !s->export)
2410         fprintf (f, "private ");
2411
2412       /*@-loopswitchbreak@*/
2413       switch (s->kind)
2414         {
2415         case SRT_HOF:
2416           fprintf (f, "hof nil nil\n");
2417           break;
2418         case SRT_PRIM:
2419           if (s->abstract)
2420             fprintf (f, "immutable nil nil\n");
2421           else
2422             fprintf (f, "primitive nil nil\n");
2423           break;
2424         case SRT_OBJ:
2425           if (s->abstract)
2426             fprintf (f, "mutable %s nil\n",
2427                      lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2428           else
2429             fprintf (f, "obj %s nil\n",
2430                      lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2431           break;
2432         case SRT_SYN:
2433           fprintf (f, "synonym %s nil\n",
2434                    lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2435           break;
2436         case SRT_PTR:
2437           fprintf (f, "ptr %s nil\n", lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2438           break;
2439         case SRT_ARRAY:
2440           fprintf (f, "arr %s nil\n",
2441                    lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2442           break;
2443         case SRT_VECTOR:
2444           fprintf (f, "vec %s %s\n",
2445                    lsymbol_toCharsSafe (sortTable[s->baseSort]->name),
2446                    lsymbol_toCharsSafe (sortTable[s->objSort]->name));
2447           break;
2448         case SRT_STRUCT:
2449           if (s->tag == lsymbol_undefined)
2450             {
2451               /* we need to make up a tag to prevent excessive
2452                  growth of .lcs files when tags are overloaded
2453                  */
2454               llbuglit ("Struct has no tag");
2455             }
2456           else
2457             fprintf (f, "str %s nil\n", lsymbol_toCharsSafe (s->tag));
2458
2459           for (mem = s->members;
2460                mem != smemberInfo_undefined; mem = mem->next)
2461             {
2462               if (lco)
2463                 fprintf (f, "%%LCL");
2464               fprintf (f, "sort %s strMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2465                        lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2466             }
2467           if (lco)
2468             fprintf (f, "%%LCL");
2469           fprintf (f, "sort strEnd nil nil nil\n");
2470           break;
2471         case SRT_UNION:
2472           if (s->tag == lsymbol_undefined)
2473             llbuglit ("Union has no tag");
2474           else
2475             fprintf (f, "union %s nil\n", lsymbol_toCharsSafe (s->tag));
2476           for (mem = s->members;
2477                mem != smemberInfo_undefined; mem = mem->next)
2478             {
2479               if (lco)
2480                 fprintf (f, "%%LCL");
2481               fprintf (f, "sort %s unionMem %s nil\n", lsymbol_toCharsSafe (mem->name),
2482                        lsymbol_toCharsSafe (sortTable[mem->sort]->name));
2483             }
2484           if (lco)
2485             fprintf (f, "%%LCL");
2486           fprintf (f, "sort unionEnd nil nil nil\n");
2487           break;
2488         case SRT_ENUM:
2489           if (s->tag == lsymbol_undefined)
2490             {
2491               llbuglit ("Enum has no tag");
2492             }
2493
2494           fprintf (f, "enum %s nil\n", lsymbol_toCharsSafe (s->tag));
2495
2496           for (mem = s->members;
2497                mem != smemberInfo_undefined; mem = mem->next)
2498             {
2499               if (lco)
2500                 fprintf (f, "%%LCL");
2501               fprintf (f, "sort %s enumMem nil nil\n", lsymbol_toCharsSafe (mem->name));
2502             }
2503           if (lco)
2504             fprintf (f, "%%LCL");
2505           fprintf (f, "sort enumEnd nil nil nil\n");
2506           break;
2507         case SRT_TUPLE:
2508           fprintf (f, "tup %s nil\n",
2509                    lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2510           break;
2511         case SRT_UNIONVAL:
2512           fprintf (f, "unionval %s nil\n",
2513                    lsymbol_toCharsSafe (sortTable[s->baseSort]->name));
2514           break;
2515         default:
2516           fprintf (f, "sort_dump: unexpected sort: %d", (int)s->kind);
2517         }                       /* switch */
2518       /*@=loopswitchbreak@*/
2519     }
2520
2521   fprintf (f, "%s\n", SORTTABLEEND);
2522 }
2523
2524 static void
2525 sort_loadOther (char *kstr, lsymbol sname, sort bsort)
2526 {
2527   if (strcmp (kstr, "synonym") == 0)
2528     {
2529       (void) sort_construct (sname, SRT_SYN, bsort, lsymbol_undefined,
2530                              FALSE, NOSORTHANDLE, smemberInfo_undefined);
2531     }
2532   else if (strcmp (kstr, "mutable") == 0)
2533     {
2534       (void) sort_constructAbstract (sname, TRUE, bsort);
2535     }
2536   else if (strcmp (kstr, "obj") == 0)
2537     {
2538       (void) sort_construct (sname, SRT_OBJ, bsort, lsymbol_undefined,
2539                              TRUE, NOSORTHANDLE, smemberInfo_undefined);
2540     }
2541   else if (strcmp (kstr, "ptr") == 0)
2542     {
2543       (void) sort_construct (sname, SRT_PTR, bsort, lsymbol_undefined,
2544                              FALSE, NOSORTHANDLE, smemberInfo_undefined);
2545     }
2546   else if (strcmp (kstr, "arr") == 0)
2547     {
2548       (void) sort_construct (sname, SRT_ARRAY, bsort, lsymbol_undefined,
2549                              TRUE, NOSORTHANDLE, smemberInfo_undefined);
2550     }
2551   else if (strcmp (kstr, "tup") == 0)
2552     {
2553       (void) sort_construct (sname, SRT_TUPLE, bsort, lsymbol_undefined,
2554                              FALSE, NOSORTHANDLE, smemberInfo_undefined);
2555     }
2556   else if (strcmp (kstr, "unionval") == 0)
2557     {
2558       (void) sort_construct (sname, SRT_UNIONVAL, bsort, lsymbol_undefined,
2559                              FALSE, NOSORTHANDLE, smemberInfo_undefined);
2560     }
2561   else
2562     {
2563       llbug (message ("Unhandled: %s", cstring_fromChars (kstr)));
2564     }
2565 }
2566
2567 static void
2568 parseSortLine (char *line, ltoken t, inputStream  s,
2569                mapping map, lsymbolList slist)
2570 {
2571   /* caller expects that map and slist are updated */
2572   /* t and importfle are only used for error messages */
2573   static lsymbol strName = lsymbol_undefined;
2574   static smemberInfo *strMemList = NULL;
2575   static lsymbol unionName = lsymbol_undefined;
2576   static smemberInfo *unionMemList = NULL;
2577   static lsymbol enumName = lsymbol_undefined;
2578   static smemberInfo *enumMemList = NULL;
2579   static lsymbol tagName = lsymbol_undefined;
2580
2581   cstring importfile = inputStream_fileName (s);
2582   char sostr[MAXBUFFLEN], kstr[10], basedstr[MAXBUFFLEN], objstr[MAXBUFFLEN];
2583   bool tmp;
2584   tagInfo ti;
2585   lsymbol sname, bname, new_name, objName;
2586   sort objSort;
2587   char *lineptr;
2588   int col;                      /* for keeping column number */
2589   ltoken tagid;
2590
2591   if (sscanf (line, "sort %s %s %s %s", &(sostr[0]), &(kstr[0]),
2592               &(basedstr[0]), &(objstr[0])) != 4)
2593     {
2594       /* if this fails, can have weird errors */
2595       /* strEnd, unionEnd, enumEnd won't return 4 args */
2596       lclplainerror
2597         (message ("%q: Imported file contains illegal sort declaration.   "
2598                   "Skipping this line: \n%s\n",
2599                   fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s)),
2600                   cstring_fromChars (line)));
2601       return;
2602     }
2603
2604   sname = lsymbol_fromChars (sostr);
2605   if (sname == lsymbol_fromChars ("nil"))
2606     {
2607       /* No given sort name.  Use lsymbol_undefined and generate sort name
2608          in sort building routines. */
2609       sname = lsymbol_undefined;
2610       lclerror (t, message ("Illegal sort declaration in import file: %s:\n%s",
2611                             importfile,
2612                             cstring_fromChars (line)));
2613     }
2614
2615   /* Assume that when we encounter a sort S1 that is based on sort
2616      S2, S2 is before S1 in the imported file.  sort table is a
2617      linear list and we create base sorts before other sorts. */
2618
2619   bname = lsymbol_fromChars (basedstr);
2620   if (strcmp (kstr, "primitive") == 0)
2621     {
2622       new_name = lsymbol_translateSort (map, sname);
2623       (void) sort_construct (new_name, SRT_PRIM, NOSORTHANDLE,
2624                              lsymbol_undefined, FALSE,
2625                              NOSORTHANDLE, smemberInfo_undefined);
2626     }
2627   else if (strcmp (kstr, "strMem") == 0)
2628     {
2629       smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2630       mem->next = strMemList;
2631       mem->name = sname;
2632       mem->sortname = bname;
2633       mem->sort = NOSORTHANDLE;
2634       strMemList = mem;
2635     }
2636   else if (strcmp (sostr, "strEnd") == 0)
2637     {                           /* now process it */
2638       if (strName != lsymbol_undefined && strMemList != NULL)
2639         {
2640           sort asort = sort_construct (strName, SRT_STRUCT, NOSORTHANDLE, tagName,
2641                                        TRUE, NOSORTHANDLE, strMemList);
2642
2643           if (tagName != lsymbol_undefined)
2644             {
2645               tagid = ltoken_create (simpleId, tagName);
2646
2647               ti = (tagInfo) dmalloc (sizeof (*ti));
2648               ti->sort = asort;
2649               ti->kind = TAG_STRUCT;
2650               ti->id = tagid;
2651               ti->imported = FALSE;
2652
2653               (void) symtable_enterTagForce (g_symtab, ti);
2654             }
2655         }
2656       else
2657         {
2658           if (strName == lsymbol_undefined)
2659             {
2660               lclbug (message ("%q: Imported file contains unexpected null struct sort",
2661                                fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2662             }
2663           else
2664             {
2665               /*
2666                ** no members -> its a forward struct
2667                */
2668
2669               if (tagName != lsymbol_undefined)
2670                 {
2671                   tagid = ltoken_create (simpleId, tagName);
2672                   (void) checkAndEnterTag (TAG_FWDSTRUCT, tagid);
2673                 }
2674             }
2675         }
2676       strName = lsymbol_undefined;
2677       strMemList = NULL;
2678       tagName = lsymbol_undefined;
2679     }
2680   else if (strcmp (kstr, "str") == 0)
2681     {
2682       if (strName != lsymbol_undefined || strMemList != NULL)
2683         {
2684           lclbug (message ("%q: unexpected non-null struct sort or "
2685                            "non-empty member list",
2686                            fileloc_unparseRaw (importfile,
2687                                                inputStream_thisLineNumber (s))));
2688         }
2689       /* see if a tag is associated with this sort */
2690       if (strcmp (basedstr, "nil") == 0)
2691         {
2692           llfatalerror (message ("%s: Struct missing tag.  Obsolete .lcs file, remove and rerun lcl.",
2693                                  importfile));
2694           /*
2695             strName = sortTag_toSymbol ("Struct", nulltok, &tmp);
2696             tagName = lsymbol_undefined;
2697             mapping_bind (map, sname, strName);
2698             */
2699         }
2700       else /* a tag exists */
2701         {  /* create tag in symbol table and add tagged sort in sort table */
2702           tagName = bname;
2703           tagid = ltoken_create (simpleId, bname);
2704
2705           strName = sortTag_toSymbol ("Struct", tagid, &tmp);
2706           ti = symtable_tagInfo (g_symtab, tagName);
2707
2708           /*
2709           ** No error for redefining a tag in an import.
2710           */
2711         }
2712       /* to be processed later in sort_import */
2713       lsymbolList_addh (slist, strName);
2714     }
2715   else if (strcmp (kstr, "enumMem") == 0)
2716     {
2717       smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2718       mem->next = enumMemList;
2719       mem->sortname = enumName;
2720       mem->name = sname;
2721       mem->sort = NOSORTHANDLE;
2722       enumMemList = mem;
2723     }
2724   else if (strcmp (sostr, "enumEnd") == 0)
2725     {
2726       if (enumName != lsymbol_undefined && enumMemList != NULL)
2727         {
2728           sort asort = sort_construct (enumName, SRT_ENUM, NOSORTHANDLE, tagName,
2729                                        FALSE, NOSORTHANDLE, enumMemList);
2730
2731           if (tagName != lsymbol_undefined)
2732             {
2733               tagid = ltoken_create (simpleId, tagName);
2734
2735               ti = (tagInfo) dmalloc (sizeof (*ti));
2736               ti->sort = asort;
2737               ti->kind = TAG_ENUM;
2738               ti->id = tagid;
2739               ti->imported = FALSE;
2740
2741               (void) symtable_enterTagForce (g_symtab, ti);
2742             }
2743         }
2744       else
2745         {
2746           lclbug (message ("%q: unexpected null enum sort or empty member list",
2747                            fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2748         }
2749       enumName = lsymbol_undefined;
2750       enumMemList = NULL;
2751       tagName = lsymbol_undefined;
2752     }
2753   else if (strcmp (kstr, "enum") == 0)
2754     {
2755       if (enumName != lsymbol_undefined || enumMemList != NULL)
2756         {
2757           lclbug (message ("%q: Unexpected non-null enum sort or "
2758                            "non-empty member list",
2759                            fileloc_unparseRaw (importfile,
2760                                                inputStream_thisLineNumber (s))));
2761         }
2762
2763       /* see if a tag is associated with this sort */
2764       if (strcmp (basedstr, "nil") == 0)
2765         {
2766           llfatalerror (message ("%s: Enum missing tag.  Obsolete .lcs file, "
2767                                  "remove and rerun lcl.",
2768                                  importfile));
2769         }
2770       else
2771         {                       /* a tag exists */
2772           tagName = bname;
2773           tagid = ltoken_create (simpleId, bname);
2774           enumName = sortTag_toSymbol ("Enum", tagid, &tmp);
2775           ti = symtable_tagInfo (g_symtab, bname);
2776         }
2777     }
2778   else if (strcmp (kstr, "unionMem") == 0)
2779     {
2780       smemberInfo *mem = (smemberInfo *) dmalloc (sizeof (*mem));
2781       mem->next = unionMemList;
2782       mem->sortname = bname;
2783       mem->name = sname;
2784       mem->sort = NOSORTHANDLE;
2785       unionMemList = mem;
2786     }
2787   else if (strcmp (sostr, "unionEnd") == 0)
2788     {
2789       if (unionName != lsymbol_undefined && unionMemList != NULL)
2790         {
2791           sort asort = sort_construct (unionName, SRT_UNION, NOSORTHANDLE, tagName,
2792                                        FALSE, NOSORTHANDLE, unionMemList);
2793
2794           if (tagName != lsymbol_undefined)
2795             {
2796               tagid = ltoken_create (simpleId, tagName);
2797
2798               ti = (tagInfo) dmalloc (sizeof (*ti));
2799               ti->sort = asort;
2800               ti->kind = TAG_UNION;
2801               ti->id = tagid;
2802               ti->imported = FALSE;
2803
2804               (void) symtable_enterTagForce (g_symtab, ti);
2805             }
2806         }
2807       else
2808         {
2809           if (unionName == lsymbol_undefined)
2810             {
2811               lclbug
2812                 (message ("%q: Imported file contains unexpected null union sort",
2813                           fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2814             }
2815           else
2816             {
2817               /*
2818                ** no members -> its a forward struct
2819                */
2820
2821               if (tagName != lsymbol_undefined)
2822                 {
2823                   tagid = ltoken_create (simpleId, tagName);
2824
2825                   (void) checkAndEnterTag (TAG_FWDUNION, tagid);
2826                 }
2827             }
2828         }
2829
2830       unionName = lsymbol_undefined;
2831       unionMemList = NULL;
2832       tagName = lsymbol_undefined;
2833     }
2834   else if (strcmp (kstr, "union") == 0)
2835     {
2836       if (unionName != lsymbol_undefined || unionMemList != NULL)
2837         {
2838           lclbug
2839             (message
2840              ("%q: Unexpected non-null union sort or non-empty "
2841               "member list",
2842               fileloc_unparseRaw (importfile, inputStream_thisLineNumber (s))));
2843         }
2844       /* see if a tag is associated with this sort */
2845       if (strcmp (basedstr, "nil") == 0)
2846         {
2847           llfatalerror
2848             (message ("%s: Union missing tag.  Obsolete .lcs file, "
2849                       "remove and rerun lcl.",
2850               importfile));
2851         }
2852       else
2853         {                       /* a tag exists */
2854           tagName = bname;
2855           tagid = ltoken_create (simpleId, bname);
2856
2857           unionName = sortTag_toSymbol ("Union", tagid, &tmp);
2858           ti = symtable_tagInfo (g_symtab, bname);
2859         }
2860       lsymbolList_addh (slist, unionName);
2861     }
2862   else if (strcmp (kstr, "immutable") == 0)
2863     {
2864       (void) sort_constructAbstract (sname, FALSE, NOSORTHANDLE);
2865     }
2866   else if (strcmp (kstr, "hof") == 0)
2867     {
2868       (void) sort_construct (sname, SRT_HOF, NOSORTHANDLE, lsymbol_undefined,
2869                              FALSE, NOSORTHANDLE, smemberInfo_undefined);
2870     }
2871   else
2872     {
2873       sort bsort = sort_lookupName (lsymbol_translateSort (map, bname));
2874
2875       if (sort_isNoSort (bsort))
2876         {
2877           lineptr = strchr (line, ' '); /* go past "sort" */
2878           llassert (lineptr != NULL);
2879           lineptr = strchr (lineptr + 1, ' ');  /* go past sostr */
2880           llassert (lineptr != NULL);
2881           lineptr = strchr (lineptr + 1, ' ');  /* go past kstr */
2882           llassert (lineptr != NULL);
2883           col = 5 + lineptr - line;     /* 5 for initial "%LCL "*/
2884
2885           llbug
2886             (message ("%q: Imported file contains unknown base sort: %s",
2887                       fileloc_unparseRawCol (importfile,
2888                                              inputStream_thisLineNumber (s), col),
2889                       cstring_fromChars (lsymbol_toCharsSafe (bname))));
2890         }
2891
2892       if (strcmp (kstr, "vec") == 0)
2893         {
2894           objName = lsymbol_fromChars (objstr);
2895           objSort = sort_lookupName (lsymbol_translateSort (map, objName));
2896           (void) sort_construct (sname, SRT_VECTOR, bsort, lsymbol_undefined,
2897                                  FALSE, objSort, smemberInfo_undefined);
2898         }
2899       else
2900         {
2901           sort_loadOther (kstr, sname, bsort);
2902         }
2903     }
2904 }
2905
2906 void
2907 sort_import (inputStream imported, ltoken tok, mapping map)
2908 {
2909   /* tok is only used for error message line number */
2910   char *buf;
2911   cstring importfile;
2912   inputStream lclsource;
2913   sort bsort;
2914   lsymbolList slist = lsymbolList_new ();
2915
2916   buf = inputStream_nextLine (imported);
2917
2918   llassert (buf != NULL);
2919
2920   importfile = inputStream_fileName (imported);
2921
2922   if (!firstWord (buf, "%LCLSortTable"))
2923     {
2924       lclsource = LCLScanSource ();
2925
2926       lclfatalerror (tok, message ("Expecting \"%%LCLSortTable\" line "
2927                                    "in import file %s:\n%s",
2928                                    importfile,
2929                                    cstring_fromChars (buf)));
2930
2931     }
2932
2933   for (;;)
2934     {
2935       buf = inputStream_nextLine (imported);
2936
2937       llassert (buf != NULL);
2938
2939       if (firstWord (buf, "%LCLSortTableEnd"))
2940         {
2941           break;
2942         }
2943       else
2944         { /* a good line, remove %LCL from line first */
2945           if (firstWord (buf, "%LCL"))
2946             {
2947               parseSortLine (buf + 4, tok, imported, map, slist);
2948             }
2949           else
2950             {
2951               lclsource = LCLScanSource ();
2952               lclfatalerror
2953                 (tok,
2954                  message ("Expecting '%%LCL' prefix in import file %s:\n%s\n",
2955                           importfile,
2956                           cstring_fromChars (buf)));
2957             }
2958         }
2959     }
2960
2961   /* now process the smemberInfo in the sort List */
2962   lsymbolList_elements (slist, s)
2963     {
2964       if (s != lsymbol_undefined)
2965         {
2966           sort sor;
2967           sortNode sn;
2968
2969           sor = sort_lookupName (s);
2970           sn = sort_quietLookup (sor);
2971
2972           switch (sn->kind)
2973             {
2974             case SRT_ENUM:
2975               {                 /* update the symbol table with members of enum */
2976                 varInfo vi;
2977                 smemberInfo *mlist = sn->members;
2978                 for (; mlist != NULL; mlist = mlist->next)
2979                   {
2980                     /* check that enumeration constants are unique */
2981                     vi = symtable_varInfo (g_symtab, mlist->name);
2982                     if (!varInfo_exists (vi))
2983                       { /* put info into symbol table */
2984                         vi = (varInfo) dmalloc (sizeof (*vi));
2985                         vi->id = ltoken_create (NOTTOKEN, mlist->name);
2986                         vi->kind = VRK_ENUM;
2987                         vi->sort = sor;
2988                         vi->export = TRUE;
2989
2990                         (void) symtable_enterVar (g_symtab, vi);
2991                         varInfo_free (vi);
2992                       }
2993                     else
2994                       {
2995                         lclplainerror
2996                           (message ("%s: enum member %s of %s has already been declared",
2997                                     importfile,
2998                                     lsymbol_toString (mlist->name),
2999                                     lsymbol_toString (sn->name)));
3000                       }
3001                   }
3002                 /*@switchbreak@*/ break;
3003               }
3004             case SRT_STRUCT:
3005             case SRT_UNION:
3006               {
3007                 smemberInfo *mlist = sn->members;
3008
3009                 for (; mlist != NULL; mlist = mlist->next)
3010                   {
3011                     bsort = sort_lookupName (lsymbol_translateSort (map, mlist->sortname));
3012                     if (sort_isNoSort (bsort))
3013                       {
3014                         lclbug (message ("%s: member %s of %s has unknown sort\n",
3015                                          importfile,
3016                                          cstring_fromChars (lsymbol_toChars (mlist->name)),
3017                                          cstring_fromChars (lsymbol_toChars (sn->name))));
3018                       }
3019                     else
3020                       {
3021                         mlist->sort = bsort;
3022                       }
3023                   }
3024                 /*@switchbreak@*/ break;
3025               }
3026             default:
3027               lclbug (message ("%s: %s has unexpected sort kind %s",
3028                                importfile,
3029                                cstring_fromChars (lsymbol_toChars (sn->name)),
3030                                sort_unparseKind (sn->kind)));
3031             }
3032         }
3033     } end_lsymbolList_elements;
3034
3035   /* list and sorts in it are not used anymore */
3036   lsymbolList_free (slist);
3037 }
3038
3039 bool
3040 sort_equal (sort s1, sort s2)
3041 {
3042   sort syn1, syn2;
3043
3044   if (s1 == s2) return TRUE;
3045
3046   /* handle synonym sorts */
3047   syn1 = sort_getUnderlying (s1);
3048   syn2 = sort_getUnderlying (s2);
3049
3050   if (syn1 == syn2) return TRUE;
3051   /* makes bool and Bool equal */
3052
3053   return FALSE;
3054 }
3055
3056 bool
3057 sort_compatible (sort s1, sort s2)
3058 {
3059   sort syn1, syn2;
3060   /* later: might consider "char" and enum types the same as "int" */
3061   if (s1 == s2)
3062     return TRUE;
3063   /* handle synonym sorts */
3064   syn1 = sort_getUnderlying (s1);
3065   syn2 = sort_getUnderlying (s2);
3066   if (syn1 == syn2)
3067     return TRUE;
3068   /* makes bool and Bool equal */
3069   return FALSE;
3070 }
3071
3072 bool
3073 sort_compatible_modulo_cstring (sort s1, sort s2)
3074 {
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[]^)
3081  */
3082   sort syn1, syn2;
3083   if (sort_compatible (s1, s2))
3084     return TRUE;
3085   syn1 = sort_getUnderlying (s1);
3086   syn2 = sort_getUnderlying (s2);
3087   if (sort_cstring == syn2 &&
3088       (syn1 == char_obj_ptrSort || syn1 == char_obj_ArrSort))
3089     return TRUE;
3090   return FALSE;
3091 }
3092
3093 lsymbol
3094 sort_getLsymbol (sort sor)
3095 {
3096   sortNode sn = sort_quietLookup (sor);
3097   return sn->name;
3098 }
3099
3100 /* a few handy routines for debugging */
3101
3102 char *sort_getName (sort s)
3103 {
3104   return (lsymbol_toCharsSafe (sort_getLsymbol (s)));
3105 }
3106
3107 /*@exposed@*/ cstring
3108 sort_unparseName (sort s)
3109 {
3110   return (cstring_fromChars (sort_getName (s)));
3111 }
3112
3113 static void
3114 sortError (ltoken t, sort oldsort, sortNode newnode)
3115 {
3116   sortNode old = sort_quietLookup (oldsort);
3117
3118   if ((old->kind <= SRT_FIRST || old->kind >= SRT_LAST) ||
3119       (newnode->kind <= SRT_FIRST || newnode->kind >= SRT_LAST))
3120     {
3121       llbuglit ("sortError: illegal sort kind");
3122     }
3123
3124   llassert (sortTable != NULL);
3125
3126   lclerror (t, message ("Sort %s defined as %s cannot be redefined as %s",
3127                         cstring_fromChars (lsymbol_toChars (newnode->name)),
3128                         sort_unparseKindName (sortTable[oldsort]),
3129                         sort_unparseKindName (newnode)));
3130 }
3131
3132 static /*@observer@*/ cstring
3133   sort_unparseKindName (sortNode s)
3134 {
3135   switch (s->kind)
3136     {
3137     case SRT_NONE:
3138       return cstring_fromChars (sortKindName[(int)s->kind]);
3139     default:
3140       if (s->abstract)
3141         {
3142           if (s->mutable)
3143             {
3144               return cstring_makeLiteralTemp ("MUTABLE");
3145             }
3146           else
3147             {
3148               return cstring_makeLiteralTemp ("IMMUTABLE");
3149             }
3150         }
3151       else
3152         return cstring_fromChars (sortKindName[(int)s->kind]);
3153     }
3154
3155   BADEXIT;
3156 }
3157
3158 sort
3159 sort_fromLsymbol (lsymbol sortid)
3160 {
3161  /* like sort_lookupName but creates sort if not already present */
3162   sort sort = sort_lookupName (sortid);
3163   if (sort == NOSORTHANDLE)
3164     sort = sort_makeSort (ltoken_undefined, sortid);
3165   return sort;
3166 }
3167
3168 bool
3169 sort_isHOFSortKind (sort s)
3170 {
3171   sortNode sn = sort_quietLookup (s);
3172   if (sn->kind == SRT_HOF)
3173     return TRUE;
3174   return FALSE;
3175 }
3176
3177 /*
3178 ** returns TRUE iff s has State operators (', ~, ^)
3179 */
3180
3181 static bool
3182 sort_hasStateFcns (sort s)
3183 {
3184   sortNode sn = sort_quietLookup (s);
3185   sortKind kind = sn->kind;
3186
3187   if (kind == SRT_SYN)
3188     {
3189       return (sort_hasStateFcns (sn->baseSort));
3190     }
3191
3192   return ((kind == SRT_PTR) ||
3193           (kind == SRT_OBJ) ||
3194           (kind == SRT_ARRAY) ||
3195           (kind == SRT_STRUCT) ||
3196           (kind == SRT_UNION));
3197 }
3198
3199