Thrift: OCaml library and generator
Summary: Added (minimal) library and code generator for OCaml.
Reviewed by: mcslee
Test plan: Test client and server (included).
Revert plan: yes
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665163 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/compiler/cpp/Makefile.am b/compiler/cpp/Makefile.am
index 98d0008..6465e56 100644
--- a/compiler/cpp/Makefile.am
+++ b/compiler/cpp/Makefile.am
@@ -15,8 +15,10 @@
src/generate/t_rb_generator.cc \
src/generate/t_xsd_generator.cc \
src/generate/t_perl_generator.cc \
+ src/generate/t_ocaml_generator.cc \
src/generate/t_erl_generator.cc
+
thrift_CXXFLAGS = -Wall -Isrc $(BOOST_CPPFLAGS)
thrift_LDFLAGS = -Wall $(BOOST_LDFLAGS)
diff --git a/compiler/cpp/src/generate/t_generator.h b/compiler/cpp/src/generate/t_generator.h
index af1d4b1..52ffb70 100644
--- a/compiler/cpp/src/generate/t_generator.h
+++ b/compiler/cpp/src/generate/t_generator.h
@@ -118,6 +118,17 @@
std::ostream& indent(std::ostream &os) {
return os << indent();
}
+ /**
+ * Capitalization helpers
+ */
+ std::string capitalize(std::string in) {
+ in[0] = toupper(in[0]);
+ return in;
+ }
+ std::string decapitalize(std::string in) {
+ in[0] = tolower(in[0]);
+ return in;
+ }
protected:
/**
diff --git a/compiler/cpp/src/generate/t_ocaml_generator.cc b/compiler/cpp/src/generate/t_ocaml_generator.cc
new file mode 100644
index 0000000..39ad45b
--- /dev/null
+++ b/compiler/cpp/src/generate/t_ocaml_generator.cc
@@ -0,0 +1,1520 @@
+// Copyright (c) 2006- Facebook
+// Distributed under the Thrift Software License
+//
+// See accompanying file LICENSE or visit the Thrift site at:
+// http://developers.facebook.com/thrift/
+
+#include <stdlib.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <sstream>
+#include "t_ocaml_generator.h"
+using namespace std;
+
+/*
+ * This is necessary because we want typedefs to appear later,
+ * after all the types have been declared.
+ */
+void t_ocaml_generator::generate_program() {
+ // Initialize the generator
+ init_generator();
+
+ // Generate enums
+ vector<t_enum*> enums = program_->get_enums();
+ vector<t_enum*>::iterator en_iter;
+ for (en_iter = enums.begin(); en_iter != enums.end(); ++en_iter) {
+ generate_enum(*en_iter);
+ }
+
+ // Generate structs
+ vector<t_struct*> structs = program_->get_structs();
+ vector<t_struct*>::iterator st_iter;
+ for (st_iter = structs.begin(); st_iter != structs.end(); ++st_iter) {
+ generate_struct(*st_iter);
+ }
+
+ // Generate xceptions
+ vector<t_struct*> xceptions = program_->get_xceptions();
+ vector<t_struct*>::iterator x_iter;
+ for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
+ generate_xception(*x_iter);
+ }
+
+ // Generate typedefs
+ vector<t_typedef*> typedefs = program_->get_typedefs();
+ vector<t_typedef*>::iterator td_iter;
+ for (td_iter = typedefs.begin(); td_iter != typedefs.end(); ++td_iter) {
+ generate_typedef(*td_iter);
+ }
+
+ // Generate services
+ vector<t_service*> services = program_->get_services();
+ vector<t_service*>::iterator sv_iter;
+ for (sv_iter = services.begin(); sv_iter != services.end(); ++sv_iter) {
+ service_name_ = get_service_name(*sv_iter);
+ generate_service(*sv_iter);
+ }
+
+ // Generate constants
+ vector<t_const*> consts = program_->get_consts();
+ generate_consts(consts);
+
+ // Close the generator
+ close_generator();
+}
+
+
+/**
+ * Prepares for file generation by opening up the necessary file output
+ * streams.
+ *
+ * @param tprogram The program to generate
+ */
+void t_ocaml_generator::init_generator() {
+ // Make output directory
+ mkdir(T_OCAML_DIR, S_IREAD | S_IWRITE | S_IEXEC);
+
+ // Make output file
+ string f_types_name = string(T_OCAML_DIR)+"/"+program_name_+"_types.ml";
+ f_types_.open(f_types_name.c_str());
+ string f_types_i_name = string(T_OCAML_DIR)+"/"+program_name_+"_types.mli";
+ f_types_i_.open(f_types_i_name.c_str());
+
+ string f_consts_name = string(T_OCAML_DIR)+"/"+program_name_+"_consts.ml";
+ f_consts_.open(f_consts_name.c_str());
+
+ // Print header
+ f_types_ <<
+ ocaml_autogen_comment() << endl <<
+ ocaml_imports() << endl;
+ f_types_i_ <<
+ ocaml_autogen_comment() << endl <<
+ ocaml_imports() << endl;
+ f_consts_ <<
+ ocaml_autogen_comment() << endl <<
+ ocaml_imports() << endl <<
+ "open " << capitalize(program_name_)<<"_types"<< endl;
+}
+
+
+/**
+ * Autogen'd comment
+ */
+string t_ocaml_generator::ocaml_autogen_comment() {
+ return
+ std::string("(*\n") +
+ " Autogenerated by Thrift\n" +
+ "\n" +
+ " DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING\n" +
+ "*)\n";
+}
+
+/**
+ * Prints standard thrift imports
+ */
+string t_ocaml_generator::ocaml_imports() {
+ return "open Thrift";
+}
+
+/**
+ * Closes the type files
+ */
+void t_ocaml_generator::close_generator() {
+ // Close types file
+ f_types_.close();
+}
+
+/**
+ * Generates a typedef. Ez.
+ *
+ * @param ttypedef The type definition
+ */
+void t_ocaml_generator::generate_typedef(t_typedef* ttypedef) {
+ f_types_ <<
+ indent() << "type "<< decapitalize(ttypedef->get_symbolic()) << " = " << render_ocaml_type(ttypedef->get_type()) << endl << endl;
+ f_types_i_ <<
+ indent() << "type "<< decapitalize(ttypedef->get_symbolic()) << " = " << render_ocaml_type(ttypedef->get_type()) << endl << endl;
+}
+
+/**
+ * Generates code for an enumerated type.
+ * the values.
+ *
+ * @param tenum The enumeration
+ */
+void t_ocaml_generator::generate_enum(t_enum* tenum) {
+ indent(f_types_) << "module " << capitalize(tenum->get_name()) << " = " << endl << "struct" << endl;
+ indent(f_types_i_) << "module " << capitalize(tenum->get_name()) << " : " << endl << "sig" << endl;
+ indent_up();
+ indent(f_types_) << "type t = " << endl;
+ indent(f_types_i_) << "type t = " << endl;
+ indent_up();
+ vector<t_enum_value*> constants = tenum->get_constants();
+ vector<t_enum_value*>::iterator c_iter;
+ int value = -1;
+ for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
+ string name = capitalize((*c_iter)->get_name());
+ indent(f_types_) << "| " << name << endl;
+ indent(f_types_i_) << "| " << name << endl;
+ }
+ indent_down();
+
+ indent(f_types_) << "let to_i = function" << endl;
+ indent(f_types_i_) << "val to_i : t -> int" << endl;
+ indent_up();
+ for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
+ if ((*c_iter)->has_value()) {
+ value = (*c_iter)->get_value();
+ } else {
+ ++value;
+ }
+ string name = capitalize((*c_iter)->get_name());
+
+ f_types_ <<
+ indent() << "| " << name << " -> " << value << endl;
+ }
+ indent_down();
+
+ indent(f_types_) << "let of_i = function" << endl;
+ indent(f_types_i_) << "val of_i : int -> t" << endl;
+ indent_up();
+ for(c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
+ if ((*c_iter)->has_value()) {
+ value = (*c_iter)->get_value();
+ } else {
+ ++value;
+ }
+ string name = capitalize((*c_iter)->get_name());
+
+ f_types_ <<
+ indent() << "| " << value << " -> " << name << endl;
+ }
+ indent(f_types_) << "| _ -> raise Thrift_error" << endl;
+ indent_down();
+ indent_down();
+ indent(f_types_) << "end" << endl;
+ indent(f_types_i_) << "end" << endl;
+}
+
+/**
+ * Generate a constant value
+ */
+void t_ocaml_generator::generate_const(t_const* tconst) {
+ t_type* type = tconst->get_type();
+ string name = decapitalize(tconst->get_name());
+ t_const_value* value = tconst->get_value();
+
+ indent(f_consts_) << "let " << name << " = " << render_const_value(type, value) << endl << endl;
+}
+
+/**
+ * Prints the value of a constant with the given type. Note that type checking
+ * is NOT performed in this function as it is always run beforehand using the
+ * validate_types method in main.cc
+ */
+string t_ocaml_generator::render_const_value(t_type* type, t_const_value* value) {
+ std::ostringstream out;
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_STRING:
+ out << "\"" << value->get_string() << "\"";
+ break;
+ case t_base_type::TYPE_BOOL:
+ out << (value->get_integer() > 0 ? "true" : "false");
+ break;
+ case t_base_type::TYPE_BYTE:
+ case t_base_type::TYPE_I16:
+ case t_base_type::TYPE_I32:
+ out << value->get_integer();
+ break;
+ case t_base_type::TYPE_I64:
+ out << value->get_integer() << "L";
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ if (value->get_type() == t_const_value::CV_INTEGER) {
+ out << value->get_integer();
+ } else {
+ out << value->get_double();
+ }
+ break;
+ default:
+ throw "compiler error: no const of base type " + tbase;
+ }
+ } else if (type->is_enum()) {
+ t_enum* tenum = (t_enum*)type;
+ vector<t_enum_value*> constants = tenum->get_constants();
+ vector<t_enum_value*>::iterator c_iter;
+ int val = -1;
+ for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
+ if ((*c_iter)->has_value()) {
+ val = (*c_iter)->get_value();
+ } else {
+ ++val;
+ }
+ if(val == value->get_integer()){
+ indent(out) << capitalize(tenum->get_name()) << "." << capitalize((*c_iter)->get_name());
+ break;
+ }
+ }
+ } else if (type->is_struct() || type->is_xception()) {
+ string cname = type_name(type);
+ string ct = tmp("_c");
+ out << endl;
+ indent_up();
+ indent(out) << "(let " << ct << " = new " << cname << " in" << endl;
+ indent_up();
+ const vector<t_field*>& fields = ((t_struct*)type)->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ const map<t_const_value*, t_const_value*>& val = value->get_map();
+ map<t_const_value*, t_const_value*>::const_iterator v_iter;
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ t_type* field_type = NULL;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if ((*f_iter)->get_name() == v_iter->first->get_string()) {
+ field_type = (*f_iter)->get_type();
+ }
+ }
+ if (field_type == NULL) {
+ throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string();
+ }
+ string fname = v_iter->first->get_string();
+ out << indent();
+ out << ct <<"#set_" << fname << " ";
+ out << render_const_value(field_type, v_iter->second);
+ out << ";" << endl;
+ }
+ indent(out) << ct << ")";
+ indent_down();
+ indent_down();
+ } else if (type->is_map()) {
+ t_type* ktype = ((t_map*)type)->get_key_type();
+ t_type* vtype = ((t_map*)type)->get_val_type();
+ const map<t_const_value*, t_const_value*>& val = value->get_map();
+ map<t_const_value*, t_const_value*>::const_iterator v_iter;
+ string hm = tmp("_hm");
+ out << endl;
+ indent_up();
+ indent(out) << "(let " << hm << " = Hashtbl.create " << val.size() << " in" << endl;
+ indent_up();
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ string key = render_const_value(ktype, v_iter->first);
+ string val = render_const_value(vtype, v_iter->second);
+ indent(out) << "Hashtbl.add " << hm << " " << key << " " << val << ";" << endl;
+ }
+ indent(out) << hm << ")";
+ indent_down();
+ indent_down();
+ } else if (type->is_list()) {
+ t_type* etype;
+ etype = ((t_list*)type)->get_elem_type();
+ out << "[" << endl;
+ indent_up();
+ const vector<t_const_value*>& val = value->get_list();
+ vector<t_const_value*>::const_iterator v_iter;
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ out << indent();
+ out << render_const_value(etype, *v_iter);
+ out << ";" << endl;
+ }
+ indent_down();
+ indent(out) << "]";
+ } else if (type->is_set()) {
+ t_type* etype = ((t_set*)type)->get_elem_type();
+ const vector<t_const_value*>& val = value->get_list();
+ vector<t_const_value*>::const_iterator v_iter;
+ string hm = tmp("_hm");
+ indent(out) << "(let " << hm << " = Hashtbl.create " << val.size() << " in" << endl;
+ indent_up();
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ string val = render_const_value(etype, *v_iter);
+ indent(out) << "Hashtbl.add " << hm << " " << val << " true;" << endl;
+ }
+ indent(out) << hm << ")" << endl;
+ indent_down();
+ out << endl;
+ }
+ return out.str();
+}
+
+/**
+ * Generates a "struct"
+ */
+void t_ocaml_generator::generate_struct(t_struct* tstruct) {
+ generate_ocaml_struct(tstruct, false);
+}
+
+/**
+ * Generates a struct definition for a thrift exception. Basically the same
+ * as a struct, but also has an exception declaration.
+ *
+ * @param txception The struct definition
+ */
+void t_ocaml_generator::generate_xception(t_struct* txception) {
+ generate_ocaml_struct(txception, true);
+}
+
+/**
+ * Generates an OCaml struct
+ */
+void t_ocaml_generator::generate_ocaml_struct(t_struct* tstruct,
+ bool is_exception) {
+ generate_ocaml_struct_definition(f_types_, tstruct, is_exception);
+ generate_ocaml_struct_sig(f_types_i_,tstruct,is_exception);
+}
+
+/**
+ * Generates a struct definition for a thrift data type.
+ *
+ * @param tstruct The struct definition
+ */
+void t_ocaml_generator::generate_ocaml_struct_definition(ofstream& out,
+ t_struct* tstruct,
+ bool is_exception) {
+ const vector<t_field*>& members = tstruct->get_members();
+ vector<t_field*>::const_iterator m_iter;
+ string tname = type_name(tstruct);
+ indent(out) << "class " << tname << " =" << endl;
+ indent(out) << "object (self)" << endl;
+
+ indent_up();
+
+ string x = tmp("_x");
+ if (members.size() > 0) {
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ string mname = decapitalize((*m_iter)->get_name());
+ indent(out) << "val mutable _" << mname << " : " << render_ocaml_type((*m_iter)->get_type()) << " option = None" << endl;
+ indent(out) << "method get_" << mname << " = _" << mname << endl;
+ indent(out) << "method grab_" << mname << " = match _"<<mname<<" with None->raise (Field_empty \""<<tname<<"."<<mname<<"\") | Some " << x <<" -> " << x << endl;
+ indent(out) << "method set_" << mname << " " << x << " = _" << mname << " <- Some " << x << endl;
+ }
+ }
+ generate_ocaml_struct_writer(out, tstruct);
+ indent_down();
+ indent(out) << "end" << endl;
+
+ if(is_exception){
+ indent(out) << "exception " << capitalize(tname) <<" of " << tname << endl;
+ }
+
+ generate_ocaml_struct_reader(out, tstruct);
+}
+
+/**
+ * Generates a struct definition for a thrift data type.
+ *
+ * @param tstruct The struct definition
+ */
+void t_ocaml_generator::generate_ocaml_struct_sig(ofstream& out,
+ t_struct* tstruct,
+ bool is_exception) {
+ const vector<t_field*>& members = tstruct->get_members();
+ vector<t_field*>::const_iterator m_iter;
+ string tname = type_name(tstruct);
+ indent(out) << "class " << tname << " :" << endl;
+ indent(out) << "object" << endl;
+
+ indent_up();
+
+ string x = tmp("_x");
+ if (members.size() > 0) {
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ string mname = decapitalize((*m_iter)->get_name());
+ string type = render_ocaml_type((*m_iter)->get_type());
+ indent(out) << "method get_" << mname << " : " << type << " option" << endl;
+ indent(out) << "method grab_" << mname << " : " << type << endl;
+ indent(out) << "method set_" << mname << " : " << type << " -> unit" << endl;
+ }
+ }
+ indent(out) << "method write : Protocol.t -> unit" << endl;
+ indent_down();
+ indent(out) << "end" << endl;
+
+ if(is_exception){
+ indent(out) << "exception " << capitalize(tname) <<" of " << tname << endl;
+ }
+
+ indent(out) << "val read_" << tname << " : Protocol.t -> " << tname << endl;
+}
+
+/**
+ * Generates the read method for a struct
+ */
+void t_ocaml_generator::generate_ocaml_struct_reader(ofstream& out, t_struct* tstruct) {
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ string sname = type_name(tstruct);
+ string str = tmp("_str");
+ string t = tmp("_t");
+ string id = tmp("_id");
+ indent(out) <<
+ "let rec read_" << sname << " (iprot : Protocol.t) =" << endl;
+ indent_up();
+ indent(out) << "let " << str << " = new " << sname << " in" << endl;
+ indent_up();
+ indent(out) <<
+ "ignore(iprot#readStructBegin);" << endl;
+
+ // Loop over reading in fields
+ indent(out) <<
+ "(try while true do" << endl;
+ indent_up();
+ indent_up();
+
+ // Read beginning field marker
+ indent(out) <<
+ "let (_," << t <<","<<id<<") = iprot#readFieldBegin in" << endl;
+
+ // Check for field STOP marker and break
+ indent(out) <<
+ "if " << t <<" = Protocol.T_STOP then" << endl;
+ indent_up();
+ indent(out) <<
+ "raise Break" << endl;
+ indent_down();
+ indent(out) << "else ();" << endl;
+
+ indent(out) << "(match " << id<<" with " << endl;
+ indent_up();
+ // Generate deserialization code for known cases
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ indent(out) << "| " << (*f_iter)->get_key() << " -> (";
+ out << "if " << t <<" = " << type_to_enum((*f_iter)->get_type()) << " then" << endl;
+ indent_up();
+ indent_up();
+ generate_deserialize_field(out, *f_iter,str);
+ indent_down();
+ out <<
+ indent() << "else" << endl <<
+ indent() << " iprot#skip "<< t << ")" << endl;
+ indent_down();
+ }
+
+ // In the default case we skip the field
+ out <<
+ indent() << "| _ -> " << "iprot#skip "<<t<<");" << endl;
+ indent_down();
+ // Read field end marker
+ indent(out) << "iprot#readFieldEnd;" << endl;
+ indent_down();
+ indent(out) << "done; ()" << endl;
+ indent_down();
+ indent(out) << "with Break -> ());" << endl;
+
+ indent(out) <<
+ "iprot#readStructEnd;" << endl;
+
+ indent(out) << str << endl << endl;
+ indent_down();
+ indent_down();
+}
+
+void t_ocaml_generator::generate_ocaml_struct_writer(ofstream& out,
+ t_struct* tstruct) {
+ string name = tstruct->get_name();
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ string str = tmp("_str");
+ string f = tmp("_f");
+
+ indent(out) <<
+ "method write (oprot : Protocol.t) =" << endl;
+ indent_up();
+ indent(out) <<
+ "oprot#writeStructBegin \""<<name<<"\";" << endl;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ // Write field header
+ string mname = "_"+decapitalize((*f_iter)->get_name());
+ indent(out) <<
+ "(match " << mname << " with None -> () | Some _v -> " << endl;
+ indent_up();
+ indent(out) << "oprot#writeFieldBegin(\""<< (*f_iter)->get_name()<<"\","
+ <<type_to_enum((*f_iter)->get_type())<<","
+ <<(*f_iter)->get_key()<<");" << endl;
+
+ // Write field contents
+ generate_serialize_field(out, *f_iter, "_v");
+
+ // Write field closer
+ indent(out) << "oprot#writeFieldEnd" << endl;
+
+ indent_down();
+ indent(out) << ");" << endl;
+ }
+
+ // Write the struct map
+ out <<
+ indent() << "oprot#writeFieldStop;" << endl <<
+ indent() << "oprot#writeStructEnd" << endl;
+
+ indent_down();
+}
+
+/**
+ * Generates a thrift service.
+ *
+ * @param tservice The service definition
+ */
+void t_ocaml_generator::generate_service(t_service* tservice) {
+ string f_service_name = string(T_OCAML_DIR)+"/"+capitalize(service_name_)+".ml";
+ f_service_.open(f_service_name.c_str());
+ string f_service_i_name = string(T_OCAML_DIR)+"/"+capitalize(service_name_)+".mli";
+ f_service_i_.open(f_service_i_name.c_str());
+
+ f_service_ <<
+ ocaml_autogen_comment() << endl <<
+ ocaml_imports() << endl;
+ f_service_i_ <<
+ ocaml_autogen_comment() << endl <<
+ ocaml_imports() << endl;
+
+ /* if (tservice->get_extends() != NULL) {
+ f_service_ <<
+ "open " << capitalize(tservice->get_extends()->get_name()) << endl;
+ f_service_i_ <<
+ "open " << capitalize(tservice->get_extends()->get_name()) << endl;
+ }
+ */
+ f_service_ <<
+ "open " << capitalize(program_name_) << "_types" << endl <<
+ endl;
+
+ f_service_i_ <<
+ "open " << capitalize(program_name_) << "_types" << endl <<
+ endl;
+
+ // Generate the three main parts of the service
+ generate_service_helpers(tservice);
+ generate_service_interface(tservice);
+ generate_service_client(tservice);
+ generate_service_server(tservice);
+
+
+ // Close service file
+ f_service_.close();
+ f_service_i_.close();
+}
+
+/**
+ * Generates helper functions for a service.
+ *
+ * @param tservice The service to generate a header definition for
+ */
+void t_ocaml_generator::generate_service_helpers(t_service* tservice) {
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+
+ indent(f_service_) <<
+ "(* HELPER FUNCTIONS AND STRUCTURES *)" << endl << endl;
+
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ t_struct* ts = (*f_iter)->get_arglist();
+ generate_ocaml_struct_definition(f_service_, ts, false);
+ generate_ocaml_function_helpers(*f_iter);
+ }
+}
+
+/**
+ * Generates a struct and helpers for a function.
+ *
+ * @param tfunction The function
+ */
+void t_ocaml_generator::generate_ocaml_function_helpers(t_function* tfunction) {
+ t_struct result(program_, decapitalize(tfunction->get_name()) + "_result");
+ t_field success(tfunction->get_returntype(), "success", 0);
+ if (!tfunction->get_returntype()->is_void()) {
+ result.append(&success);
+ }
+
+ t_struct* xs = tfunction->get_xceptions();
+ const vector<t_field*>& fields = xs->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ result.append(*f_iter);
+ }
+ generate_ocaml_struct_definition(f_service_, &result, false);
+}
+
+/**
+ * Generates a service interface definition.
+ *
+ * @param tservice The service to generate a header definition for
+ */
+void t_ocaml_generator::generate_service_interface(t_service* tservice) {
+ f_service_ <<
+ indent() << "class virtual iface =" << endl << "object (self)" << endl;
+ f_service_i_ <<
+ indent() << "class virtual iface :" << endl << "object" << endl;
+
+ indent_up();
+
+ if (tservice->get_extends() != NULL) {
+ string extends = type_name(tservice->get_extends());
+ indent(f_service_) << "inherit " << extends << ".iface" << endl;
+ indent(f_service_i_) << "inherit " << extends << ".iface" << endl;
+ }
+
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ string ft = function_type(*f_iter,true,true);
+ f_service_ <<
+ indent() << "method virtual " << decapitalize((*f_iter)->get_name()) << " : " << ft << endl;
+ f_service_i_ <<
+ indent() << "method virtual " << decapitalize((*f_iter)->get_name()) << " : " << ft << endl;
+ }
+ indent_down();
+ indent(f_service_) << "end" << endl << endl;
+ indent(f_service_i_) << "end" << endl << endl;
+}
+
+/**
+ * Generates a service client definition. Note that in OCaml, the client doesn't implement iface. This is because
+ * The client does not (and should not have to) deal with arguments being None.
+ *
+ * @param tservice The service to generate a server for.
+ */
+void t_ocaml_generator::generate_service_client(t_service* tservice) {
+ string extends = "";
+ indent(f_service_) <<
+ "class client (iprot : Protocol.t) (oprot : Protocol.t) =" << endl << "object (self)" << endl;
+ indent(f_service_i_) <<
+ "class client : Protocol.t -> Protocol.t -> " << endl << "object" << endl;
+ indent_up();
+
+
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends());
+ indent(f_service_) << "inherit " << extends << ".client iprot oprot as super" << endl;
+ indent(f_service_i_) << "inherit " << extends << ".client" << endl;
+ }
+ indent(f_service_) << "val mutable seqid = 0" << endl;
+
+
+ // Generate client method implementations
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::const_iterator f_iter;
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ t_struct* arg_struct = (*f_iter)->get_arglist();
+ const vector<t_field*>& fields = arg_struct->get_members();
+ vector<t_field*>::const_iterator fld_iter;
+ string funname = (*f_iter)->get_name();
+
+ // Open function
+ indent(f_service_) <<
+ "method " << function_signature(*f_iter) << " = " << endl;
+ indent(f_service_i_) <<
+ "method " << decapitalize((*f_iter)->get_name()) << " : " << function_type(*f_iter,true,false) << endl;
+ indent_up();
+ indent(f_service_) <<
+ "self#send_" << funname;
+
+
+ for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+ f_service_ << " " << decapitalize((*fld_iter)->get_name());
+ }
+ f_service_ << ";" << endl;
+
+ if (!(*f_iter)->is_async()) {
+ f_service_ << indent();
+ f_service_ <<
+ "self#recv_" << funname << endl;
+ }
+ indent_down();
+
+ indent(f_service_) <<
+ "method private send_" << function_signature(*f_iter) << " = " << endl;
+ indent_up();
+
+ std::string argsname = decapitalize((*f_iter)->get_name() + "_args");
+
+ // Serialize the request header
+ f_service_ <<
+ indent() << "oprot#writeMessageBegin (\"" << (*f_iter)->get_name() << "\", Protocol.CALL, seqid);" << endl;
+
+ f_service_ <<
+ indent() << "let args = new " << argsname << " in" << endl;
+ indent_up();
+
+ for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+ f_service_ <<
+ indent() << "args#set_" << (*fld_iter)->get_name() << " " << (*fld_iter)->get_name() << ";" << endl;
+ }
+
+ // Write to the stream
+ f_service_ <<
+ indent() << "args#write oprot;" << endl <<
+ indent() << "oprot#writeMessageEnd;" << endl <<
+ indent() << "oprot#getTransport#flush" << endl;
+
+ indent_down();
+ indent_down();
+
+ if (!(*f_iter)->is_async()) {
+ std::string resultname = decapitalize((*f_iter)->get_name() + "_result");
+ t_struct noargs(program_);
+
+ t_function recv_function((*f_iter)->get_returntype(),
+ string("recv_") + (*f_iter)->get_name(),
+ &noargs);
+ // Open function
+ f_service_ <<
+ indent() << "method private " << function_signature(&recv_function) << " =" << endl;
+ indent_up();
+
+ // TODO(mcslee): Validate message reply here, seq ids etc.
+
+ f_service_ <<
+ indent() << "let (fname, mtype, rseqid) = iprot#readMessageBegin in" << endl;
+ indent_up();
+ f_service_ <<
+ indent() << "(if mtype = Protocol.EXCEPTION then" << endl <<
+ indent() << " let x = Application_Exn.read iprot in" << endl;
+ indent_up();
+ f_service_ <<
+ indent() << " raise (Application_Exn.E x)" << endl;
+ indent_down();
+ f_service_ <<
+ indent() << "else ());" << endl;
+ string res = "_";
+
+ t_struct* xs = (*f_iter)->get_xceptions();
+ const std::vector<t_field*>& xceptions = xs->get_members();
+
+ if (!(*f_iter)->get_returntype()->is_void() || xceptions.size() > 0) {
+ res = "result";
+ }
+ f_service_ <<
+ indent() << "let "<<res<<" = read_" << resultname << " iprot in" << endl;
+ indent_up();
+ f_service_ <<
+ indent() << "iprot#readMessageEnd;" << endl;
+
+ // Careful, only return _result if not a void function
+ if (!(*f_iter)->get_returntype()->is_void()) {
+ f_service_ <<
+ indent() << "match result#get_success with Some v -> v | None -> (" << endl;
+ indent_up();
+ }
+
+
+ vector<t_field*>::const_iterator x_iter;
+ for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
+ f_service_ <<
+ indent() << "(match result#get_" << (*x_iter)->get_name() << " with None -> () | Some _v ->" << endl;
+ indent(f_service_) << " raise (" << capitalize(type_name((*x_iter)->get_type())) << " _v));" << endl;
+ }
+
+ // Careful, only return _result if not a void function
+ if ((*f_iter)->get_returntype()->is_void()) {
+ indent(f_service_) <<
+ "()" << endl;
+ } else {
+ f_service_ <<
+ indent() << "raise (Application_Exn.E (Application_Exn.create Application_Exn.MISSING_RESULT \"" << (*f_iter)->get_name() << " failed: unknown result\")))" << endl;
+ indent_down();
+ }
+
+ // Close function
+ indent_down();
+ indent_down();
+ indent_down();
+ }
+ }
+
+ indent_down();
+ indent(f_service_) << "end" << endl << endl;
+ indent(f_service_i_) << "end" << endl << endl;
+}
+
+/**
+ * Generates a service server definition.
+ *
+ * @param tservice The service to generate a server for.
+ */
+void t_ocaml_generator::generate_service_server(t_service* tservice) {
+ // Generate the dispatch methods
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+
+
+ // Generate the header portion
+ indent(f_service_) <<
+ "class processor (handler : iface) =" << endl << indent() << "object (self)" << endl;
+ indent(f_service_i_) <<
+ "class processor : iface ->" << endl << indent() << "object" << endl;
+ indent_up();
+
+ f_service_ <<
+ indent() << "inherit Processor.t" << endl <<
+ endl;
+ f_service_i_ <<
+ indent() << "inherit Processor.t" << endl <<
+ endl;
+ string extends = "";
+
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends());
+ indent(f_service_) << "inherit " + extends + ".processor (handler :> " + extends + ".iface)" << endl;
+ indent(f_service_i_) << "inherit " + extends + ".processor" << endl;
+ }
+
+ if (extends.empty()) {
+ indent(f_service_) << "val processMap = Hashtbl.create " << functions.size() << endl;
+ }
+ indent(f_service_i_) << "val processMap : (string, int * Protocol.t * Protocol.t -> unit) Hashtbl.t" << endl;
+
+ // Generate the server implementation
+ indent(f_service_) <<
+ "method process iprot oprot =" << endl;
+ indent(f_service_i_) <<
+ "method process : Protocol.t -> Protocol.t -> bool" << endl;
+ indent_up();
+
+ f_service_ <<
+ indent() << "let (name, typ, seqid) = iprot#readMessageBegin in" << endl;
+ indent_up();
+ // TODO(mcslee): validate message
+
+ // HOT: dictionary function lookup
+ f_service_ <<
+ indent() << "if Hashtbl.mem processMap name then" << endl <<
+ indent() << " (Hashtbl.find processMap name) (seqid, iprot, oprot)" << endl <<
+ indent() << "else (" << endl <<
+ indent() << " iprot#skip(Protocol.T_STRUCT);" << endl <<
+ indent() << " iprot#readMessageEnd;" << endl <<
+ indent() << " let x = Application_Exn.create Application_Exn.UNKNOWN_METHOD (\"Unknown function \"^name) in" << endl <<
+ indent() << " oprot#writeMessageBegin(name, Protocol.EXCEPTION, seqid);" << endl <<
+ indent() << " x#write oprot;" << endl <<
+ indent() << " oprot#writeMessageEnd;" << endl <<
+ indent() << " oprot#getTransport#flush" << endl <<
+ indent() << ");" << endl;
+
+ // Read end of args field, the T_STOP, and the struct close
+ f_service_ <<
+ indent() << "true" << endl;
+ indent_down();
+ indent_down();
+ // Generate the process subfunctions
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ generate_process_function(tservice, *f_iter);
+ }
+
+ indent(f_service_) << "initializer" << endl;
+ indent_up();
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ f_service_ <<
+ indent() << "Hashtbl.add processMap \"" << (*f_iter)->get_name() << "\" self#process_" << (*f_iter)->get_name() << ";" << endl;
+ }
+ indent_down();
+
+ indent_down();
+ indent(f_service_) << "end" << endl << endl;
+ indent(f_service_i_) << "end" << endl << endl;
+}
+
+/**
+ * Generates a process function definition.
+ *
+ * @param tfunction The function to write a dispatcher for
+ */
+void t_ocaml_generator::generate_process_function(t_service* tservice,
+ t_function* tfunction) {
+ // Open function
+ indent(f_service_) <<
+ "method private process_" << tfunction->get_name() <<
+ " (seqid, iprot, oprot) =" << endl;
+ indent_up();
+
+ string argsname = decapitalize(tfunction->get_name()) + "_args";
+ string resultname = decapitalize(tfunction->get_name()) + "_result";
+
+ // Generate the function call
+ t_struct* arg_struct = tfunction->get_arglist();
+ const std::vector<t_field*>& fields = arg_struct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+
+ string args = "args";
+ if(fields.size() == 0){
+ args="_";
+ }
+
+ f_service_ <<
+ indent() << "let "<<args<<" = read_" << argsname << " iprot in" << endl;
+ indent_up();
+ f_service_ <<
+ indent() << "iprot#readMessageEnd;" << endl;
+
+ t_struct* xs = tfunction->get_xceptions();
+ const std::vector<t_field*>& xceptions = xs->get_members();
+ vector<t_field*>::const_iterator x_iter;
+
+ // Declare result for non async function
+ if (!tfunction->is_async()) {
+ f_service_ <<
+ indent() << "let result = new " << resultname << " in" << endl;
+ indent_up();
+ }
+
+ // Try block for a function with exceptions
+ if (xceptions.size() > 0) {
+ f_service_ <<
+ indent() << "(try" << endl;
+ indent_up();
+ }
+
+
+
+
+ f_service_ << indent();
+ if (!tfunction->is_async() && !tfunction->get_returntype()->is_void()) {
+ f_service_ << "result#set_success ";
+ }
+ f_service_ <<
+ "(handler#" << tfunction->get_name();
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ f_service_ << " args#get_" << (*f_iter)->get_name();
+ }
+ f_service_ << ");" << endl;
+
+
+ if (xceptions.size() > 0) {
+ indent_down();
+ indent(f_service_) << "with" <<endl;
+ indent_up();
+ for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
+ f_service_ <<
+ indent() << "| " << capitalize(type_name((*x_iter)->get_type())) << " " << (*x_iter)->get_name() << " -> " << endl;
+ indent_up();
+ indent_up();
+ if(!tfunction->is_async()){
+ f_service_ <<
+ indent() << "result#set_" << (*x_iter)->get_name() << " " << (*x_iter)->get_name() << endl;
+ } else {
+ indent(f_service_) << "()";
+ }
+ indent_down();
+ indent_down();
+ }
+ indent_down();
+ f_service_ << indent() << ");" << endl;
+ }
+
+
+
+ // Shortcut out here for async functions
+ if (tfunction->is_async()) {
+ f_service_ <<
+ indent() << "()" << endl;
+ indent_down();
+ indent_down();
+ return;
+ }
+
+ f_service_ <<
+ indent() << "oprot#writeMessageBegin (\"" << tfunction->get_name() << "\", Protocol.REPLY, seqid);" << endl <<
+ indent() << "result#write oprot;" << endl <<
+ indent() << "oprot#writeMessageEnd;" << endl <<
+ indent() << "oprot#getTransport#flush" << endl;
+
+ // Close function
+ indent_down();
+ indent_down();
+ indent_down();
+}
+
+/**
+ * Deserializes a field of any type.
+ */
+void t_ocaml_generator::generate_deserialize_field(ofstream &out,
+ t_field* tfield,
+ string prefix){
+ t_type* type = tfield->get_type();
+
+
+ string name = decapitalize(tfield->get_name());
+ indent(out) << prefix << "#set_"<<name << " ";
+ generate_deserialize_type(out,type);
+ out << endl;
+}
+
+
+/**
+ * Deserializes a field of any type.
+ */
+void t_ocaml_generator::generate_deserialize_type(ofstream &out,
+ t_type* type){
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_void()) {
+ throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE";
+ }
+
+
+ if (type->is_struct() || type->is_xception()) {
+ generate_deserialize_struct(out,
+ (t_struct*)type);
+ } else if (type->is_container()) {
+ generate_deserialize_container(out, type);
+ } else if (type->is_base_type()) {
+ out << "iprot#";
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ throw "compiler error: cannot serialize void field in a struct";
+ break;
+ case t_base_type::TYPE_STRING:
+ out << "readString";
+ break;
+ case t_base_type::TYPE_BOOL:
+ out << "readBool";
+ break;
+ case t_base_type::TYPE_BYTE:
+ out << "readByte";
+ break;
+ case t_base_type::TYPE_I16:
+ out << "readI16";
+ break;
+ case t_base_type::TYPE_I32:
+ out << "readI32";
+ break;
+ case t_base_type::TYPE_I64:
+ out << "readI64";
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ out << "readDouble";
+ break;
+ default:
+ throw "compiler error: no PHP name for base type " + tbase;
+ }
+ } else if (type->is_enum()) {
+ string ename = capitalize(type->get_name());
+ out << "(" <<ename << ".of_i iprot#readI32)";
+ } else {
+ printf("DO NOT KNOW HOW TO DESERIALIZE TYPE '%s'\n",
+ type->get_name().c_str());
+ }
+}
+
+
+/**
+ * Generates an unserializer for a struct, calling read()
+ */
+void t_ocaml_generator::generate_deserialize_struct(ofstream &out,
+ t_struct* tstruct) {
+ string name = decapitalize(tstruct->get_name());
+ out << "(read_" << name << " iprot)";
+
+}
+
+/**
+ * Serialize a container by writing out the header followed by
+ * data and then a footer.
+ */
+void t_ocaml_generator::generate_deserialize_container(ofstream &out,
+ t_type* ttype) {
+ string size = tmp("_size");
+ string ktype = tmp("_ktype");
+ string vtype = tmp("_vtype");
+ string etype = tmp("_etype");
+ string con = tmp("_con");
+
+ t_field fsize(g_type_i32, size);
+ t_field fktype(g_type_byte, ktype);
+ t_field fvtype(g_type_byte, vtype);
+ t_field fetype(g_type_byte, etype);
+
+ out << endl;
+ indent_up();
+ // Declare variables, read header
+ if (ttype->is_map()) {
+ indent(out) << "(let ("<<ktype<<","<<vtype<<","<<size<<") = iprot#readMapBegin in" << endl;
+ indent(out) << "let "<<con<<" = Hashtbl.create "<<size<<" in" << endl;
+ indent_up();
+ indent(out) << "for i = 1 to "<<size<<" do" <<endl;
+ indent_up();
+ indent(out) << "let _k = ";
+ generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
+ out << " in" << endl;
+ indent(out) << "let _v = ";
+ generate_deserialize_type(out,((t_map*)ttype)->get_val_type());
+ out << " in" << endl;
+ indent_up();
+ indent(out) << "Hashtbl.add "<<con<< " _k _v" << endl;
+ indent_down();
+ indent_down();
+ indent(out) << "done; iprot#readMapEnd; "<<con<<")";
+ indent_down();
+ } else if (ttype->is_set()) {
+ indent(out) << "(let ("<<etype<<","<<size<<") = iprot#readSetBegin in" << endl;
+ indent(out) << "let "<<con<<" = Hashtbl.create "<<size<<" in" << endl;
+ indent_up();
+ indent(out) << "for i = 1 to "<<size<<" do" <<endl;
+ indent_up();
+ indent(out) << "Hashtbl.add "<<con<<" ";
+ generate_deserialize_type(out,((t_set*)ttype)->get_elem_type());
+ out << " true" << endl;
+ indent_down();
+ indent(out) << "done; iprot#readSetEnd; "<<con<<")";
+ indent_down();
+ } else if (ttype->is_list()) {
+ indent(out) << "(let ("<<etype<<","<<size<<") = iprot#readListBegin in" << endl;
+ indent_up();
+ indent(out) << "let "<<con<<" = (Array.to_list (Array.init "<<size<<" (fun _ -> ";
+ generate_deserialize_type(out,((t_list*)ttype)->get_elem_type());
+ out << "))) in" << endl;
+ indent_up();
+ indent(out) << "iprot#readListEnd; "<<con<<")";
+ indent_down();
+ indent_down();
+ }
+ indent_down();
+}
+
+
+
+/**
+ * Serializes a field of any type.
+ *
+ * @param tfield The field to serialize
+ * @param prefix Name to prepend to field name
+ */
+void t_ocaml_generator::generate_serialize_field(ofstream &out,
+ t_field* tfield,
+ string name) {
+ t_type* type = tfield->get_type();
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ // Do nothing for void types
+ if (type->is_void()) {
+ throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " +
+ tfield->get_name();
+ }
+
+ if(name.length() == 0){
+ name = decapitalize(tfield->get_name());
+ }
+
+ if (type->is_struct() || type->is_xception()) {
+ generate_serialize_struct(out,
+ (t_struct*)type,
+ name);
+ } else if (type->is_container()) {
+ generate_serialize_container(out,
+ type,
+ name);
+ } else if (type->is_base_type() || type->is_enum()) {
+
+
+ indent(out) <<
+ "oprot#";
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ throw
+ "compiler error: cannot serialize void field in a struct: " + name;
+ break;
+ case t_base_type::TYPE_STRING:
+ out << "writeString(" << name << ")";
+ break;
+ case t_base_type::TYPE_BOOL:
+ out << "writeBool(" << name << ")";
+ break;
+ case t_base_type::TYPE_BYTE:
+ out << "writeByte(" << name << ")";
+ break;
+ case t_base_type::TYPE_I16:
+ out << "writeI16(" << name << ")";
+ break;
+ case t_base_type::TYPE_I32:
+ out << "writeI32(" << name << ")";
+ break;
+ case t_base_type::TYPE_I64:
+ out << "writeI64(" << name << ")";
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ out << "writeDouble(" << name << ")";
+ break;
+ default:
+ throw "compiler error: no ocaml name for base type " + tbase;
+ }
+ } else if (type->is_enum()) {
+ string ename = capitalize(type->get_name());
+ out << "writeI32("<<ename<<".to_i " << name << ")";
+ }
+
+ } else {
+ printf("DO NOT KNOW HOW TO SERIALIZE FIELD '%s' TYPE '%s'\n",
+ tfield->get_name().c_str(),
+ type->get_name().c_str());
+ }
+ out << ";" << endl;
+}
+
+/**
+ * Serializes all the members of a struct.
+ *
+ * @param tstruct The struct to serialize
+ * @param prefix String prefix to attach to all fields
+ */
+void t_ocaml_generator::generate_serialize_struct(ofstream &out,
+ t_struct* tstruct,
+ string prefix) {
+ indent(out) << prefix << "#write(oprot)";
+}
+
+void t_ocaml_generator::generate_serialize_container(ofstream &out,
+ t_type* ttype,
+ string prefix) {
+ if (ttype->is_map()) {
+ indent(out) << "oprot#writeMapBegin("<< type_to_enum(((t_map*)ttype)->get_key_type()) << ",";
+ out << type_to_enum(((t_map*)ttype)->get_val_type()) << ",";
+ out << "Hashtbl.length " << prefix << ");" << endl;
+ } else if (ttype->is_set()) {
+ indent(out) <<
+ "oprot#writeSetBegin(" << type_to_enum(((t_set*)ttype)->get_elem_type()) << ",";
+ out << "Hashtbl.length " << prefix << ");" << endl;
+ } else if (ttype->is_list()) {
+ indent(out) <<
+ "oprot#writeListBegin(" << type_to_enum(((t_list*)ttype)->get_elem_type()) << ",";
+ out << "List.length " << prefix << ");" << endl;
+ }
+
+ if (ttype->is_map()) {
+ string kiter = tmp("_kiter");
+ string viter = tmp("_viter");
+ indent(out) << "Hashtbl.iter (fun "<<kiter<<" -> fun " << viter << " -> " << endl;
+ indent_up();
+ generate_serialize_map_element(out, (t_map*)ttype, kiter, viter);
+ indent_down();
+ indent(out) << ") " << prefix << ";" << endl;
+ } else if (ttype->is_set()) {
+ string iter = tmp("_iter");
+ indent(out) << "Hashtbl.iter (fun "<<iter<<" -> fun _ -> ";
+ indent_up();
+ generate_serialize_set_element(out, (t_set*)ttype, iter);
+ indent_down();
+ indent(out) << ") " << prefix << ";" << endl;
+ } else if (ttype->is_list()) {
+ string iter = tmp("_iter");
+ indent(out) << "List.iter (fun "<<iter<<" -> ";
+ indent_up();
+ generate_serialize_list_element(out, (t_list*)ttype, iter);
+ indent_down();
+ indent(out) << ") " << prefix << ";" << endl;
+ }
+
+ if (ttype->is_map()) {
+ indent(out) <<
+ "oprot#writeMapEnd";
+ } else if (ttype->is_set()) {
+ indent(out) <<
+ "oprot#writeSetEnd";
+ } else if (ttype->is_list()) {
+ indent(out) <<
+ "oprot#writeListEnd";
+ }
+}
+
+/**
+ * Serializes the members of a map.
+ *
+ */
+void t_ocaml_generator::generate_serialize_map_element(ofstream &out,
+ t_map* tmap,
+ string kiter,
+ string viter) {
+ t_field kfield(tmap->get_key_type(), kiter);
+ generate_serialize_field(out, &kfield);
+
+ t_field vfield(tmap->get_val_type(), viter);
+ generate_serialize_field(out, &vfield);
+}
+
+/**
+ * Serializes the members of a set.
+ */
+void t_ocaml_generator::generate_serialize_set_element(ofstream &out,
+ t_set* tset,
+ string iter) {
+ t_field efield(tset->get_elem_type(), iter);
+ generate_serialize_field(out, &efield);
+}
+
+/**
+ * Serializes the members of a list.
+ */
+void t_ocaml_generator::generate_serialize_list_element(ofstream &out,
+ t_list* tlist,
+ string iter) {
+ t_field efield(tlist->get_elem_type(), iter);
+ generate_serialize_field(out, &efield);
+}
+
+
+
+/**
+ * Renders a function signature of the form 'name args'
+ *
+ * @param tfunction Function definition
+ * @return String of rendered function definition
+ */
+string t_ocaml_generator::function_signature(t_function* tfunction,
+ string prefix) {
+ return
+ prefix + decapitalize(tfunction->get_name()) +
+ " " + argument_list(tfunction->get_arglist());
+}
+
+string t_ocaml_generator::function_type(t_function* tfunc, bool method, bool options){
+ string result="";
+
+ const vector<t_field*>& fields = tfunc->get_arglist()->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ result += render_ocaml_type((*f_iter)->get_type());
+ if(options)
+ result += " option";
+ result += " -> ";
+ }
+ if(fields.empty() && !method){
+ result += "unit -> ";
+ }
+ result += render_ocaml_type(tfunc->get_returntype());
+ return result;
+}
+
+/**
+ * Renders a field list
+ */
+string t_ocaml_generator::argument_list(t_struct* tstruct) {
+ string result = "";
+
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ bool first = true;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if (first) {
+ first = false;
+ } else {
+ result += " ";
+ }
+ result += (*f_iter)->get_name();
+ }
+ return result;
+}
+
+string t_ocaml_generator::type_name(t_type* ttype) {
+ string prefix = "";
+ t_program* program = ttype->get_program();
+ if (program != NULL && program != program_) {
+ if (!ttype->is_service()) {
+ prefix = capitalize(program->get_name()) + "_types.";
+ }
+ }
+
+ string name = ttype->get_name();
+ if(ttype->is_service()){
+ name = capitalize(name);
+ } else {
+ name = decapitalize(name);
+ }
+ return prefix + name;
+}
+
+/**
+ * Converts the parse type to a Protocol.t_type enum
+ */
+string t_ocaml_generator::type_to_enum(t_type* type) {
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ return "Protocol.T_VOID";
+ case t_base_type::TYPE_STRING:
+ return "Protocol.T_STRING";
+ case t_base_type::TYPE_BOOL:
+ return "Protocol.T_BOOL";
+ case t_base_type::TYPE_BYTE:
+ return "Protocol.T_BYTE";
+ case t_base_type::TYPE_I16:
+ return "Protocol.T_I16";
+ case t_base_type::TYPE_I32:
+ return "Protocol.T_I32";
+ case t_base_type::TYPE_I64:
+ return "Protocol.T_I64";
+ case t_base_type::TYPE_DOUBLE:
+ return "Protocol.T_DOUBLE";
+ }
+ } else if (type->is_enum()) {
+ return "Protocol.T_I32";
+ } else if (type->is_struct() || type->is_xception()) {
+ return "Protocol.T_STRUCT";
+ } else if (type->is_map()) {
+ return "Protocol.T_MAP";
+ } else if (type->is_set()) {
+ return "Protocol.T_SET";
+ } else if (type->is_list()) {
+ return "Protocol.T_LIST";
+ }
+
+ throw "INVALID TYPE IN type_to_enum: " + type->get_name();
+}
+
+/**
+ * Converts the parse type to an ocaml type
+ */
+string t_ocaml_generator::render_ocaml_type(t_type* type) {
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ return "unit";
+ case t_base_type::TYPE_STRING:
+ return "string";
+ case t_base_type::TYPE_BOOL:
+ return "bool";
+ case t_base_type::TYPE_BYTE:
+ return "int";
+ case t_base_type::TYPE_I16:
+ return "int";
+ case t_base_type::TYPE_I32:
+ return "int";
+ case t_base_type::TYPE_I64:
+ return "Int64.t";
+ case t_base_type::TYPE_DOUBLE:
+ return "float";
+ }
+ } else if (type->is_enum()) {
+ return capitalize(((t_enum*)type)->get_name())+".t";
+ } else if (type->is_struct() || type->is_xception()) {
+ return type_name((t_struct*)type);
+ } else if (type->is_map()) {
+ t_type* ktype = ((t_map*)type)->get_key_type();
+ t_type* vtype = ((t_map*)type)->get_val_type();
+ return "("+render_ocaml_type(ktype)+","+render_ocaml_type(vtype)+") Hashtbl.t";
+ } else if (type->is_set()) {
+ t_type* etype = ((t_set*)type)->get_elem_type();
+ return "("+render_ocaml_type(etype)+",bool) Hashtbl.t";
+ } else if (type->is_list()) {
+ t_type* etype = ((t_list*)type)->get_elem_type();
+ return render_ocaml_type(etype)+" list";
+ }
+
+ throw "INVALID TYPE IN type_to_enum: " + type->get_name();
+}
diff --git a/compiler/cpp/src/generate/t_ocaml_generator.h b/compiler/cpp/src/generate/t_ocaml_generator.h
new file mode 100644
index 0000000..1ea9b2f
--- /dev/null
+++ b/compiler/cpp/src/generate/t_ocaml_generator.h
@@ -0,0 +1,148 @@
+// Copyright (c) 2006- Facebook
+// Distributed under the Thrift Software License
+//
+// See accompanying file LICENSE or visit the Thrift site at:
+// http://developers.facebook.com/thrift/
+
+#ifndef T_OCAML_GENERATOR_H
+#define T_OCAML_GENERATOR_H
+
+#include <string>
+#include <fstream>
+#include <iostream>
+#include <vector>
+
+#include "t_oop_generator.h"
+
+#define T_OCAML_DIR "gen-ocaml"
+
+/**
+ * OCaml code generator.
+ *
+ * @author Iain Proctor <iproctor@facebook.com>
+ */
+class t_ocaml_generator : public t_oop_generator {
+ public:
+ t_ocaml_generator(t_program* program) :
+ t_oop_generator(program) {}
+
+ /**
+ * Init and close methods
+ */
+
+ void init_generator();
+ void close_generator();
+
+ /**
+ * Program-level generation functions
+ */
+ void generate_program ();
+ void generate_typedef (t_typedef* ttypedef);
+ void generate_enum (t_enum* tenum);
+ void generate_const (t_const* tconst);
+ void generate_struct (t_struct* tstruct);
+ void generate_xception (t_struct* txception);
+ void generate_service (t_service* tservice);
+
+ std::string render_const_value(t_type* type, t_const_value* value);
+
+ /**
+ * Struct generation code
+ */
+
+ void generate_ocaml_struct(t_struct* tstruct, bool is_exception);
+ void generate_ocaml_struct_definition(std::ofstream& out, t_struct* tstruct, bool is_xception=false);
+ void generate_ocaml_struct_sig(std::ofstream& out, t_struct* tstruct, bool is_exception);
+ void generate_ocaml_struct_reader(std::ofstream& out, t_struct* tstruct);
+ void generate_ocaml_struct_writer(std::ofstream& out, t_struct* tstruct);
+ void generate_ocaml_function_helpers(t_function* tfunction);
+
+ /**
+ * Service-level generation functions
+ */
+
+ void generate_service_helpers (t_service* tservice);
+ void generate_service_interface (t_service* tservice);
+ void generate_service_client (t_service* tservice);
+ void generate_service_server (t_service* tservice);
+ void generate_process_function (t_service* tservice, t_function* tfunction);
+
+ /**
+ * Serialization constructs
+ */
+
+ void generate_deserialize_field (std::ofstream &out,
+ t_field* tfield,
+ std::string prefix);
+
+ void generate_deserialize_struct (std::ofstream &out,
+ t_struct* tstruct);
+
+ void generate_deserialize_container (std::ofstream &out,
+ t_type* ttype);
+
+ void generate_deserialize_set_element (std::ofstream &out,
+ t_set* tset);
+
+
+ void generate_deserialize_list_element (std::ofstream &out,
+ t_list* tlist,
+ std::string prefix="");
+ void generate_deserialize_type (std::ofstream &out,
+ t_type* type);
+
+ void generate_serialize_field (std::ofstream &out,
+ t_field* tfield,
+ std::string name= "");
+
+ void generate_serialize_struct (std::ofstream &out,
+ t_struct* tstruct,
+ std::string prefix="");
+
+ void generate_serialize_container (std::ofstream &out,
+ t_type* ttype,
+ std::string prefix="");
+
+ void generate_serialize_map_element (std::ofstream &out,
+ t_map* tmap,
+ std::string kiter,
+ std::string viter);
+
+ void generate_serialize_set_element (std::ofstream &out,
+ t_set* tmap,
+ std::string iter);
+
+ void generate_serialize_list_element (std::ofstream &out,
+ t_list* tlist,
+ std::string iter);
+
+ /**
+ * Helper rendering functions
+ */
+
+ std::string ocaml_autogen_comment();
+ std::string ocaml_imports();
+ std::string type_name(t_type* ttype);
+ std::string function_signature(t_function* tfunction, std::string prefix="");
+ std::string function_type(t_function* tfunc, bool method=false, bool options = false);
+ std::string argument_list(t_struct* tstruct);
+ std::string type_to_enum(t_type* ttype);
+ std::string render_ocaml_type(t_type* type);
+
+
+ private:
+
+ /**
+ * File streams
+ */
+
+ std::ofstream f_types_;
+ std::ofstream f_consts_;
+ std::ofstream f_service_;
+
+ std::ofstream f_types_i_;
+ std::ofstream f_service_i_;
+
+};
+
+#endif
diff --git a/compiler/cpp/src/generate/t_rb_generator.h b/compiler/cpp/src/generate/t_rb_generator.h
index 61a1d30..0c7524f 100644
--- a/compiler/cpp/src/generate/t_rb_generator.h
+++ b/compiler/cpp/src/generate/t_rb_generator.h
@@ -136,10 +136,7 @@
std::string argument_list(t_struct* tstruct);
std::string type_to_enum(t_type* ttype);
- std::string capitalize(std::string in) {
- in[0] = toupper(in[0]);
- return in;
- }
+
std::string ruby_namespace(t_program* p) {
std::string ns = p->get_ruby_namespace();
diff --git a/compiler/cpp/src/main.cc b/compiler/cpp/src/main.cc
index 949558e..b2abb9b 100644
--- a/compiler/cpp/src/main.cc
+++ b/compiler/cpp/src/main.cc
@@ -35,6 +35,7 @@
#include "generate/t_rb_generator.h"
#include "generate/t_xsd_generator.h"
#include "generate/t_perl_generator.h"
+#include "generate/t_ocaml_generator.h"
#include "generate/t_erl_generator.h"
using namespace std;
@@ -126,6 +127,7 @@
bool gen_phpi = false;
bool gen_rest = false;
bool gen_perl = false;
+bool gen_ocaml = false;
bool gen_erl = false;
bool gen_recurse = false;
@@ -304,6 +306,7 @@
fprintf(stderr, " -rb Generate Ruby output files\n");
fprintf(stderr, " -xsd Generate XSD output files\n");
fprintf(stderr, " -perl Generate Perl output files\n");
+ fprintf(stderr, " -ocaml Generate OCaml output files\n");
fprintf(stderr, " -erl Generate Erlang output files\n");
fprintf(stderr, " -I dir Add a directory to the list of directories \n");
fprintf(stderr, " searched for include directives\n");
@@ -567,6 +570,13 @@
delete perl;
}
+ if (gen_ocaml) {
+ pverbose("Generating OCaml\n");
+ t_ocaml_generator* ocaml = new t_ocaml_generator(program);
+ ocaml->generate_program();
+ delete ocaml;
+ }
+
if (gen_erl) {
pverbose("Generating Erlang\n");
t_erl_generator* erl = new t_erl_generator(program);
@@ -574,6 +584,7 @@
delete erl;
}
+
} catch (string s) {
printf("Error: %s\n", s.c_str());
} catch (const char* exc) {
@@ -638,6 +649,8 @@
gen_xsd = true;
} else if (strcmp(arg, "-perl") == 0) {
gen_perl = true;
+ } else if (strcmp(arg, "-ocaml") == 0) {
+ gen_ocaml = true;
} else if (strcmp(arg, "-erl") == 0) {
gen_erl = true;
} else if (strcmp(arg, "-I") == 0) {
@@ -660,7 +673,7 @@
}
// You gotta generate something!
- if (!gen_cpp && !gen_java && !gen_php && !gen_phpi && !gen_py && !gen_rb && !gen_xsd && !gen_perl && !gen_erl) {
+ if (!gen_cpp && !gen_java && !gen_php && !gen_phpi && !gen_py && !gen_rb && !gen_xsd && !gen_perl && !gen_ocaml && !gen_erl) {
fprintf(stderr, "!!! No output language(s) specified\n\n");
usage();
}
diff --git a/lib/ocaml/Makefile b/lib/ocaml/Makefile
new file mode 100644
index 0000000..80ddb05
--- /dev/null
+++ b/lib/ocaml/Makefile
@@ -0,0 +1,4 @@
+all:
+ cd src; make; cd ..
+clean:
+ cd src; make clean; cd ..
diff --git a/lib/ocaml/OCamlMakefile b/lib/ocaml/OCamlMakefile
new file mode 100644
index 0000000..dfb6c78
--- /dev/null
+++ b/lib/ocaml/OCamlMakefile
@@ -0,0 +1,1189 @@
+###########################################################################
+# OCamlMakefile
+# Copyright (C) 1999-2007 Markus Mottl
+#
+# For updates see:
+# http://www.ocaml.info/home/ocaml_sources.html
+#
+###########################################################################
+
+# Modified by damien for .glade.ml compilation
+
+# Set these variables to the names of the sources to be processed and
+# the result variable. Order matters during linkage!
+
+ifndef SOURCES
+ SOURCES := foo.ml
+endif
+export SOURCES
+
+ifndef RES_CLIB_SUF
+ RES_CLIB_SUF := _stubs
+endif
+export RES_CLIB_SUF
+
+ifndef RESULT
+ RESULT := foo
+endif
+export RESULT := $(strip $(RESULT))
+
+export LIB_PACK_NAME
+
+ifndef DOC_FILES
+ DOC_FILES := $(filter %.mli, $(SOURCES))
+endif
+export DOC_FILES
+FIRST_DOC_FILE := $(firstword $(DOC_FILES))
+
+export BCSUFFIX
+export NCSUFFIX
+
+ifndef TOPSUFFIX
+ TOPSUFFIX := .top
+endif
+export TOPSUFFIX
+
+# Eventually set include- and library-paths, libraries to link,
+# additional compilation-, link- and ocamlyacc-flags
+# Path- and library information needs not be written with "-I" and such...
+# Define THREADS if you need it, otherwise leave it unset (same for
+# USE_CAMLP4)!
+
+export THREADS
+export VMTHREADS
+export ANNOTATE
+export USE_CAMLP4
+
+export INCDIRS
+export LIBDIRS
+export EXTLIBDIRS
+export RESULTDEPS
+export OCAML_DEFAULT_DIRS
+
+export LIBS
+export CLIBS
+export CFRAMEWORKS
+
+export OCAMLFLAGS
+export OCAMLNCFLAGS
+export OCAMLBCFLAGS
+
+export OCAMLLDFLAGS
+export OCAMLNLDFLAGS
+export OCAMLBLDFLAGS
+
+export OCAMLMKLIB_FLAGS
+
+ifndef OCAMLCPFLAGS
+ OCAMLCPFLAGS := a
+endif
+export OCAMLCPFLAGS
+
+ifndef DOC_DIR
+ DOC_DIR := doc
+endif
+export DOC_DIR
+
+export PPFLAGS
+
+export LFLAGS
+export YFLAGS
+export IDLFLAGS
+
+export OCAMLDOCFLAGS
+
+export OCAMLFIND_INSTFLAGS
+
+export DVIPSFLAGS
+
+export STATIC
+
+# Add a list of optional trash files that should be deleted by "make clean"
+export TRASH
+
+ECHO := echo
+
+ifdef REALLY_QUIET
+ export REALLY_QUIET
+ ECHO := true
+ LFLAGS := $(LFLAGS) -q
+ YFLAGS := $(YFLAGS) -q
+endif
+
+#################### variables depending on your OCaml-installation
+
+ifdef MINGW
+ export MINGW
+ WIN32 := 1
+ CFLAGS_WIN32 := -mno-cygwin
+endif
+ifdef MSVC
+ export MSVC
+ WIN32 := 1
+ ifndef STATIC
+ CPPFLAGS_WIN32 := -DCAML_DLL
+ endif
+ CFLAGS_WIN32 += -nologo
+ EXT_OBJ := obj
+ EXT_LIB := lib
+ ifeq ($(CC),gcc)
+ # work around GNU Make default value
+ ifdef THREADS
+ CC := cl -MT
+ else
+ CC := cl
+ endif
+ endif
+ ifeq ($(CXX),g++)
+ # work around GNU Make default value
+ CXX := $(CC)
+ endif
+ CFLAG_O := -Fo
+endif
+ifdef WIN32
+ EXT_CXX := cpp
+ EXE := .exe
+endif
+
+ifndef EXT_OBJ
+ EXT_OBJ := o
+endif
+ifndef EXT_LIB
+ EXT_LIB := a
+endif
+ifndef EXT_CXX
+ EXT_CXX := cc
+endif
+ifndef EXE
+ EXE := # empty
+endif
+ifndef CFLAG_O
+ CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)!
+endif
+
+export CC
+export CXX
+export CFLAGS
+export CXXFLAGS
+export LDFLAGS
+export CPPFLAGS
+
+ifndef RPATH_FLAG
+ ifdef ELF_RPATH_FLAG
+ RPATH_FLAG := $(ELF_RPATH_FLAG)
+ else
+ RPATH_FLAG := -R
+ endif
+endif
+export RPATH_FLAG
+
+ifndef MSVC
+ifndef PIC_CFLAGS
+ PIC_CFLAGS := -fPIC
+endif
+ifndef PIC_CPPFLAGS
+ PIC_CPPFLAGS := -DPIC
+endif
+endif
+
+export PIC_CFLAGS
+export PIC_CPPFLAGS
+
+BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT))
+NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT))
+TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT))
+
+ifndef OCAMLFIND
+ OCAMLFIND := ocamlfind
+endif
+export OCAMLFIND
+
+ifndef OCAMLC
+ OCAMLC := ocamlc
+endif
+export OCAMLC
+
+ifndef OCAMLOPT
+ OCAMLOPT := ocamlopt
+endif
+export OCAMLOPT
+
+ifndef OCAMLMKTOP
+ OCAMLMKTOP := ocamlmktop
+endif
+export OCAMLMKTOP
+
+ifndef OCAMLCP
+ OCAMLCP := ocamlcp
+endif
+export OCAMLCP
+
+ifndef OCAMLDEP
+ OCAMLDEP := ocamldep
+endif
+export OCAMLDEP
+
+ifndef OCAMLLEX
+ OCAMLLEX := ocamllex
+endif
+export OCAMLLEX
+
+ifndef OCAMLYACC
+ OCAMLYACC := ocamlyacc
+endif
+export OCAMLYACC
+
+ifndef OCAMLMKLIB
+ OCAMLMKLIB := ocamlmklib
+endif
+export OCAMLMKLIB
+
+ifndef OCAML_GLADECC
+ OCAML_GLADECC := lablgladecc2
+endif
+export OCAML_GLADECC
+
+ifndef OCAML_GLADECC_FLAGS
+ OCAML_GLADECC_FLAGS :=
+endif
+export OCAML_GLADECC_FLAGS
+
+ifndef CAMELEON_REPORT
+ CAMELEON_REPORT := report
+endif
+export CAMELEON_REPORT
+
+ifndef CAMELEON_REPORT_FLAGS
+ CAMELEON_REPORT_FLAGS :=
+endif
+export CAMELEON_REPORT_FLAGS
+
+ifndef CAMELEON_ZOGGY
+ CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo
+endif
+export CAMELEON_ZOGGY
+
+ifndef CAMELEON_ZOGGY_FLAGS
+ CAMELEON_ZOGGY_FLAGS :=
+endif
+export CAMELEON_ZOGGY_FLAGS
+
+ifndef OXRIDL
+ OXRIDL := oxridl
+endif
+export OXRIDL
+
+ifndef CAMLIDL
+ CAMLIDL := camlidl
+endif
+export CAMLIDL
+
+ifndef CAMLIDLDLL
+ CAMLIDLDLL := camlidldll
+endif
+export CAMLIDLDLL
+
+ifndef NOIDLHEADER
+ MAYBE_IDL_HEADER := -header
+endif
+export NOIDLHEADER
+
+export NO_CUSTOM
+
+ifndef CAMLP4
+ CAMLP4 := camlp4
+endif
+export CAMLP4
+
+ifndef REAL_OCAMLFIND
+ ifdef PACKS
+ ifndef CREATE_LIB
+ ifdef THREADS
+ PACKS += threads
+ endif
+ endif
+ empty :=
+ space := $(empty) $(empty)
+ comma := ,
+ ifdef PREDS
+ PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS))
+ PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS))
+ OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES)
+ # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES)
+ OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ else
+ OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS))
+ OCAML_DEP_PACKAGES :=
+ endif
+ OCAML_FIND_LINKPKG := -linkpkg
+ REAL_OCAMLFIND := $(OCAMLFIND)
+ endif
+endif
+
+export OCAML_FIND_PACKAGES
+export OCAML_DEP_PACKAGES
+export OCAML_FIND_LINKPKG
+export REAL_OCAMLFIND
+
+ifndef OCAMLDOC
+ OCAMLDOC := ocamldoc
+endif
+export OCAMLDOC
+
+ifndef LATEX
+ LATEX := latex
+endif
+export LATEX
+
+ifndef DVIPS
+ DVIPS := dvips
+endif
+export DVIPS
+
+ifndef PS2PDF
+ PS2PDF := ps2pdf
+endif
+export PS2PDF
+
+ifndef OCAMLMAKEFILE
+ OCAMLMAKEFILE := OCamlMakefile
+endif
+export OCAMLMAKEFILE
+
+ifndef OCAMLLIBPATH
+ OCAMLLIBPATH := \
+ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml)
+endif
+export OCAMLLIBPATH
+
+ifndef OCAML_LIB_INSTALL
+ OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib
+endif
+export OCAML_LIB_INSTALL
+
+###########################################################################
+
+#################### change following sections only if
+#################### you know what you are doing!
+
+# delete target files when a build command fails
+.PHONY: .DELETE_ON_ERROR
+.DELETE_ON_ERROR:
+
+# for pedants using "--warn-undefined-variables"
+export MAYBE_IDL
+export REAL_RESULT
+export CAMLIDLFLAGS
+export THREAD_FLAG
+export RES_CLIB
+export MAKEDLL
+export ANNOT_FLAG
+export C_OXRIDL
+export SUBPROJS
+export CFLAGS_WIN32
+export CPPFLAGS_WIN32
+
+INCFLAGS :=
+
+SHELL := /bin/sh
+
+MLDEPDIR := ._d
+BCDIDIR := ._bcdi
+NCDIDIR := ._ncdi
+
+FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade
+
+FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES))
+SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED))))
+
+FILTERED_REP := $(filter %.rep, $(FILTERED))
+DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d)
+AUTO_REP := $(FILTERED_REP:.rep=.ml)
+
+FILTERED_ZOG := $(filter %.zog, $(FILTERED))
+DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d)
+AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml)
+
+FILTERED_GLADE := $(filter %.glade, $(FILTERED))
+DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d)
+AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml)
+
+FILTERED_ML := $(filter %.ml, $(FILTERED))
+DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d)
+
+FILTERED_MLI := $(filter %.mli, $(FILTERED))
+DEP_MLI := $(FILTERED_MLI:.mli=.di)
+
+FILTERED_MLL := $(filter %.mll, $(FILTERED))
+DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d)
+AUTO_MLL := $(FILTERED_MLL:.mll=.ml)
+
+FILTERED_MLY := $(filter %.mly, $(FILTERED))
+DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di)
+AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml)
+
+FILTERED_IDL := $(filter %.idl, $(FILTERED))
+DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di)
+C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c)
+ifndef NOIDLHEADER
+ C_IDL += $(FILTERED_IDL:.idl=.h)
+endif
+OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ))
+AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL)
+
+FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED))
+DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di)
+AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL)
+
+FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED))
+OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ))
+OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ))
+OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ))
+
+PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE)
+
+ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE)
+
+MLDEPS := $(filter %.d, $(ALL_DEPS))
+MLIDEPS := $(filter %.di, $(ALL_DEPS))
+BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di)
+NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di)
+
+ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED))
+
+IMPLO_INTF := $(ALLML:%.mli=%.mli.__)
+IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \
+ $(basename $(file)).cmi $(basename $(file)).cmo)
+IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF))
+IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi)
+
+IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx)
+
+INTF := $(filter %.cmi, $(IMPLO_INTF))
+IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF))
+IMPL_CMX := $(IMPL_CMO:.cmo=.cmx)
+IMPL_ASM := $(IMPL_CMO:.cmo=.asm)
+IMPL_S := $(IMPL_CMO:.cmo=.s)
+
+OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX)
+OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK)
+
+EXECS := $(addsuffix $(EXE), \
+ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT)))
+ifdef WIN32
+ EXECS += $(BCRESULT).dll $(NCRESULT).dll
+endif
+
+CLIB_BASE := $(RESULT)$(RES_CLIB_SUF)
+ifneq ($(strip $(OBJ_LINK)),)
+ RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB)
+endif
+
+ifdef WIN32
+DLLSONAME := $(CLIB_BASE).dll
+else
+DLLSONAME := dll$(CLIB_BASE).so
+endif
+
+NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \
+ $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \
+ $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \
+ $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \
+ $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \
+ $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o
+
+ifndef STATIC
+ NONEXECS += $(DLLSONAME)
+endif
+
+ifndef LIBINSTALL_FILES
+ LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \
+ $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ LIBINSTALL_FILES += $(DLLSONAME)
+ endif
+ endif
+endif
+
+export LIBINSTALL_FILES
+
+ifdef WIN32
+ # some extra stuff is created while linking DLLs
+ NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib
+endif
+
+TARGETS := $(EXECS) $(NONEXECS)
+
+# If there are IDL-files
+ifneq ($(strip $(FILTERED_IDL)),)
+ MAYBE_IDL := -cclib -lcamlidl
+endif
+
+ifdef USE_CAMLP4
+ CAMLP4PATH := \
+ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4)
+ INCFLAGS := -I $(CAMLP4PATH)
+ CINCFLAGS := -I$(CAMLP4PATH)
+endif
+
+DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %)
+INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %)
+CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%)
+
+ifndef MSVC
+ CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \
+ $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%)
+
+ ifeq ($(ELF_RPATH), yes)
+ CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%)
+ endif
+endif
+
+ifndef PROFILING
+ INTF_OCAMLC := $(OCAMLC)
+else
+ ifndef THREADS
+ INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS)
+ else
+ # OCaml does not support profiling byte code
+ # with threads (yet), therefore we force an error.
+ ifndef REAL_OCAMLC
+ $(error Profiling of multithreaded byte code not yet supported by OCaml)
+ endif
+ INTF_OCAMLC := $(OCAMLC)
+ endif
+endif
+
+ifndef MSVC
+ COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \
+ $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \
+ $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%))
+
+ ifeq ($(ELF_RPATH),yes)
+ COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%)
+ endif
+else
+ COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \
+ $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \
+ $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) "
+endif
+
+CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %')
+ifdef MSVC
+ ifndef STATIC
+ # MSVC libraries do not have 'lib' prefix
+ CLIBS_OPTS := $(CLIBS:%=-cclib %.lib)
+ endif
+endif
+
+ifneq ($(strip $(OBJ_LINK)),)
+ ifdef CREATE_LIB
+ OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL)
+ else
+ OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL)
+ endif
+else
+ OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
+endif
+
+# If we have to make byte-code
+ifndef REAL_OCAMLC
+ BYTE_OCAML := y
+
+ # EXTRADEPS is added dependencies we have to insert for all
+ # executable files we generate. Ideally it should be all of the
+ # libraries we use, but it's hard to find the ones that get searched on
+ # the path since I don't know the paths built into the compiler, so
+ # just include the ones with slashes in their names.
+ EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
+
+ REAL_OCAMLC := $(INTF_OCAMLC)
+
+ REAL_IMPL := $(IMPL_CMO)
+ REAL_IMPL_INTF := $(IMPLO_INTF)
+ IMPL_SUF := .cmo
+
+ DEPFLAGS :=
+ MAKE_DEPS := $(MLDEPS) $(BCDEPIS)
+
+ ifdef CREATE_LIB
+ override CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ MAKEDLL := $(DLLSONAME)
+ ALL_LDFLAGS := -dllib $(DLLSONAME)
+ endif
+ endif
+ endif
+
+ ifndef NO_CUSTOM
+ ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" ""
+ ALL_LDFLAGS += -custom
+ endif
+ endif
+
+ ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \
+ $(COMMON_LDFLAGS) $(LIBS:%=%.cma)
+ CAMLIDLDLLFLAGS :=
+
+ ifdef THREADS
+ ifdef VMTHREADS
+ THREAD_FLAG := -vmthread
+ else
+ THREAD_FLAG := -thread
+ endif
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+
+# we have to make native-code
+else
+ EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ ifndef PROFILING
+ SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
+ PLDFLAGS :=
+ else
+ SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS)
+ PLDFLAGS := -p
+ endif
+
+ REAL_IMPL := $(IMPL_CMX)
+ REAL_IMPL_INTF := $(IMPLX_INTF)
+ IMPL_SUF := .cmx
+
+ override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS)
+
+ DEPFLAGS := -native
+ MAKE_DEPS := $(MLDEPS) $(NCDEPIS)
+
+ ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \
+ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS)
+ CAMLIDLDLLFLAGS := -opt
+
+ ifndef CREATE_LIB
+ ALL_LDFLAGS += $(LIBS:%=%.cmxa)
+ else
+ override CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ endif
+
+ ifdef THREADS
+ THREAD_FLAG := -thread
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+endif
+
+export MAKE_DEPS
+
+ifdef ANNOTATE
+ ANNOT_FLAG := -dtypes
+else
+endif
+
+ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \
+ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS)
+
+ifdef make_deps
+ -include $(MAKE_DEPS)
+ PRE_TARGETS :=
+endif
+
+###########################################################################
+# USER RULES
+
+# Call "OCamlMakefile QUIET=" to get rid of all of the @'s.
+QUIET=@
+
+# generates byte-code (default)
+byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bc: byte-code
+
+byte-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bcnl: byte-code-nolink
+
+top: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+
+# generates native-code
+
+native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+nc: native-code
+
+native-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncnl: native-code-nolink
+
+# generates byte-code libraries
+byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+bcl: byte-code-library
+
+# generates native-code libraries
+native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+ncl: native-code-library
+
+ifdef WIN32
+# generates byte-code dll
+byte-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).dll \
+ REAL_RESULT="$(BCRESULT)" \
+ make_deps=yes
+bcd: byte-code-dll
+
+# generates native-code dll
+native-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).dll \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncd: native-code-dll
+endif
+
+# generates byte-code with debugging information
+debug-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dc: debug-code
+
+debug-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcnl: debug-code-nolink
+
+# generates byte-code libraries with debugging information
+debug-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ CREATE_LIB=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcl: debug-code-library
+
+# generates byte-code for profiling
+profiling-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ make_deps=yes
+pbc: profiling-byte-code
+
+# generates native-code
+
+profiling-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PROFILING="y" \
+ make_deps=yes
+pnc: profiling-native-code
+
+# generates byte-code libraries
+profiling-byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pbcl: profiling-byte-code-library
+
+# generates native-code libraries
+profiling-native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" PROFILING="y" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pncl: profiling-native-code-library
+
+# packs byte-code objects
+pack-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \
+ REAL_RESULT="$(BCRESULT)" \
+ PACK_LIB=yes make_deps=yes
+pabc: pack-byte-code
+
+# packs native-code objects
+pack-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(NCRESULT).cmx $(NCRESULT).o \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PACK_LIB=yes make_deps=yes
+panc: pack-native-code
+
+# generates HTML-documentation
+htdoc: $(DOC_DIR)/$(RESULT)/html/index.html
+
+# generates Latex-documentation
+ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex
+
+# generates PostScript-documentation
+psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps
+
+# generates PDF-documentation
+pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf
+
+# generates all supported forms of documentation
+doc: htdoc ladoc psdoc pdfdoc
+
+###########################################################################
+# LOW LEVEL RULES
+
+$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+nolink: $(REAL_IMPL_INTF) $(OBJ_LINK)
+
+ifdef WIN32
+$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK)
+ $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \
+ -o $@ $(REAL_IMPL)
+endif
+
+%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(OCAMLMKTOP) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \
+ .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \
+ .rep .zog .glade
+
+ifndef STATIC
+ifdef MINGW
+$(DLLSONAME): $(OBJ_LINK)
+ $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \
+ -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \
+ $(OCAMLLIBPATH)/ocamlrun.a \
+ -Wl,--export-all-symbols \
+ -Wl,--no-whole-archive
+else
+ifdef MSVC
+$(DLLSONAME): $(OBJ_LINK)
+ link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \
+ $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \
+ $(OCAMLLIBPATH)/ocamlrun.lib
+
+else
+$(DLLSONAME): $(OBJ_LINK)
+ $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \
+ -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \
+ $(OCAMLMKLIB_FLAGS)
+endif
+endif
+endif
+
+ifndef LIB_PACK_NAME
+$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+else
+ifdef BYTE_OCAML
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL)
+else
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL)
+endif
+
+$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmo
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmx
+endif
+
+$(RES_CLIB): $(OBJ_LINK)
+ifndef MSVC
+ ifneq ($(strip $(OBJ_LINK)),)
+ $(AR) rcs $@ $(OBJ_LINK)
+ endif
+else
+ ifneq ($(strip $(OBJ_LINK)),)
+ lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK)
+ endif
+endif
+
+.mli.cmi: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ fi
+
+.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \
+ fi
+
+ifdef PACK_LIB
+$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
+ $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+endif
+
+.PRECIOUS: %.ml
+%.ml: %.mll
+ $(OCAMLLEX) $(LFLAGS) $<
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.mly
+ $(OCAMLYACC) $(YFLAGS) $<
+ $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \
+ if [ ! -z "$$pp" ]; then \
+ mv $*.ml $*.ml.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \
+ cat $*.ml.temporary >> $*.ml; \
+ rm $*.ml.temporary; \
+ mv $*.mli $*.mli.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \
+ cat $*.mli.temporary >> $*.mli; \
+ rm $*.mli.temporary; \
+ fi
+
+
+.PRECIOUS: %.ml
+%.ml: %.rep
+ $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $<
+
+.PRECIOUS: %.ml
+%.ml: %.zog
+ $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@
+
+.PRECIOUS: %.ml
+%.ml: %.glade
+ $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.oxridl
+ $(OXRIDL) $<
+
+.PRECIOUS: %.ml %.mli %_stubs.c %.h
+%.ml %.mli %_stubs.c %.h: %.idl
+ $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \
+ $(CAMLIDLFLAGS) $<
+ $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi
+
+.c.$(EXT_OBJ):
+ $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \
+ $(CPPFLAGS) $(CPPFLAGS_WIN32) \
+ $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $<
+
+.m.$(EXT_OBJ):
+ $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
+ -I'$(OCAMLLIBPATH)' \
+ $< $(CFLAG_O)$@
+
+.$(EXT_CXX).$(EXT_OBJ):
+ $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
+ -I'$(OCAMLLIBPATH)' \
+ $< $(CFLAG_O)$@
+
+$(MLDEPDIR)/%.d: %.ml
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ $(DINCFLAGS) $< > $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
+ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+$(DOC_DIR)/$(RESULT)/html:
+ mkdir -p $@
+
+$(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES)
+ rm -rf $</*
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -html -d $< $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -html -d $< $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ fi
+
+$(DOC_DIR)/$(RESULT)/latex:
+ mkdir -p $@
+
+$(DOC_DIR)/$(RESULT)/latex/doc.tex: $(DOC_DIR)/$(RESULT)/latex $(DOC_FILES)
+ rm -rf $</*
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
+ $(DOC_FILES) -o $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
+ -o $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@; \
+ fi
+
+$(DOC_DIR)/$(RESULT)/latex/doc.ps: $(DOC_DIR)/$(RESULT)/latex/doc.tex
+ cd $(DOC_DIR)/$(RESULT)/latex && \
+ $(LATEX) doc.tex && \
+ $(LATEX) doc.tex && \
+ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
+
+$(DOC_DIR)/$(RESULT)/latex/doc.pdf: $(DOC_DIR)/$(RESULT)/latex/doc.ps
+ cd $(DOC_DIR)/$(RESULT)/latex && $(PS2PDF) $(<F)
+
+define make_subproj
+.PHONY:
+subproj_$(1):
+ $$(eval $$(call PROJ_$(1)))
+ $(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \
+ $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \
+ fi
+endef
+
+$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj))))
+
+.PHONY:
+subprojs: $(SUBPROJS:%=subproj_%)
+
+###########################################################################
+# (UN)INSTALL RULES FOR LIBRARIES
+
+.PHONY: libinstall
+libinstall: all
+ $(QUIET)printf "\nInstalling library with ocamlfind\n"
+ $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES)
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libuninstall
+libuninstall:
+ $(QUIET)printf "\nUninstalling library with ocamlfind\n"
+ $(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT)
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+.PHONY: rawinstall
+rawinstall: all
+ $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n"
+ -install -d $(OCAML_LIB_INSTALL)
+ for i in $(LIBINSTALL_FILES); do \
+ if [ -f $$i ]; then \
+ install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \
+ fi; \
+ done
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: rawuninstall
+rawuninstall:
+ $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n"
+ cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES))
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+###########################################################################
+# MAINTENANCE RULES
+
+.PHONY: clean
+clean::
+ rm -f $(TARGETS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: cleanup
+cleanup::
+ rm -f $(NONEXECS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: clean-doc
+clean-doc::
+ rm -rf $(DOC_DIR)/$(RESULT)
+
+.PHONY: clean-all
+clean-all:: clean clean-doc
+
+.PHONY: nobackup
+nobackup:
+ rm -f *.bak *~ *.dup
diff --git a/lib/ocaml/README b/lib/ocaml/README
new file mode 100644
index 0000000..9f871fb
--- /dev/null
+++ b/lib/ocaml/README
@@ -0,0 +1,68 @@
+Library
+-------
+The library abstract classes, exceptions, and general use functions are mostly jammed in Thrift.ml (an exception being TServer). Implementations live in their own files. I'm on the fence about whether it should be done with objects or modules/functors. Right now they are objects. TBinaryProtocol and TSocket are implemented. TServer and TSimpleServer classes are there, but the fastest route to a binary protocol socket server is to use TServer.run_basic_server which uses OCaml's own server abstraction. To that end, there is TChannelTransport which is a transport class parametrized on input and output channels that does nothing but wrap up the input and output functions.
+
+A note on making the library: Running make should create native and bytecode libraries.
+
+
+Struct format
+-------------
+Structs are turned into classes. The fields are all option types and are initially None. Write is a method, but reading is done by a separate function (since there is no such thing as a static class). I'm still arguing with myself about whether structs should be put in their own modules along with this read function.
+
+
+enum format
+-----------
+Enums are put in their own module along with functions to_i and of_i which convert the ocaml types into ints. For example:
+
+enum Numberz
+{
+ ONE = 1,
+ TWO,
+ THREE,
+ FIVE = 5,
+ SIX,
+ EIGHT = 8
+}
+
+==>
+
+module Numbers =
+struct
+type t =
+| ONE
+| TWO
+| THREE
+| FIVE
+| SIX
+| EIGHT
+
+let of_i = ...
+let to_i = ...
+end
+
+typedef format
+--------------
+Typedef turns into the type declaration:
+typedef i64 UserId
+
+==>
+
+type userid Int64.t
+
+exception format
+----------------
+Exceptions are kind of ugly since the exception structs can't be thrown directly. They also have this exception type which has the name BLAHBLAH_exn. For example, for an exception Xception you get:
+
+exception Xception_exn of xception
+
+list format
+-----------
+Lists are turned into OCaml native lists
+
+Map/Set formats
+---------------
+These are both turned into Hashtbl.t's.
+
+Services
+--------
+The client is a class "client" parametrized on input and output protocols. The processor is a class parametrized on a handler. A handler is a class inheriting the iface abstract class. Unlike other implementations, client does not implement iface since iface functions must take option arguments so as to deal with the case where a client does not send all the arguments.
diff --git a/lib/ocaml/TODO b/lib/ocaml/TODO
new file mode 100644
index 0000000..4d1dc77
--- /dev/null
+++ b/lib/ocaml/TODO
@@ -0,0 +1,5 @@
+Write interfaces
+Clean up the code generator
+Avoid capture properly instead of relying on the user not to use _
+
+
diff --git a/lib/ocaml/src/Makefile b/lib/ocaml/src/Makefile
new file mode 100644
index 0000000..0b989ce
--- /dev/null
+++ b/lib/ocaml/src/Makefile
@@ -0,0 +1,6 @@
+SOURCES = Thrift.ml TBinaryProtocol.ml TSocket.ml TChannelTransport.ml TServer.ml TSimpleServer.ml
+RESULT = thrift
+LIBS = unix
+all: native-code-library byte-code-library top
+OCAMLMAKEFILE = ../OCamlMakefile
+include $(OCAMLMAKEFILE)
diff --git a/lib/ocaml/src/TBinaryProtocol.ml b/lib/ocaml/src/TBinaryProtocol.ml
new file mode 100644
index 0000000..44433d6
--- /dev/null
+++ b/lib/ocaml/src/TBinaryProtocol.ml
@@ -0,0 +1,145 @@
+open Thrift
+
+module P = Protocol
+
+let get_byte i b = 255 land (i lsr (8*b))
+let get_byte64 i b = 255 land (Int64.to_int (Int64.shift_right i (8*b)))
+
+
+let tv = P.t_type_to_i
+let vt = P.t_type_of_i
+
+
+let comp_int b n =
+ let s = ref 0 in
+ let sb = Sys.word_size - 8*n in
+ for i=0 to (n-1) do
+ s:=!s lor ((int_of_char b.[i]) lsl (8*(n-1-i)))
+ done;
+ s:=(!s lsl sb) asr sb;
+ !s
+
+let comp_int64 b n =
+ let s = ref 0L in
+ for i=0 to (n-1) do
+ s:=Int64.logor !s (Int64.shift_left (Int64.of_int (int_of_char b.[i])) (8*(n-1-i)))
+ done;
+ !s
+
+class t trans =
+object (self)
+ inherit P.t trans
+ val ibyte = String.create 8
+ method writeBool b =
+ ibyte.[0] <- char_of_int (if b then 1 else 0);
+ trans#write ibyte 0 1
+ method writeByte i =
+ ibyte.[0] <- char_of_int (get_byte i 0);
+ trans#write ibyte 0 1
+ method writeI16 i =
+ let gb = get_byte i in
+ ibyte.[1] <- char_of_int (gb 0);
+ ibyte.[0] <- char_of_int (gb 1);
+ trans#write ibyte 0 2
+ method writeI32 i =
+ let gb = get_byte i in
+ for i=0 to 3 do
+ ibyte.[3-i] <- char_of_int (gb i)
+ done;
+ trans#write ibyte 0 4
+ method writeI64 i=
+ let gb = get_byte64 i in
+ for i=0 to 7 do
+ ibyte.[7-i] <- char_of_int (gb i)
+ done;
+ trans#write ibyte 0 8
+ method writeDouble d =
+ self#writeI64 (Int64.bits_of_float d)
+ method writeString s=
+ let n = String.length s in
+ self#writeI32(n);
+ trans#write s 0 n
+ method writeBinary a = self#writeString a
+ method writeMessageBegin (n,t,s) =
+ self#writeString n;
+ self#writeByte (P.message_type_to_i t);
+ self#writeI32 s
+ method writeMessageEnd = ()
+ method writeStructBegin s = ()
+ method writeStructEnd = ()
+ method writeFieldBegin (n,t,i) =
+ self#writeByte (tv t);
+ self#writeI16 i
+ method writeFieldEnd = ()
+ method writeFieldStop =
+ self#writeByte (tv (Protocol.T_STOP))
+ method writeMapBegin (k,v,s) =
+ self#writeByte (tv k);
+ self#writeByte (tv v);
+ self#writeI32 s
+ method writeMapEnd = ()
+ method writeListBegin (t,s) =
+ self#writeByte (tv t);
+ self#writeI32 s
+ method writeListEnd = ()
+ method writeSetBegin (t,s) =
+ self#writeByte (tv t);
+ self#writeI32 s
+ method writeSetEnd = ()
+ method readByte =
+ ignore (trans#readAll ibyte 0 1);
+ (comp_int ibyte 1)
+ method readI16 =
+ ignore (trans#readAll ibyte 0 2);
+ comp_int ibyte 2
+ method readI32 =
+ ignore (trans#readAll ibyte 0 4);
+ comp_int ibyte 4
+ method readI64 =
+ ignore (trans#readAll ibyte 0 8);
+ comp_int64 ibyte 8
+ method readDouble =
+ Int64.float_of_bits (self#readI64)
+ method readBool =
+ self#readByte = 1
+ method readString =
+ let sz = self#readI32 in
+ let buf = String.create sz in
+ ignore (trans#readAll buf 0 sz);
+ buf
+ method readBinary = self#readString
+ method readMessageBegin =
+ let s = self#readString in
+ let mt = P.message_type_of_i (self#readByte) in
+ (s,mt, self#readI32)
+ method readMessageEnd = ()
+ method readStructBegin =
+ ""
+ method readStructEnd = ()
+ method readFieldBegin =
+ let t = (vt (self#readByte))
+ in
+ if t != P.T_STOP then
+ ("",t,self#readI16)
+ else ("",t,0);
+ method readFieldEnd = ()
+ method readMapBegin =
+ let kt = vt (self#readByte) in
+ let vt = vt (self#readByte) in
+ (kt,vt, self#readI32)
+ method readMapEnd = ()
+ method readListBegin =
+ let t = vt (self#readByte) in
+ (t,self#readI32)
+ method readListEnd = ()
+ method readSetBegin =
+ let t = vt (self#readByte) in
+ (t, self#readI32);
+ method readSetEnd = ()
+end
+
+class factory =
+object
+ inherit P.factory
+ method getProtocol tr = new t tr
+end
diff --git a/lib/ocaml/src/TChannelTransport.ml b/lib/ocaml/src/TChannelTransport.ml
new file mode 100644
index 0000000..89ae352
--- /dev/null
+++ b/lib/ocaml/src/TChannelTransport.ml
@@ -0,0 +1,16 @@
+open Thrift
+module T = Transport
+
+class t (i,o) =
+object (self)
+ inherit Transport.t
+ method isOpen = true
+ method opn = ()
+ method close = ()
+ method read buf off len =
+ try
+ really_input i buf off len; len
+ with _ -> T.raise_TTransportExn ("TChannelTransport: Could not read "^(string_of_int len)) T.UNKNOWN
+ method write buf off len = output o buf off len
+ method flush = flush o
+end
diff --git a/lib/ocaml/src/TServer.ml b/lib/ocaml/src/TServer.ml
new file mode 100644
index 0000000..d8509ff
--- /dev/null
+++ b/lib/ocaml/src/TServer.ml
@@ -0,0 +1,30 @@
+open Thrift
+
+class virtual t
+ (pf : Processor.factory)
+ (st : Transport.server_t)
+ (itf : Transport.factory)
+ (otf : Transport.factory)
+ (ipf : Protocol.factory)
+ (opf : Protocol.factory)=
+object
+ val processorFactory = pf
+ val serverTransport = st
+ val inputTransportFactory = itf
+ val outputTransportFactory = otf
+ val inputProtocolFactory = ipf
+ val outputProtocolFactory = opf
+ method virtual serve : unit
+end;;
+
+
+let run_basic_server proc port =
+ Unix.establish_server (fun inp -> fun out ->
+ let trans = new TChannelTransport.t (inp,out) in
+ let proto = new TBinaryProtocol.t (trans :> Transport.t) in
+ try
+ while proc#process proto proto do () done;
+ ()
+ with e -> ()) (Unix.ADDR_INET (Unix.inet_addr_of_string "127.0.0.1",port))
+
+
diff --git a/lib/ocaml/src/TSimpleServer.ml b/lib/ocaml/src/TSimpleServer.ml
new file mode 100644
index 0000000..1a85809
--- /dev/null
+++ b/lib/ocaml/src/TSimpleServer.ml
@@ -0,0 +1,24 @@
+open Thrift
+module S = TServer
+
+class t pf st itf otf ipf opf =
+object
+ inherit S.t pf st itf otf ipf opf
+ method serve =
+ try
+ st#listen;
+ let c = st#accept in
+ let proc = pf#getProcessor c in
+ let itrans = itf#getTransport c in
+ let otrans = try
+ otf#getTransport c
+ with e -> itrans#close; raise e
+ in
+ let inp = ipf#getProtocol itrans in
+ let op = opf#getProtocol otrans in
+ try
+ while (proc#process inp op) do () done;
+ itrans#close; otrans#close
+ with e -> itrans#close; otrans#close; raise e
+ with _ -> ()
+end
diff --git a/lib/ocaml/src/TSocket.ml b/lib/ocaml/src/TSocket.ml
new file mode 100644
index 0000000..c02f1eb
--- /dev/null
+++ b/lib/ocaml/src/TSocket.ml
@@ -0,0 +1,32 @@
+open Thrift
+
+module T = Transport
+
+class t host port=
+object (self)
+ inherit T.t
+ val mutable chans = None
+ method isOpen = chans != None
+ method opn =
+ try
+ chans <- Some(Unix.open_connection (Unix.ADDR_INET ((Unix.inet_addr_of_string host),port)))
+ with _ ->
+ T.raise_TTransportExn
+ ("Could not connect to "^host^":"^(string_of_int port))
+ T.NOT_OPEN
+ method close = match chans with None -> () | Some(inc,_) -> (Unix.shutdown_connection inc; chans <- None)
+ method read buf off len = match chans with
+ None -> T.raise_TTransportExn "Socket not open" T.NOT_OPEN
+ | Some(i,o) ->
+ try
+ really_input i buf off len; len
+ with _ -> T.raise_TTransportExn ("TSocket: Could not read "^(string_of_int len)^" from "^host^":"^(string_of_int port)) T.UNKNOWN
+ method write buf off len = match chans with
+ None -> T.raise_TTransportExn "Socket not open" T.NOT_OPEN
+ | Some(i,o) -> output o buf off len
+ method flush = match chans with
+ None -> T.raise_TTransportExn "Socket not open" T.NOT_OPEN
+ | Some(i,o) -> flush o
+end
+
+
diff --git a/lib/ocaml/src/Thrift.ml b/lib/ocaml/src/Thrift.ml
new file mode 100644
index 0000000..224febb
--- /dev/null
+++ b/lib/ocaml/src/Thrift.ml
@@ -0,0 +1,357 @@
+exception Break;;
+exception Thrift_error;;
+exception Field_empty of string;;
+
+class t_exn =
+object
+ val mutable message = ""
+ method get_message = message
+ method set_message s = message <- s
+end;;
+
+exception TExn of t_exn;;
+
+
+
+
+module Transport =
+struct
+ type exn_type =
+ | UNKNOWN
+ | NOT_OPEN
+ | ALREADY_OPEN
+ | TIMED_OUT
+ | END_OF_FILE;;
+
+ class exn =
+ object
+ inherit t_exn
+ val mutable typ = UNKNOWN
+ method get_type = typ
+ method set_type t = typ <- t
+ end
+ exception TTransportExn of exn
+ let raise_TTransportExn message typ =
+ let e = new exn in
+ e#set_message message;
+ e#set_type typ;
+ raise (TTransportExn e)
+
+ class virtual t =
+ object (self)
+ method virtual isOpen : bool
+ method virtual opn : unit
+ method virtual close : unit
+ method virtual read : string -> int -> int -> int
+ method readAll buf off len =
+ let got = ref 0 in
+ let ret = ref 0 in
+ while !got < len do
+ ret := self#read buf (off+(!got)) (len - (!got));
+ if !ret <= 0 then
+ let e = new exn in
+ e#set_message "Cannot read. Remote side has closed.";
+ raise (TTransportExn e)
+ else ();
+ got := !got + !ret
+ done;
+ !got
+ method virtual write : string -> int -> int -> unit
+ method virtual flush : unit
+ end
+
+ class factory =
+ object
+ method getTransport (t : t) = t
+ end
+
+ class virtual server_t =
+ object (self)
+ method virtual listen : unit
+ method accept = self#acceptImpl
+ method virtual close : unit
+ method virtual acceptImpl : t
+ end
+
+end;;
+
+
+
+module Protocol =
+struct
+ type t_type =
+ | T_STOP
+ | T_VOID
+ | T_BOOL
+ | T_BYTE
+ | T_I08
+ | T_I16
+ | T_I32
+ | T_U64
+ | T_I64
+ | T_DOUBLE
+ | T_STRING
+ | T_UTF7
+ | T_STRUCT
+ | T_MAP
+ | T_SET
+ | T_LIST
+ | T_UTF8
+ | T_UTF16
+
+ let t_type_to_i = function
+ T_STOP -> 0
+ | T_VOID -> 1
+ | T_BOOL -> 2
+ | T_BYTE -> 3
+ | T_I08 -> 3
+ | T_I16 -> 6
+ | T_I32 -> 8
+ | T_U64 -> 9
+ | T_I64 -> 10
+ | T_DOUBLE -> 4
+ | T_STRING -> 11
+ | T_UTF7 -> 11
+ | T_STRUCT -> 12
+ | T_MAP -> 13
+ | T_SET -> 14
+ | T_LIST -> 15
+ | T_UTF8 -> 16
+ | T_UTF16 -> 17
+
+ let t_type_of_i = function
+ 0 -> T_STOP
+ | 1 -> T_VOID
+ | 2 -> T_BOOL
+ | 3 -> T_BYTE
+ | 6-> T_I16
+ | 8 -> T_I32
+ | 9 -> T_U64
+ | 10 -> T_I64
+ | 4 -> T_DOUBLE
+ | 11 -> T_STRING
+ | 12 -> T_STRUCT
+ | 13 -> T_MAP
+ | 14 -> T_SET
+ | 15 -> T_LIST
+ | 16 -> T_UTF8
+ | 17 -> T_UTF16
+ | _ -> raise Thrift_error
+
+ type message_type =
+ | CALL
+ | REPLY
+ | EXCEPTION
+
+ let message_type_to_i = function
+ | CALL -> 1
+ | REPLY -> 2
+ | EXCEPTION -> 3
+
+ let message_type_of_i = function
+ | 1 -> CALL
+ | 2 -> REPLY
+ | 3 -> EXCEPTION
+ | _ -> raise Thrift_error
+
+ class virtual t (trans: Transport.t) =
+ object (self)
+ val mutable trans_ = trans
+ method getTransport = trans_
+ (* writing methods *)
+ method virtual writeMessageBegin : string * message_type * int -> unit
+ method virtual writeMessageEnd : unit
+ method virtual writeStructBegin : string -> unit
+ method virtual writeStructEnd : unit
+ method virtual writeFieldBegin : string * t_type * int -> unit
+ method virtual writeFieldEnd : unit
+ method virtual writeFieldStop : unit
+ method virtual writeMapBegin : t_type * t_type * int -> unit
+ method virtual writeMapEnd : unit
+ method virtual writeListBegin : t_type * int -> unit
+ method virtual writeListEnd : unit
+ method virtual writeSetBegin : t_type * int -> unit
+ method virtual writeSetEnd : unit
+ method virtual writeBool : bool -> unit
+ method virtual writeByte : int -> unit
+ method virtual writeI16 : int -> unit
+ method virtual writeI32 : int -> unit
+ method virtual writeI64 : Int64.t -> unit
+ method virtual writeDouble : float -> unit
+ method virtual writeString : string -> unit
+ method virtual writeBinary : string -> unit
+ (* reading methods *)
+ method virtual readMessageBegin : string * message_type * int
+ method virtual readMessageEnd : unit
+ method virtual readStructBegin : string
+ method virtual readStructEnd : unit
+ method virtual readFieldBegin : string * t_type * int
+ method virtual readFieldEnd : unit
+ method virtual readMapBegin : t_type * t_type * int
+ method virtual readMapEnd : unit
+ method virtual readListBegin : t_type * int
+ method virtual readListEnd : unit
+ method virtual readSetBegin : t_type * int
+ method virtual readSetEnd : unit
+ method virtual readBool : bool
+ method virtual readByte : int
+ method virtual readI16 : int
+ method virtual readI32: int
+ method virtual readI64 : Int64.t
+ method virtual readDouble : float
+ method virtual readString : string
+ method virtual readBinary : string
+ (* skippage *)
+ method skip typ =
+ match typ with
+ | T_STOP -> ()
+ | T_VOID -> ()
+ | T_BOOL -> ignore self#readBool
+ | T_BYTE
+ | T_I08 -> ignore self#readByte
+ | T_I16 -> ignore self#readI16
+ | T_I32 -> ignore self#readI32
+ | T_U64
+ | T_I64 -> ignore self#readI64
+ | T_DOUBLE -> ignore self#readDouble
+ | T_STRING -> ignore self#readString
+ | T_UTF7 -> ()
+ | T_STRUCT -> ignore ((ignore self#readStructBegin);
+ (try
+ while true do
+ let (_,t,_) = self#readFieldBegin in
+ if t = T_STOP then
+ raise Break
+ else
+ (self#skip t;
+ self#readFieldEnd)
+ done
+ with Break -> ());
+ self#readStructEnd)
+ | T_MAP -> ignore (let (k,v,s) = self#readMapBegin in
+ for i=0 to s do
+ self#skip k;
+ self#skip v;
+ done;
+ self#readMapEnd)
+ | T_SET -> ignore (let (t,s) = self#readSetBegin in
+ for i=0 to s do
+ self#skip t
+ done;
+ self#readSetEnd)
+ | T_LIST -> ignore (let (t,s) = self#readListBegin in
+ for i=0 to s do
+ self#skip t
+ done;
+ self#readListEnd)
+ | T_UTF8 -> ()
+ | T_UTF16 -> ()
+ end
+
+ class virtual factory =
+ object
+ method virtual getProtocol : Transport.t -> t
+ end
+
+end;;
+
+
+module Processor =
+struct
+ class virtual t =
+ object
+ method virtual process : Protocol.t -> Protocol.t -> bool
+ end;;
+
+ class factory (processor : t) =
+ object
+ val processor_ = processor
+ method getProcessor (trans : Transport.t) = processor_
+ end;;
+end
+
+
+
+module Application_Exn =
+struct
+ type typ=
+ | UNKNOWN
+ | UNKNOWN_METHOD
+ | INVALID_MESSAGE_TYPE
+ | WRONG_METHOD_NAME
+ | BAD_SEQUENCE_ID
+ | MISSING_RESULT
+
+ let typ_of_i = function
+ 0 -> UNKNOWN
+ | 1 -> UNKNOWN_METHOD
+ | 2 -> INVALID_MESSAGE_TYPE
+ | 3 -> WRONG_METHOD_NAME
+ | 4 -> BAD_SEQUENCE_ID
+ | 5 -> MISSING_RESULT
+ | _ -> raise Thrift_error;;
+ let typ_to_i = function
+ | UNKNOWN -> 0
+ | UNKNOWN_METHOD -> 1
+ | INVALID_MESSAGE_TYPE -> 2
+ | WRONG_METHOD_NAME -> 3
+ | BAD_SEQUENCE_ID -> 4
+ | MISSING_RESULT -> 5
+
+ class t =
+ object (self)
+ inherit t_exn
+ val mutable typ = UNKNOWN
+ method get_type = typ
+ method set_type t = typ <- t
+ method write (oprot : Protocol.t) =
+ oprot#writeStructBegin "TApplicationExeception";
+ if self#get_message != "" then
+ (oprot#writeFieldBegin ("message",Protocol.T_STRING, 1);
+ oprot#writeString self#get_message;
+ oprot#writeFieldEnd)
+ else ();
+ oprot#writeFieldBegin ("type",Protocol.T_I32,2);
+ oprot#writeI32 (typ_to_i typ);
+ oprot#writeFieldEnd;
+ oprot#writeFieldStop;
+ oprot#writeStructEnd
+ end;;
+
+ let create typ msg =
+ let e = new t in
+ e#set_type typ;
+ e#set_message msg;
+ e
+
+ let read (iprot : Protocol.t) =
+ let msg = ref "" in
+ let typ = ref 0 in
+ iprot#readStructBegin;
+ (try
+ while true do
+ let (name,ft,id) =iprot#readFieldBegin in
+ if ft = Protocol.T_STOP then
+ raise Break
+ else ();
+ (match id with
+ | 1 -> (if ft = Protocol.T_STRING then
+ msg := (iprot#readString)
+ else
+ iprot#skip ft)
+ | 2 -> (if ft = Protocol.T_I32 then
+ typ := iprot#readI32
+ else
+ iprot#skip ft)
+ | _ -> iprot#skip ft);
+ iprot#readFieldEnd
+ done
+ with Break -> ());
+ iprot#readStructEnd;
+ let e = new t in
+ e#set_type (typ_of_i !typ);
+ e#set_message !msg;
+ e;;
+
+ exception E of t
+end;;
diff --git a/test/ocaml/Makefile b/test/ocaml/Makefile
new file mode 100644
index 0000000..c6ce7c3
--- /dev/null
+++ b/test/ocaml/Makefile
@@ -0,0 +1,5 @@
+all:
+ cd client; make; cd ..; cd server; make
+clean:
+ cd client; make clean; cd ..; cd server; make clean
+
diff --git a/test/ocaml/client/Makefile b/test/ocaml/client/Makefile
new file mode 100644
index 0000000..67757b9
--- /dev/null
+++ b/test/ocaml/client/Makefile
@@ -0,0 +1,7 @@
+SOURCES = ../gen-ocaml/ThriftTest_types.ml ../gen-ocaml/ThriftTest_consts.ml ../gen-ocaml/SecondService.ml ../gen-ocaml/ThriftTest.ml TestClient.ml
+RESULT = tc
+INCDIRS = "/home/iproctor/code/projects/thrift/trunk/lib/ocaml/src/" "../gen-ocaml/"
+LIBS = unix thrift
+all: nc
+OCAMLMAKEFILE = ../../../lib/ocaml/OCamlMakefile
+include $(OCAMLMAKEFILE)
diff --git a/test/ocaml/client/TestClient.ml b/test/ocaml/client/TestClient.ml
new file mode 100644
index 0000000..c60f1fb
--- /dev/null
+++ b/test/ocaml/client/TestClient.ml
@@ -0,0 +1,63 @@
+open Thrift;;
+open ThriftTest_types;;
+
+let s = new TSocket.t "127.0.0.1" 9090;;
+let p = new TBinaryProtocol.t s;;
+let c = new ThriftTest.client p p;;
+let sod = function
+ Some v -> v
+ | None -> raise Thrift_error;;
+
+s#opn;
+print_string (c#testString "bya");
+print_char '\n';
+print_int (c#testByte 8);
+print_char '\n';
+print_int (c#testByte (-8));
+print_char '\n';
+print_int (c#testI32 32);
+print_char '\n';
+print_string (Int64.to_string (c#testI64 64L));
+print_char '\n';
+print_float (c#testDouble 3.14);
+print_char '\n';
+
+let l = [1;2;3;4] in
+ if l = (c#testList l) then print_string "list ok\n" else print_string "list fail\n";;
+let h = Hashtbl.create 5 in
+let a = Hashtbl.add h in
+ for i=1 to 10 do
+ a i (10*i)
+ done;
+ let r = c#testMap h in
+ for i=1 to 10 do
+ try
+ let g = Hashtbl.find r i in
+ print_int i;
+ print_char ' ';
+ print_int g;
+ print_char '\n'
+ with Not_found -> print_string ("Can't find "^(string_of_int i)^"\n")
+ done;;
+
+let s = Hashtbl.create 5 in
+let a = Hashtbl.add s in
+ for i = 1 to 10 do
+ a i true
+ done;
+ let r = c#testSet s in
+ for i = 1 to 10 do
+ try
+ let g = Hashtbl.find r i in
+ print_int i;
+ print_char '\n'
+ with Not_found -> print_string ("Can't find "^(string_of_int i)^"\n")
+ done;;
+try
+ c#testException "Xception"
+with Xception _ -> print_string "testException ok\n";;
+try
+ ignore(c#testMultiException "Xception" "bya")
+with Xception e -> Printf.printf "%d %s\n" (sod e#get_errorCode) (sod e#get_message);;
+
+
diff --git a/test/ocaml/server/Makefile b/test/ocaml/server/Makefile
new file mode 100644
index 0000000..839292d
--- /dev/null
+++ b/test/ocaml/server/Makefile
@@ -0,0 +1,7 @@
+SOURCES = ../gen-ocaml/ThriftTest_types.ml ../gen-ocaml/ThriftTest_consts.ml ../gen-ocaml/SecondService.ml ../gen-ocaml/ThriftTest.ml TestServer.ml
+RESULT = ts
+INCDIRS = "/home/iproctor/code/projects/thrift/trunk/lib/ocaml/src/" "../gen-ocaml/"
+LIBS = unix thrift
+all: nc
+OCAMLMAKEFILE = ../../../lib/ocaml/OCamlMakefile
+include $(OCAMLMAKEFILE)
diff --git a/test/ocaml/server/TestServer.ml b/test/ocaml/server/TestServer.ml
new file mode 100644
index 0000000..3789035
--- /dev/null
+++ b/test/ocaml/server/TestServer.ml
@@ -0,0 +1,107 @@
+open Thrift
+open ThriftTest_types
+
+let p = Printf.printf;;
+exception Die;;
+let sod = function
+ Some v -> v
+ | None -> raise Die;;
+
+
+class test_handler =
+object (self)
+ inherit ThriftTest.iface
+ method testVoid = p "testVoid()\n"
+ method testString x = p "testString(%s)\n" (sod x); (sod x)
+ method testByte x = p "testByte(%d)\n" (sod x); (sod x)
+ method testI32 x = p "testI32(%d)\n" (sod x); (sod x)
+ method testI64 x = p "testI64(%s)\n" (Int64.to_string (sod x)); (sod x)
+ method testDouble x = p "testDouble(%f)\n" (sod x); (sod x)
+ method testStruct x = p "testStruct(---)\n"; (sod x)
+ method testNest x = p "testNest(---)\n"; (sod x)
+ method testMap x = p "testMap(---)\n"; (sod x)
+ method testSet x = p "testSet(---)\n"; (sod x)
+ method testList x = p "testList(---)\n"; (sod x)
+ method testEnum x = p "testEnum(---)\n"; (sod x)
+ method testTypedef x = p "testTypedef(---)\n"; (sod x)
+ method testMapMap x = p "testMapMap(%d)\n" (sod x);
+ let mm = Hashtbl.create 3 in
+ let pos = Hashtbl.create 7 in
+ let neg = Hashtbl.create 7 in
+ for i=1 to 4 do
+ Hashtbl.add pos i i;
+ Hashtbl.add neg (-i) (-i);
+ done;
+ Hashtbl.add mm 4 pos;
+ Hashtbl.add mm (-4) neg;
+ mm
+ method testInsanity x = p "testInsanity()\n";
+ p "testinsanity()\n";
+ let hello = new xtruct in
+ let goodbye = new xtruct in
+ let crazy = new insanity in
+ let looney = new insanity in
+ let cumap = Hashtbl.create 7 in
+ let insane = Hashtbl.create 7 in
+ let firstmap = Hashtbl.create 7 in
+ let secondmap = Hashtbl.create 7 in
+ hello#set_string_thing "Hello2";
+ hello#set_byte_thing 2;
+ hello#set_i32_thing 2;
+ hello#set_i64_thing 2L;
+ goodbye#set_string_thing "Goodbye4";
+ goodbye#set_byte_thing 4;
+ goodbye#set_i32_thing 4;
+ goodbye#set_i64_thing 4L;
+ Hashtbl.add cumap Numberz.EIGHT 8L;
+ Hashtbl.add cumap Numberz.FIVE 5L;
+ crazy#set_userMap cumap;
+ crazy#set_xtructs [goodbye; hello];
+ Hashtbl.add firstmap Numberz.TWO crazy;
+ Hashtbl.add firstmap Numberz.THREE crazy;
+ Hashtbl.add secondmap Numberz.SIX looney;
+ Hashtbl.add insane 1L firstmap;
+ Hashtbl.add insane 2L secondmap;
+ insane
+ method testMulti a0 a1 a2 a3 a4 a5 =
+ p "testMulti()\n";
+ let hello = new xtruct in
+ hello#set_string_thing "Hello2";
+ hello#set_byte_thing (sod a0);
+ hello#set_i32_thing (sod a1);
+ hello#set_i64_thing (sod a2);
+ hello
+ method testException s =
+ p "testException(%S)\n" (sod s);
+ if (sod s) = "Xception" then
+ let x = new xception in
+ x#set_errorCode 1001;
+ x#set_message "This is an Xception";
+ raise (Xception x)
+ else ()
+ method testMultiException a0 a1 =
+ p "testMultiException(%S, %S)\n" (sod a0) (sod a1);
+ if (sod a0) = "Xception" then
+ let x = new xception in
+ x#set_errorCode 1001;
+ x#set_message "This is an Xception";
+ raise (Xception x)
+ else (if (sod a0) = "Xception2" then
+ let x = new xception2 in
+ let s = new xtruct in
+ x#set_errorCode 2002;
+ s#set_string_thing "This as an Xception2";
+ x#set_struct_thing s;
+ raise (Xception2 x)
+ else ());
+ let res = new xtruct in
+ res#set_string_thing (sod a1);
+ res
+end;;
+
+let h = new test_handler in
+let proc = new ThriftTest.processor h in
+let port = 9090 in
+ TServer.run_basic_server proc port;;
+
+