prop-src/persistgen.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file handles persistent datatypes processing.
   4 //
   5 ///////////////////////////////////////////////////////////////////////////////
   6 #include <AD/strings/quark.h>
   7 #include "ir.ph"
   8 #include "ast.ph"
   9 #include "datagen.h"
  10 #include "type.h"
  11 #include "hashtab.h"
  12 #include "options.h"
  13 #include "datatype.ph"
  14
  15 ///////////////////////////////////////////////////////////////////////////////
  16 //
  17 //  Equality and hashing on cons/tys pairs
  18 //
  19 ///////////////////////////////////////////////////////////////////////////////
  20 unsigned int id_tys_hash(HashTable::Key a)
  21 {  Pair<Id,Tys> key = (Pair<Id,Tys>)a;
  22    return (unsigned int)key->fst + tys_hash(key->snd);
  23 }
  24 Bool id_tys_equal(HashTable::Key a, HashTable::Key b)
  25 {  Pair<Id,Tys> x = (Pair<Id,Tys>)a;
  26    Pair<Id,Tys> y = (Pair<Id,Tys>)b;
  27    return x->fst == y->fst && tys_equal(x->snd,y->snd);
  28 }
  29
  30 unsigned int pid_hash(HashTable::Key pid)
  31 {  match (Pid(pid))
  32    {  PERSISTid id:  { return string_hash(id); }
  33    |  PERSISTnone:   { return 1235; }
  34    }
  35 }
  36
  37 Bool pid_equal(HashTable::Key a, HashTable::Key b)
  38 {  match (Pid(a)) and (Pid(b))
  39    {  PERSISTid  a, PERSISTid  b: { return string_equal(a,b); }
  40    |  _,            _:            { return false; }
  41    }
  42 }
  43
  44 ///////////////////////////////////////////////////////////////////////////////
  45 //
  46 //  Global hashtables to store mapping from types to persistent Id's
  47 //  and vice versa.
  48 //
  49 ///////////////////////////////////////////////////////////////////////////////
  50 HashTable type_pid_map(id_tys_hash, id_tys_equal);
  51 HashTable pid_type_map(pid_hash, pid_equal);
  52
  53 ///////////////////////////////////////////////////////////////////////////////
  54 //
  55 //  Enter a new persistent id entry
  56 //
  57 ///////////////////////////////////////////////////////////////////////////////
  58 void update_persistent(Id id, Tys tys, Pid pid)
  59 {  Pair<Id,Tys> key = pair(id,tys);
  60    HashTable::Entry * e1 = type_pid_map.lookup((HashTable::Key)key);
  61    HashTable::Entry * e2 = pid_type_map.lookup((HashTable::Key)pid);
  62    if (e1)
  63    {  error ("%Lpersistence redefined for type %s%P\n",id,tys);
  64    }
  65    if (e2)
  66    {  Pair<Id,Tys> previous = (Pair<Id,Tys>)(e2->v);
  67       error ("%Lpersistence pid %Q already allocated for type %s%P\n",
  68              pid, previous->fst, previous->snd);
  69    }
  70    if (e1 == 0 && e2 == 0)
  71    {  type_pid_map.insert(key,(HashTable::Value)pid);
  72       pid_type_map.insert((HashTable::Key)pid,key);
  73    }
  74
  75    // add persistent qualifier to the constructor's type
  76    match (lookup_ty(id))
  77    {  DATATYPEty ({ hierarchy ... },_) | hierarchy != 0:
  78       { hierarchy->qualifiers |= QUALpersistent; }
  79    |  _: { error("%Ltype %s%P is not a datatype\n",id,tys); }
  80    }
  81 }
  82
  83 ///////////////////////////////////////////////////////////////////////////////
  84 //
  85 //  Lookup a new persistent id entry
  86 //
  87 ///////////////////////////////////////////////////////////////////////////////
  88 Pid lookup_persistent(Id id, Tys tys)
  89 {  Pair<Id,Tys> key = pair(id,tys);
  90    HashTable::Entry * e1 = type_pid_map.lookup((HashTable::Key)key);
  91    if (e1)
  92    {  return value_of(Pid, type_pid_map, e1); }
  93    else
  94    {  return PERSISTnone;
  95    }
  96 }
  97
  98 ///////////////////////////////////////////////////////////////////////////////
  99 //
 100 //  This method generates the class interface of a persistence object
 101 //
 102 ///////////////////////////////////////////////////////////////////////////////
 103 void DatatypeClass::generate_persistence_interface(CodeGen& C)
 104 {
 105    C.pr ("%^%/"
 106          "%^//"
 107          "%^// Methods for persistence and object serialization"
 108          "%^//"
 109          "%^%/"
 110          "%-%^protected:%+"
 111          "%^virtual const PObjectType& persist_type_id () const;"
 112          "%^virtual Pistream&          persist_read    (Pistream&);"
 113          "%^virtual Postream&          persist_write   (Postream&) const;"
 114          "%-%^public:%+"
 115         );
 116
 117    C.pr ("%^// Default constructor for persistence object factory"
 118          "%^%s();",
 119          class_name);
 120 }
 121
 122 ///////////////////////////////////////////////////////////////////////////////
 123 //
 124 //  This method generates the implementation of the persistent I/O functions
 125 //
 126 ///////////////////////////////////////////////////////////////////////////////
 127 void DatatypeClass::generate_persistence_implementation
 128    (CodeGen& C, Tys tys, DefKind k)
 129 {
 130    Id obj_type = DatatypeCompiler::temp_vars.new_label();
 131
 132    //
 133    // Generate a PObjectType object for this class.
 134    //
 135    Pid pid  = lookup_persistent(root->datatype_name, tys);
 136
 137    if (pid == PERSISTnone)
 138    {  error ("%Lpersist object id is undefined for %s%P\n",
 139              root->datatype_name,tys);
 140    }
 141
 142    //
 143    // Generate a default constructor for this class
 144    //
 145    C.pr("%^%s%P::%s()", class_name, tys, class_name);
 146    if (this != root && root->has_variant_tag)
 147    {  C.pr(" : %s%P(tag_%S)", root->class_name, tys, constructor_name); }
 148    C.pr("%^{%+");
 149    gen_class_constructor_body(C,tys,k);
 150    C.pr("%-%^}");
 151
 152
 153    //
 154    // Generate the object type for this class
 155    //
 156    C.pr("%^static PObjectType %s(%Q \"(%s%P::%s)\");"
 157         "%^const PObjectType& %s%P::persist_type_id() const { return %s; }",
 158         obj_type, pid, root->datatype_name, tys,
 159         (cons == NOcons ? "base_class" : constructor_name),
 160         class_name, tys, obj_type);
 161
 162    if (cons != NOcons)
 163    {  //
 164       //  Generate an object factory for this class if it is creatable.
 165       //
 166       C.pr("%^static PObjectFactory< %s%P > %s(%s);\n",
 167            class_name, tys, DatatypeCompiler::temp_vars.new_label(), obj_type);
 168    }
 169
 170    //
 171    // Generate the read method
 172    //
 173    Exp self_exp = DEREFexp(IDexp(#"this"));
 174    C.pr("%^Pistream& %s%P::persist_read(Pistream& strm__)"
 175         "%^{%+",
 176         class_name, tys);
 177    gen_super_class_persist_IO(C,tys,k,">>");
 178    if (cons != NOcons)
 179       gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,">>",true);
 180    C.pr("%^return strm__;%-%^}");
 181
 182    //
 183    // Generate the write method
 184    //
 185    C.pr("%^Postream& %s%P::persist_write(Postream& strm__) const"
 186         "%^{%+",
 187         class_name, tys);
 188    gen_super_class_persist_IO(C,tys,k,"<<");
 189    if (cons != NOcons)
 190       gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,"<<",true);
 191    C.pr("%^return strm__;%-%^}");
 192 }
 193
 194 ///////////////////////////////////////////////////////////////////////////////
 195 //
 196 //  This method generates the persistence calls I/O for superclasses
 197 //
 198 ///////////////////////////////////////////////////////////////////////////////
 199 void DatatypeClass::gen_super_class_persist_IO
 200    (CodeGen& C, Tys tys, DefKind k, Id io_op)
 201 {
 202    // Generate a call to the superclass
 203    Id rw = io_op[0] == '>' ? "read" : "write";
 204    if (this != root)
 205    {
 206       C.pr("%^%s%P::persist_%s(strm__);", root->class_name, tys, rw);
 207    }
 208
 209    // Generate a call to all the persistent superclasses
 210    for_each (Inherit, inh, inherited_classes)
 211    {  if ((inh->qualifiers & QUALpersistent) ||
 212           has_qual(QUALpersistent,inh->super_class))
 213       {  C.pr("%t::trace(strm__);",
 214               apply_ty(mkpolyty(inh->super_class,parameters),tys), "");
 215          if (this == root) root->use_persist_base = true;
 216       }
 217    }
 218 }
 219
 220 ///////////////////////////////////////////////////////////////////////////////
 221 //
 222 //  This method generates the persistence calls I/O for individual
 223 //  fields of the datatype
 224 //
 225 ///////////////////////////////////////////////////////////////////////////////
 226 void DatatypeClass::gen_field_persist_IO
 227    (CodeGen& C, Exp exp, Ty ty, Tys tys, DefKind k, Id io, Bool toplevel)
 228 {
 229    Bool is_reading = io[0] == '>';
 230
 231    match (deref(ty))
 232    {  TUPLEty types:
 233       {  int i = 1;
 234          for_each(Ty, ty, types)
 235             gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
 236       }
 237    |  EXTUPLEty types:
 238       {  int i = 1;
 239          for_each(Ty, ty, types)
 240             gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
 241       }
 242    |  RECORDty (labels, _, types):
 243       {  Ids ls; Tys ts;
 244          for(ls = labels, ts = types; ls && ts; ls = ls->#2, ts = ts->#2)
 245             gen_field_persist_IO(C,DOTexp(exp,ls->#1),ts->#1,tys,k,io);
 246       }
 247    |  ARRAYty (ty,bound):
 248       {  C.pr("%^{%+"
 249               "%^for (int i__ = 0; i__ < %e; i__++)"
 250               "%^{%+",
 251               bound);
 252          gen_field_persist_IO(C,INDEXexp(exp,IDexp(#"i__")),ty,tys,k,io);
 253          C.pr("%-%^}"
 254               "%-%^}");
 255       }
 256    |  ty:
 257       {  if (toplevel) exp = DOTexp(exp,mangle(cons->name));
 258          if (is_reading && is_datatype(ty))
 259             C.pr("%^%e = (%t)read_object(strm__);",exp,ty,"");
 260          else
 261             C.pr("%^strm__ %s %e;",io, exp, ty);
 262          C.pr(" // %T", ty);
 263       }
 264    }
 265 }