Source

ocaml-bert / bert.ml

Full commit
UENISHI Kota 98e42ef 







UENISHI Kota 9a3b9b5 














UENISHI Kota 98e42ef 


UENISHI Kota b8bd721 
UENISHI Kota 3d6a887 

UENISHI Kota b8bd721 






UENISHI Kota 3d6a887 
UENISHI Kota b8bd721 
UENISHI Kota 98e42ef 









































































































UENISHI Kota 19d1fed 
UENISHI Kota aa8b121 







UENISHI Kota 19d1fed 
UENISHI Kota aa8b121 





































open Str;;

(*
class pid = let a in 1;;
class ref = let a in 1;;
class port = Not_supported;;
*)

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

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

exception Not_supported;;
exception Unknown_type;;

let print_binary bin = 
  print_endline "------------------------------";;
  (*
  let rec print_ n =
    if n < String.length bin then begin 
      print_int (int_of_char (String.get bin n));
      print_ (n+1);
    end else 
      print_endline " ahoge  .. "
  in
    print_ 0;; *)

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 = 
  let rec decode_list len binary list = 
    if len = 0 then
      Ok(List(list), binary)
    else 
      begin match local_decode binary with
	| Ok(t, remain) ->  decode_list (len-1) remain (t::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 1)
      | '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 *)
	  raise Not_supported;
      | '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_list 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_list len (Str.string_after local_bin 5) []; (* is it OK to use list? *)
      | 'j' -> (* NIL_EXT *)
	  None;
      | '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+3) ), 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+3)) 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+6)) 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 *)
	  raise Not_supported;	    
      | '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 (String.sub bin 1 ((String.length bin)-1)); 
      | _ -> raise Unknown_type;
    end;;

let print_binary bin = 
  let rec p_bin i =
    if i < (String.length bin) then begin
      Printf.printf " %c" (String.get bin i);
      p_bin (i+1)
    end in
    p_bin 0 ;;

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
      | 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_string str;
      | Binary(bin)-> begin
	  print_string "<<";
	  print_binary bin ;
	  print_string ">>";
	end;
(*      | None ->
	  print_string "Nil"; *)
      | _->
	  raise Unknown_type;
    end in
    print_term term;
    print_char '.';;