prop-src/persistgen.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 "persistgen.pcc".
   5 ///////////////////////////////////////////////////////////////////////////////
   6
   7 #define PROP_QUARK_USED
   8 #include <propdefs.h>
   9 ///////////////////////////////////////////////////////////////////////////////
  10 //  Quark literals
  11 ///////////////////////////////////////////////////////////////////////////////
  12 static const Quark _p_e_r_s_i_s_t_g_e_nco_c_c_Q2("i__");
  13 static const Quark _p_e_r_s_i_s_t_g_e_nco_c_c_Q1("this");
  14 #line 1 "persistgen.pcc"
  15 ///////////////////////////////////////////////////////////////////////////////
  16 //
  17 //  This file handles persistent datatypes processing.
  18 //
  19 ///////////////////////////////////////////////////////////////////////////////
  20 #include <AD/strings/quark.h>
  21 #include "ir.h"
  22 #include "ast.h"
  23 #include "datagen.h"
  24 #include "type.h"
  25 #include "hashtab.h"
  26 #include "options.h"
  27 #include "datatype.h"
  28
  29 ///////////////////////////////////////////////////////////////////////////////
  30 //
  31 //  Equality and hashing on cons/tys pairs
  32 //
  33 ///////////////////////////////////////////////////////////////////////////////
  34 unsigned int id_tys_hash(HashTable::Key a)
  35 {
  36 #line 21 "persistgen.pcc"
  37 a_Pair<Id, Tys> *
  38 #line 21 "persistgen.pcc"
  39  key = (a_Pair<Id, Tys> *
  40 #line 21 "persistgen.pcc"
  41 )a;
  42    return (unsigned int)key->fst + tys_hash(key->snd);
  43 }
  44 Bool id_tys_equal(HashTable::Key a, HashTable::Key b)
  45 {  a_Pair<Id, Tys> *
  46 #line 25 "persistgen.pcc"
  47  x = (a_Pair<Id, Tys> *
  48 #line 25 "persistgen.pcc"
  49 )a;
  50    a_Pair<Id, Tys> *
  51 #line 26 "persistgen.pcc"
  52  y = (a_Pair<Id, Tys> *
  53 #line 26 "persistgen.pcc"
  54 )b;
  55    return x->fst == y->fst && tys_equal(x->snd,y->snd);
  56 }
  57
  58 unsigned int pid_hash(HashTable::Key pid)
  59 {
  60 #line 33 "persistgen.pcc"
  61 {
  62    Pid _V1 = Pid(pid);
  63    if (_V1) {
  64 #line 32 "persistgen.pcc"
  65      return string_hash(_V1->PERSISTid);
  66 #line 32 "persistgen.pcc"
  67    } else {
  68 #line 33 "persistgen.pcc"
  69      return 1235;
  70 #line 33 "persistgen.pcc"
  71    }
  72 }
  73 #line 34 "persistgen.pcc"
  74 #line 34 "persistgen.pcc"
  75
  76 }
  77
  78 Bool pid_equal(HashTable::Key a, HashTable::Key b)
  79 {
  80 #line 38 "persistgen.pcc"
  81 #line 40 "persistgen.pcc"
  82 {
  83    Pid _V2 = Pid(a);
  84    Pid _V3 = Pid(b);
  85    if (_V2) {
  86       if (_V3) {
  87 #line 39 "persistgen.pcc"
  88         return string_equal(_V2->PERSISTid,_V3->PERSISTid);
  89 #line 39 "persistgen.pcc"
  90       } else {
  91          L1:;
  92 #line 40 "persistgen.pcc"
  93         return false;
  94 #line 40 "persistgen.pcc"
  95       }
  96    } else { goto L1; }
  97 }
  98 #line 41 "persistgen.pcc"
  99 #line 41 "persistgen.pcc"
 100
 101 }
 102
 103 ///////////////////////////////////////////////////////////////////////////////
 104 //
 105 //  Global hashtables to store mapping from types to persistent Id's
 106 //  and vice versa.
 107 //
 108 ///////////////////////////////////////////////////////////////////////////////
 109 HashTable type_pid_map(id_tys_hash, id_tys_equal);
 110 HashTable pid_type_map(pid_hash, pid_equal);
 111
 112 ///////////////////////////////////////////////////////////////////////////////
 113 //
 114 //  Enter a new persistent id entry
 115 //
 116 ///////////////////////////////////////////////////////////////////////////////
 117 void update_persistent(Id id, Tys tys, Pid pid)
 118 {
 119 #line 59 "persistgen.pcc"
 120 a_Pair<Id, Tys> *
 121 #line 59 "persistgen.pcc"
 122  key = pair(id,tys);
 123    HashTable::Entry * e1 = type_pid_map.lookup((HashTable::Key)key);
 124    HashTable::Entry * e2 = pid_type_map.lookup((HashTable::Key)pid);
 125    if (e1)
 126    {  error ("%Lpersistence redefined for type %s%P\n",id,tys);
 127    }
 128    if (e2)
 129    {  a_Pair<Id, Tys> *
 130 #line 66 "persistgen.pcc"
 131  previous = (a_Pair<Id, Tys> *
 132 #line 66 "persistgen.pcc"
 133 )(e2->v);
 134       error ("%Lpersistence pid %Q already allocated for type %s%P\n",
 135              pid, previous->fst, previous->snd);
 136    }
 137    if (e1 == 0 && e2 == 0)
 138    {  type_pid_map.insert(key,(HashTable::Value)pid);
 139       pid_type_map.insert((HashTable::Key)pid,key);
 140    }
 141
 142    // add persistent qualifier to the constructor's type
 143
 144 #line 79 "persistgen.pcc"
 145 {
 146    Ty _V4 = lookup_ty(id);
 147    if (_V4) {
 148       switch (_V4->tag__) {
 149          case a_Ty::tag_TYCONty: {
 150             if (boxed(((Ty_TYCONty *)_V4)->_1)) {
 151                switch (((Ty_TYCONty *)_V4)->_1->tag__) {
 152                   case a_TyCon::tag_DATATYPEtycon: {
 153                      if (
 154 #line 77 "persistgen.pcc"
 155                      (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->hierarchy != 0)
 156 #line 77 "persistgen.pcc"
 157 ) {
 158
 159 #line 78 "persistgen.pcc"
 160                        ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->hierarchy->qualifiers |= QUALpersistent;
 161 #line 78 "persistgen.pcc"
 162                      } else {
 163
 164                         L2:;
 165 #line 79 "persistgen.pcc"
 166                        error("%Ltype %s%P is not a datatype\n",id,tys);
 167 #line 79 "persistgen.pcc"
 168                      }
 169                      } break;
 170                   default: { goto L2; } break;
 171                }
 172             } else { goto L2; }
 173             } break;
 174          default: { goto L2; } break;
 175       }
 176    } else { goto L2; }
 177 }
 178 #line 80 "persistgen.pcc"
 179 #line 80 "persistgen.pcc"
 180
 181 }
 182
 183 ///////////////////////////////////////////////////////////////////////////////
 184 //
 185 //  Lookup a new persistent id entry
 186 //
 187 ///////////////////////////////////////////////////////////////////////////////
 188 Pid lookup_persistent(Id id, Tys tys)
 189 {
 190 #line 89 "persistgen.pcc"
 191 a_Pair<Id, Tys> *
 192 #line 89 "persistgen.pcc"
 193  key = pair(id,tys);
 194    HashTable::Entry * e1 = type_pid_map.lookup((HashTable::Key)key);
 195    if (e1)
 196    {  return value_of(Pid, type_pid_map, e1); }
 197    else
 198    {  return PERSISTnone;
 199    }
 200 }
 201
 202 ///////////////////////////////////////////////////////////////////////////////
 203 //
 204 //  This method generates the class interface of a persistence object
 205 //
 206 ///////////////////////////////////////////////////////////////////////////////
 207 void DatatypeClass::generate_persistence_interface(CodeGen& C)
 208 {
 209    C.pr ("%^%/"
 210          "%^//"
 211          "%^// Methods for persistence and object serialization"
 212          "%^//"
 213          "%^%/"
 214          "%-%^protected:%+"
 215          "%^virtual const PObjectType& persist_type_id () const;"
 216          "%^virtual Pistream&          persist_read    (Pistream&);"
 217          "%^virtual Postream&          persist_write   (Postream&) const;"
 218          "%-%^public:%+"
 219         );
 220
 221    C.pr ("%^// Default constructor for persistence object factory"
 222          "%^%s();",
 223          class_name);
 224 }
 225
 226 ///////////////////////////////////////////////////////////////////////////////
 227 //
 228 //  This method generates the implementation of the persistent I/O functions
 229 //
 230 ///////////////////////////////////////////////////////////////////////////////
 231 void DatatypeClass::generate_persistence_implementation
 232    (CodeGen& C, Tys tys, DefKind k)
 233 {
 234    Id obj_type = DatatypeCompiler::temp_vars.new_label();
 235
 236    //
 237    // Generate a PObjectType object for this class.
 238    //
 239    Pid pid  = lookup_persistent(root->datatype_name, tys);
 240
 241    if (pid == PERSISTnone)
 242    {  error ("%Lpersist object id is undefined for %s%P\n",
 243              root->datatype_name,tys);
 244    }
 245
 246    //
 247    // Generate a default constructor for this class
 248    //
 249    C.pr("%^%s%P::%s()", class_name, tys, class_name);
 250    if (this != root && root->has_variant_tag)
 251    {  C.pr(" : %s%P(tag_%S)", root->class_name, tys, constructor_name); }
 252    C.pr("%^{%+");
 253    gen_class_constructor_body(C,tys,k);
 254    C.pr("%-%^}");
 255
 256
 257    //
 258    // Generate the object type for this class
 259    //
 260    C.pr("%^static PObjectType %s(%Q \"(%s%P::%s)\");"
 261         "%^const PObjectType& %s%P::persist_type_id() const { return %s; }",
 262         obj_type, pid, root->datatype_name, tys,
 263         (cons == NOcons ? "base_class" : constructor_name),
 264         class_name, tys, obj_type);
 265
 266    if (cons != NOcons)
 267    {  //
 268       //  Generate an object factory for this class if it is creatable.
 269       //
 270       C.pr("%^static PObjectFactory< %s%P > %s(%s);\n",
 271            class_name, tys, DatatypeCompiler::temp_vars.new_label(), obj_type);
 272    }
 273
 274    //
 275    // Generate the read method
 276    //
 277    Exp self_exp = DEREFexp(IDexp(
 278 #line 173 "persistgen.pcc"
 279 _p_e_r_s_i_s_t_g_e_nco_c_c_Q1
 280 #line 173 "persistgen.pcc"
 281 #line 173 "persistgen.pcc"
 282 ));
 283    C.pr("%^Pistream& %s%P::persist_read(Pistream& strm__)"
 284         "%^{%+",
 285         class_name, tys);
 286    gen_super_class_persist_IO(C,tys,k,">>");
 287    if (cons != NOcons)
 288       gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,">>",true);
 289    C.pr("%^return strm__;%-%^}");
 290
 291    //
 292    // Generate the write method
 293    //
 294    C.pr("%^Postream& %s%P::persist_write(Postream& strm__) const"
 295         "%^{%+",
 296         class_name, tys);
 297    gen_super_class_persist_IO(C,tys,k,"<<");
 298    if (cons != NOcons)
 299       gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,"<<",true);
 300    C.pr("%^return strm__;%-%^}");
 301 }
 302
 303 ///////////////////////////////////////////////////////////////////////////////
 304 //
 305 //  This method generates the persistence calls I/O for superclasses
 306 //
 307 ///////////////////////////////////////////////////////////////////////////////
 308 void DatatypeClass::gen_super_class_persist_IO
 309    (CodeGen& C, Tys tys, DefKind k, Id io_op)
 310 {
 311    // Generate a call to the superclass
 312    Id rw = io_op[0] == '>' ? "read" : "write";
 313    if (this != root)
 314    {
 315       C.pr("%^%s%P::persist_%s(strm__);", root->class_name, tys, rw);
 316    }
 317
 318    // Generate a call to all the persistent superclasses
 319    for_each (Inherit, inh, inherited_classes)
 320    {  if ((inh->qualifiers & QUALpersistent) ||
 321           has_qual(QUALpersistent,inh->super_class))
 322       {  C.pr("%t::trace(strm__);",
 323               apply_ty(mkpolyty(inh->super_class,parameters),tys), "");
 324          if (this == root) root->use_persist_base = true;
 325       }
 326    }
 327 }
 328
 329 ///////////////////////////////////////////////////////////////////////////////
 330 //
 331 //  This method generates the persistence calls I/O for individual
 332 //  fields of the datatype
 333 //
 334 ///////////////////////////////////////////////////////////////////////////////
 335 void DatatypeClass::gen_field_persist_IO
 336    (CodeGen& C, Exp exp, Ty ty, Tys tys, DefKind k, Id io, Bool toplevel)
 337 {
 338    Bool is_reading = io[0] == '>';
 339
 340
 341 #line 231 "persistgen.pcc"
 342 #line 263 "persistgen.pcc"
 343 {
 344    Ty _V5 = deref(ty);
 345    if (_V5) {
 346       switch (_V5->tag__) {
 347          case a_Ty::tag_TYCONty: {
 348             if (boxed(((Ty_TYCONty *)_V5)->_1)) {
 349                switch (((Ty_TYCONty *)_V5)->_1->tag__) {
 350                   case a_TyCon::tag_RECORDtycon: {
 351 #line 243 "persistgen.pcc"
 352                    Ids ls; Tys ts;
 353                          for(ls = ((TyCon_RECORDtycon *)((Ty_TYCONty *)_V5)->_1)->_1, ts = ((Ty_TYCONty *)_V5)->_2; ls && ts; ls = ls->_2, ts = ts->_2)
 354                                  gen_field_persist_IO(C,DOTexp(exp,ls->_1),ts->_1,tys,k,io);
 355
 356 #line 246 "persistgen.pcc"
 357                      } break;
 358                   case a_TyCon::tag_ARRAYtycon: {
 359                      if (((Ty_TYCONty *)_V5)->_2) {
 360                         if (((Ty_TYCONty *)_V5)->_2->_2) {
 361                            L3:;
 362 #line 257 "persistgen.pcc"
 363                          if (toplevel) exp = DOTexp(exp,mangle(cons->name));
 364                                  if (is_reading && is_datatype(_V5))
 365                                     C.pr("%^%e = (%t)read_object(strm__);",exp,_V5,"");
 366                                     else
 367                                     C.pr("%^strm__ %s %e;",io, exp, _V5);
 368                                     C.pr(" // %T", _V5);
 369
 370 #line 263 "persistgen.pcc"
 371                         } else {
 372 #line 248 "persistgen.pcc"
 373                          C.pr("%^{%+"
 374                                       "%^for (int i__ = 0; i__ < %e; i__++)"
 375                                       "%^{%+",
 376                                       ((TyCon_ARRAYtycon *)((Ty_TYCONty *)_V5)->_1)->ARRAYtycon);
 377                                     gen_field_persist_IO(C,INDEXexp(exp,IDexp(
 378 #line 252 "persistgen.pcc"
 379 #line 252 "persistgen.pcc"
 380                            _p_e_r_s_i_s_t_g_e_nco_c_c_Q2
 381 #line 252 "persistgen.pcc"
 382 #line 252 "persistgen.pcc"
 383                            )),((Ty_TYCONty *)_V5)->_2->_1,tys,k,io);
 384                                  C.pr("%-%^}"
 385                                       "%-%^}");
 386
 387 #line 255 "persistgen.pcc"
 388                         }
 389                      } else { goto L3; }
 390                      } break;
 391                   default: { goto L3; } break;
 392                }
 393             } else {
 394                switch ((int)((Ty_TYCONty *)_V5)->_1) {
 395                   case ((int)TUPLEtycon): {
 396 #line 233 "persistgen.pcc"
 397                    int i = 1;
 398                          for_each(Ty, ty, ((Ty_TYCONty *)_V5)->_2)
 399                                  gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
 400
 401 #line 236 "persistgen.pcc"
 402                      } break;
 403                   case ((int)EXTUPLEtycon): {
 404 #line 238 "persistgen.pcc"
 405                    int i = 1;
 406                          for_each(Ty, ty, ((Ty_TYCONty *)_V5)->_2)
 407                                  gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
 408
 409 #line 241 "persistgen.pcc"
 410                      } break;
 411                   default: { goto L3; } break;
 412                }
 413             }
 414             } break;
 415          default: { goto L3; } break;
 416       }
 417    } else { goto L3; }
 418 }
 419 #line 264 "persistgen.pcc"
 420 #line 264 "persistgen.pcc"
 421
 422 }
 423 #line 266 "persistgen.pcc"
 424 /*
 425 ------------------------------- Statistics -------------------------------
 426 Merge matching rules         = yes
 427 Number of DFA nodes merged   = 50
 428 Number of ifs generated      = 10
 429 Number of switches generated = 5
 430 Number of labels             = 3
 431 Number of gotos              = 10
 432 Adaptive matching            = enabled
 433 Fast string matching         = disabled
 434 Inline downcasts             = enabled
 435 --------------------------------------------------------------------------
 436 */