ocaml-bert / bert.ml

UENISHI Kota 98e42ef 

UENISHI Kota 9a3b9b5 


UENISHI Kota ce038fb 
UENISHI Kota 9a3b9b5 



UENISHI Kota 86a4538 
UENISHI Kota 9a3b9b5 





UENISHI Kota 98e42ef 


















UENISHI Kota fa0ce44 







UENISHI Kota 98e42ef 



UENISHI Kota 672d395 

UENISHI Kota 86a4538 
UENISHI Kota 672d395 

UENISHI Kota 98e42ef 
UENISHI Kota 672d395 

UENISHI Kota 86a4538 

UENISHI Kota 672d395 


UENISHI Kota 86a4538 
UENISHI Kota 672d395 









UENISHI Kota 98e42ef 



UENISHI Kota c3bcbad 
UENISHI Kota 98e42ef 
UENISHI Kota b64d1a2 
UENISHI Kota 98e42ef 



UENISHI Kota ce038fb 

UENISHI Kota 98e42ef 







UENISHI Kota 86a4538 
UENISHI Kota 98e42ef 

UENISHI Kota 86a4538 
UENISHI Kota 98e42ef 
UENISHI Kota 86a4538 
UENISHI Kota 98e42ef 

UENISHI Kota c3bcbad 
UENISHI Kota 98e42ef 










UENISHI Kota c3bcbad 
UENISHI Kota 98e42ef 








UENISHI Kota c3bcbad 
UENISHI Kota 98e42ef 








UENISHI Kota ce038fb 
UENISHI Kota 59c0b1d 
UENISHI Kota 98e42ef 









UENISHI Kota 86a4538 

UENISHI Kota 98e42ef 


UENISHI Kota c3bcbad 
UENISHI Kota 86a4538 

UENISHI Kota 98e42ef 
UENISHI Kota 19d1fed 
UENISHI Kota aa8b121 
UENISHI Kota 43a4232 







UENISHI Kota aa8b121 
UENISHI Kota 19d1fed 
UENISHI Kota aa8b121 














UENISHI Kota 86a4538 

UENISHI Kota aa8b121 










UENISHI Kota c3bcbad 
UENISHI Kota aa8b121 
UENISHI Kota c3bcbad 
UENISHI Kota 86a4538 





UENISHI Kota aa8b121 


UENISHI Kota 86a4538 












UENISHI Kota 8e46290 
UENISHI Kota 9433b13 

UENISHI Kota 59c0b1d 
UENISHI Kota 89e6797 




UENISHI Kota 9433b13 
UENISHI Kota 89e6797 

UENISHI Kota fa0ce44 

UENISHI Kota 89e6797 
UENISHI Kota fa0ce44 




UENISHI Kota 89e6797 









UENISHI Kota 9433b13 
UENISHI Kota 89e6797 
UENISHI Kota 9433b13 



















UENISHI Kota 59c0b1d 
UENISHI Kota 9433b13 


UENISHI Kota 59c0b1d 
UENISHI Kota fa0ce44 








UENISHI Kota 9433b13 

UENISHI Kota 9b0aa34 






















UENISHI Kota 8e46290 
UENISHI Kota 9b0aa34 













UENISHI Kota 59c0b1d 






UENISHI Kota 9b0aa34 

UENISHI Kota 59c0b1d 
open Str;;

type erlterm =
    Int of int
  | Float of float
  | Atom of string
  | Tuple of erlterm list (* type of tuple is different btw Erlang and OCaml *)
  | List of erlterm list 
  | String of string
  | Binary of string
  | Nil;;

type result = 
  | Ok of erlterm * string
  | More of int
  | None;;

exception Not_supported;;
exception Unknown_type;;

let make_small_bigint bin len =
  let rec make_small_bigint_ i prod v = 
    if i < len then
      let p = prod lsl 8 in
      let n = int_of_char (String.get bin i) in
	make_small_bigint_ (i+1) p (v  + p * n)
    else v in
    make_small_bigint_ 0 1 0;;

let make_int32 bin = 
  let rec make_int32_ bin v i =
    if i < 4 then 
      make_int32_ bin ((v*256) + (int_of_char (String.get bin i))) (i+1)
    else v
  in make_int32_ bin 0 0;;

