1 ///////////////////////////////////////////////////////////////////////////////
3 // This file handles persistent datatypes processing.
5 ///////////////////////////////////////////////////////////////////////////////
6 #include <AD/strings/quark.h>
13 #include "datatype.ph"
15 ///////////////////////////////////////////////////////////////////////////////
17 // Equality and hashing on cons/tys pairs
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);
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);
30 unsigned int pid_hash(HashTable::Key pid)
32 { PERSISTid id: { return string_hash(id); }
33 | PERSISTnone: { return 1235; }
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; }
44 ///////////////////////////////////////////////////////////////////////////////
46 // Global hashtables to store mapping from types to persistent Id's
49 ///////////////////////////////////////////////////////////////////////////////
50 HashTable type_pid_map(id_tys_hash, id_tys_equal);
51 HashTable pid_type_map(pid_hash, pid_equal);
53 ///////////////////////////////////////////////////////////////////////////////
55 // Enter a new persistent id entry
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);
63 { error ("%Lpersistence redefined for type %s%P\n",id,tys);
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);
70 if (e1 == 0 && e2 == 0)
71 { type_pid_map.insert(key,(HashTable::Value)pid);
72 pid_type_map.insert((HashTable::Key)pid,key);
75 // add persistent qualifier to the constructor's type
77 { DATATYPEty ({ hierarchy ... },_) | hierarchy != 0:
78 { hierarchy->qualifiers |= QUALpersistent; }
79 | _: { error("%Ltype %s%P is not a datatype\n",id,tys); }
83 ///////////////////////////////////////////////////////////////////////////////
85 // Lookup a new persistent id entry
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);
92 { return value_of(Pid, type_pid_map, e1); }
98 ///////////////////////////////////////////////////////////////////////////////
100 // This method generates the class interface of a persistence object
102 ///////////////////////////////////////////////////////////////////////////////
103 void DatatypeClass::generate_persistence_interface(CodeGen& C)
107 "%^// Methods for persistence and object serialization"
111 "%^virtual const PObjectType& persist_type_id () const;"
112 "%^virtual Pistream& persist_read (Pistream&);"
113 "%^virtual Postream& persist_write (Postream&) const;"
117 C.pr ("%^// Default constructor for persistence object factory"
122 ///////////////////////////////////////////////////////////////////////////////
124 // This method generates the implementation of the persistent I/O functions
126 ///////////////////////////////////////////////////////////////////////////////
127 void DatatypeClass::generate_persistence_implementation
128 (CodeGen& C, Tys tys, DefKind k)
130 Id obj_type = DatatypeCompiler::temp_vars.new_label();
133 // Generate a PObjectType object for this class.
135 Pid pid = lookup_persistent(root->datatype_name, tys);
137 if (pid == PERSISTnone)
138 { error ("%Lpersist object id is undefined for %s%P\n",
139 root->datatype_name,tys);
143 // Generate a default constructor for this class
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); }
149 gen_class_constructor_body(C,tys,k);
154 // Generate the object type for this class
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);
164 // Generate an object factory for this class if it is creatable.
166 C.pr("%^static PObjectFactory< %s%P > %s(%s);\n",
167 class_name, tys, DatatypeCompiler::temp_vars.new_label(), obj_type);
171 // Generate the read method
173 Exp self_exp = DEREFexp(IDexp(#"this"));
174 C.pr("%^Pistream& %s%P::persist_read(Pistream& strm__)"
177 gen_super_class_persist_IO(C,tys,k,">>");
179 gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,">>",true);
180 C.pr("%^return strm__;%-%^}");
183 // Generate the write method
185 C.pr("%^Postream& %s%P::persist_write(Postream& strm__) const"
188 gen_super_class_persist_IO(C,tys,k,"<<");
190 gen_field_persist_IO(C,self_exp,cons_arg_ty,tys,k,"<<",true);
191 C.pr("%^return strm__;%-%^}");
194 ///////////////////////////////////////////////////////////////////////////////
196 // This method generates the persistence calls I/O for superclasses
198 ///////////////////////////////////////////////////////////////////////////////
199 void DatatypeClass::gen_super_class_persist_IO
200 (CodeGen& C, Tys tys, DefKind k, Id io_op)
202 // Generate a call to the superclass
203 Id rw = io_op[0] == '>' ? "read" : "write";
206 C.pr("%^%s%P::persist_%s(strm__);", root->class_name, tys, rw);
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;
220 ///////////////////////////////////////////////////////////////////////////////
222 // This method generates the persistence calls I/O for individual
223 // fields of the datatype
225 ///////////////////////////////////////////////////////////////////////////////
226 void DatatypeClass::gen_field_persist_IO
227 (CodeGen& C, Exp exp, Ty ty, Tys tys, DefKind k, Id io, Bool toplevel)
229 Bool is_reading = io[0] == '>';
234 for_each(Ty, ty, types)
235 gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
239 for_each(Ty, ty, types)
240 gen_field_persist_IO(C,DOTexp(exp,index_of(i++)),ty,tys,k,io);
242 | RECORDty (labels, _, types):
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);
247 | ARRAYty (ty,bound):
249 "%^for (int i__ = 0; i__ < %e; i__++)"
252 gen_field_persist_IO(C,INDEXexp(exp,IDexp(#"i__")),ty,tys,k,io);
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,"");
261 C.pr("%^strm__ %s %e;",io, exp, ty);