src/sort.c

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