src/sort.c

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