Source

ocaml-bert / bert.ml

Full commit
UENISHI Kota 98e42ef 

UENISHI Kota 9a3b9b5 


UENISHI Kota ce038fb 
UENISHI Kota 9a3b9b5 



UENISHI Kota 86a4538 
UENISHI Kota 9a3b9b5 





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 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 











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;;

(* 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 3 len ), Str.string_after local_bin (len+3) );
      | '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;;