From: iproctor Date: Mon, 16 Jul 2007 21:59:24 +0000 (+0000) Subject: Thrift: OCaml library and generator X-Git-Tag: 0.2.0~1309 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=9a41a0c51ea322c3950ddc0cbbcc04fa3f135f1c;p=common%2Fthrift.git 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 98d00080..6465e56f 100644 --- a/compiler/cpp/Makefile.am +++ b/compiler/cpp/Makefile.am @@ -15,8 +15,10 @@ thrift_SOURCES = src/thrifty.yy \ 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 af1d4b19..52ffb70f 100644 --- a/compiler/cpp/src/generate/t_generator.h +++ b/compiler/cpp/src/generate/t_generator.h @@ -118,6 +118,17 @@ class t_generator { 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 00000000..39ad45bf --- /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 +#include +#include +#include +#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 enums = program_->get_enums(); + vector::iterator en_iter; + for (en_iter = enums.begin(); en_iter != enums.end(); ++en_iter) { + generate_enum(*en_iter); + } + + // Generate structs + vector structs = program_->get_structs(); + vector::iterator st_iter; + for (st_iter = structs.begin(); st_iter != structs.end(); ++st_iter) { + generate_struct(*st_iter); + } + + // Generate xceptions + vector xceptions = program_->get_xceptions(); + vector::iterator x_iter; + for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) { + generate_xception(*x_iter); + } + + // Generate typedefs + vector typedefs = program_->get_typedefs(); + vector::iterator td_iter; + for (td_iter = typedefs.begin(); td_iter != typedefs.end(); ++td_iter) { + generate_typedef(*td_iter); + } + + // Generate services + vector services = program_->get_services(); + vector::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 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 constants = tenum->get_constants(); + vector::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 constants = tenum->get_constants(); + vector::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& fields = ((t_struct*)type)->get_members(); + vector::const_iterator f_iter; + const map& val = value->get_map(); + map::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& val = value->get_map(); + map::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& val = value->get_list(); + vector::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& val = value->get_list(); + vector::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& members = tstruct->get_members(); + vector::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 _"<raise (Field_empty \""< " << 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& members = tstruct->get_members(); + vector::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& fields = tstruct->get_members(); + vector::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 <<","<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 "< ());" << 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& fields = tstruct->get_members(); + vector::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 \""<get_name()); + indent(out) << + "(match " << mname << " with None -> () | Some _v -> " << endl; + indent_up(); + indent(out) << "oprot#writeFieldBegin(\""<< (*f_iter)->get_name()<<"\"," + <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 functions = tservice->get_functions(); + vector::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& fields = xs->get_members(); + vector::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 functions = tservice->get_functions(); + vector::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 functions = tservice->get_functions(); + vector::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& fields = arg_struct->get_members(); + vector::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& xceptions = xs->get_members(); + + if (!(*f_iter)->get_returntype()->is_void() || xceptions.size() > 0) { + res = "result"; + } + f_service_ << + indent() << "let "<get_returntype()->is_void()) { + f_service_ << + indent() << "match result#get_success with Some v -> v | None -> (" << endl; + indent_up(); + } + + + vector::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 functions = tservice->get_functions(); + vector::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& fields = arg_struct->get_members(); + vector::const_iterator f_iter; + + string args = "args"; + if(fields.size() == 0){ + args="_"; + } + + f_service_ << + indent() << "let "<get_xceptions(); + const std::vector& xceptions = xs->get_members(); + vector::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" <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_"<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 << "(" <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 ("<is_set()) { + indent(out) << "(let ("<get_elem_type()); + out << " true" << endl; + indent_down(); + indent(out) << "done; iprot#readSetEnd; "<is_list()) { + indent(out) << "(let ("< "; + generate_deserialize_type(out,((t_list*)ttype)->get_elem_type()); + out << "))) in" << endl; + indent_up(); + indent(out) << "iprot#readListEnd; "<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("<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 "< 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 "< 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 "< "; + 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& fields = tfunc->get_arglist()->get_members(); + vector::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& fields = tstruct->get_members(); + vector::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 00000000..1ea9b2f2 --- /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 +#include +#include +#include + +#include "t_oop_generator.h" + +#define T_OCAML_DIR "gen-ocaml" + +/** + * OCaml code generator. + * + * @author Iain Proctor + */ +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 61a1d301..0c7524f9 100644 --- a/compiler/cpp/src/generate/t_rb_generator.h +++ b/compiler/cpp/src/generate/t_rb_generator.h @@ -136,10 +136,7 @@ class t_rb_generator : public t_oop_generator { 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 949558ea..b2abb9bb 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_php = false; 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 @@ void usage() { 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 @@ void generate(t_program* program) { 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 @@ void generate(t_program* program) { delete erl; } + } catch (string s) { printf("Error: %s\n", s.c_str()); } catch (const char* exc) { @@ -638,6 +649,8 @@ int main(int argc, char** argv) { 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 @@ int main(int argc, char** argv) { } // 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 00000000..80ddb051 --- /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 00000000..dfb6c78f --- /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 $ + +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 00000000..4d1dc771 --- /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 00000000..0b989ce2 --- /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 00000000..44433d6a --- /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 00000000..89ae352c --- /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 00000000..d8509ff4 --- /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 00000000..1a85809b --- /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 00000000..c02f1eba --- /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 00000000..224febbc --- /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 00000000..c6ce7c39 --- /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 00000000..67757b9c --- /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 00000000..c60f1fba --- /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 00000000..839292d1 --- /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 00000000..37890353 --- /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;; + +