src/sort.c

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