prop-src/datatype.cc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //  This file is generated automatically using Prop (version 2.3.6),
   3 //  last updated on Nov 2, 1999.
   4 //  The original source file is "datatype.pcc".
   5 ///////////////////////////////////////////////////////////////////////////////
   6
   7 #define PROP_QUARK_USED
   8 #include <propdefs.h>
   9 ///////////////////////////////////////////////////////////////////////////////
  10 //  Quark literals
  11 ///////////////////////////////////////////////////////////////////////////////
  12 static const Quark _d_a_t_a_t_y_p_eco_c_c_Q1("a_");
  13 #line 1 "datatype.pcc"
  14 /////////////////////////////////////////////////////////////////////////////
  15 //
  16 //  This file implements the DatatypeClass
  17 //
  18 //////////////////////////////////////////////////////////////////////////////
  19 #include <AD/strings/quark.h>
  20 #include "datatype.h"
  21 #include "ast.h"
  22 #include "ir.h"
  23 #include "type.h"
  24 #include "options.h"
  25 #include "list.h"
  26 #include "datagen.h"
  27
  28 //////////////////////////////////////////////////////////////////////////////
  29 //
  30 //  Constructor for DatatypeClass
  31 //
  32 //////////////////////////////////////////////////////////////////////////////
  33 DatatypeClass::DatatypeClass
  34    (CLASS_TYPE my_class_type,
  35     Id cid, Id id, TyVars p, Inherits i, TyQual q, Decls d, Cons c,
  36     DatatypeHierarchy * r)
  37    : ClassDefinition(my_class_type,id,p,i,q,d),
  38      constructor_name(cid), cons(c), root(r),
  39      generating_list_special_forms(false),
  40      cons_arg_ty(NOty), has_destructor(false)
  41    {
  42       is_const = (qualifiers & QUALconst) ? "const " : "";
  43       is_list  = is_list_constructor(constructor_name);
  44       is_array = is_array_constructor(constructor_name);
  45    }
  46
  47 DatatypeClass::~DatatypeClass() {}
  48
  49 //////////////////////////////////////////////////////////////////////////////
  50 //
  51 //  Method to update the qualifiers and other
  52 //
  53 //////////////////////////////////////////////////////////////////////////////
  54 void DatatypeHierarchy::get_info()
  55 {
  56    if (got_info) return;
  57
  58    got_info = true;
  59
  60 /*
  61    match (lookup_ty(datatype_name))
  62    {  DATATYPEty({ qualifiers = q, body = b, unit, arg, terms ... },_):
  63       {  qualifiers = q;
  64          class_body = b;
  65          for (int i = 0; i < number_of_subclasses; i++)
  66          {  match (subclasses[i]->cons)
  67             {  ONEcons { inherit, qual, body ... }:
  68                {  // subclasses[i]->inherited_classes = inherit;
  69                   subclasses[i]->qualifiers |= qual;
  70                   subclasses[i]->class_body = body;
  71                }
  72             |  _: // skip
  73             }
  74          }
  75       }
  76    |  _: // skip
  77    }
  78 */
  79
  80
  81    //
  82    //  Construct the inheritance list and fix it up if necessary
  83    //
  84    build_inheritance_list();
  85
  86    //
  87    //  Use inline methods if we are not in space saving mode
  88    //  or if the user specificately specified the inline qualifier
  89    //
  90    Bool must_inline     = (qualifiers & QUALinline);
  91    Bool must_not_inline = (qualifiers & QUALextern);
  92    if (must_inline && must_not_inline)
  93    {  error("%Ldatatype %s%V cannot be inline and external at the same time",
  94             datatype_name, parameters
  95            );
  96    }
  97    if (must_inline)          inline_methods = true;
  98    else if (must_not_inline) inline_methods = false;
  99    else                      inline_methods = (! options.save_space);
 100
 101    //
 102    //  Use a variant tag if we have subclasses in our hierarchy
 103    //  and if the tag is not embedded into the pointer representation
 104    //
 105    has_variant_tag = ((optimizations & OPTtagless) == 0);
 106
 107    has_destructor = (qualifiers & QUALvirtualdestr) || (cons && is_array);
 108 }
 109
 110 //////////////////////////////////////////////////////////////////////////////
 111 //
 112 //  Constructor for DatatypeHierarchy
 113 //
 114 //////////////////////////////////////////////////////////////////////////////
 115 DatatypeHierarchy::DatatypeHierarchy
 116     (Id id, TyVars p, Inherits i, TyQual q, TermDefs t, Decls d)
 117     : DatatypeClass(DATATYPE_CLASS,id,
 118 #line 104 "datatype.pcc"
 119 #line 104 "datatype.pcc"
 120 _d_a_t_a_t_y_p_eco_c_c_Q1
 121 #line 104 "datatype.pcc"
 122 #line 104 "datatype.pcc"
 123  + id,p,i,q,d,NOcons,this),
 124       datatype_name(id), term_defs(t), subclasses(0),
 125       number_of_subclasses(0), datatype_ty(NOty)
 126     {
 127        unit_constructors = 0;
 128        arg_constructors  = 0;
 129        constructor_terms = 0;
 130        use_persist_base  = false;
 131        use_gc_base       = false;
 132        got_info          = false;
 133
 134        //
 135        //  Build the class hierarchy
 136        //
 137        build_class_hierarchy();
 138
 139     }
 140
 141 DatatypeHierarchy::~DatatypeHierarchy()
 142 {
 143    delete [] subclasses;
 144 }
 145
 146 //////////////////////////////////////////////////////////////////////////////
 147 //
 148 //  Method to build the class hierarchy given a datatype.
 149 //  We'll create a DatatypeClass object for each subclass.
 150 //
 151 //////////////////////////////////////////////////////////////////////////////
 152 void DatatypeHierarchy::build_class_hierarchy()
 153 {
 154    // don't bother building the class hierarchy for views
 155    if (is_view()) return;
 156
 157    // construct class hierarchy
 158
 159 #line 139 "datatype.pcc"
 160 #line 174 "datatype.pcc"
 161 {
 162    Ty _V1 = lookup_ty(datatype_name);
 163    if (_V1) {
 164       switch (_V1->tag__) {
 165          case a_Ty::tag_TYCONty: {
 166             if (boxed(((Ty_TYCONty *)_V1)->_1)) {
 167                switch (((Ty_TYCONty *)_V1)->_1->tag__) {
 168                   case a_TyCon::tag_DATATYPEtycon: {
 169 #line 141 "datatype.pcc"
 170                    arity = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->unit + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->arg;
 171                          unit_constructors = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->unit;
 172                          arg_constructors  = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->arg;
 173                          constructor_terms = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms;
 174                          optimizations     = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->opt;
 175                          datatype_ty       = _V1;
 176                          ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->hierarchy         = this;
 177                               if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->arg > 0) // build class hierarchy only if we have more than
 178                                       // one variants
 179                               {  if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->opt & OPTsubclassless) // no subclass
 180                             {  number_of_subclasses = 0;
 181                                for (int i = 0; i < arity; i++)
 182                                {  if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[i]->ty != NOty)
 183                                   {  cons = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[i];
 184                                      constructor_name = cons->name;
 185                                           is_list  = is_list_constructor(constructor_name);
 186                                           is_array = is_array_constructor(constructor_name);
 187                                      class_body = append(class_body, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[i]->body);
 188                                   }
 189                                     }
 190                             }
 191                             else // use subclass
 192                             {  number_of_subclasses = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->arg;
 193                                subclasses = new DatatypeClass * [number_of_subclasses];
 194                                for (int i = 0, j = 0; i < arity; i++)
 195                                {  if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[i]->ty != NOty)
 196                                   {  subclasses[j++] = build_one_subclass(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[i]);
 197                                   }
 198                                     }
 199                                  }
 200                               }
 201
 202 #line 172 "datatype.pcc"
 203                      } break;
 204                   default: {
 205                      L1:; } break;
 206                }
 207             } else { goto L1; }
 208             } break;
 209          default: { goto L1; } break;
 210       }
 211    } else { goto L1; }
 212 }
 213 #line 174 "datatype.pcc"
 214 #line 174 "datatype.pcc"
 215
 216 }
 217
 218 //////////////////////////////////////////////////////////////////////////////
 219 //
 220 //  Method to build one subclass in the hierarchy.
 221 //
 222 //////////////////////////////////////////////////////////////////////////////
 223 DatatypeClass * DatatypeHierarchy::build_one_subclass(Cons cons)
 224 {
 225 #line 183 "datatype.pcc"
 226 #line 196 "datatype.pcc"
 227 {
 228    if (cons) {
 229 #line 185 "datatype.pcc"
 230     return cons->class_def = new DatatypeClass(
 231              DATATYPE_SUBCLASS,
 232              cons->name,
 233              Quark(mangle(datatype_name),"_",mangle(cons->name)),
 234              parameters,
 235              add_inherit(class_name,parameters,cons->inherit),
 236              cons->qual,
 237              cons->body,
 238              cons,
 239              this);
 240
 241 #line 195 "datatype.pcc"
 242    } else {
 243 #line 196 "datatype.pcc"
 244      return 0;
 245 #line 196 "datatype.pcc"
 246    }
 247 }
 248 #line 197 "datatype.pcc"
 249 #line 197 "datatype.pcc"
 250
 251 }
 252
 253 //////////////////////////////////////////////////////////////////////////////
 254 //
 255 //  Method to build the inheritance list of the class hierachy.
 256 //
 257 //////////////////////////////////////////////////////////////////////////////
 258 void DatatypeHierarchy::build_inheritance_list()
 259 {
 260    if (qualifiers & QUALrelation)    append_base_class("Fact");
 261    if (qualifiers & QUALrewritable)  append_base_class("TermObj");
 262    if (qualifiers & QUALpersistent)  append_base_class("PObject");
 263
 264    if (qualifiers & QUALcollectable)
 265    {  // Make sure we are only inheriting from one collectable object
 266       // Make sure virtual inheritance is not used.
 267       // Make sure that the collectable object is the first base class.
 268
 269       int pos       = 0;
 270       int count     = 0;
 271       for_each (Inherit, inh, inherited_classes)
 272       {  if((inh->qualifiers & QUALcollectable) || is_gc_ty(inh->super_class))
 273          {  count++;
 274             if (pos != 0)
 275             {  msg("%!%wcollectable object %T must be first base class\n",
 276                   inh->loc(), inh->super_class);
 277             }
 278          }
 279          if (inh->qualifiers & QUALvirtual)
 280          {  msg("%!%wvirtual inheritance of %T may fail"
 281                 " with garbage collection\n",
 282                 inh->loc(), inh->super_class);
 283          }
 284          pos++;
 285       }
 286       if (count >= 2)
 287       {  error("%Linheritance of multiple collectable object will fail\n");
 288       }
 289       if (count == 0)
 290       {  add_base_class("GCObject");
 291       }
 292    }
 293 }
 294
 295 //////////////////////////////////////////////////////////////////////////////
 296 //
 297 // Method to generate a class constructor
 298 //
 299 //////////////////////////////////////////////////////////////////////////////
 300 void DatatypeClass::gen_class_constructor(CodeGen& C, Tys tys, DefKind k)
 301 {
 302    ClassDefinition::gen_class_constructor(C,tys,k);
 303
 304    if (is_list)
 305    {  generating_list_special_forms = true;
 306       ClassDefinition::gen_class_constructor(C,tys,k);
 307       generating_list_special_forms = false;
 308    }
 309 }
 310
 311 //////////////////////////////////////////////////////////////////////////////
 312 //
 313 //  Method to generate the constructor parameters.
 314 //
 315 //////////////////////////////////////////////////////////////////////////////
 316 void DatatypeClass::gen_class_constructor_parameters
 317    (CodeGen& C, Tys tys, DefKind k)
 318 {
 319    Ty arg_ty = cons_arg_ty;
 320
 321 #line 267 "datatype.pcc"
 322 #line 271 "datatype.pcc"
 323 {
 324    Ty _V2 = deref(arg_ty);
 325    if (_V2) {
 326       switch (_V2->tag__) {
 327          case a_Ty::tag_TYCONty: {
 328             if (boxed(((Ty_TYCONty *)_V2)->_1)) {
 329                L2:; } else {
 330                switch ((int)((Ty_TYCONty *)_V2)->_1) {
 331                   case ((int)TUPLEtycon): {
 332                      if (((Ty_TYCONty *)_V2)->_2) {
 333                         if (((Ty_TYCONty *)_V2)->_2->_2) {
 334                            if (((Ty_TYCONty *)_V2)->_2->_2->_2) { goto L2; } else {
 335                               if (
 336 #line 268 "datatype.pcc"
 337                               generating_list_special_forms
 338 #line 268 "datatype.pcc"
 339 ) {
 340
 341 #line 269 "datatype.pcc"
 342                                 arg_ty = mktuplety(
 343 #line 269 "datatype.pcc"
 344 #line 269 "datatype.pcc"
 345                                  list_1_(((Ty_TYCONty *)_V2)->_2->_1)
 346 #line 269 "datatype.pcc"
 347 #line 269 "datatype.pcc"
 348                                  );
 349 #line 269 "datatype.pcc"
 350                               } else {
 351                                   goto L2; }
 352                            }
 353                         } else { goto L2; }
 354                      } else { goto L2; }
 355                      } break;
 356                   default: { goto L2; } break;
 357                }
 358             }
 359             } break;
 360          default: { goto L2; } break;
 361       }
 362    } else { goto L2; }
 363 }
 364 #line 271 "datatype.pcc"
 365 #line 271 "datatype.pcc"
 366
 367    Parameter param;
 368    switch (k)
 369    {  case EXTERNAL_IMPLEMENTATION:
 370       case EXTERNAL_INSTANTIATION:
 371          param = TYsimpleformal; break;
 372       default:
 373          param = TYformal; break;
 374    }
 375    C.pr("%b", arg_ty, cons->name, param);
 376 }
 377
 378 //////////////////////////////////////////////////////////////////////////////
 379 //
 380 //  Method to generate the constructor initializers.
 381 //
 382 //////////////////////////////////////////////////////////////////////////////
 383 void DatatypeClass::gen_class_constructor_initializers
 384    (CodeGen& C, Tys tys, DefKind k)
 385 {
 386
 387 #line 291 "datatype.pcc"
 388 #line 312 "datatype.pcc"
 389 {
 390    if (cons) {
 391 #line 293 "datatype.pcc"
 392     Id colon = " : ";
 393          Id comma = "";
 394          C.pr("%^");
 395
 396          // First generate the tag initializer
 397                if (root->has_variant_tag)
 398          {  if (k == EXTERNAL_INSTANTIATION)
 399                      C.pr(" : %s%P(tag_%S)",
 400                    root->class_name, tys, constructor_name);
 401                   else
 402                      C.pr(" : %s%V(tag_%S)",
 403                    root->class_name, parameters, constructor_name);
 404             colon = ""; comma = ", ";
 405          }
 406
 407          // Now generate the initializers for the arguments
 408                gen_constructor_initializers(C,tys,k,cons_arg_ty,colon,comma);
 409
 410 #line 310 "datatype.pcc"
 411    } else {}
 412 }
 413 #line 312 "datatype.pcc"
 414 #line 312 "datatype.pcc"
 415
 416 }
 417
 418 //////////////////////////////////////////////////////////////////////////////
 419 //
 420 //  Method to generate the constructor initializers.
 421 //
 422 //////////////////////////////////////////////////////////////////////////////
 423 void DatatypeClass::gen_constructor_initializers
 424    (CodeGen& C, Tys tys, DefKind k, Ty ty, Id colon, Id comma)
 425 {
 426    if (is_array)
 427    {  C.pr("%s%slen_(x__len_)", colon, comma);
 428       colon = ""; comma = ", ";
 429       ty = mkarrayty(ty,IDexp("len_"));
 430    }
 431
 432
 433 #line 329 "datatype.pcc"
 434 #line 367 "datatype.pcc"
 435 {
 436    Ty _V3 = deref(ty);
 437    if (_V3) {
 438       switch (_V3->tag__) {
 439          case a_Ty::tag_TYCONty: {
 440             if (boxed(((Ty_TYCONty *)_V3)->_1)) {
 441                switch (((Ty_TYCONty *)_V3)->_1->tag__) {
 442                   case a_TyCon::tag_RECORDtycon: {
 443 #line 353 "datatype.pcc"
 444                    Ids l; Tys t;
 445                      for (l = ((TyCon_RECORDtycon *)((Ty_TYCONty *)_V3)->_1)->_1, t = ((Ty_TYCONty *)_V3)->_2; l && t; l = l->_2, t = t->_2) {
 446                         if (! is_array_ty(t->_1))
 447                         {  C.pr("%s%s%s(x_%s)", colon, comma, l->_1, l->_1);
 448                            colon = ""; comma = ", ";
 449                         }
 450                      }
 451
 452 #line 360 "datatype.pcc"
 453                      } break;
 454                   default: {
 455                      L3:;
 456 #line 362 "datatype.pcc"
 457                    if (! is_array_ty(_V3))
 458                      {  C.pr("%s%s%S(x_%S)",
 459                              colon, comma, constructor_name, constructor_name);
 460                              colon = ""; comma = ", ";
 461                      }
 462
 463 #line 367 "datatype.pcc"
 464                      } break;
 465                }
 466             } else {
 467                switch ((int)((Ty_TYCONty *)_V3)->_1) {
 468                   case ((int)TUPLEtycon): {
 469                      if (((Ty_TYCONty *)_V3)->_2) {
 470 #line 332 "datatype.pcc"
 471                       int i = 1;
 472                         for_each(Ty, t, ((Ty_TYCONty *)_V3)->_2)
 473                         {  if (generating_list_special_forms && i == 2)
 474                            {  if (k == EXTERNAL_INSTANTIATION)
 475                                  C.pr("%s%s_%i((%s%P *)0)", colon, comma,
 476                                       i, root->class_name, tys, i);
 477                               else
 478                                           C.pr("%s%s_%i((%s%V *)0)", colon, comma,
 479                                       i, root->class_name, parameters, i);
 480                                        colon = ""; comma = ", ";
 481                            }
 482                            else
 483                            {  if (! is_array_ty(t))
 484                                        {  C.pr("%s%s_%i(x_%i)", colon, comma, i, i);
 485                                           colon = ""; comma = ", ";
 486                               }
 487                            }
 488                                     i++;
 489                         }
 490
 491 #line 351 "datatype.pcc"
 492                      } else {}
 493                      } break;
 494                   default: { goto L3; } break;
 495                }
 496             }
 497             } break;
 498          default: { goto L3; } break;
 499       }
 500    } else { goto L3; }
 501 }
 502 #line 368 "datatype.pcc"
 503 #line 368 "datatype.pcc"
 504
 505 }
 506
 507 //////////////////////////////////////////////////////////////////////////////
 508 //
 509 //  Methods to generate body of a constructor
 510 //
 511 //////////////////////////////////////////////////////////////////////////////
 512 void DatatypeClass::gen_class_constructor_body(CodeGen& C, Tys tys, DefKind k)
 513 {
 514    if (cons == NOcons) return;
 515
 516    Ty ty = cons_arg_ty;
 517    if (is_array)
 518    {  ty = mkarrayty(ty,IDexp("len_"));
 519    }
 520
 521    // Now generate the initializers for array arguments
 522
 523 #line 386 "datatype.pcc"
 524 #line 401 "datatype.pcc"
 525 {
 526    Ty _V4 = deref(ty);
 527    if (_V4) {
 528       switch (_V4->tag__) {
 529          case a_Ty::tag_TYCONty: {
 530             if (boxed(((Ty_TYCONty *)_V4)->_1)) {
 531                switch (((Ty_TYCONty *)_V4)->_1->tag__) {
 532                   case a_TyCon::tag_RECORDtycon: {
 533 #line 396 "datatype.pcc"
 534                    Ids ls; Tys ts;
 535                      for(ls = ((TyCon_RECORDtycon *)((Ty_TYCONty *)_V4)->_1)->_1, ts = ((Ty_TYCONty *)_V4)->_2; ls && ts; ls = ls->_2, ts = ts->_2)
 536                      {  gen_array_initializer(C,((Ty_TYCONty *)_V4)->_2,k,ls->_1,ts->_1,"x_");
 537                      }
 538
 539 #line 400 "datatype.pcc"
 540                      } break;
 541                   default: {
 542                      L4:;
 543 #line 401 "datatype.pcc"
 544                     gen_array_initializer(C,tys,k,mangle(cons->name),_V4,"x_");
 545 #line 401 "datatype.pcc"
 546                      } break;
 547                }
 548             } else {
 549                switch ((int)((Ty_TYCONty *)_V4)->_1) {
 550                   case ((int)TUPLEtycon): {
 551                      if (((Ty_TYCONty *)_V4)->_2) {
 552 #line 389 "datatype.pcc"
 553                       int i = 1;
 554                         for_each(Ty, t, ((Ty_TYCONty *)_V4)->_2)
 555                         {  gen_array_initializer(C,tys,k,index_of(i),t,"x");
 556                            i++;
 557                         }
 558
 559 #line 394 "datatype.pcc"
 560                      } else {}
 561                      } break;
 562                   default: { goto L4; } break;
 563                }
 564             }
 565             } break;
 566          default: { goto L4; } break;
 567       }
 568    } else { goto L4; }
 569 }
 570 #line 402 "datatype.pcc"
 571 #line 402 "datatype.pcc"
 572
 573 }
 574
 575 //////////////////////////////////////////////////////////////////////////////
 576 //
 577 //  Methods to generate body of a constructor
 578 //
 579 //////////////////////////////////////////////////////////////////////////////
 580 void DatatypeClass::gen_array_initializer
 581    (CodeGen& C, Tys tys, DefKind k, Id exp, Ty ty, Id prefix)
 582 {
 583 #line 412 "datatype.pcc"
 584 #line 429 "datatype.pcc"
 585 {
 586    Ty _V5 = deref(ty);
 587    if (_V5) {
 588       switch (_V5->tag__) {
 589          case a_Ty::tag_TYCONty: {
 590             if (boxed(((Ty_TYCONty *)_V5)->_1)) {
 591                switch (((Ty_TYCONty *)_V5)->_1->tag__) {
 592                   case a_TyCon::tag_ARRAYtycon: {
 593                      if (((Ty_TYCONty *)_V5)->_2) {
 594                         if (((Ty_TYCONty *)_V5)->_2->_2) {
 595                            L5:; } else {
 596 #line 414 "datatype.pcc"
 597                          C.pr("%^{%+"
 598                            "%^for (int i__ = 0; i__ < (%e); i__++)"
 599                            "%^{%+",
 600                            ((TyCon_ARRAYtycon *)((Ty_TYCONty *)_V5)->_1)->ARRAYtycon);
 601                            if (is_array)
 602                            {  C.pr("%^typedef %t ELEMENT_TYPE__;"
 603                               "%^new (%S + i__) ELEMENT_TYPE__ (%s%S[i__]);",
 604                               ((Ty_TYCONty *)_V5)->_2->_1, "", exp, prefix, exp);
 605                            } else
 606                            {  C.pr("%^%S[i__] = %s%S[i__];", exp, prefix, exp);
 607                            }
 608                            C.pr("%-%^}"
 609                            "%-%^}");
 610
 611 #line 427 "datatype.pcc"
 612                         }
 613                      } else { goto L5; }
 614                      } break;
 615                   default: { goto L5; } break;
 616                }
 617             } else { goto L5; }
 618             } break;
 619          default: { goto L5; } break;
 620       }
 621    } else { goto L5; }
 622 }
 623 #line 429 "datatype.pcc"
 624 #line 429 "datatype.pcc"
 625
 626 }
 627
 628 //////////////////////////////////////////////////////////////////////////////
 629 //
 630 //  Methods to generate array initialization code.
 631 //
 632 //////////////////////////////////////////////////////////////////////////////
 633
 634 //////////////////////////////////////////////////////////////////////////////
 635 //
 636 //  Methods to generate destructor code.
 637 //
 638 //////////////////////////////////////////////////////////////////////////////
 639 void DatatypeClass::gen_class_destructor_body(CodeGen& C, Tys tys, DefKind)
 640 {
 641    if (is_array && cons)
 642    {  C.pr("%^{%+"
 643            "%^for (int i__; i__ < len_; i__++)"
 644            "%^{%+"
 645            "%^typedef %t ELEMENT_TYPE;"
 646            "%^(%S+i__)->~ELEMENT_TYPE();"
 647            "%-%^}"
 648            "%-%^}",
 649            cons_arg_ty, "", constructor_name
 650           );
 651    }
 652 }
 653
 654 //////////////////////////////////////////////////////////////////////////////
 655 //
 656 //  Methods to generate the forward declarations for a datatype.
 657 //  These include unit constructors for the class.
 658 //
 659 //////////////////////////////////////////////////////////////////////////////
 660 void DatatypeHierarchy::generate_forward_declarations(CodeGen& C)
 661 {
 662    // don't generate code for views
 663    if (is_view()) return;
 664
 665    get_info();
 666    generate_forward_class_declarations(C);
 667    generate_forward_constructor_declarations(C);
 668
 669    // don't generate code for forward definitions
 670    if (term_defs ==
 671 #line 474 "datatype.pcc"
 672 #line 474 "datatype.pcc"
 673 nil_1_
 674 #line 474 "datatype.pcc"
 675 #line 474 "datatype.pcc"
 676 ) return;
 677
 678    generate_unit_constructors(C);
 679 }
 680
 681 //////////////////////////////////////////////////////////////////////////////
 682 //
 683 //  Method to generate forward class declarations.
 684 //  If the datatype is monomorphic, generate a typedef.
 685 //  Otherwise, generate a forward template declaration
 686 //  and a #define.
 687 //
 688 //////////////////////////////////////////////////////////////////////////////
 689 void DatatypeHierarchy::generate_forward_class_declarations(CodeGen& C)
 690 {  // Generate forward declarations only if we have at least one variant
 691    if (arg_constructors == 0 && term_defs !=
 692 #line 489 "datatype.pcc"
 693 #line 489 "datatype.pcc"
 694 nil_1_
 695 #line 489 "datatype.pcc"
 696 #line 489 "datatype.pcc"
 697 ) return;
 698
 699    C.pr("%^%/"
 700         "%^//"
 701         "%^// Forward class definition for %s%V"
 702         "%^//"
 703         "%^%/"
 704         "%n#ifndef datatype_%S_defined"
 705         "%n#define datatype_%S_defined",
 706         datatype_name, parameters, datatype_name, datatype_name
 707        );
 708
 709    if (is_polymorphic())
 710    {  // Polymorphic datatypes
 711       C.pr("%^%Hclass %s;", parameters, class_name);
 712       C.pr("%n#define %s%v %s%s%V *\n",
 713            datatype_name, parameters, is_const, class_name, parameters);
 714    } else
 715    {  // Monomorphic datatypes
 716       C.pr("%^   class %s;", class_name);
 717       C.pr("%^   typedef %s%s * %s;", is_const, class_name, datatype_name);
 718    }
 719
 720    C.pr("%n#endif\n\n");
 721 }
 722
 723 //////////////////////////////////////////////////////////////////////////////
 724 //
 725 //  Method to generate forward declarations for datatype constructors.
 726 //
 727 //////////////////////////////////////////////////////////////////////////////
 728 void DatatypeHierarchy::generate_forward_constructor_declarations(CodeGen& C)
 729 {
 730 }
 731
 732
 733 //////////////////////////////////////////////////////////////////////////////
 734 //
 735 //  Method to generate code for the definition of a datatype
 736 //
 737 //////////////////////////////////////////////////////////////////////////////
 738 void DatatypeHierarchy::generate_datatype_definitions(CodeGen& C)
 739 {
 740    // don't generate code for views
 741    if (is_view()) return;
 742
 743    // don't generate code for forward definitions
 744    if (term_defs ==
 745 #line 536 "datatype.pcc"
 746 #line 536 "datatype.pcc"
 747 nil_1_
 748 #line 536 "datatype.pcc"
 749 #line 536 "datatype.pcc"
 750 ) return;
 751
 752    // If there are no argument constructors, don't generate code
 753    get_info();
 754
 755    if (arg_constructors == 0)
 756    {
 757       gen_class_postdefinition(C);
 758
 759    } else
 760    {
 761       // Otherwise generate code for all the classes.
 762       gen_class_definition(C);
 763       for (int i = 0; i < number_of_subclasses; i++)
 764          subclasses[i]->gen_class_definition(C);
 765
 766       // Generate datatype constructors
 767       DefKind kind = inline_methods
 768           ? INLINE_IMPLEMENTATION : INTERFACE_DEFINITION;
 769
 770       generate_datatype_constructors(C,
 771 #line 556 "datatype.pcc"
 772 #line 556 "datatype.pcc"
 773 nil_1_
 774 #line 556 "datatype.pcc"
 775 #line 556 "datatype.pcc"
 776 ,kind);
 777
 778       if (options.inline_casts == false || parameters !=
 779 #line 558 "datatype.pcc"
 780 #line 558 "datatype.pcc"
 781 nil_1_
 782 #line 558 "datatype.pcc"
 783 #line 558 "datatype.pcc"
 784 )
 785          generate_downcasting_functions(C);
 786       C.pr("\n\n");
 787    }
 788 }
 789
 790 //////////////////////////////////////////////////////////////////////////////
 791 //
 792 //  Method to generate the unit constructor names.
 793 //  If there are no argument constructors, represent the constructors as
 794 //  enum's.   Otherwise, represent them as #define constants.
 795 //
 796 //////////////////////////////////////////////////////////////////////////////
 797 void DatatypeHierarchy::generate_unit_constructors(CodeGen& C)
 798 {  if (unit_constructors == 0) return;
 799    if (arg_constructors == 0)
 800       generate_constructor_tags(C,"","", unit_constructors, constructor_terms);
 801    else
 802       generate_define_tags(C,unit_constructors,constructor_terms);
 803    C.pr("\n\n");
 804 }
 805
 806 //////////////////////////////////////////////////////////////////////////////
 807 //
 808 //  Method to generate the constructor tags as enum's.
 809 //  Constructor tags are used to represent unit constructors
 810 //  and variant tags.
 811 //
 812 //////////////////////////////////////////////////////////////////////////////
 813 void DatatypeHierarchy::generate_constructor_tags
 814   (CodeGen& C, Id enum_prefix, Id tag_prefix, int n, Cons terms[])
 815 {  C.pr("%^enum %s%s {%+", enum_prefix, datatype_name);
 816    Bool comma = false;
 817    for (int i = 0; i < n; i++)
 818    {  if (comma) C.pr (", ");
 819       if (i % 3 == 0) C.pr("%^");
 820       C.pr("%s%S = %i", tag_prefix, terms[i]->name, tag_of(terms[i]));
 821       comma = true;
 822    }
 823    C.pr("%-%^};\n\n");
 824 }
 825
 826 //////////////////////////////////////////////////////////////////////////////
 827 //
 828 //  Method to generate the unit constructor tags as #define constants.
 829 //  This is necessary if we have both unit and argument constructors
 830 //  for a type.  If polymorphic types are used, the #define constants
 831 //  are not given a type.
 832 //
 833 //////////////////////////////////////////////////////////////////////////////
 834 void DatatypeHierarchy::generate_define_tags(CodeGen& C, int n, Cons terms[])
 835 {  for (int i = 0; i < n; i++)
 836    {  if (is_polymorphic())
 837          C.pr("%n#  define %S %i", terms[i]->name, tag_of(terms[i]));
 838       else
 839          C.pr("%n#  define %S (%s)%i",
 840             terms[i]->name, datatype_name, tag_of(terms[i]));
 841    }
 842 }
 843
 844 //////////////////////////////////////////////////////////////////////////////
 845 //
 846 //  Method to generate datatype constructor functions for a datatype.
 847 //  Datatype constructor functions are just external functions.
 848 //
 849 //////////////////////////////////////////////////////////////////////////////
 850 void DatatypeHierarchy::generate_datatype_constructors
 851    (CodeGen& C, Tys tys, DefKind kind)
 852 {
 853    C.pr("%^%/"
 854         "%^//"
 855         "%^// Datatype constructor functions for %s%V"
 856         "%^//"
 857         "%^%/",
 858         datatype_name, parameters);
 859    generate_datatype_constructor(C,tys,kind);
 860    for (int i = 0; i < number_of_subclasses; i++)
 861    {  subclasses[i]->generate_datatype_constructor(C,tys,kind);
 862    }
 863 }
 864
 865 //////////////////////////////////////////////////////////////////////////////
 866 //
 867 //  Method to generate a datatype constructor function.
 868 //
 869 //////////////////////////////////////////////////////////////////////////////
 870 void DatatypeClass::generate_datatype_constructor
 871    (CodeGen& C, Tys tys, DefKind kind)
 872 {
 873    // No datatype descriptor, then no datatype constructor function
 874    if (cons == NOcons) return;
 875
 876    Id prefix = "";
 877
 878    switch (kind)
 879    {  case INLINE_IMPLEMENTATION:   prefix = "inline "; break;
 880       case INTERFACE_DEFINITION:
 881       case EXTERNAL_DEFINITION:     prefix = "extern "; break;
 882       case EXTERNAL_IMPLEMENTATION:
 883       case EXTERNAL_INSTANTIATION:  prefix = ""; break;
 884    }
 885
 886    // Generate special form constructors for lists and vectors
 887    int special_forms = 1;
 888    if (is_list) special_forms = 2;
 889    else if (is_array) special_forms = options.max_vector_len + 2;
 890    Tys params =
 891 #line 664 "datatype.pcc"
 892 #line 664 "datatype.pcc"
 893 nil_1_
 894 #line 664 "datatype.pcc"
 895 #line 664 "datatype.pcc"
 896 ;
 897    Ids labels =
 898 #line 665 "datatype.pcc"
 899 #line 665 "datatype.pcc"
 900 nil_1_
 901 #line 665 "datatype.pcc"
 902 #line 665 "datatype.pcc"
 903 ;
 904
 905    for (int form = 1; form <= special_forms; form++)
 906    {
 907       Ty formals_ty = cons_arg_ty;
 908       Ty actuals_ty = cons_arg_ty;
 909       Id formals_name = constructor_name;
 910
 911       // If it is a list special form, fake the second argument
 912       if (is_list && form == 2)
 913       {
 914 #line 675 "datatype.pcc"
 915 #line 679 "datatype.pcc"
 916 {
 917    Ty _V6 = deref(formals_ty);
 918    if (_V6) {
 919       switch (_V6->tag__) {
 920          case a_Ty::tag_TYCONty: {
 921             if (boxed(((Ty_TYCONty *)_V6)->_1)) {
 922                L6:;
 923 #line 678 "datatype.pcc"
 924               bug("%LDatatypeClass::generate_datatype_constructor: %T\n",
 925                _V6);
 926 #line 679 "datatype.pcc"
 927             } else {
 928                switch ((int)((Ty_TYCONty *)_V6)->_1) {
 929                   case ((int)TUPLEtycon): {
 930                      if (((Ty_TYCONty *)_V6)->_2) {
 931                         if (((Ty_TYCONty *)_V6)->_2->_2) {
 932                            if (((Ty_TYCONty *)_V6)->_2->_2->_2) { goto L6; } else {
 933 #line 677 "datatype.pcc"
 934                             formals_ty = actuals_ty = mktuplety(
 935 #line 677 "datatype.pcc"
 936 #line 677 "datatype.pcc"
 937                               list_1_(((Ty_TYCONty *)_V6)->_2->_1)
 938 #line 677 "datatype.pcc"
 939 #line 677 "datatype.pcc"
 940                               );
 941 #line 677 "datatype.pcc"
 942                            }
 943                         } else { goto L6; }
 944                      } else { goto L6; }
 945                      } break;
 946                   default: { goto L6; } break;
 947                }
 948             }
 949             } break;
 950          default: { goto L6; } break;
 951       }
 952    } else { goto L6; }
 953 }
 954 #line 680 "datatype.pcc"
 955 #line 680 "datatype.pcc"
 956
 957       }
 958
 959       // If it is an array special form, fake the parameter arguments
 960       if (is_array && form >= 2)
 961       {  if (form >= 3)
 962          {  params =
 963 #line 686 "datatype.pcc"
 964 #line 686 "datatype.pcc"
 965 list_1_(cons_arg_ty,params)
 966 #line 686 "datatype.pcc"
 967 #line 686 "datatype.pcc"
 968 ;
 969             labels = append(labels,
 970 #line 687 "datatype.pcc"
 971 #line 687 "datatype.pcc"
 972 list_1_(index_of((form - 2)))
 973 #line 687 "datatype.pcc"
 974 #line 687 "datatype.pcc"
 975 );
 976          }
 977          formals_ty = mkrecordty(labels,params,false);
 978          formals_name = mangle(constructor_name);
 979       }
 980
 981       switch (kind)
 982       {  case EXTERNAL_INSTANTIATION:
 983          case EXTERNAL_DEFINITION:
 984            C.pr("%^%s%s%P * %S %b",
 985            prefix, root->class_name, tys, constructor_name,
 986            formals_ty, formals_name, TYsimpleformal);
 987            break;
 988          default:
 989            C.pr("%^%H%s%s%V * %S %b",
 990               parameters,
 991               prefix, root->class_name, parameters, constructor_name,
 992               formals_ty, formals_name, TYformal);
 993            break;
 994       }
 995
 996       //  Don't generate code for interface definitions
 997       if (kind == INTERFACE_DEFINITION ||
 998           kind == EXTERNAL_DEFINITION) { C.pr(";"); continue; }
 999
1000       C.pr("%^{%+");
1001
1002       //
1003       // Generate a temporary array
1004       //
1005       if (is_array && form >= 2)
1006       {  C.pr("%^const int x__len_ = %i;", form - 2);
1007          C.pr("%^%t x_%S[%i];", cons_arg_ty, "", constructor_name, form - 2);
1008          for (int i = 0; i < form - 2; i++)
1009             C.pr("%^x_%S[%i] = x__%i;", constructor_name,i,i+1);
1010       }
1011
1012       C.pr("%^return ");
1013
1014       //
1015       // In the tagged pointer representation, the variant tag is embedded
1016       // within the data address.
1017       //
1018       if (root->optimizations & OPTtaggedpointer)
1019       {  switch (kind)
1020          {  case EXTERNAL_INSTANTIATION:
1021                C.pr ("(%s%P*)((unsigned long)(", root->class_name, tys);
1022                break;
1023             default:
1024                C.pr ("(%s%V*)((unsigned long)(", root->class_name, parameters);
1025                break;
1026          }
1027      }
1028
1029       //
1030       // In the unboxed representation, the argument is embedded within
1031       // the address.
1032       //
1033       if (root->optimizations & OPTunboxed)
1034       {
1035          int tag_bits = DatatypeCompiler::max_embedded_bits;
1036          for (int i = root->unit_constructors;
1037            i >= DatatypeCompiler::max_embedded_tags; i >>= 1) tag_bits++;
1038          C.pr ("(%s *)(((unsigned long)%b<<(%i+1))|%i)",
1039                root->class_name, actuals_ty, constructor_name, TYactual,
1040                tag_bits, (1 << tag_bits));
1041       }
1042
1043       //
1044       // The usual boxed implementation
1045       //
1046       else
1047       {
1048           C.pr ("new ");
1049           switch (kind)
1050           {  case EXTERNAL_INSTANTIATION:
1051                 if (is_array)
1052                    C.pr ("(sizeof(%s%P)+sizeof(%t)*x__len_) ",
1053                       class_name, tys, cons_arg_ty, "");
1054                 C.pr ("%s%P %b", class_name, tys, actuals_ty,
1055                       constructor_name, TYactual);
1056                 break;
1057              default:
1058                 if (is_array)
1059                    C.pr ("(sizeof(%s%V)+sizeof(%t)*x__len_) ",
1060                       class_name, parameters, cons_arg_ty, "");
1061                 C.pr ("%s%V %b", class_name, parameters, actuals_ty,
1062                      constructor_name, TYactual);
1063                 break;
1064           }
1065        }
1066
1067        if (root->optimizations & OPTtaggedpointer)
1068        {  switch (kind)
1069           {  case EXTERNAL_INSTANTIATION:
1070                C.pr (")|%s%P::tag_%S)",
1071                      root->class_name, tys, constructor_name); break;
1072              default:
1073                C.pr (")|%s%V::tag_%S)",
1074                      root->class_name, parameters, constructor_name); break;
1075          }
1076        }
1077
1078        C.pr (";%-%^}\n");
1079    }
1080 }
1081
1082
1083 //////////////////////////////////////////////////////////////////////////////
1084 //
1085 //  Method to generate code before the interface
1086 //
1087 //////////////////////////////////////////////////////////////////////////////
1088 void DatatypeClass::gen_class_predefinition(CodeGen& C)
1089 {
1090
1091 #line 802 "datatype.pcc"
1092 #line 820 "datatype.pcc"
1093 {
1094    if (cons) {
1095 #line 804 "datatype.pcc"
1096     cons_arg_ty = cons->ty;
1097       C.pr("%^%/"
1098               "%^//"
1099               "%^// Class for datatype constructor %s%V::%s"
1100               "%^//"
1101               "%^%/",
1102               root->datatype_name, parameters, cons->name);
1103
1104 #line 811 "datatype.pcc"
1105    } else {
1106 #line 813 "datatype.pcc"
1107     cons_arg_ty = NOty;
1108       C.pr("%^%/"
1109            "%^//"
1110            "%^// Base class for datatype %s%V"
1111            "%^//"
1112            "%^%/",
1113            root->datatype_name, parameters);
1114
1115 #line 820 "datatype.pcc"
1116    }
1117 }
1118 #line 821 "datatype.pcc"
1119 #line 821 "datatype.pcc"
1120
1121 }
1122
1123 //////////////////////////////////////////////////////////////////////////////
1124 //
1125 // Method to generate the interface of a class
1126 //
1127 //////////////////////////////////////////////////////////////////////////////
1128 void DatatypeClass::gen_class_interface(CodeGen& C)
1129 {
1130    // Generate the internal representation
1131    // if there is a constructor descripter and the
1132    // argument is not represented in unboxed form.
1133    C.pr("%-%^public:%+");
1134
1135 #line 835 "datatype.pcc"
1136 #line 843 "datatype.pcc"
1137 {
1138    if (cons) {
1139 #line 837 "datatype.pcc"
1140     if ((cons->opt & OPTunboxed) == 0)
1141          {  C.pr ("%#%^%b\n", cons->location->begin_line, cons->location->file_name,
1142                    cons->ty, cons->name, TYbody);
1143                }
1144
1145 #line 841 "datatype.pcc"
1146    } else {}
1147 }
1148 #line 843 "datatype.pcc"
1149 #line 843 "datatype.pcc"
1150
1151
1152    DefKind kind = root->inline_methods
1153       ? INLINE_IMPLEMENTATION : INTERFACE_DEFINITION;
1154
1155    // Generate the constructor of the class
1156    if (cons != NOcons)
1157    {  gen_class_constructor(C,
1158 #line 850 "datatype.pcc"
1159 #line 850 "datatype.pcc"
1160 nil_1_
1161 #line 850 "datatype.pcc"
1162 #line 850 "datatype.pcc"
1163 , kind);
1164    }
1165
1166    // Generate the destructor of the class
1167    if ((root->qualifiers & QUALvirtualdestr) ||
1168        (qualifiers & QUALvirtualdestr) ||
1169        (cons && is_array))
1170        gen_class_destructor(C,
1171 #line 857 "datatype.pcc"
1172 #line 857 "datatype.pcc"
1173 nil_1_
1174 #line 857 "datatype.pcc"
1175 #line 857 "datatype.pcc"
1176 , kind);
1177
1178    // Generate the method declarations for all different types
1179    // of extra functionality
1180    if (root->qualifiers & QUALpersistent)  generate_persistence_interface(C);
1181    //if (root->qualifiers & QUALvariable)    generate_logic_interface(C);
1182    if (root->qualifiers & QUALcollectable) generate_gc_interface(C);
1183    if (root->qualifiers & QUALrelation)    generate_inference_interface(C);
1184 }
1185
1186 //////////////////////////////////////////////////////////////////////////////
1187 //
1188 // Method to generate the interface of a base class
1189 //
1190 //////////////////////////////////////////////////////////////////////////////
1191 void DatatypeHierarchy::gen_class_interface(CodeGen& C)
1192 {
1193    // Generate tags for arg constructors
1194    if (arg_constructors > 1)
1195    {  C.pr("%-%^public:%+");
1196       generate_constructor_tags(C,"Tag_","tag_",
1197          arg_constructors, constructor_terms + unit_constructors);
1198    }
1199
1200    // Generate a variant tag and a base class constructor for it
1201    // only if we have a variant_tag representation.
1202    if (has_variant_tag)
1203    {  C.pr("%-%^public:%+"
1204            "%^const Tag_%s tag__; // variant tag"
1205            "%-%^protected:%+"
1206            "%^inline %s(Tag_%s t__) : tag__(t__) {%&}",
1207            datatype_name, class_name, datatype_name, constructor_code
1208           );
1209    }
1210
1211    // Generate the untagging functions
1212    generate_untagging_member_functions(C);
1213
1214    DatatypeClass::gen_class_interface(C);
1215 }
1216
1217 //////////////////////////////////////////////////////////////////////////////
1218 //
1219 //  Method to generate untagging functions for a datatype class.
1220 //  Three untagging functions are generated:
1221 //      int untag() const  --- returns the variant tag of the class
1222 //      friend int untag(type * x) -- return a tag for the object x
1223 //                                    so that each variant (boxed or unboxed)
1224 //                                    gets a unique tag.
1225 //      friend int boxed(type * x) -- returns true if object is boxed.
1226 //
1227 //////////////////////////////////////////////////////////////////////////////
1228 void DatatypeHierarchy::generate_untagging_member_functions(CodeGen& C)
1229 {
1230    ///////////////////////////////////////////////////////////////////////////
1231    // Generate untagger
1232    ///////////////////////////////////////////////////////////////////////////
1233    // if (has_variant_tag)
1234    //    C.pr("%^inline int untag() const { return tag__; }");
1235 }
1236
1237 void DatatypeHierarchy::generate_untagging_functions(CodeGen& C)
1238 {
1239
1240    if (arg_constructors == 0) return;
1241
1242    ///////////////////////////////////////////////////////////////////////////
1243    // Generate boxed() predicate
1244    ///////////////////////////////////////////////////////////////////////////
1245    if (unit_constructors == 0)
1246       C.pr("%^%Hinline int boxed(const %s%V *) { return 1; }",
1247            parameters, class_name, parameters);
1248    else if (unit_constructors == 1)
1249       C.pr("%^%Hinline int boxed(const %s%V * x) { return x != 0; }",
1250            parameters, class_name, parameters);
1251    else
1252       C.pr("%^%Hinline int boxed(const %s%V * x)"
1253            " { return (unsigned long)x >= %i; }",
1254            parameters, class_name, parameters, unit_constructors);
1255
1256    ///////////////////////////////////////////////////////////////////////////
1257    // Generate function that untags the pointer if
1258    // the tags are embedded into a pointer.
1259    ///////////////////////////////////////////////////////////////////////////
1260    if (optimizations & OPTtaggedpointer)
1261    {  C.pr("%^%/"
1262            "%^//"
1263            "%^// Embbeded tag extraction functions"
1264            "%^//"
1265            "%^%/"
1266            "%^%Hinline int untagp(const %s%V * x)"
1267            "%^   { return (unsigned long)x & %i; }"
1268            "%^%Hinline %s%s%V * derefp(const %s%V * x)"
1269            "%^   { return (%s%s%V*)((unsigned long)x & ~%i); }",
1270            parameters, class_name, parameters,
1271            DatatypeCompiler::max_embedded_tags - 1,
1272            parameters,is_const,class_name, parameters, class_name, parameters,
1273            is_const, class_name, parameters,
1274            DatatypeCompiler::max_embedded_tags - 1);
1275    }
1276
1277    ///////////////////////////////////////////////////////////////////////////
1278    // Generate a generic untag function that works on all boxed
1279    // and unboxed variants.
1280    ///////////////////////////////////////////////////////////////////////////
1281    if (unit_constructors == 0) {
1282       // No unboxed variants.
1283       if (optimizations & OPTtaggedpointer)
1284          C.pr("%^%Hinline int untag(const %s%V * x) { return untagp(x); }",
1285               parameters, class_name, parameters);
1286       else if (arg_constructors == 1)
1287          C.pr("%^%Hinline int untag(const %s%V *) { return 0; }",
1288               parameters, class_name, parameters);
1289       else
1290          C.pr("%^%Hinline int untag(const %s%V * x) { return x->tag__; }",
1291               parameters, class_name, parameters);
1292    } else if (unit_constructors == 1) {
1293       // Only one unboxed variants.
1294       if (optimizations & OPTtaggedpointer)
1295          C.pr("%^%Hinline int untag(const %s%V * x) "
1296               "{ return x ? untagp(x)+1 : 0; }",
1297               parameters, class_name, parameters);
1298       else if (arg_constructors == 1)
1299          C.pr("%^%Hinline int untag(const %s%V * x) { return x ? 1 : 0; }",
1300               parameters, class_name, parameters);
1301       else
1302          C.pr("%^%Hinline int untag(const %s%V * x)"
1303               " { return x ? (x->tag__+1) : 0; }",
1304               parameters, class_name, parameters);
1305    } else {
1306       // More than one unboxed variants.
1307       if (optimizations & OPTtaggedpointer)
1308          C.pr("%^%Hinline int untag(const %s%V * x)"
1309               " { return boxed(x) ? untagp(x) + %i : (int)x; }",
1310               parameters, class_name, parameters, unit_constructors);
1311       else if (arg_constructors == 1)
1312          C.pr("%^%Hinline int untag(const %s%V * x)"
1313               " { return boxed(x) ? %i : (int)x; }",
1314               parameters, class_name, parameters, 1 + unit_constructors);
1315       else
1316          C.pr("%^%Hinline int untag(const %s%V * x)"
1317               " { return boxed(x) ? x->tag__ + %i : (int)x; }",
1318               parameters, class_name, parameters, unit_constructors);
1319    }
1320 }
1321
1322 //////////////////////////////////////////////////////////////////////////////
1323 //
1324 // Method to generate downcasting functions
1325 //
1326 //////////////////////////////////////////////////////////////////////////////
1327 void DatatypeHierarchy::generate_downcasting_functions(CodeGen& C)
1328 {
1329    C.pr("%^%/"
1330         "%^//"
1331         "%^// Downcasting functions for %s%V"
1332         "%^//"
1333         "%^%/",
1334         datatype_name, parameters);
1335    for (int i = 0; i < number_of_subclasses; i++)
1336    {  DatatypeClass * D = subclasses[i];
1337       C.pr("%^%Hinline %s%V * _%S(const %s%V * _x_) { return (%s%V *)_x_; }",
1338            parameters, D->class_name, parameters, D->constructor_name,
1339            class_name, parameters, D->class_name, parameters);
1340    }
1341 }
1342
1343 //////////////////////////////////////////////////////////////////////////////
1344 //
1345 //  Method to generate code right after the main class definition.
1346 //
1347 //////////////////////////////////////////////////////////////////////////////
1348 void DatatypeClass::gen_class_postdefinition(CodeGen& C)
1349 {
1350    C.pr("\n");
1351
1352    // Interfaces for extra features
1353    if (root->qualifiers & QUALprintable) generate_print_interface(C);
1354 }
1355
1356 //////////////////////////////////////////////////////////////////////////////
1357 //
1358 //  Method to generate code right after the main class definition.
1359 //
1360 //////////////////////////////////////////////////////////////////////////////
1361 void DatatypeHierarchy::gen_class_postdefinition(CodeGen& C)
1362 {
1363    generate_untagging_functions(C);
1364    DatatypeClass::gen_class_postdefinition(C);
1365 }
1366
1367 #line 1048 "datatype.pcc"
1368 /*
1369 ------------------------------- Statistics -------------------------------
1370 Merge matching rules         = yes
1371 Number of DFA nodes merged   = 156
1372 Number of ifs generated      = 27
1373 Number of switches generated = 14
1374 Number of labels             = 6
1375 Number of gotos              = 27
1376 Adaptive matching            = enabled
1377 Fast string matching         = disabled
1378 Inline downcasts             = enabled
1379 --------------------------------------------------------------------------
1380 */