let encode_int32 i = 
    let j = Int32.of_int i in
    let ff = Int32.of_int 0xFF in
      ((char_of_int (Int32.to_int (Int32.logand ff (Int32.shift_right j 24)))), 
       (char_of_int (Int32.to_int (Int32.logand ff (Int32.shift_right j 16)))),
       (char_of_int (Int32.to_int (Int32.logand ff (Int32.shift_right j 8)))),
       (char_of_int (Int32.to_int (Int32.logand ff j))) );;

(* binary -> (decoded tuple, remain), (more, Length), (error, Reason)
   throws exceptions: Not_supported | Unknown_type
   when more binaries  *)
let decode_binary bin = 
  (* decoding tuple, traverses the list twice: first when parsing 
     (and pushes each term to stack list), second when reversing *)
  let rec decode_tuple len binary list = 
    if len=0 then Ok(Tuple(List.rev list), binary)
    else
      begin match local_decode binary with
	| Ok(term, remain) -> 
	    decode_tuple (len-1) remain (term::list);
	| other -> other;
      end 

  (* decoding list, traverses the list twice: first when parsing 
     (and pushes each term to stack list), second when reversing *)
  and decode_list len binary list = 
    begin match local_decode binary with
      | Ok(Nil, remain) when len=0 -> 
	  Ok(List(List.rev list), remain);
      | Ok(term, remain) when len=0 ->
	  Ok(List(List.rev (term::list)), remain );
      | Ok(term, remain) -> 
	  decode_list (len-1) remain (term::list);
      | other -> other;
    end

  and local_decode local_bin = 
      (* see http://www.erlang.org/doc/apps/erts/erl_ext_dist.html for details*)
    begin match (String.get local_bin 0) with
      | 'a' ->  (* SMALL_INTEGER_EXT *)
	  Ok( Int(int_of_char (String.get local_bin 1)), Str.string_after local_bin 2)
      | 'b' ->  (* INTEGER_EXT *)
	  Ok( Int( make_int32 (String.sub local_bin 1 5)), Str.string_after local_bin 5);
      | 'c' -> (* FLOAT_EXT *)
	  let v = Scanf.sscanf (String.sub local_bin 1 32) "%f" (fun x->x) in
	    Ok( Float( v ), Str.string_after local_bin 32); 
      | 'd' -> (* ATOM_EXT *)
	  let len = (int_of_char (String.get local_bin 1))*256 + (int_of_char (String.get local_bin 2)) in
	    Ok( Atom( String.sub local_bin 3 len ), Str.string_after local_bin (len+3) );
      | 'e' -> (* REFERENCE_EXT *)
	  raise Not_supported;
      | 'f' -> (* PORT_EXT *)
	  raise Not_supported;
      | 'g' -> (* PID_EXT *)
	  raise Not_supported;
      | 'h' -> (* SMALL_TUPLE_EXT *)
	  let len = int_of_char (String.get local_bin 1) in
	    decode_tuple len (Str.string_after local_bin 2) []; (* is it OK to use list? *)
      | 'i' -> (* LARGE_TUPLE_EXT *)
	  let len = make_int32 (String.sub local_bin 1 5) in
	    decode_tuple len (Str.string_after local_bin 5) []; (* is it OK to use list? *)
      | 'j' -> (* NIL_EXT *)
	  Ok( Nil, Str.string_after local_bin 1);
      | 'k' -> (* STRING_EXT *)
	  let len = (int_of_char (String.get local_bin 1))*256 + (int_of_char (String.get local_bin 2)) in
	    Ok( String( String.sub local_bin 3 len ), Str.string_after local_bin (len+3) );
      | 'l' -> (* LIST_EXT *)
	  let len = make_int32 (String.sub local_bin 1 5) in
	    decode_list len (Str.string_after local_bin 5) [];
	  (*raise Not_supported; *)
      | 'm' -> (* BINARY_EXT *)
	  let len = make_int32 (String.sub local_bin 1 5) in
	  let remain = Str.string_after local_bin 5 in (* TODO: you'd better use Str.split *)
	    Ok( Binary( Str.string_before remain len ),  Str.string_after remain len );
      | 'n' -> (* SMALL_BIG_EXT *)
	  let n = int_of_char (String.get local_bin 1) in
	  let sign = int_of_char  (String.get local_bin 2) in
	  let result = make_small_bigint (String.sub local_bin 3 n) n in
	    if sign=0 then 
	      Ok( Int(result), Str.string_after local_bin (n+3) )
	    else if sign=1 then
	      Ok( Int(-result), Str.string_after local_bin (n+3) )
	    else 
	      raise Unknown_type;
      | 'o' -> (* LARGE_BIG_EXT *)
	  let n = make_int32 local_bin in
	  let sign = int_of_char  (String.get local_bin 5) in
	  let result = make_small_bigint (String.sub local_bin 6 n) n in
	    if sign=0 then 
	      Ok( Int(result), Str.string_after local_bin (n+6) )
	    else if sign=1 then
	      Ok( Int(-result), Str.string_after local_bin (n+6) )
	    else 
	      raise Unknown_type;
      | 'p' -> (* NEW_REFERENCE_EXT *)
	  raise Not_supported;
      | 'q' -> (* SMALL_ATOM_EXT *)
	  let len = int_of_char (String.get local_bin 1) in   
	    Ok( Atom( String.sub local_bin 2 len ), Str.string_after local_bin (len+2) );
      | 'r' -> (* FUN_EXT *)
	  raise Not_supported;	    
      | 's' -> (* NEW_FUN_EXT *)
	  raise Not_supported;	    
      | 't' -> (* EXPORT_EXT *)
	  raise Not_supported;	    
      | 'M' -> (* BIT_BINARY_EXT *)
	  raise Not_supported;
      | 'F' -> (* NEW_FLOAT_EXT *)
	  raise Not_supported;
      | _-> 
	  raise Unknown_type;
    end in
    begin match int_of_char (String.get bin 0) with
      | 131 -> (* magic number for BERT term; *)
	  local_decode (Str.string_after bin 1);
      | _ -> 
	  raise Unknown_type;
    end;;

let print_binary bin = 
  let rec to_inverse_list bin_ list = 
    if (String.length bin_)>0 then
      to_inverse_list (Str.string_after bin_ 1) ((int_of_char (String.get bin_ 0))::list)
    else list
  in
  let strs = List.fold_left (fun l c-> (Printf.sprintf "%.2x" c)::l ) [] (to_inverse_list bin []) in
  let s = String.concat "," strs in
    Printf.printf "<<%s>>" s;;

let print_erlterm term = 
  let rec print_termlist rhs list =
    begin match list with
      | [] -> print_char rhs;
      | a::[] -> begin 
	  print_term a;
	  print_char rhs;
	end;
      | hd::tl -> begin
	  print_term hd;
	  print_string ", ";   (* erlang way *)
	  print_termlist rhs tl;
	end;
    end
  and print_term t = 
    begin match t with
      | Nil ->
	  print_string "Nil";
      | Int(i)-> Printf.printf "%d" i;
      | Float(f)-> Printf.printf "%f" f;
      | Tuple(tpl)-> begin
	  print_char '{';  (* erlang way *)
	  print_termlist '}' tpl;
	end;
      | List(list)-> begin
	  print_char '[';    (* erlang way *)
	  print_termlist ']' list; 
	end;
      | String(str)->
	  print_char '"';
	  print_string str;
	  print_char '"';
      | Binary(bin)->
	  print_binary bin;
      | Atom(atom)->
	  print_string atom;
(*      | _->
	  raise Unknown_type; *)
    end in
    print_term term;
    print_char '.';;

let print_binary_string bin = 
  let width = 16 in
  let rec print_ n =
    if n < String.length bin then begin
      if (n mod width) = 0 then Printf.printf "%.4X: " n;
      Printf.printf "%.2X " (int_of_char (String.get bin n));
      if (n mod width) = (width-1) then print_endline "";
      print_ (n+1);
    end else 
      print_endline ""
  in
    print_ 0;;

(** these funcs have typical signature:
    [encode_* term buffer offset] -> offset + bytes_written **)

let encode_int i buf ofs =
  if i < 256 then (* SMALL_INTEGER_EXT *)
    begin 
      String.set buf ofs 'a';
      String.set buf (ofs+1) (char_of_int i);
      2+ofs;
    end
  else if i < 0xFFFFFFFF then (* INTEGER_EXT *)
    begin
      let (a,b,c,d) = encode_int32 i in
	String.set buf ofs 'b';
	String.set buf (ofs+1) a;
	String.set buf (ofs+2) b;
	String.set buf (ofs+3) c;
	String.set buf (ofs+4) d;
	5+ofs;
    end
  else (* SMALL_BIG_EXT *) 
    raise Not_supported;;
(**    begin String.set buf ofs 'n'; 1 end;; (* LARGE_BIG_EXT -> "o" *) **)

let encode_float f buf ofs = 
   (* FLOAT_EXT 'c' *)
  let str = Printf.sprintf "c%.20e" f in
  let len = min (String.length buf - ofs) (String.length str) in
    String.blit str 0 buf ofs len;
    32+ofs;;

let encode_atom atom buf ofs=
  let len = String.length atom in
    if len < 256 then (* SMALL_ATOM_EXT *)
      let str = Printf.sprintf "q %s" atom in
	begin 
	  String.set str 1 (char_of_int len);
	  String.blit str 0 buf ofs (len+2);
	  ofs + String.length str;
	end
    else (* ATOM_EXT *)
      let str = Printf.sprintf "d  %s" atom in
	begin
	  String.set str 1 (char_of_int (len/256));
	  String.set str 2 (char_of_int (len mod 256));
	  String.blit str 0 buf ofs (len+3);
	  ofs + String.length str;
	end;;

let encode_string str buf ofs =   (* STRING_EXT *) 
  let len = String.length str in
  let tmp_str = Printf.sprintf "k12%s" str in
    String.set tmp_str 1 (char_of_int (len/256));
    String.set tmp_str 2 (char_of_int (len mod 256));
    String.blit tmp_str 0 buf ofs (len+3);
    ofs + (String.length tmp_str);;

let encode_binary bin buf ofs = (* BINARY_EXT *)
  let str = Printf.sprintf "mabcd%s" bin in
  let (a,b,c,d) = encode_int32 (String.length bin) in
    String.set str 1 a;
    String.set str 2 b;
    String.set str 3 c;
    String.set str 4 d;
    String.blit str 0 buf ofs (String.length str);
    ofs + String.length str;;

let rec encode_tuple tuple buf ofs =
  let rec enc_tuple_ l nofs =
    match l with
      | [] -> nofs;
      | hd::tl -> 
	  let offset = encode_term hd buf nofs in
	    enc_tuple_ tl offset
  in
  let len = List.length tuple in
    if List.length tuple < 256 then begin (* SMALL_TUPLE_EXT *)
      String.set buf 0 'h';
      String.set buf 1 (char_of_int len);
      enc_tuple_ tuple (ofs+2);
    end else begin
      (* LARGE_TUPLE_EXT *)
      let (a,b,c,d) = encode_int32 len in
	String.set buf 0 'i';
	String.set buf 1 a;
	String.set buf 2 b;
	String.set buf 3 c;
	String.set buf 4 d;
	enc_tuple_ tuple (ofs+5);
    end

and encode_list list buf ofs = (* LIST_EXT *)
  let rec enc_list_ l nofs =
    match l with
      | [] -> nofs;
      | hd::tl ->
	  let offset = encode_term hd buf nofs in
	    enc_list_ tl offset 
  in
  let len = List.length list in
    String.set buf 0 'l';
    String.set buf 1 (char_of_int len);
    enc_list_ list (ofs+2)
      
and encode_term term buf ofs =
  String.set buf ofs (char_of_int 131);
  match term with
    | Int(i) ->   encode_int i buf (ofs+1); 
    | Float(f) -> encode_float f buf (ofs+1);
    | Atom(a)->   encode_atom a buf (ofs+1);
    | String(s)-> encode_string s buf (ofs+1);
    | Binary(b)-> encode_binary b buf (ofs+1);
    | Tuple(t)->  encode_tuple t buf (ofs+1);
    | List(l)->   encode_list l buf (ofs+1);
    | _ -> raise Unknown_type;; 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.