src/sort.c

   1 /*
   2 ** Splint - annotation-assisted static program checker
   3 ** Copyright (C) 1994-2003 University of Virginia,
   4 **         Massachusetts Institute of Technology
   5 **
   6 ** This program is free software; you can redistribute it and/or modify it
   7 ** under the terms of the GNU General Public License as published by the
   8 ** Free Software Foundation; either version 2 of the License, or (at your
   9 ** option) any later version.
  10 **
  11 ** This program is distributed in the hope that it will be useful, but
  12 ** WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ** General Public License for more details.
  15 **
  16 ** The GNU General Public License is available from http://www.gnu.org/ or
  17 ** the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  18 ** MA 02111-1307, USA.
  19 **
  20 ** For information on splint: info@splint.org
  21 ** To report a bug: splint-bug@splint.org
  22 ** For more information: http://www.splint.org
  23 */
  24 /*
  25 ** sort.c
  26 **
  27 ** sort abstraction
  28 **
  29 **      NOTE: The structure of this module follows a similar one
  30 **            used in the previous LCL checker.  However, all other
  31 **            details are quite different.
  32 **
  33 **  AUTHOR:
  34 **      Yang Meng Tan,
  35 **         Massachusetts Institute of Technology
  36 */
  37
  38 # include "splintMacros.nf"
  39 # include "llbasic.h"
  40 # include "llgrammar.h"
  41 # include "lclscan.h"
  42
  43 /*@+ignorequals@*/
  44
  45 static lsymbol newStructTag (void) /*@*/ ;
  46 static lsymbol newEnumTag (void) /*@*/ ;
  47 static lsymbol newUnionTag (void) /*@*/ ;
  48
  49 /*@constant static int MAXBUFFLEN; @*/
  50 # define MAXBUFFLEN 1024
  51
  52 /*@constant static int DELTA; @*/
  53 # define DELTA 100
  54
  55 /*@constant static int NOSORTHANDLE; @*/
  56 # define NOSORTHANDLE 0
  57
  58 /*@constant static int HOFSORTHANDLE; @*/
  59 # define HOFSORTHANDLE 1
  60
  61 /* local routines */
  62
  63 static void sort_addTupleMembers (sort p_tupleSort, sort p_strSort)
  64    /*@modifies internalState@*/ ;
  65
  66 static bool sort_isNewEntry (sortNode p_s) /*@*/ ;
  67
  68 static sort sort_enterNew (/*@only@*/ sortNode p_s)
  69    /*@modifies internalState@*/ ;
  70
  71 static sort sort_enterGlobal (/*@only@*/ sortNode p_s) /*@modifies internalState@*/ ;
  72
  73 static sort sort_enterNewForce (/*@only@*/ sortNode p_s)
  74    /*@modifies internalState@*/ ;
  75
  76 static void genPtrOps (sort p_baseSort, sort p_ptrSort, sort p_arraySort);
  77 static void genArrOps (sort p_baseSort, sort p_arraySort, int p_dim,
  78                        sort p_vecSort);
  79 static void genVecOps (sort p_baseSort, sort p_vecSort, int p_dim);
  80 static void genTupleOps (sort p_tupleSort);
  81 static void genUnionOps (sort p_tupleSort);
  82 static void genStrOps (sort p_strSort, sort p_tupleSort);
  83 static void genEnumOps (sort p_enumSort);
  84
  85 static void overloadPtrFcns (sort p_ptrSort);
  86 static void overloadIsSub (sort p_s, int p_dim);
  87 static void overloadSizeof (sort p_domainSort);
  88
  89 /*@observer@*/ static cstring sort_unparseKind (sortKind p_k) /*@*/ ;
  90
  91 static /*@observer@*/ cstring
  92   sort_unparseKindName (sortNode p_s) /*@*/ ;
  93
  94 static lsymbol
  95   sortTag_toSymbol (char *p_kind, ltoken p_tagid, /*@out@*/ bool *p_isNew);
  96
  97 static void
  98   overloadUnaryTok (/*@only@*/ nameNode p_nn,
  99                     sort p_domainSort, /*@only@*/ ltoken p_range);
 100 static void
 101   overloadUnary (/*@only@*/ nameNode p_nn,
 102                  sort p_domainSort, sort p_rangeSort);
 103 static void
 104   overloadBinary (/*@only@*/ nameNode p_nn,
 105                   sort p_s, /*@only@*/ ltoken p_dTok, sort p_rs);
 106 static /*@only@*/ nameNode makeFieldOp (lsymbol p_field);
 107 static /*@only@*/ nameNode makeArrowFieldOp (lsymbol p_field);
 108
 109 # undef sp
 110 static lsymbol sp (lsymbol p_s1, lsymbol p_s2);
 111 static void sortError (ltoken p_t, sort p_oldsort, sortNode p_newnode);
 112
 113 /*@-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, pointers p)
 681 {
 682   if (pointers_isUndefined (p))
 683     {
 684       return s;
 685     }
 686   else
 687     {
 688       return sort_makePtrN (sort_makePtr (ltoken_undefined, s),
 689                             pointers_getRest (p));
 690     }
 691 }
 692
 693 sort
 694 sort_makeArr (ltoken t, sort baseSort)
 695 {
 696   sortNode s, outSort, old;
 697   sort handle, vecHandle;
 698   int dim;
 699   lsymbol name;
 700
 701   s = sort_lookup (baseSort);
 702
 703   if (s->kind == SRT_HOF)
 704     return baseSort;
 705   if (s->kind == SRT_NONE)
 706     return baseSort;
 707
 708   if (s->kind != SRT_ARRAY && s->kind != SRT_STRUCT &&
 709       s->kind != SRT_UNION && s->kind != SRT_OBJ)
 710    /* base is not an array, struct or obj.  Need to insert a Obj. */
 711     baseSort = sort_makeObj (baseSort);
 712
 713   name = sp (sp (underscoreSymbol, sort_getLsymbol (baseSort)),
 714              lsymbol_fromChars ("_Arr"));
 715   handle = sort_lookupName (name);
 716
 717   /* must not clash with any LSL sorts */
 718   outSort = (sortNode) dmalloc (sizeof (*outSort));
 719   outSort->name = name;
 720   outSort->kind = SRT_ARRAY;
 721   outSort->baseSort = baseSort;
 722   outSort->objSort = NOSORTHANDLE;
 723   outSort->members = smemberInfo_undefined;
 724   outSort->mutable = TRUE;
 725   outSort->export = exporting;
 726   outSort->imported = context_inImport ();
 727   outSort->abstract = FALSE;
 728   outSort->handle = handle;
 729
 730   if (handle == NOSORTHANDLE)
 731     {
 732       if (sort_isNewEntry (outSort))
 733         {
 734           handle = sort_enterNew (outSort);
 735           outSort = sort_lookup (handle);
 736
 737           for (old = outSort, dim = 0;
 738                old->kind == SRT_ARRAY;
 739                dim++, old = sort_lookup (old->baseSort))
 740             {
 741               ;
 742             }
 743
 744           vecHandle = sort_makeVec (t, handle);
 745           genArrOps (baseSort, handle, dim, vecHandle);
 746         }
 747       else
 748         {
 749           outSort->handle = handle = sort_enterNew (outSort);
 750         }
 751     }
 752   else
 753     {
 754       llassert (sortTable != NULL);
 755
 756       if (sortTable[handle]->kind != SRT_ARRAY)
 757         {
 758           sortError (t, handle, outSort);
 759         }
 760
 761       sortNode_free (outSort);
 762     }
 763
 764   return handle;
 765 }
 766
 767 sort
 768 sort_makeVec (ltoken t, sort arraySort)
 769 {
 770   sortNode s, outSort, old;
 771   sort baseSort, handle, elementSort;
 772   int dim;                      /* array dimension count. */
 773   lsymbol name;
 774
 775   s = sort_lookup (arraySort);
 776
 777   if (s->kind == SRT_HOF)
 778     return arraySort;
 779   if (s->kind == SRT_NONE)
 780     return arraySort;
 781
 782   if (s->kind != SRT_ARRAY)
 783     {
 784       llbug (message ("sort_makeVec: only arrays can become vectors: given sort is %s",
 785                       sort_unparseKind (s->kind)));
 786     }
 787
 788   if (s->baseSort == NOSORTHANDLE)
 789     llbuglit ("sort_makeVec: arrays must have base (element) sort");
 790
 791  /* Vectors return "values", so make array elements values. */
 792
 793   baseSort = s->baseSort;
 794   elementSort = sort_makeVal (baseSort);
 795
 796   name = sp (sp (underscoreSymbol, sort_getLsymbol (elementSort)),
 797              lsymbol_fromChars ("_Vec"));
 798   handle = sort_lookupName (name);
 799
 800   outSort = (sortNode) dmalloc (sizeof (*outSort));
 801   outSort->baseSort = elementSort;
 802   outSort->name = name;
 803   outSort->objSort = arraySort;
 804   outSort->kind = SRT_VECTOR;
 805   outSort->members = smemberInfo_undefined;
 806   outSort->mutable = FALSE;
 807   outSort->export = exporting;
 808   outSort->imported = context_inImport ();
 809   outSort->abstract = FALSE;
 810   outSort->handle = handle;
 811
 812   if (handle == NOSORTHANDLE)
 813     {
 814       if (sort_isNewEntry (outSort))
 815         {
 816           outSort = sort_lookup (handle = sort_enterNew (outSort));
 817
 818           for (old = outSort, dim = 0;
 819                old->kind == SRT_VECTOR;
 820                dim++, old = sort_lookup (old->baseSort))
 821             {
 822               ;
 823             }
 824
 825           genVecOps (elementSort, handle, dim);
 826         }
 827       else
 828         {
 829           outSort->handle = handle = sort_enterNew (outSort);
 830         }
 831     }
 832   else
 833     {
 834       llassert (sortTable != NULL);
 835
 836       if (sortTable[handle]->kind != SRT_VECTOR)
 837         {
 838           sortError (t, handle, outSort);
 839         }
 840
 841       sortNode_free (outSort);
 842     }
 843
 844   return handle;
 845 }
 846
 847 sort
 848 sort_makeVal (sort sor)
 849 {
 850   sort retSort = sor;
 851   sortNode rsn, s;
 852
 853   llassert (sortTable != NULL);
 854   s = sort_quietLookup (sor);
 855
 856   switch (s->kind)
 857     {
 858     case SRT_PRIM:
 859     case SRT_ENUM:
 860     case SRT_PTR:
 861     case SRT_TUPLE:
 862     case SRT_UNIONVAL:
 863     case SRT_VECTOR:
 864     case SRT_HOF:
 865     case SRT_NONE:
 866      /* Do nothing for basic types and pointers. */
 867       retSort = sor;
 868       break;
 869     case SRT_SYN:
 870       return sort_makeVal (sortTable[sor]->baseSort);
 871     case SRT_OBJ:
 872      /* Strip out the last Obj's */
 873       if (s->baseSort == NOSORTHANDLE)
 874         {
 875           llbuglit ("sort_makeVal: expecting a base sort for Obj");
 876         }
 877       retSort = s->baseSort;
 878       break;
 879     case SRT_ARRAY:
 880       retSort = sort_makeVec (ltoken_undefined, sor);
 881       break;
 882     case SRT_STRUCT:
 883       retSort = sort_makeTuple (ltoken_undefined, sor);
 884       break;
 885     case SRT_UNION:
 886       retSort = sort_makeUnionVal (ltoken_undefined, sor);
 887       break;
 888     default:
 889       llbuglit ("sort_makeVal: invalid sort kind");
 890     }
 891   rsn = sort_quietLookup (retSort);
 892   if (rsn->kind == SRT_NONE)
 893     {
 894       llfatalbug (message ("sort_makeVal: invalid return sort kind: %d", (int)rsn->kind));
 895     }
 896   return retSort;
 897 }
 898
 899 sort
 900 sort_makeImmutable (ltoken t, lsymbol name)
 901 {
 902   sortNode outSort;
 903   sort handle;
 904
 905   handle = sort_lookupName (name);
 906
 907   outSort = (sortNode) dmalloc (sizeof (*outSort));
 908   outSort->kind = SRT_PRIM;
 909   outSort->name = name;
 910   outSort->baseSort = NOSORTHANDLE;
 911   outSort->objSort = NOSORTHANDLE;
 912   outSort->members = smemberInfo_undefined;
 913   outSort->export = exporting;
 914   outSort->mutable = FALSE;
 915   outSort->imported = context_inImport ();
 916   outSort->abstract = TRUE;
 917   outSort->handle = handle;
 918
 919   if (handle == NOSORTHANDLE)
 920     {
 921       handle = sort_enterNew (outSort);
 922       outSort = sort_lookup (handle);
 923       overloadSizeof (handle);
 924     }
 925   else
 926     {                           /* complain */
 927       llassert (sortTable != NULL);
 928
 929       if ((sortTable[handle]->kind != SRT_PRIM) &&
 930           (sortTable[handle]->abstract) &&
 931           (!sortTable[handle]->mutable))
 932         {
 933           sortError (t, handle, outSort);
 934         }
 935
 936       sortNode_free (outSort);
 937     }
 938
 939   return handle;
 940 }
 941
 942 sort
 943 sort_makeMutable (ltoken t, lsymbol name)
 944 {
 945   sort immutable_old, handle, baseSort;
 946   lsymbol objName;
 947
 948   immutable_old = sort_lookupName (name);
 949
 950  /* First generate the value sort */
 951   baseSort = sort_makeImmutable (t, name);
 952
 953   llassert (sortTable != NULL);
 954
 955   /* to prevent duplicate error messages */
 956   if (immutable_old != NOSORTHANDLE &&
 957       (sortTable[baseSort]->kind != SRT_PRIM) &&
 958       (sortTable[baseSort]->abstract) &&
 959       (!sortTable[baseSort]->mutable))
 960     {
 961      /* already complained */
 962       handle = NOSORTHANDLE;
 963     }
 964   else
 965     {                           /* sort_makeImmutable must have succeeded */
 966       sortNode outSort;
 967
 968      /* must not clash with any LSL sorts */
 969       objName = sp (sp (underscoreSymbol, name),
 970                     lsymbol_fromChars ("_Obj"));
 971       handle = sort_lookupName (objName);
 972
 973       outSort = (sortNode) dmalloc (sizeof (*outSort));
 974       outSort->kind = SRT_OBJ;
 975       outSort->name = objName;
 976       outSort->tag = lsymbol_undefined;
 977       outSort->baseSort = baseSort;
 978       outSort->objSort = NOSORTHANDLE;
 979       outSort->members = smemberInfo_undefined;
 980       outSort->mutable = TRUE;
 981       outSort->export = exporting;
 982       outSort->imported = context_inImport ();
 983       outSort->abstract = TRUE;
 984       outSort->handle = handle;
 985
 986       if (handle == NOSORTHANDLE)
 987         {
 988           if (sort_isNewEntry (outSort))
 989             {
 990               outSort->handle = handle = sort_enterNew (outSort);
 991             }
 992           else
 993             {
 994               handle = sort_enterNew (outSort);
 995             }
 996         }
 997       else
 998         {
 999           llassert (sortTable != NULL);
1000
1001           if ((sortTable[handle]->kind != SRT_OBJ)
1002               && sortTable[handle]->abstract
1003               && sortTable[handle]->mutable)
1004             {
1005               sortError (t, handle, outSort);
1006             }
1007
1008           sortNode_free (outSort);
1009         }
1010     }
1011   return handle;
1012 }
1013
1014 sort
1015 sort_makeStr (ltoken opttagid)
1016 {
1017   sortNode outSort;
1018   sort handle;
1019   bool isNewTag;
1020   lsymbol name;
1021
1022   outSort = (sortNode) dmalloc (sizeof (*outSort));
1023
1024   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1025   /* isNewTag true means that the name generated is new */
1026
1027   if (ltoken_isUndefined (opttagid))
1028     {
1029       opttagid = ltoken_create (simpleId, newStructTag ());
1030
1031       outSort->realtag = FALSE;
1032     }
1033   else
1034     {
1035       outSort->realtag = TRUE;
1036     }
1037
1038   name = sortTag_toSymbol ("Struct", opttagid, &isNewTag);
1039
1040   llassert (sortTable != NULL);
1041   handle = sort_lookupName (name);
1042   outSort->name = name;
1043   outSort->kind = SRT_STRUCT;
1044   outSort->tag = ltoken_getText (opttagid);
1045   outSort->baseSort = NOSORTHANDLE;
1046   outSort->objSort = NOSORTHANDLE;
1047   outSort->members = smemberInfo_undefined;
1048   outSort->export = exporting;
1049   outSort->mutable = TRUE;
1050   outSort->imported = context_inImport ();
1051   outSort->abstract = FALSE;
1052   outSort->handle = handle;
1053
1054   if (handle == NOSORTHANDLE)
1055     {
1056       if (sort_isNewEntry (outSort))
1057         {
1058           outSort->handle = handle = sort_enterNew (outSort);
1059         }
1060       else
1061         {
1062           outSort->handle = handle = sort_enterNewForce (outSort);
1063         }
1064     }
1065   else
1066     {
1067       if (sortTable[handle]->kind != SRT_STRUCT)
1068         {
1069           sortError (opttagid, handle, outSort);
1070         }
1071
1072       sortNode_free (outSort);
1073     }
1074
1075   return handle;
1076 }
1077
1078 bool
1079 sort_updateStr (sort strSort, /*@only@*/ smemberInfo *info)
1080 {
1081   /* expect strSort to be in sort table but not yet filled in */
1082   /* return TRUE if it is "new" */
1083   sort tupleSort;
1084   sortNode sn;
1085
1086   llassert (sortTable != NULL);
1087   sn = sort_lookup (strSort);
1088
1089   if (sn->members == (smemberInfo *) 0)
1090     {
1091       sortTable[strSort]->members = info;
1092       tupleSort = sort_makeTuple (ltoken_undefined, strSort);
1093       genStrOps (strSort, tupleSort);
1094       return TRUE;
1095     }
1096   else
1097     {
1098       smemberInfo_free (info);
1099       return FALSE;
1100     }
1101 }
1102
1103 sort
1104 sort_makeTuple (ltoken t, sort strSort)
1105 {
1106   sort handle;
1107   sortNode outSort, s = sort_lookup (strSort);
1108   lsymbol name;
1109
1110   if (s->kind != SRT_STRUCT)
1111     {
1112       llfatalbug (message ("sort_makeTuple: Only structs can become tuples: given sort is %s",
1113                            sort_unparseKind (s->kind)));
1114     }
1115
1116   name = sp (s->name, lsymbol_fromChars ("_Tuple"));
1117   llassert (sortTable != NULL);
1118   handle = sort_lookupName (name);
1119
1120   outSort = (sortNode) dmalloc (sizeof (*outSort));
1121   outSort->kind = SRT_TUPLE;
1122   outSort->name = name;
1123   outSort->tag = s->tag;
1124   outSort->realtag = s->realtag;
1125   outSort->baseSort = strSort;
1126   outSort->objSort = NOSORTHANDLE;
1127   outSort->members = smemberInfo_undefined;
1128   outSort->export = exporting;
1129   outSort->abstract = FALSE;
1130   outSort->imported = context_inImport ();
1131   outSort->mutable = FALSE;
1132   outSort->handle = handle;
1133
1134   if (handle == NOSORTHANDLE)
1135     {
1136       if (sort_isNewEntry (outSort))
1137         {
1138           outSort->handle = handle = sort_enterNew (outSort);
1139
1140           sort_addTupleMembers (handle, strSort);
1141           genTupleOps (handle);
1142         }
1143       else
1144         {
1145           outSort->handle = handle = sort_enterNew (outSort);
1146         }
1147     }
1148   else
1149     {
1150       if (sortTable[handle]->kind != SRT_TUPLE)
1151         {
1152           sortError (t, handle, outSort);
1153         }
1154
1155       sortNode_free (outSort);
1156     }
1157
1158   return handle;
1159 }
1160
1161 static void
1162 sort_addTupleMembers (sort tupleSort, sort strSort)
1163 {
1164   smemberInfo *mem, *tail = smemberInfo_undefined;
1165   smemberInfo *top = smemberInfo_undefined;
1166   smemberInfo *newinfo;
1167
1168   /* make sure it works for empty smemberInfo */
1169
1170   llassert (sortTable != NULL);
1171
1172   for (mem = sortTable[strSort]->members;
1173        mem != smemberInfo_undefined; mem = mem->next)
1174     {
1175       newinfo = (smemberInfo *) dmalloc (sizeof (*newinfo));
1176       newinfo->name = mem->name;
1177       newinfo->sort = sort_makeVal (mem->sort);
1178       newinfo->next = smemberInfo_undefined;
1179
1180       if (top == smemberInfo_undefined)
1181         {                       /* start of iteration */
1182           top = newinfo;
1183           tail = newinfo;
1184         }
1185       else
1186         {
1187           llassert (tail != smemberInfo_undefined);
1188
1189           tail->next = newinfo;
1190           tail = newinfo;
1191           /*@-branchstate@*/ /* tail is dependent */
1192         }
1193       /*@=branchstate@*/
1194     }
1195
1196   sortTable[tupleSort]->members = top;
1197 }
1198
1199 static
1200 void genTupleOps (sort tupleSort)
1201 {
1202   ltoken range, dom;
1203   sort fieldsort;
1204   smemberInfo *m;
1205   unsigned int memCount;
1206   ltokenList domain = ltokenList_new ();
1207   sigNode signature;
1208   opFormUnion u;
1209   opFormNode opform;
1210   nameNode nn;
1211
1212   memCount = 0;
1213   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (tupleSort));
1214
1215   llassert (sortTable != NULL);
1216   for (m = sortTable[tupleSort]->members;
1217        m != smemberInfo_undefined; m = m->next)
1218     {
1219       fieldsort = sort_makeVal (m->sort);
1220       overloadUnary (makeFieldOp (m->name), tupleSort, fieldsort);
1221
1222       dom = ltoken_createType (simpleId, SID_SORT,
1223                                sort_getLsymbol (fieldsort));
1224       ltokenList_addh (domain, dom);
1225       memCount++;
1226     }
1227
1228   /* For tuples only: [__, ...]: memSorts, ... -> tupleSort */
1229   signature = makesigNode (ltoken_undefined, domain, range);
1230   u.middle = memCount;
1231
1232   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1233                            OPF_BMIDDLE, u, ltoken_copy (ltoken_rbracket));
1234
1235   nn = makeNameNodeForm (opform);
1236   symtable_enterOp (g_symtab, nn, signature);
1237
1238   /*
1239   ** should not be able to take sizeof (struct^) ...
1240   */
1241 }
1242
1243 static
1244 void genUnionOps (sort tupleSort)
1245 {
1246  /* like genTupleOps but no constructor [ ...]: -> unionSort */
1247   smemberInfo *m;
1248   sort sort;
1249
1250   llassert (sortTable != NULL);
1251   for (m = sortTable[tupleSort]->members;
1252        m != smemberInfo_undefined; m = m->next)
1253     {
1254      /* Generate __.memName: strSort ->memSortObj */
1255       overloadUnary (makeFieldOp (m->name), tupleSort, m->sort);
1256      /*    printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1257                 sort_getName (tupleSort), sort_getName (m->sort)); */
1258      /* __->memName : Union_Ptr -> memSortObj */
1259       sort = sort_makePtr (ltoken_undefined, tupleSort);
1260       overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1261      /*    printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1262                 sort_getName (sort), sort_getName (m->sort)); */
1263     }
1264 }
1265
1266 static
1267 void genStrOps (sort strSort, /*@unused@*/ sort tupleSort)
1268 {
1269   smemberInfo *m;
1270   sort sort;
1271
1272   llassert (sortTable != NULL);
1273   for (m = sortTable[strSort]->members;
1274        m != smemberInfo_undefined; m = m->next)
1275     {
1276      /* Generate __.memName: strSort ->memSortObj */
1277       overloadUnary (makeFieldOp (m->name), strSort, m->sort);
1278       /*    printf ("making __.%s: %s -> %s\n", lsymbol_toChars (m->name),
1279             sort_getName (strSort), sort_getName (m->sort)); */
1280       /* __->memName : Struct_Ptr -> memSortObj */
1281       sort = sort_makePtr (ltoken_undefined, strSort);
1282       overloadUnary (makeArrowFieldOp (m->name), sort, m->sort);
1283       /*    printf ("making __->%s: %s -> %s\n", lsymbol_toChars (m->name),
1284             sort_getName (sort), sort_getName (m->sort)); */
1285     }
1286   /* Generate fresh, trashed, modifies, unchanged: struct/union -> bool */
1287   /* Generate __any, __pre, __post: nStruct -> nTuple */
1288   /* Generate sizeof: strSort -> int */
1289   /* overloadStateFcns (strSort, tupleSort); */
1290 }
1291
1292 sort
1293 sort_makeUnion (ltoken opttagid)
1294 {
1295   sortNode outSort;
1296   sort handle;
1297   bool isNewTag;
1298   lsymbol name;
1299
1300   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1301   /* isNewTag true means that the name generated is new */
1302
1303   outSort = (sortNode) dmalloc (sizeof (*outSort));
1304
1305   if (ltoken_isUndefined (opttagid))
1306     {
1307       opttagid = ltoken_create (simpleId, newUnionTag ());
1308       outSort->realtag = FALSE;
1309     }
1310   else
1311     {
1312       outSort->realtag = TRUE;
1313     }
1314
1315   llassert (sortTable != NULL);
1316   name = sortTag_toSymbol ("Union", opttagid, &isNewTag);
1317   handle = sort_lookupName (name);
1318   outSort->name = name;
1319   outSort->kind = SRT_UNION;
1320   outSort->tag = ltoken_getText (opttagid);
1321   outSort->baseSort = NOSORTHANDLE;
1322   outSort->objSort = NOSORTHANDLE;
1323   outSort->members = smemberInfo_undefined;
1324   outSort->export = exporting;
1325   outSort->mutable = TRUE;
1326   outSort->imported = context_inImport ();
1327   outSort->abstract = FALSE;
1328   outSort->handle = handle;
1329
1330   if (handle == NOSORTHANDLE)
1331     {
1332       if (sort_isNewEntry (outSort))
1333         {
1334           outSort->handle = handle = sort_enterNew (outSort);
1335         }
1336       else
1337         {
1338           outSort->handle = handle = sort_enterNewForce (outSort);
1339         }
1340     }
1341   else
1342     {
1343       if (sortTable[handle]->kind != SRT_UNION)
1344         {
1345           sortError (opttagid, handle, outSort);
1346         }
1347
1348       sortNode_free (outSort);
1349     }
1350
1351   return handle;
1352 }
1353
1354 bool
1355 sort_updateUnion (sort unionSort, /*@only@*/ smemberInfo *info)
1356 {
1357  /* expect unionSort to be in sort table but not yet filled in */
1358  /* return TRUE if it is "new" */
1359   sort uValSort;
1360   sortNode sn;
1361
1362   llassert (sortTable != NULL);
1363
1364   sn = sort_lookup (unionSort);
1365
1366   if (sn->members == (smemberInfo *) 0)
1367     {
1368       sortTable[unionSort]->members = info;
1369       uValSort = sort_makeUnionVal (ltoken_undefined, unionSort);
1370       /* same as struct operations */
1371       genStrOps (unionSort, uValSort);
1372       return TRUE;
1373     }
1374   else
1375     {
1376       smemberInfo_free (info);
1377       return FALSE;
1378     }
1379 }
1380
1381 sort
1382 sort_makeUnionVal (ltoken t, sort unionSort)
1383 {
1384   sort handle;
1385   sortNode outSort, s = sort_lookup (unionSort);
1386   lsymbol name;
1387
1388   if (s->kind != SRT_UNION)
1389     {
1390       llfatalbug (message ("sort_makeUnion: only unions can become unionVals: given sort is: %s",
1391                            sort_unparseKind (s->kind)));
1392     }
1393
1394   llassert (sortTable != NULL);
1395
1396   name = sp (s->name, lsymbol_fromChars ("_UnionVal"));
1397   handle = sort_lookupName (name);
1398
1399   outSort = (sortNode) dmalloc (sizeof (*outSort));
1400   outSort->kind = SRT_UNIONVAL;
1401   outSort->name = name;
1402   outSort->tag = s->tag;
1403   outSort->realtag = s->realtag;
1404   outSort->baseSort = unionSort;
1405   outSort->objSort = NOSORTHANDLE;
1406   outSort->members = smemberInfo_undefined;
1407   outSort->export = exporting;
1408   outSort->abstract = FALSE;
1409   outSort->imported = context_inImport ();
1410   outSort->mutable = FALSE;
1411   outSort->handle = handle;
1412
1413   if (handle == NOSORTHANDLE)
1414     {
1415       if (sort_isNewEntry (outSort))
1416         {
1417           outSort->handle = handle = sort_enterNew (outSort);
1418
1419           /* Add members to the unionVal's. */
1420           /* same as structs and tuples */
1421
1422           sort_addTupleMembers (handle, unionSort);
1423           genUnionOps (handle);
1424         }
1425       else
1426         {
1427           outSort->handle = handle = sort_enterNew (outSort);
1428         }
1429     }
1430   else
1431     {
1432       if (sortTable[handle]->kind != SRT_UNIONVAL)
1433         {
1434           sortError (t, handle, outSort);
1435         }
1436
1437       sortNode_free (outSort);
1438     }
1439
1440   return handle;
1441 }
1442
1443 static lsymbol
1444 newEnumTag ()
1445 {
1446   static int ecount = 0;
1447
1448   return (cstring_toSymbol (message ("e%s%de", context_moduleName (), ecount++)));
1449 }
1450
1451 static lsymbol
1452 newStructTag ()
1453 {
1454   static int ecount = 0;
1455
1456   return (cstring_toSymbol (message ("s%s%ds", context_moduleName (), ecount++)));
1457 }
1458
1459 static lsymbol
1460 newUnionTag ()
1461 {
1462   static int ecount = 0;
1463
1464   return (cstring_toSymbol (message ("u%s%du", context_moduleName (), ecount++)));
1465 }
1466
1467 sort
1468 sort_makeEnum (ltoken opttagid)
1469 {
1470   sortNode outSort;
1471   sort handle;
1472   bool isNew;
1473   lsymbol name;
1474
1475   llassert (sortTable != NULL);
1476
1477   outSort = (sortNode) dmalloc (sizeof (*outSort));
1478
1479   if (ltoken_isUndefined (opttagid))
1480     {
1481       opttagid = ltoken_create (simpleId, newEnumTag ());
1482       outSort->realtag = FALSE;
1483     }
1484   else
1485     {
1486       outSort->realtag = TRUE;
1487     }
1488
1489   /* must not clash with any LSL sorts, tag2sortname adds "_" prefix */
1490
1491   name = sortTag_toSymbol ("Enum", opttagid, &isNew);
1492   handle = sort_lookupName (name);
1493   outSort->name = name;
1494   outSort->kind = SRT_ENUM;
1495   outSort->tag = ltoken_getText (opttagid);
1496   outSort->baseSort = NOSORTHANDLE;
1497   outSort->objSort = NOSORTHANDLE;
1498   outSort->members = smemberInfo_undefined;
1499   outSort->export = exporting;
1500   outSort->mutable = FALSE;
1501   outSort->imported = context_inImport ();
1502   outSort->abstract = FALSE;
1503   outSort->handle = handle;
1504
1505   if (handle == NOSORTHANDLE)
1506     {
1507       if (sort_isNewEntry (outSort))
1508         {
1509           outSort->handle = handle = sort_enterNew (outSort);
1510         }
1511       else
1512         {
1513           outSort->handle = handle = sort_enterNewForce (outSort);
1514         }
1515     }
1516   else
1517     {
1518       if (sortTable[handle]->kind != SRT_ENUM)
1519         {
1520           sortError (opttagid, handle, outSort);
1521         }
1522
1523       sortNode_free (outSort);
1524     }
1525
1526   return handle;
1527 }
1528
1529 bool
1530 sort_updateEnum (sort enumSort, /*@only@*/ smemberInfo *info)
1531 {
1532   /*
1533   ** Expect enumSort to be in sort table but not yet filled in.
1534   ** Return TRUE if it is "new"
1535   */
1536
1537   sortNode sn;
1538
1539   llassert (sortTable != NULL);
1540
1541   sn = sort_lookup (enumSort);
1542   if (sn->members == (smemberInfo *) 0)
1543     {
1544       sortTable[enumSort]->members = info;
1545       genEnumOps (enumSort);
1546       return TRUE;
1547     }
1548   else
1549     {
1550       smemberInfo_free (info);
1551       return FALSE;
1552     }
1553 }
1554
1555 static
1556 void genEnumOps (sort enumSort)
1557 {
1558   smemberInfo *ei;
1559   ltokenList domain = ltokenList_new ();
1560   ltoken range, mem;
1561   nameNode nn;
1562   sigNode signature;
1563
1564   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (enumSort));
1565   signature = makesigNode (ltoken_undefined, domain, range);
1566
1567   llassert (sortTable != NULL);
1568
1569   for (ei = sortTable[enumSort]->members;
1570        ei != (smemberInfo *) 0; ei = ei->next)
1571     {
1572       mem = ltoken_createType (simpleId, SID_OP, ei->name);
1573       nn = makeNameNodeId (mem);
1574       symtable_enterOp (g_symtab, nn, sigNode_copy (signature));
1575     }
1576
1577   sigNode_free (signature);
1578   overloadSizeof (enumSort);
1579 }
1580
1581 static void
1582 genPtrOps (/*@unused@*/ sort baseSort, sort ptrSort, sort arraySort)
1583 {
1584   /* Generate *__: xPtr -> x */
1585
1586   /* overloadUnary (deRefNameNode, ptrSort, baseSort); */
1587
1588   /* Generate maxIndex, minIndex: xPtr -> int */
1589   /* overloadUnaryTok (maxIndexNameNode, ptrSort, intToken); */
1590   /* overloadUnaryTok (minIndexNameNode, ptrSort, intToken); */
1591
1592   /* Generate __[]: pointer -> array  */
1593   overloadUnary (nameNode_copySafe (ptr2arrayNameNode), ptrSort, arraySort);
1594
1595   /* Generate __+__, __-__: pointer, int -> pointer  */
1596   overloadBinary (nameNode_copySafe (plusNameNode), ptrSort,
1597                   ltoken_copy (intToken), ptrSort);
1598
1599   overloadBinary (nameNode_copySafe (minusNameNode), ptrSort,
1600                   ltoken_copy (intToken), ptrSort);
1601
1602   /* Generate NIL: -> xPtr */
1603   /* Generate __+__: int, pointer -> pointer  */
1604   /* Generate __-__: pointer, pointer -> int  */
1605   overloadPtrFcns (ptrSort);
1606 }
1607
1608 static void
1609 genArrOps (sort baseSort, sort arraySort, int dim, /*@unused@*/ sort vecSort)
1610 {
1611   /* Generate __[__]: nArr, int -> n */
1612   overloadBinary (nameNode_copySafe (arrayRefNameNode), arraySort,
1613                   ltoken_copy (intToken), baseSort);
1614
1615   /* Generate maxIndex, minIndex: sort -> int */
1616   /* overloadUnaryTok (maxIndexNameNode, arraySort, intToken); */
1617   /* overloadUnaryTok (minIndexNameNode, arraySort, intToken); */
1618
1619   /* Generate isSub: arraySort, int, ... -> bool */
1620   overloadIsSub (arraySort, dim);
1621
1622   /* Generate fresh, trashed, modifies, unchanged: array -> bool  */
1623   /* Generate any, pre, post: array -> vector */
1624
1625   /* overloadStateFcns (arraySort, vecSort); */
1626   /* overloadObjFcns (arraySort); */
1627 }
1628
1629 /*
1630 ** overloadPtrFcns:
1631 **   generate NIL: -> ptrSort
1632 **            __+__: int, ptrSort -> ptrSort
1633 **            __-__: ptrSort, ptrSort -> int
1634 */
1635 static void
1636 overloadPtrFcns (sort ptrSort)
1637 {
1638   ltokenList domain = ltokenList_new ();
1639   ltoken range;
1640   sigNode signature;
1641
1642   /* NIL: -> ptrSort */
1643
1644   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (ptrSort));
1645   signature = makesigNode (ltoken_undefined, ltokenList_new (), ltoken_copy (range));
1646   symtable_enterOp (g_symtab, nameNode_copySafe (nilNameNode), signature);
1647
1648   /* __+__: int, ptrSort -> ptrSort  */
1649
1650   ltokenList_addh (domain, ltoken_copy (intToken));
1651   ltokenList_addh (domain, ltoken_copy (range));
1652
1653   signature = makesigNode (ltoken_undefined, domain, ltoken_copy (range));
1654   symtable_enterOp (g_symtab, nameNode_copySafe (plusNameNode), signature);
1655
1656   /* __-__: ptrSort, ptrSort -> int  */
1657
1658   domain = ltokenList_new ();
1659   ltokenList_addh (domain, ltoken_copy (range));
1660   ltokenList_addh (domain, range);
1661   range = ltoken_copy (intToken);
1662   signature = makesigNode (ltoken_undefined, domain, range);
1663   symtable_enterOp (g_symtab, nameNode_copySafe (minusNameNode), signature);
1664 }
1665
1666 static void
1667 genVecOps (sort baseSort, sort vecSort, int dim)
1668 {
1669   /* Generate __[__]: vecSort, int -> baseSort */
1670
1671   overloadBinary (nameNode_copySafe (arrayRefNameNode), vecSort,
1672                   ltoken_copy (intToken), baseSort);
1673
1674   /*          sizeof: vecSort -> int */
1675   /* Generate isSub: vecSort, int, ... -> bool */
1676
1677   overloadIsSub (vecSort, dim);
1678 }
1679
1680 static void
1681 overloadIsSub (sort s, int dim)
1682 {
1683   /* Generate isSub: s, int, ... -> bool */
1684   int j, i;
1685   ltoken dom, nulltok = ltoken_undefined;
1686   ltokenList domain;
1687   sigNode signature;
1688
1689   for (j = 1; j <= dim; j++)
1690     {
1691       nameNode isSubNameNode = (nameNode) dmalloc (sizeof (*isSubNameNode));
1692
1693       isSubNameNode->isOpId = TRUE;
1694       isSubNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1695                                                          lsymbol_fromChars ("isSub"));
1696       dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1697
1698       domain = ltokenList_singleton (dom);
1699
1700       for (i = 1; i <= j; i++)
1701         {
1702           ltokenList_addh (domain, ltoken_copy (intToken));
1703         }
1704
1705       signature = makesigNode (nulltok, domain, ltoken_copy (ltoken_bool));
1706       symtable_enterOp (g_symtab, isSubNameNode, signature);
1707     }
1708 }
1709
1710 static void
1711 overloadUnaryTok (/*@only@*/ nameNode nn, sort domainSort, /*@only@*/ ltoken range)
1712 {
1713   /* Generate <nn>: domainSort -> rangeTok */
1714   sigNode signature;
1715   ltoken dom;
1716   ltokenList domain;
1717
1718   dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (domainSort));
1719   domain = ltokenList_singleton (dom);
1720   signature = makesigNode (ltoken_undefined, domain, range);
1721   symtable_enterOp (g_symtab, nn, signature);
1722 }
1723
1724 static void
1725 overloadSizeof (sort domainSort)
1726 {
1727   nameNode sizeofNameNode = (nameNode) dmalloc (sizeof (*sizeofNameNode));
1728
1729   sizeofNameNode->isOpId = TRUE;
1730   sizeofNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1731                                                       lsymbol_fromChars ("sizeof"));
1732
1733   overloadUnaryTok (sizeofNameNode, domainSort, ltoken_copy (intToken));
1734 }
1735
1736 static void
1737 overloadUnary (/*@only@*/ nameNode nn, sort domainSort, sort rangeSort)
1738 {
1739   ltoken range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rangeSort));
1740
1741   overloadUnaryTok (nn, domainSort, range);
1742 }
1743
1744 static void
1745 overloadBinary (/*@only@*/ nameNode nn, sort s, /*@only@*/ ltoken dTok, sort rs)
1746 {
1747   /* Generate <nn>: s, dTok -> rs */
1748   sigNode signature;
1749   ltoken range, dom;
1750   ltokenList domain = ltokenList_new ();
1751
1752   range = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (rs));
1753   dom = ltoken_createType (simpleId, SID_SORT, sort_getLsymbol (s));
1754
1755   ltokenList_addh (domain, dom);
1756   ltokenList_addh (domain, dTok);
1757
1758   signature = makesigNode (ltoken_undefined, domain, range);
1759       symtable_enterOp (g_symtab, nn, signature);
1760 }
1761
1762 static /*@only@*/ nameNode
1763 makeFieldOp (lsymbol field)
1764 {
1765  /* operator: __.<field> */
1766   nameNode nn;
1767   opFormUnion u;
1768   opFormNode opform;
1769
1770   u.id = ltoken_createType (simpleId, SID_OP, field);
1771   opform = makeOpFormNode (ltoken_undefined, OPF_MSELECT, u, ltoken_undefined);
1772   nn = makeNameNodeForm (opform);
1773   return nn;
1774 }
1775
1776 static /*@only@*/ nameNode
1777 makeArrowFieldOp (lsymbol field)
1778 {
1779  /* operator: __-><field> */
1780   nameNode nn;
1781   opFormUnion u;
1782   opFormNode opform;
1783
1784   u.id = ltoken_createType (simpleId, SID_OP, field);
1785   opform = makeOpFormNode (ltoken_undefined, OPF_MMAP, u, ltoken_undefined);
1786   nn = makeNameNodeForm (opform);
1787   return nn;
1788 }
1789
1790 void
1791 sort_init (void)
1792    /*@globals undef arrayRefNameNode,
1793               undef ptr2arrayNameNode,
1794               undef deRefNameNode,
1795               undef nilNameNode,
1796               undef plusNameNode,
1797               undef minusNameNode,
1798               undef condNameNode,
1799               undef eqNameNode,
1800               undef neqNameNode,
1801               undef intToken; @*/
1802 {
1803   /* on alpha, declaration does not allocate storage */
1804   sortNode noSort, HOFSort;
1805   opFormNode opform;
1806   opFormUnion u;
1807   underscoreSymbol = lsymbol_fromChars ("_");
1808
1809   /*
1810   ** commonly used data for generating operators
1811   */
1812
1813   lsymbol_setbool (lsymbol_fromChars ("bool"));
1814   intToken = ltoken_createType (simpleId, SID_SORT, lsymbol_fromChars ("int"));
1815
1816   /*
1817   ** __ \eq __: sort, sort -> bool
1818   */
1819
1820   u.anyop = ltoken_copy (ltoken_eq);
1821   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1822   eqNameNode = makeNameNodeForm (opform);
1823
1824   /*
1825   ** __ \neq __: sort, sort -> bool
1826   */
1827
1828   u.anyop = ltoken_copy (ltoken_neq);
1829   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1830   neqNameNode = makeNameNodeForm (opform);
1831
1832   /*
1833   **if __ then __ else __: bool, sort, sort -> sort
1834   */
1835
1836   opform = makeOpFormNode (ltoken_undefined, OPF_IF,
1837                            opFormUnion_createMiddle (0), ltoken_undefined);
1838   condNameNode = makeNameNodeForm (opform);
1839
1840   /* operator: __[__]: arraySort, int -> elementSort_Obj */
1841   u.middle = 1;
1842   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked), OPF_BMMIDDLE, u,
1843                            ltoken_copy (ltoken_rbracket));
1844   arrayRefNameNode = makeNameNodeForm (opform);
1845
1846   /* operator: __[]: ptrSort -> arraySort */
1847   u.middle = 0;
1848   opform = makeOpFormNode (ltoken_copy (ltoken_lbracked),
1849                            OPF_BMMIDDLE, u,
1850                            ltoken_copy (ltoken_rbracket));
1851   ptr2arrayNameNode = makeNameNodeForm (opform);
1852
1853   /* operator: *__ */
1854   u.anyop = ltoken_create (LLT_MULOP, lsymbol_fromChars ("*"));
1855   opform = makeOpFormNode (ltoken_undefined, OPF_ANYOPM, u, ltoken_undefined);
1856   deRefNameNode = makeNameNodeForm (opform);
1857
1858   /* operator: __ + __ */
1859   u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("+"));
1860   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1861   plusNameNode = makeNameNodeForm (opform);
1862
1863   /* operator: __ - __ */
1864   u.anyop = ltoken_create (simpleOp, lsymbol_fromChars ("-"));
1865   opform = makeOpFormNode (ltoken_undefined, OPF_MANYOPM, u, ltoken_undefined);
1866   minusNameNode = makeNameNodeForm (opform);
1867
1868   /* operator: NIL */
1869   nilNameNode = (nameNode) dmalloc (sizeof (*nilNameNode));
1870   nilNameNode->isOpId = TRUE;
1871   nilNameNode->content.opid = ltoken_createType (simpleId, SID_OP,
1872                                                  lsymbol_fromChars ("NIL"));
1873
1874   noSort = (sortNode) dmalloc (sizeof (*noSort));
1875   noSort->kind = SRT_NONE;
1876   noSort->name = lsymbol_fromChars ("_unknown");;
1877   noSort->tag = lsymbol_undefined;
1878   noSort->baseSort = NOSORTHANDLE;
1879   noSort->objSort = NOSORTHANDLE;
1880   noSort->members = smemberInfo_undefined;
1881   noSort->export = FALSE;
1882   noSort->mutable = FALSE;
1883   noSort->abstract = FALSE;
1884   noSort->imported = FALSE;
1885   noSort->handle = NOSORTHANDLE;
1886
1887   HOFSort = (sortNode) dmalloc (sizeof (*HOFSort));
1888   HOFSort->kind = SRT_HOF;
1889   HOFSort->handle = HOFSORTHANDLE;
1890   HOFSort->name = lsymbol_undefined;
1891   HOFSort->tag = lsymbol_undefined;
1892   HOFSort->realtag = FALSE;
1893   HOFSort->baseSort = NOSORTHANDLE;
1894   HOFSort->objSort = NOSORTHANDLE;
1895   HOFSort->members = smemberInfo_undefined;
1896   HOFSort->export = FALSE;
1897   HOFSort->mutable = FALSE;
1898   HOFSort->abstract = FALSE;
1899   HOFSort->imported = FALSE;
1900
1901   /*
1902   ** Store the null sort into table, and in the process initialize the sort table.
1903   ** Must be the first sort_enter so NOSORTHANDLE is truly = 0. Similarly,
1904   ** for HOFSORTHANDLE = 1.
1905   */
1906
1907   (void) sort_enterGlobal (noSort);
1908   (void) sort_enterGlobal (HOFSort);
1909
1910   /* Other builtin sorts */
1911
1912   sort_bool = sort_makeImmutable (ltoken_undefined, lsymbol_fromChars ("bool"));
1913   sort_capBool = sort_makeSortNoOps (ltoken_undefined, lsymbol_fromChars ("Bool"));
1914
1915   llassert (sortTable != NULL);
1916
1917   /* make sort_Bool a synonym for sort_bool */
1918   sortTable[sort_capBool]->kind = SRT_SYN;
1919   sortTable[sort_capBool]->baseSort = sort_bool;
1920   sortTable[sort_capBool]->mutable = FALSE;
1921   sortTable[sort_capBool]->abstract = TRUE;
1922
1923   sort_int = sort_makeLiteralSort (ltoken_undefined,
1924                                    lsymbol_fromChars ("int"));
1925   sort_char = sort_makeLiteralSort (ltoken_undefined,
1926                                     lsymbol_fromChars ("char"));
1927   sort_void = sort_makeLiteralSort (ltoken_undefined,
1928                                     lsymbol_fromChars ("void"));
1929
1930   /* sort_cstring is char__Vec, for C strings eg: "xyz" */
1931   char_obj_ptrSort = sort_makePtr (ltoken_undefined, sort_char);
1932   char_obj_ArrSort = sort_makeArr (ltoken_undefined, sort_char);
1933
1934   sort_cstring = sort_makeVal (char_obj_ArrSort);
1935   sort_float = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("float"));
1936   sort_double = sort_makeLiteralSort (ltoken_undefined, lsymbol_fromChars ("double"));
1937 }
1938
1939 sort
1940 sort_lookupName (lsymbol name)
1941 {
1942   long int i;
1943
1944   if (name == lsymbol_undefined)
1945     {
1946       return NOSORTHANDLE;
1947     }
1948
1949   llassert (sortTable != NULL);
1950
1951   for (i = 0; i < sortTableSize; i++)
1952     {
1953       if (sortTable[i]->name == name)
1954         {
1955           return i;
1956         }
1957     }
1958
1959   return NOSORTHANDLE;
1960 }
1961
1962 static bool
1963 sort_isNewEntry (sortNode s)
1964 {
1965   int i;
1966
1967   for (i = 0; i < sortTableSize; i++)
1968     {
1969       llassert (sortTable != NULL);
1970
1971       if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
1972         {
1973           return FALSE;
1974         }
1975     }
1976   return TRUE;
1977 }
1978
1979 static sort
1980 sort_enterGlobal (sortNode s)
1981 {
1982   return (sort_enterNew (s));
1983 }
1984
1985 static sort
1986 sort_enterNew (sortNode s)
1987 {
1988   /*
1989   ** This ensures that the argument sortNode is not entered into
1990   ** the sort table more than once.  isNew flag will tell the
1991   ** caller this info, and the caller will decide whether to generate
1992   ** operators for this sort.
1993   */
1994
1995   long int i;
1996
1997   for (i = 0; i < sortTableSize; i++)
1998     {
1999       llassert (sortTable != NULL);
2000
2001       if (sortTable[i]->kind == s->kind && sortTable[i]->name == s->name)
2002         {
2003           sortNode_free (s);
2004           return i;
2005         }
2006     }
2007
2008   if (sortTableSize >= sortTableAlloc)
2009     {
2010       sortNode *oldSortTable = sortTable;
2011
2012       sortTableAlloc += DELTA;
2013       sortTable = (sortNode *) dmalloc (sortTableAlloc * sizeof (*sortTable));
2014
2015       if (sortTableSize > 0)
2016         {
2017           llassert (oldSortTable != NULL);
2018           for (i = 0; i < sortTableSize; i++)
2019             {
2020               sortTable[i] = oldSortTable[i];
2021             }
2022         }
2023
2024       sfree (oldSortTable);
2025     }
2026
2027   llassert (sortTable != NULL);
2028
2029   s->handle = sortTableSize;
2030   sortTable[sortTableSize++] = s;
2031
2032   /*@-compdef@*/
2033   return s->handle;
2034 } /*=compdef@*/
2035
2036 static sort sort_enterNewForce (sortNode s)
2037 {
2038   sort sor = sort_lookupName (s->name);
2039
2040   if (sort_isNoSort (sor))
2041     {
2042       sor = sort_enterNew (s);
2043       llassert (sortTable != NULL);
2044       /*@-usereleased@*/
2045       llassert (sortTable[sor] == s);
2046       /*@=usereleased@*/
2047     }
2048   else
2049     {
2050       s->handle = sor;
2051       llassert (sortTable != NULL);
2052       sortTable[sor] = s;
2053     }
2054
2055   /*@-globstate@*/ return (sor); /*@=globstate@*/
2056 }
2057
2058 void
2059 sort_printStats (void)
2060 {
2061   /* only for debugging */
2062   printf ("sortTableSize = %d; sortTableAlloc = %d\n", sortTableSize,
2063           sortTableAlloc);
2064 }
2065
2066 sortNode
2067 sort_lookup (sort sor)
2068 {
2069   /* ymtan: can sor be 0 ? */
2070   /* evs --- yup...0 should return noSort ? */
2071
2072   if (sor > 0U && sor < (unsigned) sortTableSize)
2073     {
2074       llassert (sortTable != NULL);
2075       return sortTable[sor];
2076     }
2077
2078   llassert (sor == 0);
2079   llassert (sor == NOSORTHANDLE);
2080   llassert (sortTable != NULL);
2081   return sortTable[NOSORTHANDLE];
2082 }
2083
2084 sortNode
2085 sort_quietLookup (sort sor)
2086 {
2087   /* ymtan: can sor be 0 ? */
2088   if (sor > 0U && sor < (unsigned) sortTableSize)
2089     {
2090       llassert (sortTable != NULL);
2091       return (sortTable[sor]);
2092     }
2093   else
2094     {
2095       llassert (sortTable != NULL);
2096       return (sortTable[NOSORTHANDLE]);
2097     }
2098 }
2099
2100 static cstring
2101 printEnumMembers (/*@null@*/ smemberInfo *list)
2102 {
2103   cstring out = cstring_undefined;
2104   smemberInfo *m;
2105
2106   for (m = list; m != (smemberInfo *) 0; m = m->next)
2107     {
2108       out = cstring_concat (out, lsymbol_toString (m->name));
2109
2110       if (m->next != (smemberInfo *) 0)
2111         {
2112           out = cstring_concatChars (out, ", ");
2113         }
2114     }
2115   return out;
2116 }
2117
2118 static /*@only@*/ cstring
2119 printStructMembers (/*@null@*/ smemberInfo *list)
2120 {
2121   cstring ret = cstring_undefined;
2122   smemberInfo *m;
2123
2124   for (m = list; m != (smemberInfo *) 0; m = m->next)
2125     {
2126       ret = message ("%q%q %s; ",
2127                      ret, sort_unparse (m->sort),
2128                      cstring_fromChars (lsymbol_toChars (m->name)));
2129     }
2130
2131   return ret;
2132 }
2133
2134 /*@only@*/ cstring
2135 sort_unparse (sort s)
2136 {
2137  /* printing routine for sorts */
2138   sortNode sn;
2139   lsymbol name;
2140
2141   sn = sort_quietLookup (s);
2142   name = sn->name;
2143
2144   switch (sn->kind)
2145     {
2146     case SRT_NONE:
2147       if (name == lsymbol_undefined)
2148         {
2149           return cstring_makeLiteral ("_unknown");
2150         }
2151
2152       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2153     case SRT_HOF:
2154       return cstring_makeLiteral ("procedural");
2155     case SRT_PRIM:
2156       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2157     case SRT_SYN:
2158       return (cstring_fromCharsNew (lsymbol_toChars (name)));
2159
2160     case SRT_PTR:
2161       return (message ("%q *", sort_unparse (sort_makeVal (sn->baseSort))));
2162     case SRT_OBJ:
2163       return (message ("obj %q", sort_unparse (sn->baseSort)));
2164     case SRT_ARRAY:
2165       return (message ("array of %q", sort_unparse (sort_makeVal (sn->baseSort))));
2166     case SRT_VECTOR:
2167       return (message ("vector of %q", sort_unparse (sn->baseSort)));
2168     case SRT_TUPLE:
2169       if (sn->tag != lsymbol_undefined && sn->realtag)
2170         {
2171           return (message ("struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2172         }
2173       else
2174         {
2175           return (message ("struct {%q}", printStructMembers (sn->members)));
2176         }
2177     case SRT_UNIONVAL:
2178       if (sn->tag != lsymbol_undefined && sn->realtag)
2179         {
2180           return (message ("union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2181         }
2182       else
2183         {
2184           return (message ("union {%q}", printStructMembers (sn->members)));
2185         }
2186     case SRT_ENUM:
2187       if (sn->tag != lsymbol_undefined && sn->realtag)
2188         {
2189           return (message ("enum %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2190         }
2191       else
2192         {
2193           return (message ("enum {%q}", printEnumMembers (sn->members)));
2194         }
2195     case SRT_STRUCT:
2196       if (sn->tag != lsymbol_undefined && sn->realtag)
2197         {
2198           return (message ("obj struct %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2199         }
2200       else
2201         {
2202           return (message ("obj struct {%q}", printStructMembers (sn->members)));
2203         }
2204     case SRT_UNION:
2205       if (sn->tag != lsymbol_undefined && sn->realtag)
2206         {
2207           return (message ("obj union %s", cstring_fromChars (lsymbol_toChars (sn->tag))));
2208         }
2209       else
2210         {
2211           return (message ("obj union {%q}", printStructMembers (sn->members)));
2212         }
2213     default:
2214       return (cstring_makeLiteral ("illegal"));
2215     }
2216 }
2217
2218 static lsymbol
2219 sp (lsymbol s1, lsymbol s2)
2220 {
2221   char buff[MAXBUFFLEN];
2222   char *name1Ptr;
2223   char *name2Ptr;
2224   int temp_length;
2225
2226   name1Ptr = lsymbol_toCharsSafe (s1);
2227   name2Ptr = lsymbol_toCharsSafe (s2);
2228
2229   if (strlen (name1Ptr) + strlen (name2Ptr) + 1 > MAXBUFFLEN)
2230     {
2231       temp_length = strlen (name1Ptr) + strlen (name2Ptr) + 1;
2232       llfatalbug (message ("sp: name too long: %s%s",
2233                            cstring_fromChars (name1Ptr),
2234                            cstring_fromChars (name2Ptr)));
2235     }
2236
2237   strcpy (&buff[0], name1Ptr);
2238   strcat (&buff[0], name2Ptr);
2239
2240   return lsymbol_fromChars (&buff[0]);
2241 }
2242
2243 static lsymbol
2244 sortTag_toSymbol (char *kind, ltoken tagid, /*@out@*/ bool *isNew)
2245 {
2246   /*
2247   ** kind could be struct, union or enum.  Create a unique sort
2248   ** name based on the given info. But first check that tagid
2249   ** has not been defined already. (ok if it is a forward decl)
2250   **/
2251
2252   tagInfo to;
2253
2254   if (ltoken_isUndefined (tagid))
2255     {
2256       *isNew = TRUE;
2257       return (cstring_toSymbol (message ("_anon_%s%d", cstring_fromChars (kind), sortUID++)));
2258     }
2259   else
2260     {
2261       to = symtable_tagInfo (g_symtab, ltoken_getText (tagid));
2262
2263       if (tagInfo_exists (to))
2264         {
2265           *isNew = FALSE;
2266         }
2267       else
2268         {
2269           *isNew = TRUE;
2270         }
2271
2272       return (cstring_toSymbol (message ("_%s_%s",
2273                                          ltoken_unparse (tagid),
2274                                          cstring_fromChars (kind))));
2275     }
2276 }
2277
2278 /*@constant int MAX_SORT_DEPTH@*/
2279 # define MAX_SORT_DEPTH 10
2280
2281 static sort
2282 sort_getUnderlyingAux (sort s, int depth)
2283 {
2284   sortNode sn = sort_quietLookup (s);
2285
2286   if (sn->kind == SRT_SYN)
2287     {
2288       if (depth > MAX_SORT_DEPTH)
2289         {
2290           llcontbug (message ("sort_getUnderlying: depth charge: %d", depth));
2291           return s;
2292         }
2293
2294       return sort_getUnderlyingAux (sn->baseSort, depth + 1);
2295     }
2296
2297   return s;
2298 }
2299
2300 sort
2301 sort_getUnderlying (sort s)
2302 {
2303   return sort_getUnderlyingAux (s, 0);
2304 }
2305
2306 static lsymbol
2307 underlyingSortName (sortNode sn)
2308 {
2309   if (sn->kind == SRT_SYN)
2310     return underlyingSortName (sort_quietLookup (sn->baseSort));
2311   return sn->name;
2312 }
2313
2314 static /*@observer@*/ sortNode
2315 underlyingSortNode (sortNode sn)
2316 {
2317   if (sn->kind == SRT_SYN)
2318     {
2319       return underlyingSortNode (sort_quietLookup (sn->baseSort));
2320     }
2321
2322   return sn;
2323 }
2324
2325 bool
2326 sort_mutable (sort s)
2327 {
2328  /* if s is not a valid sort, then returns false */
2329   sortNode sn = sort_quietLookup (s);
2330   if (sn->mutable)
2331     return TRUE;
2332   return FALSE;
2333 }
2334
2335 bool
2336 sort_setExporting (bool flag)
2337 {
2338   bool old;
2339   old = exporting;
2340   exporting = flag;
2341   return old;
2342 }
2343
2344 /*@observer@*/ static cstring
2345 sort_unparseKind (sortKind k)
2346 {
2347   if (k > SRT_FIRST && k < SRT_LAST)
2348     return (cstring_fromChars (sortKindName[(int)k]));
2349   else
2350     return (cstring_makeLiteralTemp ("<unknown sort kind>"));
2351 }
2352
2353 bool
2354 sort_isValidSort (sort s)
2355 {
2356   sortNode sn = sort_quietLookup (s);
2357   sortKind k = sn->kind;
2358   if (k != SRT_NONE && k > SRT_FIRST && k < SRT_LAST)
2359     return TRUE;
2360   else
2361     return FALSE;
2362 }
2363
2364 void
2365 sort_dump (FILE *f, bool lco)
2366 {
2367   int i;
2368   sortNode s;
2369   smemberInfo *mem;
2370
2371   fprintf (f, "%s\n", BEGINSORTTABLE);
2372   llassert (sortTable != NULL);
2373
2374   for (i = 2; i < sortTableSize; i++)
2375     {
2376       /* skips 0 and 1, noSort and HOFSort */
2377       s = sortTable[i];
2378
2379       /* if (lco && !s.export) continue; */
2380       /* Difficult to keep track of where each op and sort belong to
2381          which LCL type.  Easiest to export them all (even private sorts and
2382          op's) but for checking imported modules, we only use LCL types and
2383          variables to check, i.e., we don't rely on sorts and op's for such
2384          checking. */
2385
2386       if (s->kind == SRT_NONE)
2387         continue;
2388
2389       if (lco)
2390         {
2391           fprintf (f, "%%LCL");
2392         }
2393
2394       if (lsymbol_isDefined (s->name))
2395         {
2396           fprintf (f, "sort %s ", lsymbol_toCharsSafe (s->name));
2397         }
2398       else
2399         {
2400           llcontbug (message ("Invalid sort in sort_dump: sort %d; sortname: %s. "
2401                               "This may result from using .lcs files produced by an old version of Splint. "
2402                               "Remove the .lcs files, and rerun Splint.",
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