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/lib/ocaml/src/TBinaryProtocol.ml b/lib/ocaml/src/TBinaryProtocol.ml
new file mode 100644
index 0000000..44433d6
--- /dev/null
+++ b/lib/ocaml/src/TBinaryProtocol.ml
@@ -0,0 +1,145 @@
+open Thrift
+
+module P = Protocol
+
+let get_byte i b = 255 land (i lsr (8*b))
+let get_byte64 i b = 255 land (Int64.to_int (Int64.shift_right i (8*b)))
+
+
+let tv = P.t_type_to_i
+let vt = P.t_type_of_i
+
+
+let comp_int b n =
+ let s = ref 0 in
+ let sb = Sys.word_size - 8*n in
+ for i=0 to (n-1) do
+ s:=!s lor ((int_of_char b.[i]) lsl (8*(n-1-i)))
+ done;
+ s:=(!s lsl sb) asr sb;
+ !s
+
+let comp_int64 b n =
+ let s = ref 0L in
+ for i=0 to (n-1) do
+ s:=Int64.logor !s (Int64.shift_left (Int64.of_int (int_of_char b.[i])) (8*(n-1-i)))
+ done;
+ !s
+
+class t trans =
+object (self)
+ inherit P.t trans
+ val ibyte = String.create 8
+ method writeBool b =
+ ibyte.[0] <- char_of_int (if b then 1 else 0);
+ trans#write ibyte 0 1
+ method writeByte i =
+ ibyte.[0] <- char_of_int (get_byte i 0);
+ trans#write ibyte 0 1
+ method writeI16 i =
+ let gb = get_byte i in
+ ibyte.[1] <- char_of_int (gb 0);
+ ibyte.[0] <- char_of_int (gb 1);
+ trans#write ibyte 0 2
+ method writeI32 i =
+ let gb = get_byte i in
+ for i=0 to 3 do
+ ibyte.[3-i] <- char_of_int (gb i)
+ done;
+ trans#write ibyte 0 4
+ method writeI64 i=
+ let gb = get_byte64 i in
+ for i=0 to 7 do
+ ibyte.[7-i] <- char_of_int (gb i)
+ done;
+ trans#write ibyte 0 8
+ method writeDouble d =
+ self#writeI64 (Int64.bits_of_float d)
+ method writeString s=
+ let n = String.length s in
+ self#writeI32(n);
+ trans#write s 0 n
+ method writeBinary a = self#writeString a
+ method writeMessageBegin (n,t,s) =
+ self#writeString n;
+ self#writeByte (P.message_type_to_i t);
+ self#writeI32 s
+ method writeMessageEnd = ()
+ method writeStructBegin s = ()
+ method writeStructEnd = ()
+ method writeFieldBegin (n,t,i) =
+ self#writeByte (tv t);
+ self#writeI16 i
+ method writeFieldEnd = ()
+ method writeFieldStop =
+ self#writeByte (tv (Protocol.T_STOP))
+ method writeMapBegin (k,v,s) =
+ self#writeByte (tv k);
+ self#writeByte (tv v);
+ self#writeI32 s
+ method writeMapEnd = ()
+ method writeListBegin (t,s) =
+ self#writeByte (tv t);
+ self#writeI32 s
+ method writeListEnd = ()
+ method writeSetBegin (t,s) =
+ self#writeByte (tv t);
+ self#writeI32 s
+ method writeSetEnd = ()
+ method readByte =
+ ignore (trans#readAll ibyte 0 1);
+ (comp_int ibyte 1)
+ method readI16 =
+ ignore (trans#readAll ibyte 0 2);
+ comp_int ibyte 2
+ method readI32 =
+ ignore (trans#readAll ibyte 0 4);
+ comp_int ibyte 4
+ method readI64 =
+ ignore (trans#readAll ibyte 0 8);
+ comp_int64 ibyte 8
+ method readDouble =
+ Int64.float_of_bits (self#readI64)
+ method readBool =
+ self#readByte = 1
+ method readString =
+ let sz = self#readI32 in
+ let buf = String.create sz in
+ ignore (trans#readAll buf 0 sz);
+ buf
+ method readBinary = self#readString
+ method readMessageBegin =
+ let s = self#readString in
+ let mt = P.message_type_of_i (self#readByte) in
+ (s,mt, self#readI32)
+ method readMessageEnd = ()
+ method readStructBegin =
+ ""
+ method readStructEnd = ()
+ method readFieldBegin =
+ let t = (vt (self#readByte))
+ in
+ if t != P.T_STOP then
+ ("",t,self#readI16)
+ else ("",t,0);
+ method readFieldEnd = ()
+ method readMapBegin =
+ let kt = vt (self#readByte) in
+ let vt = vt (self#readByte) in
+ (kt,vt, self#readI32)
+ method readMapEnd = ()
+ method readListBegin =
+ let t = vt (self#readByte) in
+ (t,self#readI32)
+ method readListEnd = ()
+ method readSetBegin =
+ let t = vt (self#readByte) in
+ (t, self#readI32);
+ method readSetEnd = ()
+end
+
+class factory =
+object
+ inherit P.factory
+ method getProtocol tr = new t tr
+end