Source

odeci / ocaml / src / odec_port.ml

open ErlangTerm

let precision = 100

let conv_sign = function
  | -1 -> 1
  | 0 -> 0
  | 1 -> 0
  | _ -> assert false (* should not happen *)

(* remove trailing zeroes from mantissa, reduce exponent accordingly *)
let short_decimal mant_str mant_len exp =
  let rec f str idx lexp =
    if idx > 0 && str.[idx] = '0' then
      f str (idx-1) (lexp+1)
    else
      idx, lexp
  in
  let idx, new_exp = f mant_str (mant_len-1) exp in
  let nstr = String.sub mant_str 0 (idx+1) in
  nstr, idx+1, new_exp

let create_decimal n =
  let sign = conv_sign (Num.sign_num n) in
  let str = Num.approx_num_exp precision n in
  let len = String.length str in
  (* how about length's complexity? According to Xavier Leroy: O(1) *)
  let mant_idx = String.index str '.' + 1 in
  let exp_idx = mant_idx + precision + 1 in (* +1 for 'e' *)
  let mant_str = String.sub str mant_idx precision in
  let exp_len = len - exp_idx in
  let exp_str = String.sub str exp_idx exp_len in
  let exp = int_of_string exp_str in
  let short_mant_str, short_mant_len, new_exp =
    short_decimal mant_str precision (exp-precision) in
  let mant = Big_int.big_int_of_string short_mant_str in
  (* Printf.eprintf "cr dec\nnum: %s\nm=%s\nprec=%d, len=%d, exp=%d, nexp=%d\nsm=%s\n%!" *)
  (*   (Num.string_of_num n) *)
  (*   mant_str precision len exp new_exp short_mant_str; *)
  ET_Tuple [ET_Int sign; ET_Bignum (Num.Big_int mant); ET_Int new_exp]

let make_tuple = function
  | ET_Tuple [ET_Int n1; ET_Int n2; ET_Int n3] ->
    (* Printf.eprintf "mk t, int mant: %d\n%!" n2; *)
    Some (n1, Num.num_of_int n2, n3)
  | ET_Tuple [ET_Int n1; ET_Bignum n2; ET_Int n3] ->
    (* Printf.eprintf "mk t, bigint mant: %s\n%!" (Num.string_of_num n2); *)
    Some (n1, n2, n3)
  | _x ->
    (* Printf.eprintf "mk t, other:\n%s\n%!" *)
    (*   (ErlangTerm.string_of_erlang_term _x); *)
    None

let compose_num mant = function
  | pow when pow >= 0 ->
    let ipow = Big_int.power_int_positive_int 10 pow in
    let bpow = Num.Big_int ipow in
    Num.mult_num mant bpow
  | pow ->
    let ipow = Big_int.power_int_positive_int 10 (-pow) in
    let bpow = Num.Big_int ipow in
    Num.div_num mant bpow

let make_num = function
  | Some (0, mant, pow) ->
    Some (compose_num mant pow)
  | Some (1, mant, pow) ->
    Some (Num.minus_num (compose_num mant pow))
  | None ->
    None

let mult_list list =
  let list2 = List.map (
    fun x ->
      let res = make_tuple x in
      (
        match res with
        | Some (_, rnum, _) ->
          (* Printf.eprintf "tm2, l2, f, res: %s\n%!" (Num.string_of_num rnum); *)
          ()
        | _ -> ()
      );
      res
  ) list in
  let list3 = List.map make_num list2 in
  let f acc = function
    | Some x -> Num.mult_num acc x
    | None -> acc
  in
  let res = List.fold_left f (Num.Int 1) list3 in
  (* Printf.eprintf "tm2, res: %s\n%!" (Num.string_of_num res); *)
  ET_Bignum res

let t_mult2 = function
  | ET_List [] ->
    None
  | ET_List list ->
    Some (mult_list list)

let get_info = function
  | ET_Tuple _ -> ET_Atom "tuple"
  (* erlang list [256,2,3] is a list *)
  | ET_List _ -> ET_Atom "list"
  | ET_Int _ -> ET_Atom "int"
  (* erlang list [1,2,3] turns out to be a string *)
  | ET_String _ -> ET_Atom "string"
  | ET_Binary _ -> ET_Atom "binary"
  | _ -> ET_Atom "other"

let sum_list list =
  let list2 = List.map make_tuple list in
  let list3 = List.map make_num list2 in
  let f acc = function
    | Some x -> Num.add_num acc x
    | None -> acc
  in
  let res = List.fold_left f (Num.Int 0) list3 in
  create_decimal res

let subtract d1 d2 =
  let t1 = make_tuple d1 in
  let t2 = make_tuple d2 in
  match t1, t2 with
  | Some _, Some _ ->
    let (Some n1) = make_num t1 in
    let (Some n2) = make_num t2 in
    let res = Num.sub_num n1 n2 in
    let dec_res = create_decimal res in
    ET_Tuple [ET_Atom "ok"; dec_res]
  | _ ->
    ET_Tuple [ET_Atom "error"; ET_Atom "not_decimal"]

let divide d1 d2 =
  let t1 = make_tuple d1 in
  let t2 = make_tuple d2 in
  match t1, t2 with
  | Some _, Some _ ->
    let (Some n1) = make_num t1 in
    let (Some n2) = make_num t2 in
    let res = Num.div_num n1 n2 in
    let dec_res = create_decimal res in
    ET_Tuple [ET_Atom "ok"; dec_res]
  | _ ->
    ET_Tuple [ET_Atom "error"; ET_Atom "not_decimal"]

let multiply_list list =
  match t_mult2 list with
  | Some (ET_Bignum r) ->
    let res2 = create_decimal r in
    Some list, ET_Tuple [ET_Atom "ok"; res2]
  | None ->
    Some list, ET_Tuple [ET_Atom "error"; ET_Atom "no_data"]

let port_command_dispatcher old_value = function
  | ET_Tuple [ET_Atom "forget"; _] ->
    None, ET_Atom "ok"
  | ET_Tuple [ET_Atom "set"; term] ->
    Some term, ET_Atom "ok"
  | ET_Tuple [ET_Atom "get"; _] ->
    old_value, begin match old_value with
        | None -> ET_Tuple [ET_Atom "error"; ET_Atom "no_value"]
        | Some term -> ET_Tuple [ET_Atom "ok"; term]
    end
  | ET_Tuple [ET_Atom "round_trip"; ET_Atom "true"] ->
    Some (ET_Tuple [ET_Atom "round_trip"; ET_Atom "true"]), ET_Atom "ok"
  | ET_Tuple [ET_Atom "round_trip"; ET_Atom "false"] ->
    Some (ET_Tuple [ET_Atom "round_trip"; ET_Atom "false"]), ET_Atom "ok"
  | _ when old_value = Some (ET_Tuple [ET_Atom "round_trip";
                                       ET_Atom "true"]) ->
    let res = ET_Tuple [ET_Atom "ok"; ET_Atom "round_trip"] in
    old_value, res
  | ET_Tuple [ET_Atom "info"; t] ->
    let res = get_info t in
    Some t, res
  | ET_Tuple [ET_Atom "mult_list"; (ET_List [_]) as t] ->
    Some t, ET_Tuple [ET_Atom "error"; ET_Atom "need_list_to_multiply"]
  | ET_Tuple [ET_Atom "mult_list"; (ET_List _) as t] ->
    multiply_list t
  | ET_Tuple [ET_Atom "sum_list"; (ET_List list) as t] ->
    let res = sum_list list in
    Some t, ET_Tuple [ET_Atom "ok"; res]
  | (ET_Tuple [ET_Atom "add"; t1; t2]) as t ->
    let res = sum_list [t1; t2] in
    Some t, ET_Tuple [ET_Atom "ok"; res]
  | (ET_Tuple [ET_Atom "subtract"; t1; t2]) as t ->
    let res = subtract t1 t2 in
    Some t, res
  | ET_Tuple [ET_Atom "multiply"; t1; t2] ->
    multiply_list (ET_List [t1; t2])
  | (ET_Tuple [ET_Atom "divide"; t1; t2]) as t ->
    let res = divide t1 t2 in
    Some t, res
  | _ -> raise (Failure "Unknown command")
  ;;

ErlangPort.erlang_port_interact_with_key port_command_dispatcher None