compiler/cpp/src/generate/t_ocaml_generator.cc

   1 // Copyright (c) 2006- Facebook
   2 // Distributed under the Thrift Software License
   3 //
   4 // See accompanying file LICENSE or visit the Thrift site at:
   5 // http://developers.facebook.com/thrift/
   6
   7 #include <stdlib.h>
   8 #include <sys/stat.h>
   9 #include <sys/types.h>
  10 #include <sstream>
  11 #include "t_ocaml_generator.h"
  12 #include "platform.h"
  13 using namespace std;
  14
  15 /*
  16  * This is necessary because we want typedefs to appear later,
  17  * after all the types have been declared.
  18  */
  19 void t_ocaml_generator::generate_program() {
  20   // Initialize the generator
  21   init_generator();
  22
  23   // Generate enums
  24   vector<t_enum*> enums = program_->get_enums();
  25   vector<t_enum*>::iterator en_iter;
  26   for (en_iter = enums.begin(); en_iter != enums.end(); ++en_iter) {
  27     generate_enum(*en_iter);
  28   }
  29
  30   // Generate structs
  31   vector<t_struct*> structs = program_->get_structs();
  32   vector<t_struct*>::iterator st_iter;
  33   for (st_iter = structs.begin(); st_iter != structs.end(); ++st_iter) {
  34     generate_struct(*st_iter);
  35   }
  36
  37   // Generate xceptions
  38   vector<t_struct*> xceptions = program_->get_xceptions();
  39   vector<t_struct*>::iterator x_iter;
  40   for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
  41     generate_xception(*x_iter);
  42   }
  43
  44   // Generate typedefs
  45   vector<t_typedef*> typedefs = program_->get_typedefs();
  46   vector<t_typedef*>::iterator td_iter;
  47   for (td_iter = typedefs.begin(); td_iter != typedefs.end(); ++td_iter) {
  48     generate_typedef(*td_iter);
  49   }
  50
  51   // Generate services
  52   vector<t_service*> services = program_->get_services();
  53   vector<t_service*>::iterator sv_iter;
  54   for (sv_iter = services.begin(); sv_iter != services.end(); ++sv_iter) {
  55     service_name_ = get_service_name(*sv_iter);
  56     generate_service(*sv_iter);
  57   }
  58
  59   // Generate constants
  60   vector<t_const*> consts = program_->get_consts();
  61   generate_consts(consts);
  62
  63   // Close the generator
  64   close_generator();
  65 }
  66
  67
  68 /**
  69  * Prepares for file generation by opening up the necessary file output
  70  * streams.
  71  *
  72  * @param tprogram The program to generate
  73  */
  74 void t_ocaml_generator::init_generator() {
  75   // Make output directory
  76   MKDIR(get_out_dir().c_str());
  77
  78   // Make output file
  79   string f_types_name = get_out_dir()+program_name_+"_types.ml";
  80   f_types_.open(f_types_name.c_str());
  81   string f_types_i_name = get_out_dir()+program_name_+"_types.mli";
  82   f_types_i_.open(f_types_i_name.c_str());
  83
  84   string f_consts_name = get_out_dir()+program_name_+"_consts.ml";
  85   f_consts_.open(f_consts_name.c_str());
  86
  87   // Print header
  88   f_types_ <<
  89     ocaml_autogen_comment() << endl <<
  90     ocaml_imports() << endl;
  91   f_types_i_ <<
  92     ocaml_autogen_comment() << endl <<
  93     ocaml_imports() << endl;
  94   f_consts_ <<
  95     ocaml_autogen_comment() << endl <<
  96     ocaml_imports() << endl <<
  97     "open " << capitalize(program_name_)<<"_types"<< endl;
  98 }
  99
 100
 101 /**
 102  * Autogen'd comment
 103  */
 104 string t_ocaml_generator::ocaml_autogen_comment() {
 105   return
 106     std::string("(*\n") +
 107     " Autogenerated by Thrift\n" +
 108     "\n" +
 109     " DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING\n" +
 110     "*)\n";
 111 }
 112
 113 /**
 114  * Prints standard thrift imports
 115  */
 116 string t_ocaml_generator::ocaml_imports() {
 117   return "open Thrift";
 118 }
 119
 120 /**
 121  * Closes the type files
 122  */
 123 void t_ocaml_generator::close_generator() {
 124   // Close types file
 125   f_types_.close();
 126 }
 127
 128 /**
 129  * Generates a typedef. Ez.
 130  *
 131  * @param ttypedef The type definition
 132  */
 133 void t_ocaml_generator::generate_typedef(t_typedef* ttypedef) {
 134   f_types_ <<
 135     indent() << "type "<< decapitalize(ttypedef->get_symbolic()) << " = " << render_ocaml_type(ttypedef->get_type()) << endl << endl;
 136   f_types_i_ <<
 137     indent() << "type "<< decapitalize(ttypedef->get_symbolic()) << " = " << render_ocaml_type(ttypedef->get_type()) << endl << endl;
 138 }
 139
 140 /**
 141  * Generates code for an enumerated type.
 142  * the values.
 143  *
 144  * @param tenum The enumeration
 145  */
 146 void t_ocaml_generator::generate_enum(t_enum* tenum) {
 147   indent(f_types_) << "module " << capitalize(tenum->get_name()) << " = " << endl << "struct" << endl;
 148   indent(f_types_i_) << "module " << capitalize(tenum->get_name()) << " : " << endl << "sig" << endl;
 149   indent_up();
 150   indent(f_types_) << "type t = " << endl;
 151   indent(f_types_i_) << "type t = " << endl;
 152   indent_up();
 153   vector<t_enum_value*> constants = tenum->get_constants();
 154   vector<t_enum_value*>::iterator c_iter;
 155   int value = -1;
 156   for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 157     string name = capitalize((*c_iter)->get_name());
 158     indent(f_types_) << "| " << name << endl;
 159     indent(f_types_i_) << "| " << name << endl;
 160   }
 161   indent_down();
 162
 163   indent(f_types_) << "let to_i = function" << endl;
 164   indent(f_types_i_) << "val to_i : t -> int" << endl;
 165   indent_up();
 166   for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 167     if ((*c_iter)->has_value()) {
 168       value = (*c_iter)->get_value();
 169     } else {
 170       ++value;
 171     }
 172     string name = capitalize((*c_iter)->get_name());
 173
 174     f_types_ <<
 175       indent() << "| " << name << " -> " << value << endl;
 176   }
 177   indent_down();
 178
 179   indent(f_types_) << "let of_i = function" << endl;
 180   indent(f_types_i_) << "val of_i : int -> t" << endl;
 181   indent_up();
 182   for(c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 183     if ((*c_iter)->has_value()) {
 184       value = (*c_iter)->get_value();
 185     } else {
 186       ++value;
 187     }
 188     string name = capitalize((*c_iter)->get_name());
 189
 190     f_types_ <<
 191       indent() << "| " << value << " -> " << name << endl;
 192   }
 193   indent(f_types_) << "| _ -> raise Thrift_error" << endl;
 194   indent_down();
 195   indent_down();
 196   indent(f_types_) << "end" << endl;
 197   indent(f_types_i_) << "end" << endl;
 198 }
 199
 200 /**
 201  * Generate a constant value
 202  */
 203 void t_ocaml_generator::generate_const(t_const* tconst) {
 204   t_type* type = tconst->get_type();
 205   string name = decapitalize(tconst->get_name());
 206   t_const_value* value = tconst->get_value();
 207
 208   indent(f_consts_) << "let " << name << " = " << render_const_value(type, value) << endl << endl;
 209 }
 210
 211 /**
 212  * Prints the value of a constant with the given type. Note that type checking
 213  * is NOT performed in this function as it is always run beforehand using the
 214  * validate_types method in main.cc
 215  */
 216 string t_ocaml_generator::render_const_value(t_type* type, t_const_value* value) {
 217   std::ostringstream out;
 218   if (type->is_base_type()) {
 219     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
 220     switch (tbase) {
 221     case t_base_type::TYPE_STRING:
 222       out << "\"" << value->get_string() << "\"";
 223       break;
 224     case t_base_type::TYPE_BOOL:
 225       out << (value->get_integer() > 0 ? "true" : "false");
 226       break;
 227     case t_base_type::TYPE_BYTE:
 228     case t_base_type::TYPE_I16:
 229     case t_base_type::TYPE_I32:
 230       out << value->get_integer();
 231       break;
 232     case t_base_type::TYPE_I64:
 233       out << value->get_integer() << "L";
 234       break;
 235     case t_base_type::TYPE_DOUBLE:
 236       if (value->get_type() == t_const_value::CV_INTEGER) {
 237         out << value->get_integer();
 238       } else {
 239         out << value->get_double();
 240       }
 241       break;
 242     default:
 243       throw "compiler error: no const of base type " + t_base_type::t_base_name(tbase);
 244     }
 245   } else if (type->is_enum()) {
 246     t_enum* tenum = (t_enum*)type;
 247     vector<t_enum_value*> constants = tenum->get_constants();
 248     vector<t_enum_value*>::iterator c_iter;
 249     int val = -1;
 250     for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 251       if ((*c_iter)->has_value()) {
 252         val = (*c_iter)->get_value();
 253       } else {
 254         ++val;
 255       }
 256       if(val == value->get_integer()){
 257         indent(out) << capitalize(tenum->get_name()) << "." << capitalize((*c_iter)->get_name());
 258         break;
 259       }
 260     }
 261   } else if (type->is_struct() || type->is_xception()) {
 262     string cname = type_name(type);
 263     string ct = tmp("_c");
 264     out << endl;
 265     indent_up();
 266     indent(out) << "(let " << ct << " = new " << cname << " in" << endl;
 267     indent_up();
 268     const vector<t_field*>& fields = ((t_struct*)type)->get_members();
 269     vector<t_field*>::const_iterator f_iter;
 270     const map<t_const_value*, t_const_value*>& val = value->get_map();
 271     map<t_const_value*, t_const_value*>::const_iterator v_iter;
 272     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 273       t_type* field_type = NULL;
 274       for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 275         if ((*f_iter)->get_name() == v_iter->first->get_string()) {
 276           field_type = (*f_iter)->get_type();
 277         }
 278       }
 279       if (field_type == NULL) {
 280         throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string();
 281       }
 282       string fname = v_iter->first->get_string();
 283       out << indent();
 284       out << ct <<"#set_" << fname << " ";
 285       out << render_const_value(field_type, v_iter->second);
 286       out << ";" << endl;
 287     }
 288     indent(out) << ct << ")";
 289     indent_down();
 290     indent_down();
 291   } else if (type->is_map()) {
 292     t_type* ktype = ((t_map*)type)->get_key_type();
 293     t_type* vtype = ((t_map*)type)->get_val_type();
 294     const map<t_const_value*, t_const_value*>& val = value->get_map();
 295     map<t_const_value*, t_const_value*>::const_iterator v_iter;
 296     string hm = tmp("_hm");
 297     out << endl;
 298     indent_up();
 299     indent(out) << "(let " << hm << " = Hashtbl.create " << val.size() << " in" << endl;
 300     indent_up();
 301     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 302       string key = render_const_value(ktype, v_iter->first);
 303       string val = render_const_value(vtype, v_iter->second);
 304       indent(out) << "Hashtbl.add " << hm << " " << key << " " << val << ";" << endl;
 305     }
 306     indent(out) << hm << ")";
 307     indent_down();
 308     indent_down();
 309   } else if (type->is_list()) {
 310     t_type* etype;
 311     etype = ((t_list*)type)->get_elem_type();
 312     out << "[" << endl;
 313     indent_up();
 314     const vector<t_const_value*>& val = value->get_list();
 315     vector<t_const_value*>::const_iterator v_iter;
 316     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 317       out << indent();
 318       out << render_const_value(etype, *v_iter);
 319       out << ";" << endl;
 320     }
 321     indent_down();
 322     indent(out) << "]";
 323   } else if (type->is_set()) {
 324     t_type* etype = ((t_set*)type)->get_elem_type();
 325     const vector<t_const_value*>& val = value->get_list();
 326     vector<t_const_value*>::const_iterator v_iter;
 327     string hm = tmp("_hm");
 328     indent(out) << "(let " << hm << " = Hashtbl.create " << val.size() << " in" << endl;
 329     indent_up();
 330     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 331       string val = render_const_value(etype, *v_iter);
 332       indent(out) << "Hashtbl.add " << hm << " " << val << " true;" << endl;
 333     }
 334     indent(out) << hm << ")" << endl;
 335     indent_down();
 336     out << endl;
 337   }
 338   return out.str();
 339 }
 340
 341 /**
 342  * Generates a "struct"
 343  */
 344 void t_ocaml_generator::generate_struct(t_struct* tstruct) {
 345   generate_ocaml_struct(tstruct, false);
 346 }
 347
 348 /**
 349  * Generates a struct definition for a thrift exception. Basically the same
 350  * as a struct, but also has an exception declaration.
 351  *
 352  * @param txception The struct definition
 353  */
 354 void t_ocaml_generator::generate_xception(t_struct* txception) {
 355   generate_ocaml_struct(txception, true);
 356 }
 357
 358 /**
 359  * Generates an OCaml struct
 360  */
 361 void t_ocaml_generator::generate_ocaml_struct(t_struct* tstruct,
 362                                               bool is_exception) {
 363   generate_ocaml_struct_definition(f_types_, tstruct, is_exception);
 364   generate_ocaml_struct_sig(f_types_i_,tstruct,is_exception);
 365 }
 366
 367 /**
 368  * Generates a struct definition for a thrift data type.
 369  *
 370  * @param tstruct The struct definition
 371  */
 372 void t_ocaml_generator::generate_ocaml_struct_definition(ofstream& out,
 373                                                          t_struct* tstruct,
 374                                                          bool is_exception) {
 375   const vector<t_field*>& members = tstruct->get_members();
 376   vector<t_field*>::const_iterator m_iter;
 377   string tname = type_name(tstruct);
 378   indent(out) << "class " << tname << " =" << endl;
 379   indent(out) << "object (self)" << endl;
 380
 381   indent_up();
 382
 383   string x = tmp("_x");
 384   if (members.size() > 0) {
 385     for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
 386       string mname = decapitalize((*m_iter)->get_name());
 387       indent(out) << "val mutable _" << mname << " : " << render_ocaml_type((*m_iter)->get_type()) << " option = None" << endl;
 388       indent(out) << "method get_" << mname << " = _" << mname << endl;
 389       indent(out) << "method grab_" << mname << " = match _"<<mname<<" with None->raise (Field_empty \""<<tname<<"."<<mname<<"\") | Some " << x <<" -> " << x << endl;
 390       indent(out) << "method set_" << mname << " " << x << " = _" << mname << " <- Some " << x << endl;
 391     }
 392   }
 393   generate_ocaml_struct_writer(out, tstruct);
 394   indent_down();
 395   indent(out) << "end" << endl;
 396
 397   if(is_exception){
 398     indent(out) << "exception " << capitalize(tname) <<" of " << tname << endl;
 399   }
 400
 401   generate_ocaml_struct_reader(out, tstruct);
 402 }
 403
 404 /**
 405  * Generates a struct definition for a thrift data type.
 406  *
 407  * @param tstruct The struct definition
 408  */
 409 void t_ocaml_generator::generate_ocaml_struct_sig(ofstream& out,
 410                                                   t_struct* tstruct,
 411                                                   bool is_exception) {
 412   const vector<t_field*>& members = tstruct->get_members();
 413   vector<t_field*>::const_iterator m_iter;
 414   string tname = type_name(tstruct);
 415   indent(out) << "class " << tname << " :" << endl;
 416   indent(out) << "object" << endl;
 417
 418   indent_up();
 419
 420   string x = tmp("_x");
 421   if (members.size() > 0) {
 422     for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
 423       string mname = decapitalize((*m_iter)->get_name());
 424       string type = render_ocaml_type((*m_iter)->get_type());
 425       indent(out) << "method get_" << mname << " : " << type << " option" << endl;
 426       indent(out) << "method grab_" << mname << " : " << type << endl;
 427       indent(out) << "method set_" << mname << " : " << type << " -> unit" << endl;
 428     }
 429   }
 430   indent(out) << "method write : Protocol.t -> unit" << endl;
 431   indent_down();
 432   indent(out) << "end" << endl;
 433
 434   if(is_exception){
 435     indent(out) << "exception " << capitalize(tname) <<" of " << tname << endl;
 436   }
 437
 438   indent(out) << "val read_" << tname << " : Protocol.t -> " << tname << endl;
 439 }
 440
 441 /**
 442  * Generates the read method for a struct
 443  */
 444 void t_ocaml_generator::generate_ocaml_struct_reader(ofstream& out, t_struct* tstruct) {
 445   const vector<t_field*>& fields = tstruct->get_members();
 446   vector<t_field*>::const_iterator f_iter;
 447   string sname = type_name(tstruct);
 448   string str = tmp("_str");
 449   string t = tmp("_t");
 450   string id = tmp("_id");
 451   indent(out) <<
 452     "let rec read_" << sname << " (iprot : Protocol.t) =" << endl;
 453   indent_up();
 454   indent(out) << "let " << str << " = new " << sname << " in" << endl;
 455   indent_up();
 456   indent(out) <<
 457     "ignore(iprot#readStructBegin);" << endl;
 458
 459   // Loop over reading in fields
 460   indent(out) <<
 461     "(try while true do" << endl;
 462   indent_up();
 463   indent_up();
 464
 465   // Read beginning field marker
 466   indent(out) <<
 467     "let (_," << t <<","<<id<<") = iprot#readFieldBegin in" << endl;
 468
 469   // Check for field STOP marker and break
 470   indent(out) <<
 471     "if " << t <<" = Protocol.T_STOP then" << endl;
 472   indent_up();
 473   indent(out) <<
 474       "raise Break" << endl;
 475     indent_down();
 476     indent(out) << "else ();" << endl;
 477
 478     indent(out) << "(match " << id<<" with " << endl;
 479     indent_up();
 480     // Generate deserialization code for known cases
 481     for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 482       indent(out) << "| " << (*f_iter)->get_key() << " -> (";
 483       out << "if " << t <<" = " << type_to_enum((*f_iter)->get_type()) << " then" << endl;
 484       indent_up();
 485       indent_up();
 486       generate_deserialize_field(out, *f_iter,str);
 487       indent_down();
 488       out <<
 489         indent() << "else" << endl <<
 490         indent() << "  iprot#skip "<< t << ")" << endl;
 491       indent_down();
 492     }
 493
 494     // In the default case we skip the field
 495     out <<
 496       indent() << "| _ -> " << "iprot#skip "<<t<<");" << endl;
 497     indent_down();
 498     // Read field end marker
 499     indent(out) << "iprot#readFieldEnd;" << endl;
 500     indent_down();
 501     indent(out) << "done; ()" << endl;
 502     indent_down();
 503     indent(out) << "with Break -> ());" << endl;
 504
 505     indent(out) <<
 506       "iprot#readStructEnd;" << endl;
 507
 508     indent(out) << str << endl << endl;
 509     indent_down();
 510     indent_down();
 511 }
 512
 513 void t_ocaml_generator::generate_ocaml_struct_writer(ofstream& out,
 514                                                t_struct* tstruct) {
 515   string name = tstruct->get_name();
 516   const vector<t_field*>& fields = tstruct->get_members();
 517   vector<t_field*>::const_iterator f_iter;
 518   string str = tmp("_str");
 519   string f = tmp("_f");
 520
 521   indent(out) <<
 522     "method write (oprot : Protocol.t) =" << endl;
 523   indent_up();
 524   indent(out) <<
 525     "oprot#writeStructBegin \""<<name<<"\";" << endl;
 526
 527   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 528     // Write field header
 529     string mname = "_"+decapitalize((*f_iter)->get_name());
 530     indent(out) <<
 531       "(match " << mname << " with None -> () | Some _v -> " << endl;
 532     indent_up();
 533     indent(out) << "oprot#writeFieldBegin(\""<< (*f_iter)->get_name()<<"\","
 534                 <<type_to_enum((*f_iter)->get_type())<<","
 535                 <<(*f_iter)->get_key()<<");" << endl;
 536
 537     // Write field contents
 538     generate_serialize_field(out, *f_iter, "_v");
 539
 540     // Write field closer
 541     indent(out) << "oprot#writeFieldEnd" << endl;
 542
 543     indent_down();
 544     indent(out) << ");" << endl;
 545   }
 546
 547   // Write the struct map
 548   out <<
 549     indent() << "oprot#writeFieldStop;" << endl <<
 550     indent() << "oprot#writeStructEnd" << endl;
 551
 552   indent_down();
 553 }
 554
 555 /**
 556  * Generates a thrift service.
 557  *
 558  * @param tservice The service definition
 559  */
 560 void t_ocaml_generator::generate_service(t_service* tservice) {
 561   string f_service_name = get_out_dir()+capitalize(service_name_)+".ml";
 562   f_service_.open(f_service_name.c_str());
 563   string f_service_i_name = get_out_dir()+capitalize(service_name_)+".mli";
 564   f_service_i_.open(f_service_i_name.c_str());
 565
 566   f_service_ <<
 567     ocaml_autogen_comment() << endl <<
 568     ocaml_imports() << endl;
 569   f_service_i_ <<
 570     ocaml_autogen_comment() << endl <<
 571     ocaml_imports() << endl;
 572
 573   /* if (tservice->get_extends() != NULL) {
 574     f_service_ <<
 575       "open " << capitalize(tservice->get_extends()->get_name()) << endl;
 576     f_service_i_ <<
 577       "open " << capitalize(tservice->get_extends()->get_name()) << endl;
 578   }
 579   */
 580   f_service_ <<
 581      "open " << capitalize(program_name_) << "_types" << endl <<
 582     endl;
 583
 584   f_service_i_ <<
 585      "open " << capitalize(program_name_) << "_types" << endl <<
 586     endl;
 587
 588   // Generate the three main parts of the service
 589   generate_service_helpers(tservice);
 590   generate_service_interface(tservice);
 591   generate_service_client(tservice);
 592   generate_service_server(tservice);
 593
 594
 595   // Close service file
 596   f_service_.close();
 597   f_service_i_.close();
 598 }
 599
 600 /**
 601  * Generates helper functions for a service.
 602  *
 603  * @param tservice The service to generate a header definition for
 604  */
 605 void t_ocaml_generator::generate_service_helpers(t_service* tservice) {
 606   vector<t_function*> functions = tservice->get_functions();
 607   vector<t_function*>::iterator f_iter;
 608
 609   indent(f_service_) <<
 610     "(* HELPER FUNCTIONS AND STRUCTURES *)" << endl << endl;
 611
 612   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 613     t_struct* ts = (*f_iter)->get_arglist();
 614     generate_ocaml_struct_definition(f_service_, ts, false);
 615     generate_ocaml_function_helpers(*f_iter);
 616   }
 617 }
 618
 619 /**
 620  * Generates a struct and helpers for a function.
 621  *
 622  * @param tfunction The function
 623  */
 624 void t_ocaml_generator::generate_ocaml_function_helpers(t_function* tfunction) {
 625   t_struct result(program_, decapitalize(tfunction->get_name()) + "_result");
 626   t_field success(tfunction->get_returntype(), "success", 0);
 627   if (!tfunction->get_returntype()->is_void()) {
 628     result.append(&success);
 629   }
 630
 631   t_struct* xs = tfunction->get_xceptions();
 632   const vector<t_field*>& fields = xs->get_members();
 633   vector<t_field*>::const_iterator f_iter;
 634   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 635     result.append(*f_iter);
 636   }
 637   generate_ocaml_struct_definition(f_service_, &result, false);
 638 }
 639
 640 /**
 641  * Generates a service interface definition.
 642  *
 643  * @param tservice The service to generate a header definition for
 644  */
 645 void t_ocaml_generator::generate_service_interface(t_service* tservice) {
 646   f_service_ <<
 647     indent() << "class virtual iface =" << endl << "object (self)" << endl;
 648   f_service_i_ <<
 649     indent() << "class virtual iface :" << endl << "object" << endl;
 650
 651   indent_up();
 652
 653   if (tservice->get_extends() != NULL) {
 654     string extends = type_name(tservice->get_extends());
 655     indent(f_service_) << "inherit " << extends << ".iface" << endl;
 656     indent(f_service_i_) << "inherit " << extends << ".iface" << endl;
 657   }
 658
 659   vector<t_function*> functions = tservice->get_functions();
 660   vector<t_function*>::iterator f_iter;
 661   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 662     string ft = function_type(*f_iter,true,true);
 663     f_service_ <<
 664       indent() << "method virtual " << decapitalize((*f_iter)->get_name()) << " : " << ft  << endl;
 665     f_service_i_ <<
 666       indent() << "method virtual " << decapitalize((*f_iter)->get_name()) << " : " << ft << endl;
 667   }
 668   indent_down();
 669   indent(f_service_) << "end" << endl << endl;
 670   indent(f_service_i_) << "end" << endl << endl;
 671 }
 672
 673 /**
 674  * Generates a service client definition. Note that in OCaml, the client doesn't implement iface. This is because
 675  * The client does not (and should not have to) deal with arguments being None.
 676  *
 677  * @param tservice The service to generate a server for.
 678  */
 679 void t_ocaml_generator::generate_service_client(t_service* tservice) {
 680   string extends = "";
 681   indent(f_service_) <<
 682     "class client (iprot : Protocol.t) (oprot : Protocol.t) =" << endl << "object (self)" << endl;
 683   indent(f_service_i_) <<
 684     "class client : Protocol.t -> Protocol.t -> " << endl << "object" << endl;
 685   indent_up();
 686
 687
 688   if (tservice->get_extends() != NULL) {
 689     extends = type_name(tservice->get_extends());
 690     indent(f_service_) << "inherit " << extends << ".client iprot oprot as super" << endl;
 691     indent(f_service_i_) << "inherit " << extends << ".client" << endl;
 692   }
 693   indent(f_service_) << "val mutable seqid = 0" << endl;
 694
 695
 696   // Generate client method implementations
 697   vector<t_function*> functions = tservice->get_functions();
 698   vector<t_function*>::const_iterator f_iter;
 699   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 700     t_struct* arg_struct = (*f_iter)->get_arglist();
 701     const vector<t_field*>& fields = arg_struct->get_members();
 702     vector<t_field*>::const_iterator fld_iter;
 703     string funname = (*f_iter)->get_name();
 704
 705     // Open function
 706     indent(f_service_) <<
 707       "method " << function_signature(*f_iter) << " = " << endl;
 708     indent(f_service_i_) <<
 709       "method " << decapitalize((*f_iter)->get_name()) << " : " << function_type(*f_iter,true,false) << endl;
 710     indent_up();
 711     indent(f_service_) <<
 712       "self#send_" << funname;
 713
 714
 715     for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
 716       f_service_ << " " << decapitalize((*fld_iter)->get_name());
 717     }
 718     f_service_ << ";" << endl;
 719
 720     if (!(*f_iter)->is_async()) {
 721       f_service_ << indent();
 722       f_service_ <<
 723         "self#recv_" << funname << endl;
 724     }
 725     indent_down();
 726
 727     indent(f_service_) <<
 728       "method private send_" << function_signature(*f_iter) << " = " << endl;
 729     indent_up();
 730
 731     std::string argsname = decapitalize((*f_iter)->get_name() + "_args");
 732
 733     // Serialize the request header
 734     f_service_ <<
 735       indent() << "oprot#writeMessageBegin (\"" << (*f_iter)->get_name() << "\", Protocol.CALL, seqid);" << endl;
 736
 737     f_service_ <<
 738       indent() << "let args = new " << argsname << " in" << endl;
 739     indent_up();
 740
 741     for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
 742       f_service_ <<
 743         indent() << "args#set_" << (*fld_iter)->get_name() << " " << (*fld_iter)->get_name() << ";" << endl;
 744     }
 745
 746     // Write to the stream
 747     f_service_ <<
 748       indent() << "args#write oprot;" << endl <<
 749       indent() << "oprot#writeMessageEnd;" << endl <<
 750       indent() << "oprot#getTransport#flush" << endl;
 751
 752     indent_down();
 753     indent_down();
 754
 755     if (!(*f_iter)->is_async()) {
 756       std::string resultname = decapitalize((*f_iter)->get_name() + "_result");
 757       t_struct noargs(program_);
 758
 759       t_function recv_function((*f_iter)->get_returntype(),
 760                                string("recv_") + (*f_iter)->get_name(),
 761                                &noargs);
 762       // Open function
 763       f_service_ <<
 764         indent() << "method private " << function_signature(&recv_function) << " =" << endl;
 765       indent_up();
 766
 767       // TODO(mcslee): Validate message reply here, seq ids etc.
 768
 769       f_service_ <<
 770         indent() << "let (fname, mtype, rseqid) = iprot#readMessageBegin in" << endl;
 771       indent_up();
 772       f_service_ <<
 773         indent() << "(if mtype = Protocol.EXCEPTION then" << endl <<
 774         indent() << "  let x = Application_Exn.read iprot in" << endl;
 775       indent_up();
 776       f_service_ <<
 777         indent() << "  raise (Application_Exn.E x)" << endl;
 778       indent_down();
 779       f_service_ <<
 780         indent() << "else ());" << endl;
 781       string res = "_";
 782
 783       t_struct* xs = (*f_iter)->get_xceptions();
 784       const std::vector<t_field*>& xceptions = xs->get_members();
 785
 786       if (!(*f_iter)->get_returntype()->is_void() || xceptions.size() > 0) {
 787         res = "result";
 788       }
 789       f_service_ <<
 790         indent() << "let "<<res<<" = read_" << resultname << " iprot in" << endl;
 791       indent_up();
 792       f_service_ <<
 793         indent() << "iprot#readMessageEnd;" << endl;
 794
 795       // Careful, only return _result if not a void function
 796       if (!(*f_iter)->get_returntype()->is_void()) {
 797         f_service_ <<
 798           indent() << "match result#get_success with Some v -> v | None -> (" << endl;
 799         indent_up();
 800       }
 801
 802
 803       vector<t_field*>::const_iterator x_iter;
 804       for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
 805         f_service_ <<
 806           indent() << "(match result#get_" << (*x_iter)->get_name() << " with None -> () | Some _v ->" << endl;
 807         indent(f_service_) << "  raise (" << capitalize(type_name((*x_iter)->get_type())) << " _v));" << endl;
 808       }
 809
 810       // Careful, only return _result if not a void function
 811       if ((*f_iter)->get_returntype()->is_void()) {
 812         indent(f_service_) <<
 813           "()" << endl;
 814       } else {
 815         f_service_ <<
 816           indent() << "raise (Application_Exn.E (Application_Exn.create Application_Exn.MISSING_RESULT \"" << (*f_iter)->get_name() << " failed: unknown result\")))" << endl;
 817         indent_down();
 818       }
 819
 820       // Close function
 821       indent_down();
 822       indent_down();
 823       indent_down();
 824     }
 825   }
 826
 827   indent_down();
 828   indent(f_service_) << "end" << endl << endl;
 829   indent(f_service_i_) << "end" << endl << endl;
 830 }
 831
 832 /**
 833  * Generates a service server definition.
 834  *
 835  * @param tservice The service to generate a server for.
 836  */
 837 void t_ocaml_generator::generate_service_server(t_service* tservice) {
 838   // Generate the dispatch methods
 839   vector<t_function*> functions = tservice->get_functions();
 840   vector<t_function*>::iterator f_iter;
 841
 842
 843   // Generate the header portion
 844   indent(f_service_) <<
 845     "class processor (handler : iface) =" << endl << indent() << "object (self)" << endl;
 846   indent(f_service_i_) <<
 847     "class processor : iface ->" << endl << indent() << "object" << endl;
 848   indent_up();
 849
 850   f_service_ <<
 851      indent() << "inherit Processor.t" << endl <<
 852     endl;
 853   f_service_i_ <<
 854      indent() << "inherit Processor.t" << endl <<
 855     endl;
 856   string extends = "";
 857
 858   if (tservice->get_extends() != NULL) {
 859     extends = type_name(tservice->get_extends());
 860     indent(f_service_) << "inherit " + extends + ".processor (handler :> " + extends + ".iface)" << endl;
 861     indent(f_service_i_) << "inherit " + extends + ".processor" << endl;
 862   }
 863
 864   if (extends.empty()) {
 865     indent(f_service_) << "val processMap = Hashtbl.create " << functions.size() << endl;
 866   }
 867   indent(f_service_i_) << "val processMap : (string, int * Protocol.t * Protocol.t -> unit) Hashtbl.t" << endl;
 868
 869   // Generate the server implementation
 870   indent(f_service_) <<
 871     "method process iprot oprot =" << endl;
 872   indent(f_service_i_) <<
 873     "method process : Protocol.t -> Protocol.t -> bool" << endl;
 874   indent_up();
 875
 876   f_service_ <<
 877     indent() << "let (name, typ, seqid)  = iprot#readMessageBegin in" << endl;
 878   indent_up();
 879   // TODO(mcslee): validate message
 880
 881   // HOT: dictionary function lookup
 882   f_service_ <<
 883     indent() << "if Hashtbl.mem processMap name then" << endl <<
 884     indent() << "  (Hashtbl.find processMap name) (seqid, iprot, oprot)" << endl <<
 885     indent() << "else (" << endl <<
 886     indent() << "  iprot#skip(Protocol.T_STRUCT);" << endl <<
 887     indent() << "  iprot#readMessageEnd;" << endl <<
 888     indent() << "  let x = Application_Exn.create Application_Exn.UNKNOWN_METHOD (\"Unknown function \"^name) in" << endl <<
 889     indent() << "    oprot#writeMessageBegin(name, Protocol.EXCEPTION, seqid);" << endl <<
 890     indent() << "    x#write oprot;" << endl <<
 891     indent() << "    oprot#writeMessageEnd;" << endl <<
 892     indent() << "    oprot#getTransport#flush" << endl <<
 893     indent() << ");" << endl;
 894
 895   // Read end of args field, the T_STOP, and the struct close
 896   f_service_ <<
 897     indent() << "true" << endl;
 898   indent_down();
 899   indent_down();
 900   // Generate the process subfunctions
 901   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 902     generate_process_function(tservice, *f_iter);
 903   }
 904
 905   indent(f_service_) << "initializer" << endl;
 906   indent_up();
 907   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 908     f_service_ <<
 909       indent() << "Hashtbl.add processMap \"" << (*f_iter)->get_name() << "\" self#process_" << (*f_iter)->get_name() << ";" << endl;
 910   }
 911   indent_down();
 912
 913   indent_down();
 914   indent(f_service_) << "end" << endl << endl;
 915   indent(f_service_i_) << "end" << endl << endl;
 916 }
 917
 918 /**
 919  * Generates a process function definition.
 920  *
 921  * @param tfunction The function to write a dispatcher for
 922  */
 923 void t_ocaml_generator::generate_process_function(t_service* tservice,
 924                                                t_function* tfunction) {
 925   // Open function
 926   indent(f_service_) <<
 927     "method private process_" << tfunction->get_name() <<
 928     " (seqid, iprot, oprot) =" << endl;
 929   indent_up();
 930
 931   string argsname = decapitalize(tfunction->get_name()) + "_args";
 932   string resultname = decapitalize(tfunction->get_name()) + "_result";
 933
 934   // Generate the function call
 935   t_struct* arg_struct = tfunction->get_arglist();
 936   const std::vector<t_field*>& fields = arg_struct->get_members();
 937   vector<t_field*>::const_iterator f_iter;
 938
 939   string args = "args";
 940   if(fields.size() == 0){
 941     args="_";
 942   }
 943
 944   f_service_ <<
 945     indent() << "let "<<args<<" = read_" << argsname << " iprot in" << endl;
 946   indent_up();
 947   f_service_ <<
 948     indent() << "iprot#readMessageEnd;" << endl;
 949
 950   t_struct* xs = tfunction->get_xceptions();
 951   const std::vector<t_field*>& xceptions = xs->get_members();
 952   vector<t_field*>::const_iterator x_iter;
 953
 954   // Declare result for non async function
 955   if (!tfunction->is_async()) {
 956     f_service_ <<
 957       indent() << "let result = new " << resultname << " in" << endl;
 958     indent_up();
 959   }
 960
 961   // Try block for a function with exceptions
 962   if (xceptions.size() > 0) {
 963     f_service_ <<
 964       indent() << "(try" << endl;
 965     indent_up();
 966   }
 967
 968
 969
 970
 971   f_service_ << indent();
 972   if (!tfunction->is_async() && !tfunction->get_returntype()->is_void()) {
 973     f_service_ << "result#set_success ";
 974   }
 975   f_service_ <<
 976     "(handler#" << tfunction->get_name();
 977   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 978     f_service_ <<  " args#get_" << (*f_iter)->get_name();
 979   }
 980   f_service_ << ");" << endl;
 981
 982
 983   if (xceptions.size() > 0) {
 984     indent_down();
 985     indent(f_service_) << "with" <<endl;
 986     indent_up();
 987     for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
 988       f_service_ <<
 989         indent() << "| " << capitalize(type_name((*x_iter)->get_type())) << " " << (*x_iter)->get_name() << " -> " << endl;
 990       indent_up();
 991       indent_up();
 992       if(!tfunction->is_async()){
 993            f_service_ <<
 994              indent() << "result#set_" << (*x_iter)->get_name() << " " << (*x_iter)->get_name() << endl;
 995       } else {
 996         indent(f_service_) << "()";
 997       }
 998       indent_down();
 999       indent_down();
1000     }
1001     indent_down();
1002     f_service_ << indent() << ");" << endl;
1003   }
1004
1005
1006
1007   // Shortcut out here for async functions
1008   if (tfunction->is_async()) {
1009     f_service_ <<
1010       indent() << "()" << endl;
1011     indent_down();
1012     indent_down();
1013     return;
1014   }
1015
1016   f_service_ <<
1017     indent() << "oprot#writeMessageBegin (\"" << tfunction->get_name() << "\", Protocol.REPLY, seqid);" << endl <<
1018     indent() << "result#write oprot;" << endl <<
1019     indent() << "oprot#writeMessageEnd;" << endl <<
1020     indent() << "oprot#getTransport#flush" << endl;
1021
1022   // Close function
1023   indent_down();
1024   indent_down();
1025   indent_down();
1026 }
1027
1028 /**
1029  * Deserializes a field of any type.
1030  */
1031 void t_ocaml_generator::generate_deserialize_field(ofstream &out,
1032                                                    t_field* tfield,
1033                                                    string prefix){
1034   t_type* type = tfield->get_type();
1035
1036
1037   string name = decapitalize(tfield->get_name());
1038   indent(out) << prefix << "#set_"<<name << " ";
1039   generate_deserialize_type(out,type);
1040   out << endl;
1041 }
1042
1043
1044 /**
1045  * Deserializes a field of any type.
1046  */
1047 void t_ocaml_generator::generate_deserialize_type(ofstream &out,
1048                                                    t_type* type){
1049   type = get_true_type(type);
1050
1051   if (type->is_void()) {
1052     throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE";
1053   }
1054
1055
1056   if (type->is_struct() || type->is_xception()) {
1057     generate_deserialize_struct(out,
1058                                 (t_struct*)type);
1059   } else if (type->is_container()) {
1060     generate_deserialize_container(out, type);
1061   } else if (type->is_base_type()) {
1062     out << "iprot#";
1063     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1064     switch (tbase) {
1065     case t_base_type::TYPE_VOID:
1066       throw "compiler error: cannot serialize void field in a struct";
1067       break;
1068     case t_base_type::TYPE_STRING:
1069       out << "readString";
1070       break;
1071     case t_base_type::TYPE_BOOL:
1072       out << "readBool";
1073       break;
1074     case t_base_type::TYPE_BYTE:
1075       out << "readByte";
1076       break;
1077     case t_base_type::TYPE_I16:
1078       out << "readI16";
1079       break;
1080     case t_base_type::TYPE_I32:
1081       out << "readI32";
1082       break;
1083     case t_base_type::TYPE_I64:
1084       out << "readI64";
1085       break;
1086     case t_base_type::TYPE_DOUBLE:
1087       out << "readDouble";
1088       break;
1089     default:
1090       throw "compiler error: no PHP name for base type " + t_base_type::t_base_name(tbase);
1091     }
1092   } else if (type->is_enum()) {
1093     string ename = capitalize(type->get_name());
1094     out << "(" <<ename << ".of_i iprot#readI32)";
1095   } else {
1096     printf("DO NOT KNOW HOW TO DESERIALIZE TYPE '%s'\n",
1097            type->get_name().c_str());
1098   }
1099 }
1100
1101
1102 /**
1103  * Generates an unserializer for a struct, calling read()
1104  */
1105 void t_ocaml_generator::generate_deserialize_struct(ofstream &out,
1106                                                   t_struct* tstruct) {
1107   string name = decapitalize(tstruct->get_name());
1108   out << "(read_" << name << " iprot)";
1109
1110 }
1111
1112 /**
1113  * Serialize a container by writing out the header followed by
1114  * data and then a footer.
1115  */
1116 void t_ocaml_generator::generate_deserialize_container(ofstream &out,
1117                                                     t_type* ttype) {
1118   string size = tmp("_size");
1119   string ktype = tmp("_ktype");
1120   string vtype = tmp("_vtype");
1121   string etype = tmp("_etype");
1122   string con = tmp("_con");
1123
1124   t_field fsize(g_type_i32, size);
1125   t_field fktype(g_type_byte, ktype);
1126   t_field fvtype(g_type_byte, vtype);
1127   t_field fetype(g_type_byte, etype);
1128
1129   out << endl;
1130   indent_up();
1131   // Declare variables, read header
1132   if (ttype->is_map()) {
1133     indent(out) << "(let ("<<ktype<<","<<vtype<<","<<size<<") = iprot#readMapBegin in" << endl;
1134     indent(out) << "let "<<con<<" = Hashtbl.create "<<size<<" in" << endl;
1135     indent_up();
1136     indent(out) << "for i = 1 to "<<size<<" do" <<endl;
1137     indent_up();
1138     indent(out) << "let _k = ";
1139     generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
1140     out << " in" << endl;
1141     indent(out) << "let _v = ";
1142     generate_deserialize_type(out,((t_map*)ttype)->get_val_type());
1143     out << " in" << endl;
1144     indent_up();
1145     indent(out) << "Hashtbl.add "<<con<< " _k _v" << endl;
1146     indent_down();
1147     indent_down();
1148     indent(out) << "done; iprot#readMapEnd; "<<con<<")";
1149     indent_down();
1150   } else if (ttype->is_set()) {
1151     indent(out) << "(let ("<<etype<<","<<size<<") = iprot#readSetBegin in" << endl;
1152     indent(out) << "let "<<con<<" = Hashtbl.create "<<size<<" in" << endl;
1153     indent_up();
1154     indent(out) << "for i = 1 to "<<size<<" do" <<endl;
1155     indent_up();
1156     indent(out) << "Hashtbl.add "<<con<<" ";
1157     generate_deserialize_type(out,((t_set*)ttype)->get_elem_type());
1158     out << " true" << endl;
1159     indent_down();
1160     indent(out) << "done; iprot#readSetEnd; "<<con<<")";
1161     indent_down();
1162   } else if (ttype->is_list()) {
1163     indent(out) << "(let ("<<etype<<","<<size<<") = iprot#readListBegin in" << endl;
1164     indent_up();
1165     indent(out) << "let "<<con<<" = (Array.to_list (Array.init "<<size<<" (fun _ -> ";
1166     generate_deserialize_type(out,((t_list*)ttype)->get_elem_type());
1167     out << "))) in" << endl;
1168     indent_up();
1169     indent(out) << "iprot#readListEnd; "<<con<<")";
1170     indent_down();
1171     indent_down();
1172   }
1173   indent_down();
1174 }
1175
1176
1177
1178 /**
1179  * Serializes a field of any type.
1180  *
1181  * @param tfield The field to serialize
1182  * @param prefix Name to prepend to field name
1183  */
1184 void t_ocaml_generator::generate_serialize_field(ofstream &out,
1185                                                  t_field* tfield,
1186                                                  string name) {
1187   t_type* type = get_true_type(tfield->get_type());
1188
1189   // Do nothing for void types
1190   if (type->is_void()) {
1191     throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " +
1192       tfield->get_name();
1193   }
1194
1195   if(name.length() == 0){
1196     name = decapitalize(tfield->get_name());
1197   }
1198
1199   if (type->is_struct() || type->is_xception()) {
1200     generate_serialize_struct(out,
1201                               (t_struct*)type,
1202                               name);
1203   } else if (type->is_container()) {
1204     generate_serialize_container(out,
1205                                  type,
1206                                  name);
1207   } else if (type->is_base_type() || type->is_enum()) {
1208
1209
1210     indent(out) <<
1211       "oprot#";
1212
1213     if (type->is_base_type()) {
1214       t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1215       switch (tbase) {
1216       case t_base_type::TYPE_VOID:
1217         throw
1218           "compiler error: cannot serialize void field in a struct: " + name;
1219         break;
1220       case t_base_type::TYPE_STRING:
1221         out << "writeString(" << name << ")";
1222         break;
1223       case t_base_type::TYPE_BOOL:
1224         out << "writeBool(" << name << ")";
1225        break;
1226       case t_base_type::TYPE_BYTE:
1227         out << "writeByte(" << name << ")";
1228         break;
1229       case t_base_type::TYPE_I16:
1230         out << "writeI16(" << name << ")";
1231         break;
1232       case t_base_type::TYPE_I32:
1233         out << "writeI32(" << name << ")";
1234         break;
1235       case t_base_type::TYPE_I64:
1236         out << "writeI64(" << name << ")";
1237         break;
1238       case t_base_type::TYPE_DOUBLE:
1239         out << "writeDouble(" << name << ")";
1240         break;
1241       default:
1242         throw "compiler error: no ocaml name for base type " + t_base_type::t_base_name(tbase);
1243       }
1244     } else if (type->is_enum()) {
1245       string ename = capitalize(type->get_name());
1246       out << "writeI32("<<ename<<".to_i " << name << ")";
1247     }
1248
1249   } else {
1250     printf("DO NOT KNOW HOW TO SERIALIZE FIELD '%s' TYPE '%s'\n",
1251            tfield->get_name().c_str(),
1252            type->get_name().c_str());
1253   }
1254   out << ";" << endl;
1255 }
1256
1257 /**
1258  * Serializes all the members of a struct.
1259  *
1260  * @param tstruct The struct to serialize
1261  * @param prefix  String prefix to attach to all fields
1262  */
1263 void t_ocaml_generator::generate_serialize_struct(ofstream &out,
1264                                                t_struct* tstruct,
1265                                                string prefix) {
1266   indent(out) << prefix << "#write(oprot)";
1267 }
1268
1269 void t_ocaml_generator::generate_serialize_container(ofstream &out,
1270                                                   t_type* ttype,
1271                                                   string prefix) {
1272   if (ttype->is_map()) {
1273     indent(out) << "oprot#writeMapBegin("<< type_to_enum(((t_map*)ttype)->get_key_type()) << ",";
1274     out << type_to_enum(((t_map*)ttype)->get_val_type()) << ",";
1275     out << "Hashtbl.length " << prefix << ");" << endl;
1276   } else if (ttype->is_set()) {
1277     indent(out) <<
1278       "oprot#writeSetBegin(" << type_to_enum(((t_set*)ttype)->get_elem_type()) << ",";
1279     out << "Hashtbl.length " << prefix << ");" << endl;
1280   } else if (ttype->is_list()) {
1281     indent(out) <<
1282       "oprot#writeListBegin(" << type_to_enum(((t_list*)ttype)->get_elem_type()) << ",";
1283     out << "List.length " << prefix << ");" << endl;
1284   }
1285
1286   if (ttype->is_map()) {
1287     string kiter = tmp("_kiter");
1288     string viter = tmp("_viter");
1289     indent(out) << "Hashtbl.iter (fun "<<kiter<<" -> fun " << viter << " -> " << endl;
1290     indent_up();
1291     generate_serialize_map_element(out, (t_map*)ttype, kiter, viter);
1292     indent_down();
1293     indent(out) << ") " << prefix << ";" << endl;
1294   } else if (ttype->is_set()) {
1295     string iter = tmp("_iter");
1296     indent(out) << "Hashtbl.iter (fun "<<iter<<" -> fun _ -> ";
1297     indent_up();
1298     generate_serialize_set_element(out, (t_set*)ttype, iter);
1299     indent_down();
1300     indent(out) << ") " << prefix << ";" << endl;
1301   } else if (ttype->is_list()) {
1302     string iter = tmp("_iter");
1303     indent(out) << "List.iter (fun "<<iter<<" -> ";
1304     indent_up();
1305     generate_serialize_list_element(out, (t_list*)ttype, iter);
1306     indent_down();
1307     indent(out) << ") " << prefix << ";" <<  endl;
1308   }
1309
1310   if (ttype->is_map()) {
1311     indent(out) <<
1312       "oprot#writeMapEnd";
1313   } else if (ttype->is_set()) {
1314     indent(out) <<
1315       "oprot#writeSetEnd";
1316   } else if (ttype->is_list()) {
1317     indent(out) <<
1318       "oprot#writeListEnd";
1319   }
1320 }
1321
1322 /**
1323  * Serializes the members of a map.
1324  *
1325  */
1326 void t_ocaml_generator::generate_serialize_map_element(ofstream &out,
1327                                                      t_map* tmap,
1328                                                      string kiter,
1329                                                      string viter) {
1330   t_field kfield(tmap->get_key_type(), kiter);
1331   generate_serialize_field(out, &kfield);
1332
1333   t_field vfield(tmap->get_val_type(), viter);
1334   generate_serialize_field(out, &vfield);
1335 }
1336
1337 /**
1338  * Serializes the members of a set.
1339  */
1340 void t_ocaml_generator::generate_serialize_set_element(ofstream &out,
1341                                                      t_set* tset,
1342                                                      string iter) {
1343   t_field efield(tset->get_elem_type(), iter);
1344   generate_serialize_field(out, &efield);
1345 }
1346
1347 /**
1348  * Serializes the members of a list.
1349  */
1350 void t_ocaml_generator::generate_serialize_list_element(ofstream &out,
1351                                                       t_list* tlist,
1352                                                       string iter) {
1353   t_field efield(tlist->get_elem_type(), iter);
1354   generate_serialize_field(out, &efield);
1355 }
1356
1357
1358
1359 /**
1360  * Renders a function signature of the form 'name args'
1361  *
1362  * @param tfunction Function definition
1363  * @return String of rendered function definition
1364  */
1365 string t_ocaml_generator::function_signature(t_function* tfunction,
1366                                            string prefix) {
1367   return
1368     prefix + decapitalize(tfunction->get_name()) +
1369     " " +  argument_list(tfunction->get_arglist());
1370 }
1371
1372 string t_ocaml_generator::function_type(t_function* tfunc, bool method, bool options){
1373   string result="";
1374
1375   const vector<t_field*>& fields = tfunc->get_arglist()->get_members();
1376   vector<t_field*>::const_iterator f_iter;
1377   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
1378     result += render_ocaml_type((*f_iter)->get_type());
1379     if(options)
1380       result += " option";
1381     result += " -> ";
1382   }
1383   if(fields.empty() && !method){
1384     result += "unit -> ";
1385   }
1386   result += render_ocaml_type(tfunc->get_returntype());
1387   return result;
1388 }
1389
1390 /**
1391  * Renders a field list
1392  */
1393 string t_ocaml_generator::argument_list(t_struct* tstruct) {
1394   string result = "";
1395
1396   const vector<t_field*>& fields = tstruct->get_members();
1397   vector<t_field*>::const_iterator f_iter;
1398   bool first = true;
1399   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
1400     if (first) {
1401       first = false;
1402     } else {
1403       result += " ";
1404     }
1405     result += (*f_iter)->get_name();
1406   }
1407   return result;
1408 }
1409
1410 string t_ocaml_generator::type_name(t_type* ttype) {
1411   string prefix = "";
1412   t_program* program = ttype->get_program();
1413   if (program != NULL && program != program_) {
1414     if (!ttype->is_service()) {
1415       prefix = capitalize(program->get_name()) + "_types.";
1416     }
1417   }
1418
1419   string name = ttype->get_name();
1420   if(ttype->is_service()){
1421     name = capitalize(name);
1422   } else {
1423     name = decapitalize(name);
1424   }
1425   return prefix + name;
1426 }
1427
1428 /**
1429  * Converts the parse type to a Protocol.t_type enum
1430  */
1431 string t_ocaml_generator::type_to_enum(t_type* type) {
1432   type = get_true_type(type);
1433
1434   if (type->is_base_type()) {
1435     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1436     switch (tbase) {
1437     case t_base_type::TYPE_VOID:
1438       return "Protocol.T_VOID";
1439     case t_base_type::TYPE_STRING:
1440       return "Protocol.T_STRING";
1441     case t_base_type::TYPE_BOOL:
1442       return "Protocol.T_BOOL";
1443     case t_base_type::TYPE_BYTE:
1444       return "Protocol.T_BYTE";
1445     case t_base_type::TYPE_I16:
1446       return "Protocol.T_I16";
1447     case t_base_type::TYPE_I32:
1448       return "Protocol.T_I32";
1449     case t_base_type::TYPE_I64:
1450       return "Protocol.T_I64";
1451     case t_base_type::TYPE_DOUBLE:
1452       return "Protocol.T_DOUBLE";
1453     }
1454   } else if (type->is_enum()) {
1455     return "Protocol.T_I32";
1456   } else if (type->is_struct() || type->is_xception()) {
1457     return "Protocol.T_STRUCT";
1458   } else if (type->is_map()) {
1459     return "Protocol.T_MAP";
1460   } else if (type->is_set()) {
1461     return "Protocol.T_SET";
1462   } else if (type->is_list()) {
1463     return "Protocol.T_LIST";
1464   }
1465
1466   throw "INVALID TYPE IN type_to_enum: " + type->get_name();
1467 }
1468
1469 /**
1470  * Converts the parse type to an ocaml type
1471  */
1472 string t_ocaml_generator::render_ocaml_type(t_type* type) {
1473   type = get_true_type(type);
1474
1475   if (type->is_base_type()) {
1476     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1477     switch (tbase) {
1478     case t_base_type::TYPE_VOID:
1479       return "unit";
1480     case t_base_type::TYPE_STRING:
1481       return "string";
1482     case t_base_type::TYPE_BOOL:
1483       return "bool";
1484     case t_base_type::TYPE_BYTE:
1485       return "int";
1486     case t_base_type::TYPE_I16:
1487       return "int";
1488     case t_base_type::TYPE_I32:
1489       return "int";
1490     case t_base_type::TYPE_I64:
1491       return "Int64.t";
1492     case t_base_type::TYPE_DOUBLE:
1493       return "float";
1494     }
1495   } else if (type->is_enum()) {
1496     return capitalize(((t_enum*)type)->get_name())+".t";
1497   } else if (type->is_struct() || type->is_xception()) {
1498     return type_name((t_struct*)type);
1499   } else if (type->is_map()) {
1500     t_type* ktype = ((t_map*)type)->get_key_type();
1501     t_type* vtype = ((t_map*)type)->get_val_type();
1502     return "("+render_ocaml_type(ktype)+","+render_ocaml_type(vtype)+") Hashtbl.t";
1503   } else if (type->is_set()) {
1504     t_type* etype = ((t_set*)type)->get_elem_type();
1505     return "("+render_ocaml_type(etype)+",bool) Hashtbl.t";
1506   } else if (type->is_list()) {
1507     t_type* etype = ((t_list*)type)->get_elem_type();
1508     return render_ocaml_type(etype)+" list";
1509   }
1510
1511   throw "INVALID TYPE IN type_to_enum: " + type->get_name();
1512 }