librune/type.c

   1 /*
   2  * TYPE.C
   3  *
   4  * (c)Copyright 1993-2014, Matthew Dillon, All Rights Reserved.  See the
   5  *    COPYRIGHT file at the base of the distribution.
   6  */
   7
   8 #include "defs.h"
   9
  10 Type DynamicLValueType;
  11 Type DynamicRValueType;
  12
  13 Type NumericType;
  14 Type IntegerType;
  15 Type VoidType;
  16 Type BoolType;
  17 Type Int8Type;
  18 Type UInt8Type;
  19 Type Int16Type;
  20 Type UInt16Type;
  21 Type Int32Type;
  22 Type UInt32Type;
  23 Type Int64Type;
  24 Type UInt64Type;
  25
  26 Type IntPtrType;
  27 Type UIntPtrType;
  28 Type OffType;
  29 Type SizeType;
  30 Type SSizeType;
  31
  32 Type Float32Type;
  33 Type Float64Type;
  34 Type Float128Type;
  35
  36 Type CCharType;         /* const char           */
  37 Type StrType;           /* const char *         */
  38 Type CharPtrType;       /* char *               */
  39 Type CharPtrPtrType;    /* char **              */
  40 Type VoidPtrType;       /* void *               */
  41 Type VoidRefType;       /* void @               */
  42 Type CVoidPtrType;      /* const void *         */
  43 Type LVoidPtrType;      /* lvalue void *        */
  44
  45 Type PointerType;       /* generic pointer placeholder */
  46
  47 static List DynamicTypeList = INITLIST(DynamicTypeList);
  48 static List CompoundTypeList = INITLIST(CompoundTypeList);
  49 static List ArgsTypeList = INITLIST(ArgsTypeList);
  50 static List StorageTypeList = INITLIST(StorageTypeList);
  51
  52 void
  53 initType(Type *type, List *list, int op)
  54 {
  55         type->ty_Op = op;
  56         initList(&type->ty_QList);
  57         if (list)
  58                 addTail(list, &type->ty_Node);
  59         type->ty_SQList = list;
  60 }
  61
  62 void
  63 initQualType(Type *type, List *list, int op, int sqflags)
  64 {
  65         initType(type, list, op);
  66         type->ty_SQFlags = sqflags;
  67 }
  68
  69 void
  70 initPtrType(Type *type, Type *ptrto, int sqflags)
  71 {
  72         initQualType(type, &ptrto->ty_QList, TY_PTRTO, sqflags);
  73         type->ty_PtrType.et_Type = ptrto;
  74 }
  75
  76 static void
  77 initRefType(Type *type, Type *refto, int sqflags)
  78 {
  79         initQualType(type, &refto->ty_QList, TY_REFTO, sqflags);
  80         type->ty_RefType.et_Type = refto;
  81 }
  82
  83 void
  84 TypeInit(void)
  85 {
  86         initQualType(&DynamicLValueType, &DynamicTypeList,
  87                      TY_DYNAMIC, SF_LVALUE);
  88         initType(&DynamicRValueType, &DynamicTypeList, TY_DYNAMIC);
  89         initType(&NumericType, NULL, TY_UNRESOLVED);
  90         initType(&IntegerType, NULL, TY_UNRESOLVED);
  91         initType(&VoidType, NULL, TY_UNRESOLVED);
  92         initType(&BoolType, NULL, TY_UNRESOLVED);
  93         initType(&Int8Type, NULL, TY_UNRESOLVED);
  94         initType(&UInt8Type, NULL, TY_UNRESOLVED);
  95         initType(&Int16Type, NULL, TY_UNRESOLVED);
  96         initType(&UInt16Type, NULL, TY_UNRESOLVED);
  97         initType(&Int32Type, NULL, TY_UNRESOLVED);
  98         initType(&UInt32Type, NULL, TY_UNRESOLVED);
  99         initType(&Int64Type, NULL, TY_UNRESOLVED);
 100         initType(&UInt64Type, NULL, TY_UNRESOLVED);
 101
 102         initType(&IntPtrType, NULL, TY_UNRESOLVED);
 103         initType(&UIntPtrType, NULL, TY_UNRESOLVED);
 104         initType(&OffType, NULL, TY_UNRESOLVED);
 105         initType(&SizeType, NULL, TY_UNRESOLVED);
 106         initType(&SSizeType, NULL, TY_UNRESOLVED);
 107
 108         initType(&Float32Type, NULL, TY_UNRESOLVED);
 109         initType(&Float64Type, NULL, TY_UNRESOLVED);
 110         initType(&Float128Type, NULL, TY_UNRESOLVED);
 111
 112         initQualType(&CCharType, NULL, TY_UNRESOLVED, SF_CONST);
 113         initPtrType(&StrType, &CCharType, 0);
 114         initPtrType(&CharPtrType, &UInt8Type, 0);
 115         initPtrType(&CharPtrPtrType, &CharPtrType, 0);
 116         initPtrType(&VoidPtrType, &VoidType, 0);
 117         initRefType(&VoidRefType, &VoidType, 0);
 118         initPtrType(&CVoidPtrType, &VoidType, SF_CONST);
 119         initPtrType(&LVoidPtrType, &VoidType, SF_LVALUE);
 120
 121         initType(&PointerType, NULL, TY_UNRESOLVED);
 122
 123         StrTableAlloc("__internal_void", 15, SPECIAL_INTERNAL_VOID);
 124         StrTableAlloc("__internal_bool", 15, SPECIAL_INTERNAL_BOOL);
 125         StrTableAlloc("__internal_int8", 15, SPECIAL_INTERNAL_INT8);
 126         StrTableAlloc("__internal_uint8", 16, SPECIAL_INTERNAL_UINT8);
 127         StrTableAlloc("__internal_int16", 16, SPECIAL_INTERNAL_INT16);
 128         StrTableAlloc("__internal_uint16", 17, SPECIAL_INTERNAL_UINT16);
 129         StrTableAlloc("__internal_int32", 16, SPECIAL_INTERNAL_INT32);
 130         StrTableAlloc("__internal_uint32", 17, SPECIAL_INTERNAL_UINT32);
 131         StrTableAlloc("__internal_int64", 16, SPECIAL_INTERNAL_INT64);
 132         StrTableAlloc("__internal_uint64", 17, SPECIAL_INTERNAL_UINT64);
 133
 134         StrTableAlloc("__internal_float32", 18, SPECIAL_INTERNAL_FLOAT32);
 135         StrTableAlloc("__internal_float64", 18, SPECIAL_INTERNAL_FLOAT64);
 136         StrTableAlloc("__internal_float128", 19, SPECIAL_INTERNAL_FLOAT128);
 137
 138         StrTableAlloc("__internal_pointer", 18, SPECIAL_INTERNAL_POINTER);
 139         StrTableAlloc("__internal_intptr", 17, SPECIAL_INTERNAL_INTPTR);
 140         StrTableAlloc("__internal_uintptr", 18, SPECIAL_INTERNAL_UINTPTR);
 141         StrTableAlloc("__internal_size", 15, SPECIAL_INTERNAL_SIZE);
 142         StrTableAlloc("__internal_ssize", 16, SPECIAL_INTERNAL_SSIZE);
 143         StrTableAlloc("__internal_off", 14, SPECIAL_INTERNAL_OFF);
 144
 145         StrTableAlloc("__internal_numeric", 18, SPECIAL_INTERNAL_NUMERIC);
 146         StrTableAlloc("__internal_integer", 18, SPECIAL_INTERNAL_INTEGER);
 147
 148         StrTableAlloc("__count",        7,      SPECIAL_COUNT);
 149         StrTableAlloc("__data",         6,      SPECIAL_DATA);
 150         StrTableAlloc("__varcount",     10,     SPECIAL_VAR_COUNT);
 151         StrTableAlloc("__vardata",      9,      SPECIAL_VAR_DATA);
 152         StrTableAlloc("__typeid",       8,      SPECIAL_TYPEID);
 153         StrTableAlloc("__typestr",      9,      SPECIAL_TYPESTR);
 154         StrTableAlloc("NULL",           4,      SPECIAL_NULL);
 155 }
 156
 157 int
 158 InternalTypeAttach(Parse *p, int t, Declaration *d)
 159 {
 160         Type *itype = NULL;
 161         int s;
 162
 163         dassert_decl(d, d->d_Op == DOP_TYPEDEF);
 164
 165         if ((s = StrTableSpecial(d->d_Id)) & SPECIALF_INTERNAL) {
 166                 switch(s) {
 167                 case SPECIAL_INTERNAL_VOID:
 168                         itype = &VoidType;
 169                         break;
 170                 case SPECIAL_INTERNAL_BOOL:
 171                         itype = &BoolType;
 172                         break;
 173                 case SPECIAL_INTERNAL_INT8:
 174                         itype = &Int8Type;
 175                         break;
 176                 case SPECIAL_INTERNAL_UINT8:
 177                         itype = &UInt8Type;
 178                         break;
 179                 case SPECIAL_INTERNAL_INT16:
 180                         itype = &Int16Type;
 181                         break;
 182                 case SPECIAL_INTERNAL_UINT16:
 183                         itype = &UInt16Type;
 184                         break;
 185                 case SPECIAL_INTERNAL_INT32:
 186                         itype = &Int32Type;
 187                         break;
 188                 case SPECIAL_INTERNAL_UINT32:
 189                         itype = &UInt32Type;
 190                         break;
 191                 case SPECIAL_INTERNAL_INT64:
 192                         itype = &Int64Type;
 193                         break;
 194                 case SPECIAL_INTERNAL_UINT64:
 195                         itype = &UInt64Type;
 196                         break;
 197
 198                 case SPECIAL_INTERNAL_FLOAT32:
 199                         itype = &Float32Type;
 200                         break;
 201                 case SPECIAL_INTERNAL_FLOAT64:
 202                         itype = &Float64Type;
 203                         break;
 204                 case SPECIAL_INTERNAL_FLOAT128:
 205                         itype = &Float128Type;
 206                         break;
 207
 208                 case SPECIAL_INTERNAL_INTPTR:
 209                         itype = &IntPtrType;
 210                         break;
 211                 case SPECIAL_INTERNAL_UINTPTR:
 212                         itype = &UIntPtrType;
 213                         break;
 214                 case SPECIAL_INTERNAL_OFF:
 215                         itype = &OffType;
 216                         break;
 217                 case SPECIAL_INTERNAL_SIZE:
 218                         itype = &SizeType;
 219                         break;
 220                 case SPECIAL_INTERNAL_SSIZE:
 221                         itype = &SSizeType;
 222                         break;
 223
 224                 case SPECIAL_INTERNAL_POINTER:
 225                         itype = &PointerType;
 226                         break;
 227                 case SPECIAL_INTERNAL_NUMERIC:
 228                         itype = &NumericType;
 229                         break;
 230                 case SPECIAL_INTERNAL_INTEGER:
 231                         itype = &IntegerType;
 232                         break;
 233                 default:
 234                         itype = InternalRegisteredTypeLookup(d->d_Id);
 235                         if (itype == NULL)
 236                                 dassert(0);
 237                         break;
 238                 }
 239         }
 240         if (itype) {
 241                 if (itype->ty_Op != TY_UNRESOLVED) {
 242                         t = LexError(&p->p_Token, TOK_ERR_DUPLICATE_ATTACH);
 243                 } else {
 244                         Type *ntype = d->d_TypedefDecl.ed_Type;
 245
 246                         TypeToQualType(ntype, itype, ntype->ty_SQFlags, NULL);
 247
 248                         /*
 249                          * fixup for const int8 pointers... we did not have
 250                          * a QList to put CCharType on until now.  It will
 251                          * wind up on the SemGroup's sg_ClassList.
 252                          */
 253                         if (itype == &UInt8Type) {
 254                                 TypeToQualType(ntype, &CCharType,
 255                                         ntype->ty_SQFlags | SF_CONST, NULL);
 256                         }
 257                 }
 258         } else {
 259                 t = LexError(&p->p_Token, TOK_ERR_UNRECOGNIZED_ATTACH);
 260         }
 261         return(t);
 262 }
 263
 264 Type *
 265 AllocType(List *list, int op)
 266 {
 267         Type *type = zalloc(sizeof(Type));
 268
 269         initType(type, list, op);
 270         return(type);
 271 }
 272
 273 /*
 274  * XXX match the compound type(s)
 275  *
 276  * May be used to generate a varargs compound type, in which case the
 277  * semgroup may already be resolved.
 278  */
 279 Type *
 280 AllocCompoundType(SemGroup *sg)
 281 {
 282         Type *type;
 283
 284         type = AllocType(&CompoundTypeList, TY_COMPOUND);
 285         type->ty_CompType.et_SemGroup = sg;
 286         dassert((sg->sg_Flags & SGF_RESOLVED) == 0);
 287         return(type);
 288 }
 289
 290 /*
 291  * XXX match the compound type(s)
 292  */
 293 Type *
 294 AllocArgsType(SemGroup *sg)
 295 {
 296         Type *type;
 297
 298         type = AllocType(&ArgsTypeList, TY_ARGS);
 299         type->ty_ArgsType.et_SemGroup = sg;
 300         return(type);
 301 }
 302
 303 Type *
 304 AllocStorageType(runesize_t bytes)
 305 {
 306         Type *type;
 307
 308         for (
 309                 type = getHead(&StorageTypeList);
 310                 type;
 311                 type = getSucc(&StorageTypeList, &type->ty_Node)
 312         ) {
 313                 if (type->ty_Op == TY_STORAGE &&
 314                         type->ty_StorType.et_Bytes == bytes
 315                 ) {
 316                         return(type);
 317                 }
 318         }
 319         type = AllocType(&StorageTypeList, TY_STORAGE);
 320         type->ty_StorType.et_Bytes = bytes;
 321         return(type);
 322 }
 323
 324 Type *
 325 AllocUnresolvedType(SemGroup *isg, SemGroup *sg, string_t *ary, int eatAry)
 326 {
 327         Type *type = NULL;
 328
 329         dassert_semgrp(sg, ary != NULL);
 330
 331         for (
 332                 type = getHead(&sg->sg_ClassList);
 333                 type;
 334                 type = getSucc(&sg->sg_ClassList, &type->ty_Node)
 335         ) {
 336                 int i;
 337
 338                 if (type->ty_Op != TY_UNRESOLVED)
 339                         continue;
 340                 if (type->ty_UnresType.et_ImportSemGroup != isg)
 341                         continue;
 342
 343                 for (i = 0; ary[i]; ++i) {
 344                         if (ary[i] != type->ty_UnresType.et_DottedId[i])
 345                                 break;
 346                 }
 347                 if (ary[i] == NULL &&
 348                     type->ty_UnresType.et_DottedId[i] == NULL) {
 349                         if (eatAry)
 350                                 FreeDotIdAry(ary);
 351                         return(type);
 352                 }
 353         }
 354         type = AllocType((sg ? &sg->sg_ClassList : NULL), TY_UNRESOLVED);
 355         type->ty_UnresType.et_DottedId = ary;
 356         type->ty_UnresType.et_SemGroup = sg;            /* may be NULL */
 357         type->ty_UnresType.et_ImportSemGroup = isg;     /* may be NULL */
 358         return(type);
 359 }
 360
 361 /*
 362  * AllocClassType() - allocate a type representing a the semgroup which
 363  *                      in turn represents (typically) a class.
 364  */
 365 Type *
 366 AllocClassType(List *list, Type *super, SemGroup *sg, int visibility)
 367 {
 368         Type *type;
 369
 370         for (type = getHead(list); type; type = getSucc(list, &type->ty_Node)) {
 371                 if (type->ty_Op == TY_CLASS &&
 372                     type->ty_ClassType.et_SemGroup == sg &&
 373                     type->ty_ClassType.et_Super == super &&
 374                     type->ty_Visibility == visibility
 375                 ) {
 376                         return(type);
 377                 }
 378         }
 379         type = AllocType(list, TY_CLASS);
 380         type->ty_ClassType.et_SemGroup = sg;
 381         type->ty_ClassType.et_Super = super;
 382         type->ty_Visibility = visibility;
 383         return(type);
 384 }
 385
 386 Type *
 387 AllocImportType(List *list, SemGroup *sg, int visibility)
 388 {
 389         Type *type = AllocType(list, TY_IMPORT);
 390
 391         type->ty_ImportType.et_SemGroup = sg;
 392         type->ty_Visibility = visibility;
 393         return(type);
 394 }
 395
 396 Type *
 397 TypeToQualType(Type *otype, Type *ntype, int sqFlags, Exp *exp)
 398 {
 399         /*
 400          * Combine with existing qualifiers, Shortcut if no changes made.
 401          */
 402         if (ntype == NULL &&
 403             sqFlags == otype->ty_SQFlags &&
 404             (exp == NULL || exp == otype->ty_AssExp)
 405         ) {
 406                 return(otype);
 407         }
 408
 409         /*
 410          * See if we already have a matching qualified type (only if storage
 411          * for the new type is not being provided).  Note: the provided storage
 412          * has already been initType()d
 413          */
 414         if (ntype == NULL) {
 415                 for (ntype = getHead(otype->ty_SQList);
 416                      ntype;
 417                      ntype = getSucc(otype->ty_SQList, &ntype->ty_Node)
 418                 ) {
 419                         if (ntype->ty_Op == otype->ty_Op &&
 420                             ntype->ty_SQFlags == sqFlags &&
 421                             (exp == NULL || ntype->ty_AssExp == exp)
 422                         ) {
 423                                 if (SameType(ntype, otype, sqFlags))
 424                                         return(ntype);
 425                         }
 426                 }
 427         }
 428
 429         /*
 430          * Build a new qualified type and set its qualifiers, then duplicate
 431          * appropriate sections of the old type.
 432          */
 433         if (ntype == NULL) {
 434                 ntype = AllocType(otype->ty_SQList, otype->ty_Op);
 435         } else if (ntype->ty_SQList == NULL) {
 436                 ntype->ty_SQList = otype->ty_SQList;
 437                 addTail(ntype->ty_SQList, &ntype->ty_Node);
 438         }
 439
 440         /*
 441          * Set the op and the expression.  Unlike SQFlags, if exp is passed as
 442          * NULL we inherit the old type's default.
 443          *
 444          * The DupExp() call here is special, see DupExp()'s handling of
 445          * ex_Decl.
 446          *
 447          * Normally DupExp() is called during resolution prior to ex_Decl
 448          * being set.  This is the one case where it may be called with
 449          * ex_Decl already set.
 450          */
 451         ntype->ty_Op = otype->ty_Op;
 452         if (exp)
 453                 ntype->ty_AssExp = exp;
 454         else if (otype->ty_AssExp)
 455                 ntype->ty_AssExp = SetDupExp(NULL, otype->ty_AssExp);
 456         ntype->ty_SQFlags = sqFlags;
 457         ntype->ty_Visibility = otype->ty_Visibility;
 458
 459         switch(otype->ty_Op) {
 460         case TY_CLASS:
 461                 ntype->ty_ClassType.et_SemGroup =
 462                         otype->ty_ClassType.et_SemGroup;
 463                 ntype->ty_ClassType.et_Super = otype->ty_ClassType.et_Super;
 464                 break;
 465         case TY_IMPORT:
 466                 ntype->ty_Visibility = otype->ty_Visibility;
 467                 ntype->ty_ImportType.et_SemGroup = otype->ty_ImportType.et_SemGroup;
 468                 break;
 469         case TY_CPTRTO:
 470                 ntype->ty_CPtrType.et_Type = otype->ty_CPtrType.et_Type;
 471                 break;
 472         case TY_PTRTO:
 473                 ntype->ty_PtrType.et_Type = otype->ty_PtrType.et_Type;
 474                 break;
 475         case TY_REFTO:
 476                 ntype->ty_RefType.et_Type = otype->ty_RefType.et_Type;
 477                 break;
 478         case TY_ARYOF:
 479                 /*
 480                  * note: multiple type structures may share the same array size
 481                  * expression in simple qualified-type cases.  YYY XXX bad bad.
 482                  */
 483                 ntype->ty_AryType.et_Type = otype->ty_AryType.et_Type;
 484                 ntype->ty_AryType.et_ArySize = otype->ty_AryType.et_ArySize;
 485                 ntype->ty_AryType.et_SemGroup = otype->ty_AryType.et_SemGroup;
 486                 break;
 487         case TY_COMPOUND:
 488                 ntype->ty_CompType.et_SemGroup = otype->ty_CompType.et_SemGroup;
 489                 break;
 490         case TY_VAR:
 491                 ntype->ty_VarType.et_Type = otype->ty_VarType.et_Type;
 492                 ntype->ty_VarType.et_SemGroup = otype->ty_VarType.et_SemGroup;
 493                 break;
 494         case TY_ARGS:
 495                 ntype->ty_ArgsType.et_SemGroup = otype->ty_ArgsType.et_SemGroup;
 496                 break;
 497         case TY_PROC:
 498                 ntype->ty_ProcType.et_ArgsType = otype->ty_ProcType.et_ArgsType;
 499                 ntype->ty_ProcType.et_RetType = otype->ty_ProcType.et_RetType;
 500                 ntype->ty_ProcType.et_ArgCount = otype->ty_ProcType.et_ArgCount;
 501                 break;
 502         case TY_STORAGE:
 503                 ntype->ty_StorType.et_Bytes = otype->ty_StorType.et_Bytes;
 504                 break;
 505         case TY_DYNAMIC:
 506                 /*
 507                  * It is not legal to qualify a dynamic type other then to
 508                  * add or remove SF_LVALUE.
 509                  */
 510                 dassert(0);
 511                 break;
 512         case TY_UNRESOLVED:
 513                 ntype->ty_UnresType.et_DottedId =
 514                         otype->ty_UnresType.et_DottedId;
 515                 ntype->ty_UnresType.et_SemGroup =
 516                         otype->ty_UnresType.et_SemGroup;
 517                 break;
 518         default:
 519                 dassert_type(otype, 0);
 520         }
 521         return(ntype);
 522 }
 523
 524 /*
 525  * XXX match the procedure type(s)
 526  */
 527 Type *
 528 TypeToProcType(Type *rtype, Type *atype)
 529 {
 530         Type *type;
 531         int count = 0;
 532         Declaration *d;
 533         SemGroup *sg;
 534
 535         dassert_type(atype, atype->ty_Op == TY_ARGS);
 536         sg = atype->ty_CompType.et_SemGroup;
 537
 538         for (
 539                 d = getHead(&sg->sg_DeclList);
 540                 d;
 541                 d = getSucc(&sg->sg_DeclList, &d->d_Node)
 542         ) {
 543                 ++count;
 544         }
 545         for (
 546                 type = getHead(&rtype->ty_QList);
 547                 type;
 548                 type = getSucc(&rtype->ty_QList, &type->ty_Node)
 549         ) {
 550                 if (type->ty_Op == TY_PROC) {
 551                         if (type->ty_ProcType.et_ArgsType == atype &&
 552                             type->ty_ProcType.et_RetType == rtype &&
 553                             type->ty_ProcType.et_ArgCount == count
 554                         ) {
 555                                 puts("SG1"); /* YYY */
 556                                 return(type);
 557                         }
 558                 }
 559         }
 560         type = AllocType(&rtype->ty_QList, TY_PROC);
 561         type->ty_ProcType.et_ArgsType = AllocArgsType(sg);
 562         type->ty_ProcType.et_RetType = rtype;
 563         type->ty_ProcType.et_ArgCount = count;
 564         return(type);
 565 }
 566
 567 /*
 568  * Convert type to pointer-to-type
 569  */
 570 Type *
 571 TypeToPtrType(Type *otype)
 572 {
 573         Type *type;
 574
 575         for (type = getHead(&otype->ty_QList);
 576              type;
 577              type = getSucc(&otype->ty_QList, &type->ty_Node)
 578         ) {
 579                 if (type->ty_Op == TY_PTRTO)
 580                         return(type);
 581         }
 582         type = AllocType(&otype->ty_QList, TY_PTRTO);
 583         type->ty_PtrType.et_Type = otype;
 584         return(type);
 585 }
 586
 587 /*
 588  * Convert type to pointer-to-type
 589  */
 590 Type *
 591 TypeToCPtrType(Type *otype)
 592 {
 593         Type *type;
 594
 595         for (type = getHead(&otype->ty_QList);
 596              type;
 597              type = getSucc(&otype->ty_QList, &type->ty_Node)
 598         ) {
 599                 if (type->ty_Op == TY_CPTRTO)
 600                         return(type);
 601         }
 602         type = AllocType(&otype->ty_QList, TY_CPTRTO);
 603         type->ty_CPtrType.et_Type = otype;
 604         return(type);
 605 }
 606
 607 /*
 608  * Convert type to ref-to-type
 609  *
 610  *      A reference type is similar to a pointer type except that the
 611  *      resolver is not able to entirely know what it is pointing to.
 612  *      The reference type is a superclass, but the actual type is
 613  *      stored in the run-time structure.
 614  */
 615 Type *
 616 TypeToRefType(Type *otype)
 617 {
 618         Type *type;
 619
 620         for (type = getHead(&otype->ty_QList);
 621              type;
 622              type = getSucc(&otype->ty_QList, &type->ty_Node)
 623         ) {
 624                 if (type->ty_Op == TY_REFTO)
 625                         return(type);
 626         }
 627         type = AllocType(&otype->ty_QList, TY_REFTO);
 628         type->ty_RefType.et_Type = otype;
 629         return(type);
 630 }
 631
 632 Type *
 633 TypeToAryType(Type *otype, Exp *exp, SemGroup *sg)
 634 {
 635         Type *type;
 636
 637         /*
 638          * XXX handle constant expression optimization for QList
 639          * XXX handle qualifiers
 640          */
 641         type = AllocType(&otype->ty_QList, TY_ARYOF);
 642         type->ty_AryType.et_ArySize = exp;
 643         type->ty_AryType.et_Type = DelTypeQual(otype, SF_MASK_ARY_INHERIT);
 644         type->ty_AryType.et_SemGroup = sg;
 645         type->ty_SQFlags |= otype->ty_SQFlags & SF_MASK_ARY_INHERIT;
 646         return(type);
 647 }
 648
 649 #if 0
 650
 651 Type *
 652 TypeToRunTimeAryType(Type *otype, int count)
 653 {
 654         Type *type;
 655         Type *t2 = DelTypeQual(otype, SF_MASK_ARY_INHERIT);
 656
 657         for (type = getHead(&otype->ty_QList);
 658              type;
 659              type = getSucc(&otype->ty_QList, &type->ty_Node)
 660         ) {
 661                 if (type->ty_Op == TY_ARYOF &&
 662                         type->ty_AryType.et_Type == t2 &&
 663                         type->ty_AryType.et_Count == count &&
 664                         type->ty_SQFlags ==
 665                          (otype->ty_SQFlags & SF_MASK_ARY_INHERIT)
 666                 ) {
 667                         return(type);
 668                 }
 669         }
 670         type = AllocType(&otype->ty_QList, TY_ARYOF);
 671         type->ty_AryType.et_Count = count;
 672         type->ty_AryType.et_Type = t2;
 673         type->ty_SQFlags |= otype->ty_SQFlags & SF_MASK_ARY_INHERIT;
 674         return(type);
 675 }
 676
 677 #endif
 678
 679 Type *
 680 TypeToVarType(Type *otype, SemGroup *sg)
 681 {
 682         Type *type;
 683
 684         dassert(sg->sg_Flags & SGF_RESOLVED);
 685         dassert(otype->ty_Flags & TF_RESOLVED);
 686
 687         for (type = getHead(&otype->ty_QList);
 688              type;
 689              type = getSucc(&otype->ty_QList, &type->ty_Node)
 690         ) {
 691                 if (type->ty_Op == TY_VAR &&
 692                     type->ty_VarType.et_Type == otype &&
 693                     type->ty_VarType.et_SemGroup == sg
 694                 ) {
 695                         puts("SG2"); /* YYY */
 696                         return(type);
 697                 }
 698         }
 699         type = AllocType(&otype->ty_QList, TY_VAR);
 700         type->ty_VarType.et_Type = otype;
 701         type->ty_VarType.et_SemGroup = sg;
 702 #if 0
 703         /* XXX doesn't work for var-args */
 704         if (sg->sg_Flags & SGF_RESOLVED) {
 705                 type->ty_Flags |= TF_RESOLVED;
 706                 type->ty_Bytes = sg->sg_Bytes;
 707                 type->ty_AlignMask = sg->sg_AlignMask;
 708         }
 709 #endif
 710         return(type);
 711 }
 712
 713 /*
 714  * ChangeType() - given pointer, C pointer, or array of something,
 715  *                return 'op' of something instead.
 716  */
 717 Type *
 718 ChangeType(Type *type, int op)
 719 {
 720         switch(type->ty_Op) {
 721         case TY_PTRTO:
 722                 switch(op) {
 723                 case TY_CPTRTO:
 724                         type = TypeToCPtrType(type->ty_PtrType.et_Type);
 725                         break;
 726                 case TY_ARYOF:
 727                         type = TypeToAryType(type->ty_PtrType.et_Type,
 728                                              NULL, NULL);
 729                         break;
 730                 default:
 731                         dassert(0);
 732                 }
 733                 break;
 734         case TY_CPTRTO:
 735                 switch(op) {
 736                 case TY_PTRTO:
 737                         type = TypeToPtrType(type->ty_CPtrType.et_Type);
 738                         break;
 739                 case TY_ARYOF:
 740                         type = TypeToAryType(type->ty_CPtrType.et_Type,
 741                                              NULL, NULL);
 742                         break;
 743                 default:
 744                         dassert(0);
 745                 }
 746                 break;
 747         case TY_ARYOF:
 748                 switch(op) {
 749                 case TY_PTRTO:
 750                         type = TypeToPtrType(type->ty_AryType.et_Type);
 751                         break;
 752                 case TY_CPTRTO:
 753                         type = TypeToCPtrType(type->ty_AryType.et_Type);
 754                         break;
 755                 default:
 756                         dassert(0);
 757                 }
 758                 break;
 759         default:
 760                 dassert(0);
 761         }
 762         return(type);
 763 }
 764
 765 /*
 766  * BaseType() - return base type
 767  *
 768  *      Traverse the type to locate the base type.  Store the base type
 769  *      in *ptype and return the SemGroup, or return NULL if the base type
 770  *      does not have a SemGroup.
 771  */
 772 SemGroup *
 773 BaseType(Type **ptype)
 774 {
 775         Type *type = *ptype;
 776
 777         for (;;) {
 778                 switch(type->ty_Op) {
 779                 case TY_CPTRTO:
 780                         type = type->ty_CPtrType.et_Type;
 781                         continue;
 782                 case TY_PTRTO:
 783                         type = type->ty_PtrType.et_Type;
 784                         continue;
 785                 case TY_REFTO:
 786                         type = type->ty_RefType.et_Type;
 787                         continue;
 788                 case TY_ARYOF:
 789                         type = type->ty_AryType.et_Type;
 790                         continue;
 791                 }
 792                 break;
 793         }
 794
 795         *ptype = type;
 796
 797         switch(type->ty_Op) {
 798         case TY_CLASS:
 799                 return(type->ty_ClassType.et_SemGroup);
 800         case TY_COMPOUND:
 801                 return(type->ty_CompType.et_SemGroup);
 802         case TY_ARGS:
 803                 return(type->ty_ArgsType.et_SemGroup);
 804         case TY_PROC:
 805         case TY_VAR:
 806         case TY_DYNAMIC:
 807         case TY_STORAGE:
 808                 return(NULL);
 809         case TY_UNRESOLVED:
 810         default:
 811                 dassert_type(type, 0);
 812                 return(NULL);   /* avoid compiler complaints */
 813         }
 814 }
 815
 816 /*
 817  * MatchType() -        Match two types
 818  *
 819  *      Match two types as if we wanted to cast type to super or use
 820  *      type as super.
 821  *
 822  *      SG_COMPAT_FULL          Type is a subclass, methods and storage are
 823  *                              compatible (storage may be extended).
 824  *
 825  *      SG_COMPAT_PART          Type is a subclass, methods are compatible
 826  *                              but storage is not.
 827  *
 828  *      SG_COMPAT_SUBCLASS      Type is a subclass, but the methods are
 829  *                              not directly compatible (the methods that
 830  *                              propogate down must be regenerated).
 831  *      SG_COMPAT_FAIL          Type is not even a subclass
 832  *
 833  *      XXX we are skipping qualifiers
 834  */
 835 int
 836 MatchType(Type *super, Type *type)
 837 {
 838         int r = SG_COMPAT_FULL;
 839
 840         while (super && type) {
 841                 SemGroup *sg1 = NULL;
 842                 SemGroup *sg2 = NULL;
 843
 844                 if (type->ty_Op != super->ty_Op) {
 845                         if (super->ty_Op == TY_REFTO &&
 846                             type->ty_Op == TY_PTRTO) {
 847                                 super = super->ty_RefType.et_Type;
 848                                 type = type->ty_PtrType.et_Type;
 849                                 r = MatchType(super, type);
 850                         } else {
 851                                 r = SG_COMPAT_FAIL;
 852                         }
 853                         break;
 854                 }
 855
 856                 /*
 857                  * Relaxed storage qualifiers.  The less refined target type
 858                  * (super) can omit certain storage qualifiers and still match.
 859                  *
 860                  * NOTE: Actual casts may do more stringent tests.
 861                  */
 862                 if (super->ty_SQFlags != type->ty_SQFlags) {
 863                         if ((super->ty_SQFlags & ~(SF_LVALUE)) !=
 864                             (type->ty_SQFlags & ~SF_RELAXING_MASK)) {
 865                                 r = SG_COMPAT_FAIL;
 866                                 break;
 867                         }
 868                 }
 869
 870                 switch(super->ty_Op) {
 871                 case TY_CLASS:
 872                         /*
 873                          * type can be a subclass of super
 874                          */
 875                         if (type->ty_ClassType.et_SemGroup ==
 876                             super->ty_ClassType.et_SemGroup) {
 877                                 return(r);
 878                         }
 879                         r = type->ty_ClassType.et_SemGroup->sg_Compat;
 880 #if 0
 881                         if (r < SG_COMPAT_PART)
 882                                 r = SG_COMPAT_PART;
 883 #endif
 884                         while ((type = type->ty_ClassType.et_Super) != NULL) {
 885                                 if (type->ty_ClassType.et_SemGroup ==
 886                                     super->ty_ClassType.et_SemGroup) {
 887                                         break;
 888                                 }
 889                                 if (r < type->ty_ClassType.et_SemGroup->sg_Compat)
 890                                         r = type->ty_ClassType.et_SemGroup->sg_Compat;
 891                         }
 892                         if (type == NULL)       /* not even a subclass */
 893                                 r = SG_COMPAT_FAIL;
 894                         break;
 895                 case TY_IMPORT:
 896                         /*
 897                          * type can be a subclass of super
 898                          */
 899                         if (type != super)
 900                                 r = SG_COMPAT_FAIL;
 901                         break;
 902                 case TY_CPTRTO:
 903                         type = type->ty_CPtrType.et_Type;
 904                         super = super->ty_CPtrType.et_Type;
 905                         continue;
 906                 case TY_PTRTO:
 907                         type = type->ty_PtrType.et_Type;
 908                         super = super->ty_PtrType.et_Type;
 909                         continue;
 910                 case TY_REFTO:
 911                         type = type->ty_RefType.et_Type;
 912                         super = super->ty_RefType.et_Type;
 913                         continue;
 914                 case TY_ARYOF:
 915                         type = type->ty_AryType.et_Type;
 916                         super = super->ty_AryType.et_Type;
 917                         /* XXX */
 918                         continue;
 919                 case TY_COMPOUND:
 920                         sg1 = super->ty_CompType.et_SemGroup;
 921                         sg2 = type->ty_CompType.et_SemGroup;
 922                         break;
 923                 case TY_ARGS:
 924                         sg1 = super->ty_ArgsType.et_SemGroup;
 925                         sg2 = type->ty_ArgsType.et_SemGroup;
 926                         break;
 927                 case TY_VAR:
 928                         r = MatchType(super->ty_VarType.et_Type,
 929                                       type->ty_VarType.et_Type);
 930                         break;
 931                 case TY_PROC:
 932                         {
 933                                 int v;
 934
 935                                 r = MatchType(super->ty_ProcType.et_ArgsType,
 936                                               type->ty_ProcType.et_ArgsType);
 937                                 v = MatchType(super->ty_ProcType.et_RetType,
 938                                               type->ty_ProcType.et_RetType);
 939                                 if (r < v)
 940                                         r = v;
 941                         }
 942                         break;
 943                 case TY_DYNAMIC:
 944                         break;
 945                 case TY_STORAGE:
 946                         if (type->ty_StorType.et_Bytes !=
 947                             super->ty_StorType.et_Bytes) {
 948                                 r = SG_COMPAT_SUBCLASS;
 949                         }
 950                         break;
 951                 case TY_UNRESOLVED:
 952                 default:
 953                         dassert_type(super, 0); /* can't happen */
 954                         break;
 955                 }
 956                 if (sg1) {
 957                         Declaration *sd = getHead(&sg1->sg_DeclList);
 958                         Declaration *rd = getHead(&sg2->sg_DeclList);
 959                         while (sd && rd) {
 960                                 int v = MatchDeclTypes(sd, rd);
 961                                 if (r < v)
 962                                         r = v;
 963                                 if (r == SG_COMPAT_FAIL)
 964                                         break;
 965                                 sd = getSucc(&sg1->sg_DeclList, &sd->d_Node);
 966                                 rd = getSucc(&sg2->sg_DeclList, &rd->d_Node);
 967                         }
 968                         if (sd || rd)
 969                                 r = SG_COMPAT_FAIL;
 970                 }
 971                 break;
 972         }
 973         return(r);
 974 }
 975
 976 /*
 977  * DupType()     - create a duplicate of a type, possibly in a new SemGroup.
 978  *
 979  *      This code is used when duplicating procedures and other elements
 980  *      when merging a superclass into a subclass.
 981  *
 982  *      If sg is NULL, stype is simply returned.  The case is used when we
 983  *      try to duplciate an expression with DupExp()... in that case we
 984  *      want to dup the expression tree but use the same types.
 985  */
 986 Type *
 987 DupType(SemGroup *sg, Type *stype)
 988 {
 989         Type *type = NULL;
 990
 991         if (sg == NULL)
 992                 return(stype);
 993
 994         /*
 995          * XXX type may be resolved if it is part of a varargs dup
 996          */
 997 #if 0
 998         dassert_type(stype,
 999                      (stype->ty_Flags & (TF_RESOLVED|TF_RESOLVING)) == 0);
1000 #endif
1001
1002         switch(stype->ty_Op) {
1003         case TY_CLASS:
1004                 /*
1005                  * This only occurs because the resolver has resolved an
1006                  * unresolved type on the original SemGroup.  We duplicate
1007                  * that on the new SemGroup.
1008                  */
1009                 type = AllocClassType(&sg->sg_ClassList,
1010                                       stype->ty_ClassType.et_Super,
1011                                       stype->ty_ClassType.et_SemGroup,
1012                                       stype->ty_Visibility);
1013                 break;
1014         case TY_IMPORT:
1015         case TY_DYNAMIC:
1016                 type = stype;
1017                 break;
1018         case TY_CPTRTO:
1019                 type = TypeToCPtrType(DupType(sg, stype->ty_CPtrType.et_Type));
1020                 break;
1021         case TY_PTRTO:
1022                 type = TypeToPtrType(DupType(sg, stype->ty_PtrType.et_Type));
1023                 break;
1024         case TY_REFTO:
1025                 type = TypeToRefType(DupType(sg, stype->ty_RefType.et_Type));
1026                 break;
1027         case TY_ARYOF:
1028                 type = TypeToAryType(DupType(sg, stype->ty_AryType.et_Type),
1029                                 SetDupExp(sg, stype->ty_AryType.et_ArySize),
1030                                 stype->ty_AryType.et_SemGroup);
1031                 break;
1032         case TY_VAR:
1033                 type = TypeToVarType(DupType(sg, stype->ty_VarType.et_Type),
1034                                 DupSemGroup(sg, NULL,
1035                                             stype->ty_VarType.et_SemGroup, 1));
1036                 break;
1037         case TY_COMPOUND:
1038                 type = AllocCompoundType(
1039                                 DupSemGroup(sg, NULL,
1040                                             stype->ty_CompType.et_SemGroup, 1));
1041                 break;
1042         case TY_ARGS:
1043                 /*
1044                  * At the moment we always formally duplicate the arguments
1045                  * so we can modify them for methods below.
1046                  */
1047                 type = AllocArgsType(
1048                                 DupSemGroup(sg, NULL,
1049                                             stype->ty_CompType.et_SemGroup, 1));
1050                 break;
1051         case TY_PROC:
1052                 type = DupType(sg, stype->ty_ProcType.et_RetType);
1053                 type = TypeToProcType(type,
1054                                       DupType(sg,
1055                                               stype->ty_ProcType.et_ArgsType));
1056
1057                 /*
1058                  * If this is a method procedure, we have to change the
1059                  * first argument to point at our new subclass.  It was
1060                  * previously pointing at our superclass.   XXX the
1061                  * programmer can override the argument.  If it isn't a
1062                  * reference we have to assert.
1063                  */
1064                 if (stype->ty_SQFlags & SF_METHOD) {
1065                         SemGroup *asg = type->ty_ProcType.et_ArgsType->ty_ArgsType.et_SemGroup;
1066                         Declaration *d = getHead(&asg->sg_DeclList);
1067                         Type *thisType = d->d_StorDecl.ed_Type;
1068
1069                         dassert_decl(d, d->d_Id == String_This &&
1070                                         d->d_Op == DOP_ARGS_STORAGE);
1071                         dassert_decl(d, sg->sg_Stmt->st_Op == ST_Class);
1072                         if (thisType->ty_Op == TY_CLASS) {
1073                                 /* XXX sg_ClassList? right sg? */
1074                                 /* XXX correct visibility? */
1075                                 if (d->d_Search == NULL) {
1076                                         d->d_Search = d->d_StorDecl.ed_Type->
1077                                                       ty_ClassType.et_SemGroup;
1078                                 }
1079                                 d->d_StorDecl.ed_Type =
1080                                         AllocClassType(&sg->sg_ClassList,
1081                                                        sg->sg_Stmt->st_ClassStmt.es_Super,
1082                                                        sg->sg_Stmt->st_MyGroup,
1083                                                        SCOPE_ALL_VISIBLE);
1084                         } else {
1085                                 dassert_decl(d, thisType->ty_Op == TY_REFTO);
1086                         }
1087                 } else if (stype->ty_SQFlags & SF_GMETHOD) {
1088                         SemGroup *asg;
1089                         Declaration *d;
1090
1091                         asg = type->ty_ProcType.et_ArgsType->
1092                                 ty_ArgsType.et_SemGroup;
1093                         d = getHead(&asg->sg_DeclList);
1094
1095                         dassert_decl(d, d->d_Id == String_This &&
1096                                      d->d_Op == DOP_TYPEDEF);
1097                         dassert_decl(d, sg->sg_Stmt->st_Op == ST_Class);
1098                         dassert_decl(d, d->d_TypedefDecl.ed_Type->ty_Op ==
1099                                         TY_CLASS);
1100                         /* XXX sg_ClassList? right sg? */
1101                         /* XXX correct visibility? */
1102                         if (d->d_Search == NULL) {
1103                                 d->d_Search = d->d_TypedefDecl.ed_Type->
1104                                                ty_ClassType.et_SemGroup;
1105                         }
1106                         d->d_TypedefDecl.ed_Type =
1107                                 AllocClassType(&sg->sg_ClassList,
1108                                                sg->sg_Stmt->st_ClassStmt.es_Super,
1109                                                sg->sg_Stmt->st_MyGroup,
1110                                                SCOPE_ALL_VISIBLE);
1111                 }
1112                 break;
1113         case TY_STORAGE:
1114                 type = stype;
1115                 break;
1116         case TY_UNRESOLVED:
1117                 /*
1118                  * e.g. so elements in a superclass will see refined elements
1119                  * in the subclass.  Note that the original import semgroup
1120                  * is left intact so the semantic search mechanism uses it
1121                  * when the base sg (typically a subclass) fails.
1122                  */
1123                 type = AllocUnresolvedType(
1124                                 stype->ty_UnresType.et_ImportSemGroup,
1125                                 sg,
1126                                 stype->ty_UnresType.et_DottedId,
1127                                 0);
1128                 break;
1129         default:
1130                 dassert_type(stype, 0);
1131         }
1132
1133         if (type != stype) {
1134                 type->ty_Flags = stype->ty_Flags;
1135                 type->ty_Bytes = stype->ty_Bytes;
1136                 type->ty_AlignMask = stype->ty_AlignMask;
1137                 type->ty_Visibility = stype->ty_Visibility;
1138         }
1139         if (stype->ty_AssExp || stype->ty_SQFlags != type->ty_SQFlags) {
1140                 type = TypeToQualType(type, NULL,
1141                                       stype->ty_SQFlags,
1142                                       SetDupExp(sg, stype->ty_AssExp));
1143         }
1144
1145         return(type);
1146 }
1147
1148 /*
1149  * SameType() - return 1 if the types are equilvalent, 0 if they are not.
1150  *
1151  *      The sqFlags for t2 may be overriden.  If you do not wish to override
1152  *      the sqFlags for t2, pass t2->ty_SQFlags for sqFlags.  The override
1153  *      only applies to the top level of the type.
1154  *
1155  *      Types can be aliased - for example, two different type structures
1156  *      may point to the same class data.
1157  *
1158  *      XXX this needs a lot of work.  We really need to guarentee
1159  *      some level of uniqueness for non-qualified type elements.
1160  */
1161 int
1162 SameType(Type *t1, Type *t2, int sqFlags2)
1163 {
1164         for (;;) {
1165                 if (t1 == t2)
1166                         return(1);
1167                 if (t1->ty_Op != t2->ty_Op)
1168                         break;
1169                 if (t1->ty_SQFlags != sqFlags2)
1170                         break;
1171                 switch(t1->ty_Op) {
1172                 case TY_IMPORT:
1173                         if (t1->ty_ImportType.et_SemGroup ==
1174                             t2->ty_ImportType.et_SemGroup)
1175                         {
1176                                 return(1);
1177                         }
1178                         return(0);
1179                 case TY_CLASS:
1180                         if (t1->ty_ClassType.et_SemGroup ==
1181                              t2->ty_ClassType.et_SemGroup &&
1182                             t1->ty_ClassType.et_Super ==
1183                              t2->ty_ClassType.et_Super)
1184                         {
1185                                 return(1);
1186                         }
1187                         return(0);
1188                 case TY_CPTRTO:
1189                         t1 = t1->ty_CPtrType.et_Type;
1190                         t2 = t2->ty_CPtrType.et_Type;
1191                         break;
1192                 case TY_PTRTO:
1193                         t1 = t1->ty_PtrType.et_Type;
1194                         t2 = t2->ty_PtrType.et_Type;
1195                         break;
1196                 case TY_REFTO:
1197                         t1 = t1->ty_RefType.et_Type;
1198                         t2 = t2->ty_RefType.et_Type;
1199                         break;
1200                 case TY_ARYOF:
1201                 case TY_VAR:
1202                 case TY_COMPOUND:
1203                 case TY_PROC:
1204                         /* XXX */
1205                         return(0);
1206                 case TY_STORAGE:
1207                 case TY_ARGS:
1208                 case TY_UNRESOLVED:
1209                 case TY_DYNAMIC:
1210                         /* XXX */
1211                         return(0);
1212                 default:
1213                         dassert_type(t1, 0);
1214                         return(0);
1215                 }
1216                 sqFlags2 = t2->ty_SQFlags;
1217         }
1218         return(0);
1219 }
1220
1221 /*
1222  * SimilarType() - like SameType(), but ignores storage qualifiers and
1223  *                 if t2 is varargs, compares the original version.
1224  *
1225  *    Used when casting t2 (rhs) to t1 (lhs).
1226  */
1227 int
1228 SimilarType(Type *t1, Type *t2)
1229 {
1230         if (t2->ty_Op == TY_VAR)
1231                 t2 = t2->ty_VarType.et_Type;
1232         for (;;) {
1233                 if (t1 == t2)
1234                         return(1);
1235 #if 0
1236                 /*
1237                  * Normally we fail if the ops do not match, but it is legal to
1238                  * cast a pointer (t2) to a reference type (t1) if the ref type
1239                  * is its superclass.  It is also legal to cast an array to a
1240                  * pointer or C pointer.
1241                  */
1242                 if (t2->ty_Op != t1->ty_Op) {
1243                         /*
1244                          * pointer->ref
1245                          */
1246                         if (t2->ty_Op == TY_PTRTO && t1->ty_Op == TY_REFTO) {
1247                                 t1 = t1->ty_RefType.et_Type;
1248                                 t2 = t2->ty_PtrType.et_Type;
1249                                 if (MatchType(t1, t2) <= SG_COMPAT_PART) {
1250                                         return(1);
1251                                 }
1252                                 return(0);
1253                         }
1254                         /*
1255                          * array->pointer
1256                          */
1257                         if (t2->ty_Op == TY_ARYOF && t1->ty_Op == TY_PTRTO) {
1258                                 t1 = t1->ty_PtrType.et_Type;
1259                                 t2 = t2->ty_AryType.et_Type;
1260                                 if (MatchType(t1, t2) <= SG_COMPAT_PART) {
1261                                         return(1);
1262                                 }
1263                                 return(0);
1264                         }
1265                         /*
1266                          * array->cpointer
1267                          */
1268                         if (t2->ty_Op == TY_ARYOF && t1->ty_Op == TY_CPTRTO) {
1269                                 t1 = t1->ty_PtrType.et_Type;
1270                                 t2 = t2->ty_AryType.et_Type;
1271                                 if (MatchType(t1, t2) <= SG_COMPAT_PART) {
1272                                         return(1);
1273                                 }
1274                                 return(0);
1275                         }
1276                         break;
1277                 }
1278 #endif
1279                 if (t2->ty_Op != t1->ty_Op)
1280                         break;
1281                 switch(t1->ty_Op) {
1282                 case TY_IMPORT:
1283                         if (t1->ty_ImportType.et_SemGroup ==
1284                             t2->ty_ImportType.et_SemGroup) {
1285                                 return(1);
1286                         }
1287                         return(0);
1288                 case TY_CLASS:
1289                         if (t1->ty_ClassType.et_SemGroup ==
1290                              t2->ty_ClassType.et_SemGroup &&
1291                             t1->ty_ClassType.et_Super ==
1292                              t2->ty_ClassType.et_Super)
1293                         {
1294                                 return(1);
1295                         }
1296                         return(0);
1297                 case TY_CPTRTO:
1298                         t1 = t1->ty_CPtrType.et_Type;
1299                         t2 = t2->ty_CPtrType.et_Type;
1300                         break;
1301                 case TY_PTRTO:
1302                         t1 = t1->ty_PtrType.et_Type;
1303                         t2 = t2->ty_PtrType.et_Type;
1304                         break;
1305                 case TY_REFTO:
1306                         /*
1307                          * Reference types are similar if the lhs is a
1308                          * superclass of the rhs and partially compatible
1309                          * (only method call changes and extensions).
1310                          */
1311                         t1 = t1->ty_RefType.et_Type;
1312                         t2 = t2->ty_RefType.et_Type;
1313                         if (MatchType(t1, t2) <= SG_COMPAT_PART) {
1314                                 return(1);
1315                         }
1316                         return(0);
1317                         break;
1318                 case TY_COMPOUND:
1319                         /*
1320                          * Compare the elements making up the compound type.
1321                          * XXX
1322                          */
1323                         return(SimilarSemGroup(t1->ty_CompType.et_SemGroup,
1324                                                t2->ty_CompType.et_SemGroup));
1325                         break;
1326                 case TY_ARYOF:
1327                 case TY_VAR:
1328                 case TY_PROC:
1329                         /* XXX */
1330                         return(0);
1331                 case TY_STORAGE:
1332                 case TY_ARGS:
1333                 case TY_UNRESOLVED:
1334                 case TY_DYNAMIC:
1335                         /* XXX */
1336                         return(0);
1337                 default:
1338                         dassert_type(t1, 0);
1339                         return(0);
1340                 }
1341         }
1342         return(0);
1343 }
1344
1345 /*
1346  * SimilarSemGroup() - check to see if the storage underlying the two
1347  *                      semantic groups is compatible.
1348  */
1349 int
1350 SimilarSemGroup(SemGroup *s1, SemGroup *s2)
1351 {
1352         Declaration *d1;
1353         Declaration *d2;
1354
1355         if (s1->sg_Bytes != s2->sg_Bytes)
1356                 return(0);
1357         d1 = getHead(&s1->sg_DeclList);
1358         d2 = getHead(&s2->sg_DeclList);
1359         for (;;) {
1360                 while (d1 &&
1361                        ((d1->d_Op & DOPF_STORAGE) == 0 ||
1362                          d1->d_Op == DOP_GLOBAL_STORAGE)
1363                 ) {
1364                         d1 = getSucc(&s1->sg_DeclList, &d1->d_Node);
1365                 }
1366                 while (d2 &&
1367                        ((d2->d_Op & DOPF_STORAGE) == 0 ||
1368                          d2->d_Op == DOP_GLOBAL_STORAGE)
1369                 ) {
1370                         d2 = getSucc(&s2->sg_DeclList, &d2->d_Node);
1371                 }
1372                 if (d1 == NULL || d2 == NULL)
1373                         break;
1374                 if (SimilarType(d1->d_StorDecl.ed_Type,
1375                                 d2->d_StorDecl.ed_Type) == 0) {
1376                         break;
1377                 }
1378                 d1 = getSucc(&s1->sg_DeclList, &d1->d_Node);
1379                 d2 = getSucc(&s2->sg_DeclList, &d2->d_Node);
1380         }
1381         if (d1 || d2)
1382                 return(0);      /* compare bad */
1383         return(1);              /* compare good */
1384 }
1385
1386 char *
1387 TypeToStr(Type *type, char **pstr)
1388 {
1389         char *str = NULL;
1390         char *s1 = NULL;
1391         char *s2 = NULL;
1392         Stmt *st;
1393         SemGroup *sg;
1394         Declaration *d;
1395         int count;
1396         static char *SaveStr[8];
1397         static int SaveIndex;
1398
1399         if (type == NULL) {
1400                 safe_asprintf(&str, "(null)");
1401         } else {
1402                 switch(type->ty_Op) {
1403                 case TY_CLASS:
1404                         st = type->ty_ClassType.et_SemGroup->sg_Stmt;
1405                         dassert(st->st_Op == ST_Class);
1406 #if 0
1407                         safe_asprintf(&str, "CLASS(%s",
1408                                       st->st_ClassStmt.es_Decl->d_Id);
1409 #else
1410                         LexPrintRef(&st->st_LexRef, 0);
1411                         safe_asprintf(&str, "CLASS(%s from",
1412                                 /* type->ty_ClassType.et_SemGroup->sg_Parse, */
1413                                       st->st_ClassStmt.es_Decl->d_Id);
1414                         for (;;) {
1415                                 while (st && st->st_Op != ST_Import)
1416                                         st = st->st_Parent;
1417                                 if (st == NULL)
1418                                         break;
1419                                 safe_replacef(&str, "%s <%s%s>",
1420                                               str,
1421                                               st->st_ImportStmt.es_Path,
1422                                               st->st_ImportStmt.es_File);
1423                                 st = st->st_Parent;
1424                         }
1425 #endif
1426                         safe_replacef(&str, "%s)", str);
1427                         break;
1428                 case TY_IMPORT:
1429                         st = type->ty_ImportType.et_SemGroup->sg_Stmt;
1430                         dassert(st->st_Op == ST_Module);
1431                         safe_asprintf(&str, "IMPORT(%s)",
1432                                       st->st_LexRef.lr_Lex->l_Path);
1433                         break;
1434                 case TY_CPTRTO:
1435                         TypeToStr(type->ty_CPtrType.et_Type, &s1);
1436                         safe_replacef(&str, "(CLANG)*%s", s1);
1437                         break;
1438                 case TY_PTRTO:
1439                         TypeToStr(type->ty_PtrType.et_Type, &s1);
1440                         safe_replacef(&str, "*%s", s1);
1441                         break;
1442                 case TY_REFTO:
1443                         TypeToStr(type->ty_RefType.et_Type, &s1);
1444                         safe_replacef(&str, "@%s", s1);
1445                         break;
1446                 case TY_ARYOF:
1447                         TypeToStr(type->ty_AryType.et_Type, &s1);
1448                         safe_replacef(&str, "%s[]", s1);
1449                         break;
1450                 case TY_COMPOUND:
1451                         sg = type->ty_CompType.et_SemGroup;
1452                         safe_asprintf(&str, "COMPOUND(");
1453                         count = 0;
1454                         for (d = getHead(&sg->sg_DeclList);
1455                              d;
1456                              d = getSucc(&sg->sg_DeclList, &d->d_Node)) {
1457                                 if (d->d_Op & DOPF_STORAGE) {
1458                                         TypeToStr(d->d_StorDecl.ed_Type, &s1);
1459                                         if (count)
1460                                                 safe_replacef(&str, "%s,%s",
1461                                                               str, s1);
1462                                         else
1463                                                 safe_replacef(&str, "%s%s",
1464                                                               str, s1);
1465                                         ++count;
1466                                         safe_free(&s1);
1467                                 }
1468                         }
1469                         safe_replacef(&str, "%s)", str);
1470                         break;
1471                 case TY_VAR:
1472                         safe_replacef(&str, "VAR");
1473                         break;
1474                 case TY_ARGS:
1475                         sg = type->ty_ArgsType.et_SemGroup;
1476                         safe_asprintf(&str, "ARGS(");
1477                         count = 0;
1478                         for (d = getHead(&sg->sg_DeclList);
1479                              d;
1480                              d = getSucc(&sg->sg_DeclList, &d->d_Node)) {
1481                                 if (d->d_Op & DOPF_STORAGE) {
1482                                         TypeToStr(d->d_StorDecl.ed_Type, &s1);
1483                                         if (count)
1484                                                 safe_replacef(&str, "%s,%s",
1485                                                               str, s1);
1486                                         else
1487                                                 safe_replacef(&str, "%s%s",
1488                                                               str, s1);
1489                                         safe_free(&s1);
1490                                         ++count;
1491                                 }
1492                         }
1493                         safe_replacef(&str, "%s)", str);
1494                         break;
1495                 case TY_PROC:
1496                         {
1497                                 TypeToStr(type->ty_ProcType.et_RetType, &s1);
1498                                 TypeToStr(type->ty_ProcType.et_ArgsType, &s2);
1499                                 safe_asprintf(&str, "%s %s", s1, s2);
1500                         }
1501                         break;
1502                 case TY_STORAGE:
1503                         safe_asprintf(&str, "STORAGE(%d)",
1504                                       type->ty_StorType.et_Bytes);
1505                         break;
1506                 case TY_DYNAMIC:
1507                         safe_asprintf(&str, "DYNAMIC");
1508                         break;
1509                 case TY_UNRESOLVED:
1510                         safe_asprintf(&str, "UNRES(");
1511                         for (count = 0; type->ty_UnresType.et_DottedId[count]; ++count) {
1512                                 safe_replacef(&str, "%s%s",
1513                                               str, type->ty_UnresType.et_DottedId[count]);
1514                                 if (count) {
1515                                         safe_replacef(&str, "%s,%s",
1516                                                       str, type->ty_UnresType.et_DottedId[count]);
1517                                 }
1518                         }
1519                         safe_replacef(&str, "%s)", str);
1520                         break;
1521                 default:
1522                         safe_asprintf(&str, "?");
1523                         break;
1524                 }
1525                 if (type->ty_SQFlags) {
1526                         char *sqstr;
1527
1528                         safe_asprintf(&sqstr, "(%s%s%s%s%s%s%s)",
1529                           ((type->ty_SQFlags & SF_CONST) ? "const " : ""),
1530                           ((type->ty_SQFlags & SF_VOLATILE) ? "volatile " : ""),
1531                           ((type->ty_SQFlags & SF_VARARGS) ? "varargs " : ""),
1532                           ((type->ty_SQFlags & SF_LVALUE) ? "lvalue " : ""),
1533                           ((type->ty_SQFlags & SF_NOZERO) ? "__nozero " : ""),
1534                           ((type->ty_SQFlags & SF_METHOD) ? "method " : ""),
1535                           ((type->ty_SQFlags & SF_GMETHOD) ? "global method " : "")
1536                         );
1537                         safe_replacef(&str, "%s%s", sqstr, str);
1538                         free(sqstr);
1539                 }
1540         }
1541         safe_free(&s1);
1542         safe_free(&s2);
1543         if (pstr) {
1544                 safe_free(pstr);
1545                 *pstr = str;
1546         } else {
1547                 safe_free(&SaveStr[SaveIndex]);
1548                 SaveStr[SaveIndex] = str;
1549                 SaveIndex = (SaveIndex + 1) % arysize(SaveStr);
1550         }
1551         return(str);
1552 }
1553
1554 typedef struct TypeRegNode {
1555         Node    tr_Node;
1556         string_t        tr_Id;
1557         Type    *tr_Type;
1558 } TypeRegNode;
1559
1560 List TypeRegList = INITLIST(TypeRegList);
1561
1562 void
1563 InternalRegisterType(const char *str, Type *type)
1564 {
1565         static int Special = SPECIALF_REGISTERED|SPECIALF_INTERNAL|1;
1566         TypeRegNode *tr;
1567
1568         dassert(Special & SPECIALF_MASK);
1569         tr = zalloc(sizeof(TypeRegNode));
1570         tr->tr_Id = StrTableAlloc(str, strlen(str), Special++);
1571         tr->tr_Type = type;
1572         addTail(&TypeRegList, &tr->tr_Node);
1573 }
1574
1575 Type *
1576 InternalRegisteredTypeLookup(string_t id)
1577 {
1578         TypeRegNode *tr;
1579
1580         for (
1581                 tr = getHead(&TypeRegList);
1582                 tr;
1583                 tr = getSucc(&TypeRegList, &tr->tr_Node)
1584         ) {
1585                 if (tr->tr_Id == id)
1586                         return(tr->tr_Type);
1587         }
1588         return(NULL);
1589 }